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: api.tcl 00020 # Author: Trevor Williams (trevorw@sgi.com) 00021 # Date: 07/09/2013 00022 # Brief: Provides user API to tke functionality. 00023 ###################################################################### 00024 00025 namespace eval api { 00026 00027 ###################################################################### 00028 ## \return Returns true if we are doing tke_development. 00029 proc tke_development {interp pname} { 00030 00031 return [::tke_development] 00032 00033 } 00034 00035 ###################################################################### 00036 ## \return Returns the pathname to the plugin source directory. 00037 proc get_plugin_source_directory {interp pname} { 00038 00039 set iplugin_dir [file join $::tke_home iplugins $pname] 00040 00041 if {![file exists $iplugin_dir]} { 00042 set iplugin_dir [file join $::tke_dir plugins $pname] 00043 } 00044 00045 if {[$interp issafe]} { 00046 return [::safe::interpFindInAccessPath $interp $iplugin_dir] 00047 } else { 00048 return $iplugin_dir 00049 } 00050 00051 } 00052 00053 ###################################################################### 00054 ## \return Returns the pathname to the plugin data directory. 00055 proc get_plugin_data_directory {interp pname} { 00056 00057 set plugin_dir [file join $::tke_home plugins $pname] 00058 00059 # Create the plugin directory if it does not exist 00060 if {![file exists $plugin_dir]} { 00061 catch { file mkdir $plugin_dir } 00062 } 00063 00064 if {[$interp issafe]} { 00065 return [::safe::interpFindInAccessPath $interp $plugin_dir] 00066 } else { 00067 return $plugin_dir 00068 } 00069 00070 } 00071 00072 ###################################################################### 00073 ## \return Returns the pathname to the tke plugin images directory. 00074 proc get_images_directory {interp pname} { 00075 00076 set img_dir [file join $::tke_dir plugins images] 00077 00078 if {[$interp issafe]} { 00079 return [::safe::interpFindInAccessPath $interp $img_dir] 00080 } else { 00081 return $img_dir 00082 } 00083 00084 } 00085 00086 ###################################################################### 00087 ## \return Returns the pathname to the user's home tke directory. 00088 proc get_home_directory {interp pname} { 00089 00090 # Figure out the home directory 00091 set home [file join $::tke_home plugins $pname] 00092 00093 # If the home directory does not exist, create it 00094 file mkdir $home 00095 00096 if {[$interp issafe]} { 00097 return [::safe::interpFindInAccessPath $interp $home] 00098 } else { 00099 return $home 00100 } 00101 00102 } 00103 00104 ###################################################################### 00105 ## \return Returns a fully NFS normalized filename based on the given host. 00106 # 00107 # \param host Name of the host that contains the filename 00108 # \param fname Name of the file to normalize 00109 proc normalize_filename {interp pname host fname} { 00110 00111 return [files::normalize $host $fname] 00112 00113 } 00114 00115 ###################################################################### 00116 ## Registers the given description and command in the command launcher. 00117 proc register_launcher {interp pname description command} { 00118 00119 launcher::register [format "%s-%s: %s" [msgcat::mc "Plugin"] $pname $description] "$interp eval $command" 00120 00121 } 00122 00123 ###################################################################### 00124 ## Unregisters a previously registered command launcher with the same 00125 # description. 00126 proc unregister_launcher {interp pname description} { 00127 00128 launcher::unregister [format "%s-%s: %s" [msgcat::mc "Plugin"] $pname $description] 00129 00130 } 00131 00132 ###################################################################### 00133 ## Logs the given information in the diagnostic logfile and standard 00134 # output. 00135 # 00136 # \param msg Message to display. 00137 proc log {interp pname msg} { 00138 00139 puts $msg 00140 00141 } 00142 00143 ###################################################################### 00144 ## Displays the given message string in the information bar. The 00145 # message must not contain any newline characters. 00146 # 00147 # \param msg Message to display in the information bar 00148 # \param args Optional arguments: 00149 # 00150 # -clear_delay Specifies the number of milliseconds before the message 00151 # be automatically removed from sight. 00152 # -win If specified, the associated text widget path will be 00153 # associated with the message such that if the text 00154 # loses focus and then later regains the focus, the message 00155 # will be redisplayed. 00156 proc show_info {interp pname msg args} { 00157 00158 # Displays the given message 00159 gui::set_info_message $msg {*}$args 00160 00161 } 00162 00163 ###################################################################### 00164 ## Displays the given error message with detail information in a popup 00165 # dialog window. 00166 # 00167 # \param msg Main error message 00168 # \param detail Error message detailed information 00169 proc show_error {interp pname msg {detail ""}} { 00170 00171 gui::set_error_message $msg $detail 00172 00173 } 00174 00175 ###################################################################### 00176 ## Displays a widget that allows the user to provide input. This 00177 # procedure will block until the user has either provided a response 00178 # or has cancelled the input by hitting the escape key. 00179 # 00180 # \param msg Message to display next to input field (prompt) 00181 # \param pvar Reference to variable to store user input to 00182 # \param allow_vars If set to 1, variables embedded in string will have 00183 # substitutions performed; otherwise, the raw string 00184 # will be returned. (Optional) 00185 # 00186 # \return Returns a list containing two elements. The first element is set to a 00187 # 1 if the user provided input; otherwise, returns 0 to indicate that the 00188 # user cancelled the input operation. The second item is the user provided 00189 # value (if the first value is set to 1). 00190 proc get_user_input {interp pname msg pvar {allow_vars 1}} { 00191 00192 set var [$interp eval set $pvar] 00193 00194 if {[gui::get_user_response $msg var -allow_vars $allow_vars]} { 00195 $interp eval set $pvar [list $var] 00196 return 1 00197 } 00198 00199 return 0 00200 00201 } 00202 00203 ###################################################################### 00204 ## Sets the text focus back to the last text widget to receive focus. 00205 proc reset_text_focus {interp pname {txtt ""}} { 00206 00207 if {$txtt eq ""} { 00208 after idle [list gui::set_txt_focus [gui::last_txt_focus]] 00209 } else { 00210 gui::get_info [winfo parent $txtt] txt tabbar tab 00211 after idle [list gui::set_current_tab $tabbar $tab] 00212 } 00213 00214 } 00215 00216 namespace eval file { 00217 00218 ###################################################################### 00219 ## \return Returns a list containing indices for all of the currently 00220 # opened files. 00221 proc all_indices {interp pname} { 00222 00223 return [files::get_indices fname] 00224 00225 } 00226 00227 ###################################################################### 00228 ## \return Returns the file index of the file being currently edited. If no 00229 # such file exists, returns a value of -1. 00230 proc current_index {interp pname} { 00231 00232 return [expr {[catch { gui::get_info {} current fileindex } index] ? -1 : $index}] 00233 00234 } 00235 00236 ###################################################################### 00237 ## \return Returns the file information at the given file index. 00238 # 00239 # \param file_index Unique file identifier that is passed to some plugins. 00240 # \param attr File attribute to retrieve. The following values are 00241 # valid for this option: 00242 # - \b fname : Normalized file name 00243 # - \b mtime : Last mofication timestamp (in seconds) 00244 # - \b lock : Specifies the current lock status of the file 00245 # - \b readonly : Specifies if the file is readonly 00246 # - \b modified : Specifies if the file has been modified since the last save. 00247 # - \b sb_index : Specifies the index of the file in the sidebar. 00248 # - \b txt : Specifies the text widget associated with the file 00249 # - \b current : Returns 1 if the file is the current file being edited 00250 # - \b vimmode : Returns 1 if the editor is not in edit mode; otherwise, 00251 # returns 0. 00252 # - \b lang : Returns the syntax language. 00253 proc get_info {interp pname file_index attr} { 00254 00255 set value [gui::get_file_info $file_index $attr] 00256 00257 if {$attr eq "txt"} { 00258 interpreter::add_ctext $interp $pname [winfo parent $value] 00259 } 00260 00261 return $value 00262 00263 } 00264 00265 ###################################################################### 00266 ## Adds a buffer to the browser. The first option is the name of the 00267 # buffer. The second option is a command to execute once the save 00268 # is successful. The remaining arguments are the following options: 00269 # 00270 # 00271 proc add_buffer {interp pname name save_command args} { 00272 00273 array set opts [list] 00274 00275 # If we have an odd number of arguments, we have an error condition 00276 if {[expr [llength $args] % 2] == 1} { 00277 return -code error [msgcat::mc "Argument list to api::add_file was not an even key/value pair"] 00278 } 00279 00280 # Get the options 00281 array set opts $args 00282 00283 # Change out the gutter commands with interpreter versions 00284 if {[info exists opts(-gutters)]} { 00285 set new_gutters [list] 00286 foreach gutter $opts(-gutters) { 00287 set new_sym [list] 00288 foreach {symname symopts} [lassign $gutter gutter_name] { 00289 set new_symopts [list] 00290 foreach {symopt symval} $symopts { 00291 switch $symopt { 00292 "-onenter" - 00293 "-onleave" - 00294 "-onclick" { 00295 lappend new_symopts $symopt "$interp eval $symval" 00296 } 00297 default { 00298 lappend new_symopts $symopt $symval 00299 } 00300 } 00301 } 00302 lappend new_sym $symname $new_symopts 00303 } 00304 lappend new_gutters [list $gutter_name {*}$new_sym] 00305 } 00306 set opts(-gutters) $new_gutters 00307 } 00308 00309 # Set the tags 00310 if {[info exists opts(-tags)]} { 00311 set tag_list [list] 00312 foreach tag $opts(-tags) { 00313 lappend tag_list "plugin__${pname}__$tag" 00314 } 00315 set opts(-tags) $tag_list 00316 } 00317 00318 # If the save command was specified, add the interpreter evaluation 00319 if {$save_command ne ""} { 00320 set save_command "$interp eval $save_command" 00321 } 00322 00323 # Finally, add the buffer 00324 gui::add_buffer end $name $save_command {*}[array get opts] 00325 00326 # Allow the plugin to manipulate the ctext widget 00327 set txt [gui::current_txt] 00328 $interp alias $txt $txt 00329 00330 return $txt 00331 00332 } 00333 00334 ###################################################################### 00335 ## Adds a file to the browser. If the first argument does not start with 00336 # a '-' character, the argument is considered to be the name of a file 00337 # to add. If no filename is specified, an empty/unnamed file will be added. 00338 # All other options are considered to be parameters. 00339 # 00340 # -savecommand \e command 00341 # * Specifies the name of a command to execute after 00342 # the file is saved. 00343 # 00344 # -lock (0|1) 00345 # * If set to 0, the file will begin in the unlocked 00346 # state (i.e., the user can edit the file immediately). 00347 # * If set to 1, the file will begin in the locked state 00348 # (i.e., the user must unlock the file to edit it) 00349 # 00350 # -readonly (0|1) 00351 # * If set to 1, the file will be considered readonly 00352 # (i.e., the file will be locked indefinitely); otherwise, 00353 # the file will be able to be edited. 00354 # 00355 # -remember (0|1) 00356 # * If set to 0, the file will not be saved to the user's session file 00357 # when the application is quit. By default, the file will be 00358 # remembered and reloaded when the application is reopened. 00359 # 00360 # -sidebar (0|1) 00361 # * If set to 1 (default), the file's directory contents 00362 # will be included in the sidebar; otherwise, the file's 00363 # directory components will not be added to the sidebar. 00364 # 00365 # -saveas (0|1) 00366 # * If set to 0 (default), the file will be saved to the 00367 # current file; otherwise, the file will always force a 00368 # save as dialog to be displayed when saving. 00369 # 00370 # -buffer (0|1) 00371 # * If set to 0 (default), the file will be added as a normal file; 00372 # however, if set to 1, the file will be treated as a temporary file 00373 # that will be automatically deleted when the tab is closed. 00374 # 00375 # -diff (0|1) 00376 # * If set to 0 (default), the file will be added as an editable file; 00377 # however, if set to 1, the file will be inserted as a difference viewer, 00378 # allowing the user to view file differences visually within the editor. 00379 # 00380 # -gutters \e list 00381 # * Creates a gutter in the editor. The contents of list are as follows: 00382 # \code {name {{symbol_name {symbol_tag_options+}}+}}+ \endcode 00383 # For a list of valid symbol_tag_options, see the options available for 00384 # tags in a text widget. 00385 # 00386 # -other (0|1) 00387 # * If set to 0 (default), the file will be created in a new tab in the 00388 # current pane; however, if set to 1, the file will be created in a new 00389 # tab in the other pane (the other pane will be created if it does not 00390 # exist). 00391 # 00392 # -tags \e list 00393 # * A list of plugin bindtag suffixes that will be applied only to this 00394 # this text widget. 00395 # 00396 # -name \e filename 00397 # * If this option is specified when the filename is not specified, it will 00398 # add a new tab to the editor whose name matches the given name. If the 00399 # user saves the file, the contents will be saved to disk with the given 00400 # file name. The given filename does not need to exist prior to calling 00401 # this procedure. 00402 proc add_file {interp pname args} { 00403 00404 set fname "" 00405 array set opts [list] 00406 00407 # If no filename is given, add a new file to the editor 00408 if {([llength $args] > 0) && ([string index [lindex $args 0] 0] ne "-")} { 00409 00410 # Peel the filename from the rest of the arguments 00411 set args [lassign $args fname] 00412 00413 # Check to make sure that the file is safe to add to the editor, and 00414 # if it is, create the normalized pathname of the filename. 00415 if {[set fname [interpreter::check_file $pname $fname]] eq ""} { 00416 return -code error "permission error" 00417 } 00418 00419 } 00420 00421 # If we have an odd number of arguments, we have an error condition 00422 if {[expr [llength $args] % 2] == 1} { 00423 return -code error [msgcat::mc "Argument list to api::add_file was not an even key/value pair"] 00424 } 00425 00426 # Get the options 00427 array set opts $args 00428 00429 # If the -savecommand option was given, wrap it in an interp eval call 00430 # so that we don't execute the command in the master interpreter. 00431 if {[info exists opts(-savecommand)]} { 00432 set opts(-savecommand) "$interp eval $opts(-savecommand)" 00433 } 00434 00435 # Change out the gutter commands with interpreter versions 00436 if {[info exists opts(-gutters)]} { 00437 set new_gutters [list] 00438 foreach gutter $opts(-gutters) { 00439 set new_sym [list] 00440 foreach {symname symopts} [lassign $gutter gutter_name] { 00441 set new_symopts [list] 00442 foreach {symopt symval} $symopts { 00443 switch $symopt { 00444 "-onenter" - 00445 "-onleave" - 00446 "-onclick" { 00447 lappend new_symopts $symopt "$interp eval $symval" 00448 } 00449 default { 00450 lappend new_symopts $symopt $symval 00451 } 00452 } 00453 } 00454 lappend new_sym $symname $new_symopts 00455 } 00456 lappend new_gutters [list $gutter_name {*}$new_sym] 00457 } 00458 set opts(-gutters) $new_gutters 00459 } 00460 00461 # Set the tags 00462 if {[info exists opts(-tags)]} { 00463 set tag_list [list] 00464 foreach tag $opts(-tags) { 00465 lappend tag_list "plugin__${pname}__$tag" 00466 } 00467 set opts(-tags) $tag_list 00468 } 00469 00470 # Finally, add the new file 00471 if {$fname eq ""} { 00472 gui::add_new_file end {*}[array get opts] 00473 } else { 00474 gui::add_file end $fname {*}[array get opts] 00475 } 00476 00477 # Allow the plugin to manipulate the ctext widget 00478 set txt [gui::current_txt] 00479 $interp alias $txt $txt 00480 00481 return $txt 00482 00483 } 00484 00485 } 00486 00487 namespace eval edit { 00488 00489 ###################################################################### 00490 ## \return Returns the text widget index based on the given input 00491 # parameters. 00492 # 00493 # \param txt Pathname of text widget to get index of. 00494 # \param position The specifies the visible cursor position to lookup. The 00495 # values that can be used for this option are as follows: 00496 # - left Index num characters left of the starting position, staying on the same line. 00497 # - right Index num characters right of the starting position, staying on the same line. 00498 # - up Index above the starting position, remaining in the same 00499 # column, if possible. 00500 # - down Index below the starting position, remaining in the same 00501 # column, if possible. 00502 # - first Index of the first line/column in the buffer. 00503 # - last Index of the last line/column in the buffer. 00504 # - char Index of the a specified character before or after the starting 00505 # position. 00506 # - dchar Index of num'th character before or after the starting 00507 # position. 00508 # - findchar Index of a specified character before or after the starting 00509 # position. 00510 # - firstchar Index of first non-whitespace character of the line specified 00511 # by startpos. 00512 # - lastchar Index of last non-whitespace character of the line specified 00513 # by startpos. 00514 # - wordstart Index of the first character of the word containing startpos. 00515 # - wordend Index of the last character+1 of the word containing startpos. 00516 # - WORDstart Index of the first character of the WORD containing startpos. 00517 # - WORDend Index of the last character+1 of the WORD containing startpos. 00518 # - column Index of the character in the line containing startpos at the 00519 # num'th position. 00520 # - linenum Index of the first non-whitespace character on the given line. 00521 # - linestart Index of the beginning of the line containing startpos. 00522 # - lineend Index of the ending of the line containing startpos. 00523 # - dispstart Index of the first character that is displayed in the line 00524 # containing startpos. 00525 # - dispmid Index of the middle-most character that is displayed in the 00526 # line containing startpos. 00527 # - dispend Index of the last character that is displayed in the line 00528 # containing startpos. 00529 # - screentop Index of the start of the first line that is displayed in 00530 # the buffer. 00531 # - screenmid Index of the start of the middle-most line that is displayed 00532 # in the buffer. 00533 # - screenbot Index of the start of the last line that is displayed in 00534 # the buffer. 00535 # - numberstart First numerical character of the word containing startpos. 00536 # - numberend Last numerical character of the word containing startpos. 00537 # - spacestart First whitespace character of the whitespace containing startpos. 00538 # - spaceend Last whitespace character of the whitespace containing startpos. 00539 # \param args Modifier arguments based on position value. 00540 # -dir Specifies direction from starting position (values are "next" 00541 # or "prev"). Defaults to "next". 00542 # -startpos Specifies the starting index of calculation. Defaults to "insert". 00543 # -num Specifies the number to apply. Defaults to 1. 00544 # -char Used with "findchar" position type. Specifies the character 00545 # to find. 00546 # -exclusive If set to 1, returns character position before calculated 00547 # index. Defaults to 0. 00548 # -column Specifies the name of a variable containing the column to 00549 # use for "up" and "down" positions. 00550 # -adjust Adjusts the calculated index by the given value before 00551 # returning the result. 00552 proc get_index {interp pname txt position args} { 00553 00554 return [edit::get_index $txt $position {*}$args] 00555 00556 } 00557 00558 ###################################################################### 00559 ## Deletes all characters between startpos and endpos-1, inclusive. 00560 # 00561 # \param txt Pathname of text widget to delete text from. 00562 # \param startpos Text widget index to begin deleting from. 00563 # \param endpos Text widget index to stop deleting from. 00564 # \param copy Copies deleted text to the clipboard. 00565 proc delete {interp pname txt startpos endpos copy} { 00566 00567 edit::delete $txt $startpos $endpos $copy 1 00568 00569 } 00570 00571 ###################################################################### 00572 ## Toggles the case of all characters in the range of startpos to endpos-1, 00573 # inclusive. If text is selected, the selected text is toggled instead 00574 # of the given range. 00575 # 00576 # \param txt Text widget to modify. 00577 # \param startpos Starting index of range to modify. 00578 # \param endpos Ending index of range to modify. 00579 proc toggle_case {interp pname txt startpos endpos} { 00580 00581 edit::transform_toggle_case $txt $startpos $endpos 00582 00583 } 00584 00585 ###################################################################### 00586 ## Transforms all text in the given range of startpos to endpos-1, 00587 # inclusive, to lower case. If text is seelected, the selected text 00588 # is transformed instead of the given range. 00589 # 00590 # \param txt Text widget to modify. 00591 # \param startpos Starting index of range to modify. 00592 # \param endpos Ending index of range to modify. 00593 proc lower_case {interp pname txt startpos endpos} { 00594 00595 edit::transform_to_lower_case $txt $startpos $endpos 00596 00597 } 00598 00599 ###################################################################### 00600 ## Transforms all text in the given range of startpos to endpos-1, 00601 # inclusive, to upper case. If text is selected, the selected text 00602 # is transformed instead of the given range. 00603 # 00604 # \param txt Text widget to modify. 00605 # \param startpos Starting index of range to modify. 00606 # \param endpos Ending index of range to modify. 00607 proc upper_case {interp pname txt startpos endpos} { 00608 00609 edit::transform_to_upper_case $txt $startpos $endpos 00610 00611 } 00612 00613 ###################################################################### 00614 ## Transforms all text in the given range of startpos to endpos-1, 00615 # inclusive, to its rot13 equivalent. If text is selected, the 00616 # selected text is transformed instead of the given range. 00617 # 00618 # \param txt Text widget to modify. 00619 # \param startpos Starting index of range to modify. 00620 # \param endpos Ending index of range to modify. 00621 proc rot13 {interp pname txt startpos endpos} { 00622 00623 edit::transform_to_rot13 $txt $startpos $endpos 00624 00625 } 00626 00627 ###################################################################### 00628 ## Transforms all text in the given range of startpos to endpos-1, 00629 # inclusive, to title case (first character of each word is capitalized 00630 # while the rest of the characters are set to lowercase). 00631 # 00632 # \param txt Text widget to modify. 00633 # \param startpos Starting index of range to modify. 00634 # \param endpos Ending index of range to modify. 00635 proc title_case {interp pname txt startpos endpos} { 00636 00637 edit::transform_to_title_case $txt $startpos $endpos 00638 00639 } 00640 00641 ###################################################################### 00642 ## Joins the given number of lines, guaranteeing that on a single space 00643 # separates the text of each joined line, starting at the current 00644 # insertion cursor position. If text is selected, any line that contains 00645 # a selection will be joined together. 00646 # 00647 # \param txt Text widget to modify. 00648 # \param num Number of lines to join below current line. 00649 proc join_lines {interp pname txt {num 1}} { 00650 00651 edit::transform_join_lines $txt $num 00652 00653 } 00654 00655 ###################################################################### 00656 ## Moves the current line up by one (unless the current line is the 00657 # first line in the buffer. If any text is selected, lines containing 00658 # a selection will be moved up by one line. 00659 # 00660 # \param txt Text widget to change. 00661 proc bubble_up {interp pname txt} { 00662 00663 edit::transform_bubble_up $txt 00664 00665 } 00666 00667 ###################################################################### 00668 ## Moves the current line down by one (unless the current line is the 00669 # last line in the buffer. If any text is selected, lines containing 00670 # a selection will be moved down by one line. 00671 # 00672 # \param txt Text widget to change. 00673 proc bubble_down {interp pname txt} { 00674 00675 edit::transform_bubble_down $txt 00676 00677 } 00678 00679 ###################################################################### 00680 ## Comments the currently selected lines. 00681 # 00682 # \param txt Text widget to comment. 00683 proc comment {interp pname txt} { 00684 00685 edit::comment_text [winfo parent $txt] 00686 00687 } 00688 00689 ###################################################################### 00690 ## Uncomments the currently selected lines. 00691 # 00692 # \param txt Text widget to uncomment. 00693 proc uncomment {interp pname txt} { 00694 00695 edit::uncomment_text [winfo parent $txt] 00696 00697 } 00698 00699 ###################################################################### 00700 ## Toggles the comment status of the currently selected lines. 00701 # 00702 # \param txt Text widget to change. 00703 proc toggle_comment {interp pname txt} { 00704 00705 edit::comment_toggle_text [winfo parent $txt] 00706 00707 } 00708 00709 ###################################################################### 00710 ## Indents the given range of text between startpos and endpos-1, inclusive, 00711 # by one level of indentation. If text is currently selected, the 00712 # selected text is indented instead. 00713 # 00714 # \param txt Text widget to indent. 00715 # \param startpos Starting position of range to indent. 00716 # \param endpos Ending position of range to indent. 00717 proc indent {interp pname txt {startpos insert} {endpos insert}} { 00718 00719 edit::indent $txt $startpos $endpos 00720 00721 } 00722 00723 ###################################################################### 00724 ## Unindents the given range of text between startpos and endpos-1, 00725 # inclusive, by one level of indentation. If text is currently 00726 # selected, the selected text is unindented instead. 00727 # 00728 # \param txt Text widget to unindent. 00729 # \param startpos Starting position of range to unindent. 00730 # \param endpos Ending position of range to unindent. 00731 proc unindent {interp pname txt {startpos insert} {endpos insert}} { 00732 00733 edit::unindent $txt $startpos $endpos 00734 00735 } 00736 00737 ###################################################################### 00738 ## Moves the cursor to the given cursor position. The value of position 00739 # and args are the same as those of the \ref api::edit::get_index. 00740 # 00741 # \param txt Text widget to change the cursor of. 00742 # \param position Position to move the cursor to (see \ref api::edit::get_index) 00743 # \param args List of arguments based on position value (see \ref api::edit::get_index) 00744 proc move_cursor {interp pname txt position args} { 00745 00746 edit::move_cursor $txt $position {*}$args 00747 00748 } 00749 00750 ###################################################################### 00751 ## Adds text formatting to current word of the given type. If text is 00752 # currently selected, the formatting will be applied to all of the 00753 # selected text. 00754 # 00755 # \param txt Text widget to apply formatting to. 00756 # \param type Type of formatting to apply. The available formats 00757 # supported by the current syntax are allowed. The legal 00758 # values for this 00759 # parameter are as follows: 00760 # - bold 00761 # - italics 00762 # - underline 00763 # - strikethrough 00764 # - highlight 00765 # - superscript 00766 # - subscript 00767 # - code 00768 # - header1 00769 # - header2 00770 # - header3 00771 # - header4 00772 # - header5 00773 # - header6 00774 # - unordered 00775 # - ordered 00776 proc format {interp pname txt type} { 00777 00778 edit::format $txt $type 00779 00780 } 00781 00782 ###################################################################### 00783 ## Removes any formatting that is applied to the selected text. 00784 # 00785 # \param txt Text widget to unformat. 00786 proc unformat {interp pname txt} { 00787 00788 edit::unformat $txt 00789 00790 } 00791 00792 } 00793 00794 namespace eval sidebar { 00795 00796 ###################################################################### 00797 ## \return Returns the selected sidebar file index. 00798 proc get_selected_indices {interp pname} { 00799 00800 return [::sidebar::get_selected_indices] 00801 00802 } 00803 00804 ###################################################################### 00805 ## \return Returns the value for the specified attribute of the 00806 # file/directory in the sidebar with the given index. 00807 # 00808 # \param sb_index Sidebar index of file/directory in the sidebar 00809 # \param attr Attribute to return the value of. Valid attribute 00810 # names are: 00811 # - \b fname : Normalized name file or directory 00812 # - \b file_index : If not set, indicates the file has 00813 # not been opened in the editor; otherwise, 00814 # specifies the file index of the opened 00815 # file. 00816 # - \b is_dir : True if the given sidebar item is a directory. 00817 # - \b is_open : True if the given sidebar item is in the 00818 # open state. 00819 # - \b children : Ordered list of children items of the given 00820 # sidebar directory. 00821 proc get_info {interp pname sb_index attr} { 00822 00823 return [::sidebar::get_info $sb_index $attr] 00824 00825 } 00826 00827 ###################################################################### 00828 ## Changes the state of the specified sidebar item to the given value. 00829 # 00830 # \param sb_index Sidebar index of file/directory in the sidebar 00831 # \param attr Attribute to set the value of. Valid attribute names 00832 # are: 00833 # - \b open : If set to 1, causes the sidebar item to be 00834 # opened; otherwise, if set to 0, causes the sidebar 00835 # item to be closed. 00836 proc set_info {interp pname sb_index attr value} { 00837 00838 ::sidebar::set_info $sb_index $attr $value 00839 00840 } 00841 00842 } 00843 00844 namespace eval plugin { 00845 00846 ###################################################################### 00847 ## Saves the value of the given variable name to non-corruptible memory 00848 # so that it can be later retrieved when the plugin is reloaded. 00849 # 00850 # \param index Unique value that is passed to the on_reload save command. 00851 # \param name Name of the variable to store 00852 # \param value Variable value to store 00853 proc save_variable {interp pname index name value} { 00854 00855 plugins::save_data $index $name $value 00856 00857 } 00858 00859 ###################################################################### 00860 ## Retrieves the value of the named variable from non-corruptible memory 00861 # (from a previous save_variable call. 00862 # 00863 # \param index Unique value that is passed to the on_reload retrieve command. 00864 # \param name Name of the variable to get the value of. If the named variable 00865 # could not be found), an empty string is returned. 00866 proc load_variable {interp pname index name} { 00867 00868 return [plugins::restore_data $index $name] 00869 00870 } 00871 00872 ###################################################################### 00873 ## Returns a value of true if the given procedure has been exposed by 00874 # another plugin. The value of "name" should be in the form of: 00875 # <plugin_name>::<procedure_name> 00876 proc is_exposed {interp pname name} { 00877 00878 return [plugins::is_exposed $name] 00879 00880 } 00881 00882 ###################################################################### 00883 ## Executes the exposed procedure (if it exists) and returns the value 00884 # returned by the procedure. If the procedure does not exist or there 00885 # is an exception thrown by the procedure, a value of -1 will be 00886 # returned to the calling method. 00887 proc exec_exposed {interp pname name args} { 00888 00889 if {[plugins::is_exposed $name] && ![catch { plugins::execute_exposed $name {*}$args } retval]} { 00890 return $retval 00891 } 00892 00893 return -1 00894 00895 } 00896 00897 ###################################################################### 00898 ## Reloads the plugins. This is useful if the plugin changes its own 00899 # code at runtime and needs to re-source itself. 00900 proc reload {interp pname} { 00901 00902 plugins::reload 00903 00904 } 00905 00906 ###################################################################### 00907 ## Returns the value of the requested field from the header.tkedat file 00908 # associated with the calling plugin. 00909 # 00910 # The supported values for the 'attr' parameter are the following: 00911 # - name 00912 # - display_name 00913 # - author 00914 # - email 00915 # - website 00916 # - version 00917 # - trust_required 00918 # - description 00919 # - category 00920 proc get_header_info {interp pname attr} { 00921 00922 return [plugins::get_header_info $pname $attr] 00923 00924 } 00925 00926 } 00927 00928 namespace eval preferences { 00929 00930 ###################################################################### 00931 ## Returns a references to a widget created for the preferences window. 00932 # 00933 # \return Returns the pathname of the widget to pack. 00934 # 00935 # \param type Specifies the type of widget to create. 00936 # (Legal values are: checkbutton, radiobutton, menubutton, 00937 # emtry, text, spinbox) 00938 # \param win Pathname of parent window to add widgets to. 00939 # \param pref Name of preference value associated with the widget. 00940 # \param msg Label text to associate with the widget (this text is 00941 # searchable. 00942 # \param args For all widget types that are not "spacer", the first arg 00943 # must be the name of the preference value associated with the 00944 # widget, the second arg must be a label to associated with the 00945 # widget (this text is searchable), the rest of the arguments 00946 # provide additional information required by the widget. 00947 proc widget {interp pname type win args} { 00948 00949 # Figure out a unique identifier for the widget within the parent frame 00950 set index [llength [winfo children $win]] 00951 00952 array set opts { 00953 -grid 0 00954 } 00955 00956 switch $type { 00957 spacer { 00958 array set opts $args 00959 return [pref_ui::make_spacer $win $opts(-grid)] 00960 } 00961 help { 00962 if {([llength $args] < 1) || (([llength $args] % 2) == 0)} { 00963 return -code error "api::preferences::widget $type sent an incorrect number of parameters" 00964 } 00965 set args [lassign $args msg] 00966 array set opts $args 00967 return [pref_ui::make_help $win $msg $opts(-grid)] 00968 } 00969 default { 00970 00971 if {([llength $args] < 2) || (([llength $args] % 2) == 1)} { 00972 return -code error "api::preferences::widget $type sent an incorrect number of parameters" 00973 } 00974 00975 set args [lassign $args pref msg] 00976 00977 array set opts { 00978 -value "" 00979 -values "" 00980 -grid 0 00981 -from "" 00982 -to "" 00983 -increment 1 00984 -ending "" 00985 -color "white" 00986 -height 4 00987 -columns "" 00988 -watermark "" 00989 -help "" 00990 } 00991 array set opts $args 00992 00993 # Calculate the full preference pathname 00994 set pref_path "Plugins/$pname/$pref" 00995 00996 # Make sure that the preference was loaded prior to creating the UI 00997 if {![info exists [preferences::ref $pref_path]]} { 00998 return -code error "Plugin preference $pref for $pname not previously loaded" 00999 } 01000 01001 switch $type { 01002 checkbutton { 01003 return [pref_ui::make_cb $win.cb$index $msg Plugins/$pname/$pref $opts(-grid)] 01004 } 01005 radiobutton { 01006 if {$opts(-value) eq ""} { 01007 return -code error "Radiobutton widget must have -value option set" 01008 } 01009 return [pref_ui::make_rb $win.rb$index $msg Plugins/$pname/$pref $opts(-value) $opts(-grid)] 01010 } 01011 menubutton { 01012 if {$opts(-values) eq ""} { 01013 return -code error "Menubutton widget must have -values option set" 01014 } 01015 return [pref_ui::make_mb $win.mb$index $msg Plugins/$pname/$pref $opts(-values) $opts(-grid)] 01016 } 01017 entry { 01018 return [pref_ui::make_entry $win.e$index $msg Plugins/$pname/$pref $opts(-grid) $opts(-help)] 01019 } 01020 token { 01021 return [pref_ui::make_token $win.te$index $msg Plugins/$pname/$pref $opts(-watermark) $opts(-grid) $opts(-help)] 01022 } 01023 text { 01024 return [pref_ui::make_text $win.t$index $msg Plugins/$pname/$pref $opts(-height) $opts(-grid) $opts(-help)] 01025 } 01026 spinbox { 01027 if {$opts(-from) eq ""} { 01028 return -code error "Spinbox widget must have -from option set" 01029 } 01030 if {$opts(-to) eq ""} { 01031 return -code error "Spinbox widget must have -to option set" 01032 } 01033 return [pref_ui::make_sb $win.sb$index $msg Plugins/$pname/$pref $opts(-from) $opts(-to) $opts(-increment) $opts(-grid) $opts(-ending)] 01034 } 01035 colorpicker { 01036 return [pref_ui::make_cp $win.cp$index $msg Plugins/$pname/$pref $opts(-color) $opts(-grid)] 01037 } 01038 table { 01039 if {$opts(-columns) eq ""} { 01040 return -code error "Table widget must have -columns option set" 01041 } 01042 return [pref_ui::make_table $win.tl$index $msg Plugins/$pname/$pref $opts(-columns) $opts(-height) $opts(-grid) $opts(-help)] 01043 } 01044 default { 01045 return -code error "Unsupported preference widget type ($type)" 01046 } 01047 } 01048 01049 } 01050 } 01051 01052 } 01053 01054 ###################################################################### 01055 # Returns the current specified preference value. 01056 # 01057 # \param varname Name of the preference value to retrieve 01058 proc get_value {interp pname varname} { 01059 01060 return $preferences::prefs(Plugins/$pname/$varname) 01061 01062 } 01063 01064 } 01065 01066 namespace eval menu { 01067 01068 # This is a list of menu items that a plugin will not be allowed to invoke 01069 array set not_allowed { 01070 "File/Quit" 1 01071 "Tools/Restart TKE" 1 01072 } 01073 01074 ###################################################################### 01075 ## Returns true if the given menu path exists in the main menubar; 01076 # otherwise, returns false. The 'mnu_path' is a slash-separated (/) path 01077 # to a menu item. The menu path must match the menu strings exactly 01078 # (case-sensitive). 01079 proc exists {interp pname mnu_path} { 01080 01081 set menu_list [split $mnu_path /] 01082 01083 if {![catch { menus::get_menu [lrange $menu_list 0 end-1] } mnu]} { 01084 if {![catch { menus::get_menu_index $mnu [lindex $menu_list end] } res] && ($res ne "none")} { 01085 return 1 01086 } 01087 } 01088 01089 return 0 01090 01091 } 01092 01093 ###################################################################### 01094 # Returns 1 if the given menu path is enabled in the menu; otherwise, 01095 # returns 0. 01096 proc enabled {interp pname mnu_path} { 01097 01098 set menu_list [split $mnu_path /] 01099 01100 if {![catch { menus::get_menu [lrange $menu_list 0 end-1] } mnu]} { 01101 if {![catch { menus::get_menu_index $mnu [lindex $menu_list end] } index] && ($index ne "none")} { 01102 return [expr {[$mnu entrycget $index -state] eq "normal"}] 01103 } 01104 } 01105 01106 return 0 01107 01108 } 01109 01110 ###################################################################### 01111 ## Returns the current value of the given menu path (only valid for 01112 # checkbutton or radiobutton menus). 01113 proc selected {interp pname mnu_path} { 01114 01115 set menu_list [split $mnu_path /] 01116 01117 if {![catch { menus::get_menu [lrange $menu_list 0 end-1] } mnu]} { 01118 if {![catch { menus::get_menu_index $mnu [lindex $menu_list end] } index] && ($index ne "none")} { 01119 switch [$mnu type $index] { 01120 checkbutton { return [expr {[set [$mnu entrycget $index -variable]] eq [$mnu entrycget $index -onvalue]}] } 01121 radiobutton { return [expr {[set [$mnu entrycget $index -variable]] eq [$mnu entrycget $index -value]}] } 01122 default { return "" } 01123 } 01124 } 01125 } 01126 01127 return "" 01128 01129 } 01130 01131 ###################################################################### 01132 ## Attempts to invoke the menu item specified by the given menu path. 01133 proc invoke {interp pname mnu_path} { 01134 01135 variable not_allowed 01136 01137 if {[info exists not_allowed($mnu_path)]} { 01138 return 0 01139 } 01140 01141 set menu_list [split $mnu_path /] 01142 01143 if {![catch { menus::get_menu [lrange $menu_list 0 end-1] } mnu]} { 01144 if {![catch { menus::get_menu_index $mnu [lindex $menu_list end] } index] && ($index ne "none")} { 01145 if {![catch { menus::invoke $mnu $index }]} { 01146 return 1 01147 } 01148 } 01149 } 01150 01151 return 0 01152 01153 } 01154 01155 } 01156 01157 namespace eval theme { 01158 01159 ###################################################################### 01160 ## Returns the given theme value as specified by the category and option 01161 # value. If no value exists, we will return an error. 01162 proc get_value {interp pname category option} { 01163 01164 # Get the category options 01165 array set opts [theme::get_category_options $category 1] 01166 01167 if {![info exists opts($option)]} { 01168 return -code error "Unable to find theme category option ($category, $option)" 01169 } 01170 01171 return $opts($option) 01172 01173 } 01174 01175 } 01176 01177 namespace eval utils { 01178 01179 ###################################################################### 01180 ## Opens the given file in a file browser. If in_background is set to 01181 # a value of 1, the focus will remain in the editor; otherwise, focus 01182 # will be given to the opening application. 01183 proc open_file {interp pname fname {in_background 0}} { 01184 01185 return [utils::open_file_externally $fname $in_background] 01186 01187 } 01188 01189 } 01190 01191 }