00001 #!wish8.6 00002 00003 # TKE - Advanced Programmer's Editor 00004 # Copyright (C) 2014-2019 Trevor Williams (phase1geo@gmail.com) 00005 # 00006 # This program is free software; you can redistribute it and/or modify 00007 # it under the terms of the GNU General Public License as published by 00008 # the Free Software Foundation; either version 2 of the License, or 00009 # (at your option) any later version. 00010 # 00011 # This program is distributed in the hope that it will be useful, 00012 # but WITHOUT ANY WARRANTY; without even the implied warranty of 00013 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 00014 # GNU General Public License for more details. 00015 # 00016 # You should have received a copy of the GNU General Public License along 00017 # with this program; if not, write to the Free Software Foundation, Inc., 00018 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 00019 00020 ###################################################################### 00021 # Name: tke.tcl 00022 # Author: Trevor Williams (phase1geo@gmail.com) 00023 # Date: 5/11/2013 00024 # Brief: Tcl/Tk editor written in Tcl/Tk 00025 # Usage: tke [<options>] <file>* 00026 ###################################################################### 00027 00028 ###################################################################### 00029 # Adjusts the given filename to be compatible with the file system 00030 # (standard or FreeWrap). 00031 proc adjust_fname {fname} { 00032 00033 # Strip any leading disk names from the given filename, if we are running in 00034 # freewrap 00035 if {[namespace exists ::freewrap] && [regexp {^\w:(.*)$} $fname -> new_fname]} { 00036 return $new_fname 00037 } 00038 00039 return $fname 00040 00041 } 00042 00043 set tke_dir [adjust_fname [file dirname [file dirname [file normalize [info script]]]]] 00044 set tke_home [file normalize [file join ~ .tke]] 00045 00046 ###################################################################### 00047 # Returns 1 if we are doing TKE development; otherwise, returns 0. 00048 proc tke_development {} { 00049 00050 return [expr [info exists ::env(TKE_DEVEL)] || [preferences::get {Debug/DevelopmentMode} 0]] 00051 00052 } 00053 00054 # Withdraw . to eliminate the "ghost" window 00055 wm withdraw . 00056 00057 set auto_path [list [file join $tke_dir lib ctext] \ 00058 [file join $tke_dir lib tablelist6.3] \ 00059 [file join $tke_dir lib ptwidgets1.2] \ 00060 [file join $tke_dir lib specl] \ 00061 [file join $tke_dir lib webdav] \ 00062 [file join $tke_dir lib tkcon] \ 00063 [file join $tke_dir lib zipper] \ 00064 {*}$auto_path] 00065 00066 switch -glob $tcl_platform(os) { 00067 Darwin { 00068 lappend auto_path [file join $tke_dir lib macOS tkdnd2.8] [file join $tke_dir lib macOS expect] 00069 package require Tclx 00070 } 00071 Linux* { 00072 package require Tclx 00073 } 00074 *Win* { 00075 set auto_path [list [file join $tke_dir lib win tkdnd2.8-64] [file join $tke_dir lib win expect] {*}$auto_path] 00076 } 00077 } 00078 00079 package require -exact ctext 5.0 00080 package require -exact tablelist 6.3 00081 package require tooltip 00082 package require msgcat 00083 package require tokenentry 00084 package require wmarkentry 00085 package require tabbar 00086 package require specl 00087 package require http 00088 # package require fileutil 00089 package require struct::set 00090 package require comm 00091 package require ftp 00092 package require base64 00093 package require tkcon 00094 catch { package require md5 } 00095 catch { package require sha1 } 00096 catch { package require sha256 } 00097 catch { package require Img } 00098 if {[catch { package require xml }]} { 00099 lappend auto_path [file join $tke_dir lib ptwidgets1.2 common Tclxml3.2] 00100 } 00101 catch { package require webdav } 00102 catch { package require tkdnd } 00103 catch { package require registry } 00104 catch { package require zipper } 00105 00106 if {[catch { package require Scrolledframe }]} { 00107 source [file join $tke_dir lib scrolledframe.tcl] 00108 package require Scrolledframe 00109 } 00110 00111 source [file join $tke_dir lib ptwidgets1.2 common htmllib.tcl] 00112 source [file join $tke_dir lib ptwidgets1.2 common gifblock.tcl] 00113 00114 source [file join $tke_dir lib version.tcl] 00115 source [file join $tke_dir lib share.tcl] 00116 source [file join $tke_dir lib startup.tcl] 00117 source [file join $tke_dir lib utils.tcl] 00118 source [file join $tke_dir lib preferences.tcl] 00119 source [file join $tke_dir lib edit.tcl] 00120 source [file join $tke_dir lib gui.tcl] 00121 source [file join $tke_dir lib sidebar.tcl] 00122 source [file join $tke_dir lib indent.tcl] 00123 source [file join $tke_dir lib menus.tcl] 00124 source [file join $tke_dir lib launcher.tcl] 00125 source [file join $tke_dir lib plugins.tcl] 00126 source [file join $tke_dir lib interpreter.tcl] 00127 source [file join $tke_dir lib snip_parser.tcl] 00128 source [file join $tke_dir lib format_parser.tcl] 00129 source [file join $tke_dir lib snippets.tcl] 00130 source [file join $tke_dir lib completer.tcl] 00131 source [file join $tke_dir lib bindings.tcl] 00132 source [file join $tke_dir lib bgproc.tcl] 00133 source [file join $tke_dir lib multicursor.tcl] 00134 source [file join $tke_dir lib cliphist.tcl] 00135 source [file join $tke_dir lib vim.tcl] 00136 source [file join $tke_dir lib syntax.tcl] 00137 source [file join $tke_dir lib api.tcl] 00138 source [file join $tke_dir lib markers.tcl] 00139 source [file join $tke_dir lib tkedat.tcl] 00140 source [file join $tke_dir lib themer.tcl] 00141 source [file join $tke_dir lib theme.tcl] 00142 source [file join $tke_dir lib themes.tcl] 00143 source [file join $tke_dir lib favorites.tcl] 00144 source [file join $tke_dir lib logger.tcl] 00145 source [file join $tke_dir lib diff.tcl] 00146 source [file join $tke_dir lib sessions.tcl] 00147 source [file join $tke_dir lib search.tcl] 00148 source [file join $tke_dir lib scroller.tcl] 00149 source [file join $tke_dir lib templates.tcl] 00150 source [file join $tke_dir lib folding.tcl] 00151 source [file join $tke_dir lib fontchooser.tcl] 00152 source [file join $tke_dir lib emmet.tcl] 00153 source [file join $tke_dir lib pref_ui.tcl] 00154 source [file join $tke_dir lib remote.tcl] 00155 source [file join $tke_dir lib socksend.tcl] 00156 source [file join $tke_dir lib ftp_wrapper.tcl] 00157 source [file join $tke_dir lib files.tcl] 00158 source [file join $tke_dir lib thumbnail.tcl] 00159 source [file join $tke_dir lib select.tcl] 00160 source [file join $tke_dir lib ipanel.tcl] 00161 source [file join $tke_dir lib plugmgr.tcl] 00162 00163 if {[tk windowingsystem] eq "aqua"} { 00164 source [file join $tke_dir lib windowlist.tcl] 00165 } 00166 00167 # Load the message file that is needed 00168 msgcat::mcload [file join $::tke_dir data msgs] 00169 00170 # Set the default right click button number 00171 set right_click 3 00172 00173 ###################################################################### 00174 # Display the usage information to standard output and exits. 00175 proc usage {} { 00176 00177 puts "" 00178 puts "tke \[<options>\] \[<files>|<directories>\]" 00179 puts "" 00180 puts "Options:" 00181 puts " -h Displays usage information" 00182 puts " -v Displays version" 00183 puts " -nosb Avoids populating the sidebar with the current" 00184 puts " directory contents (only valid if no files are" 00185 puts " specified)." 00186 puts " -e Exits the application when the last tab is closed" 00187 puts " (overrides preference setting)." 00188 puts " -m Creates a minimal editing environment (overrides" 00189 puts " preference settings)." 00190 puts " -n Opens a new window without attempting to merge" 00191 puts " with an existing window or last saved session." 00192 puts " -s <session_name> Opens the specified session name. This option" 00193 puts " is ignored if the -n option is specified." 00194 puts "" 00195 puts "Files and directories can be specified using relative or absolute" 00196 puts "pathnames and can contain the wildcard characters: * and ?. Any" 00197 puts "filenames specified will be immediately opened in the editor and" 00198 puts "their directories will be added to the sidebar. Any directories" 00199 puts "specified will be added to the sidebar." 00200 puts "" 00201 00202 exit 00203 00204 } 00205 00206 ###################################################################### 00207 # Displays version information to standard output and exits. 00208 proc version {} { 00209 00210 if {$::version_point == 0} { 00211 puts "$::version_major.$::version_minor ($::version_hgid)" 00212 } else { 00213 puts "$::version_major.$::version_minor.$::version_point ($::version_hgid)" 00214 } 00215 00216 exit 00217 00218 } 00219 00220 ###################################################################### 00221 # We will parse the given file pathname for wildcard characters and 00222 # perform substitutions as necessary. This is only needed in Windows 00223 # environments if we are executing from the command-line. 00224 proc get_files {path pfiles} { 00225 00226 upvar $pfiles files 00227 00228 if {[string map {* {} ? {}} $path] ne $path} { 00229 lappend files {*}[glob -nocomplain -- $path] 00230 } else { 00231 lappend files $path 00232 } 00233 00234 } 00235 00236 ###################################################################### 00237 # Parse the command-line options 00238 proc parse_cmdline {argc argv} { 00239 00240 set ::cl_files [list] 00241 set ::cl_sidebar 1 00242 set ::cl_exit_on_close 0 00243 set ::cl_minimal 0 00244 set ::cl_new 0 00245 set ::cl_use_session "" 00246 set ::cl_profile 0 00247 set ::cl_testport "" 00248 00249 set i 0 00250 while {$i < $argc} { 00251 switch -- [lindex $argv $i] { 00252 -h { usage } 00253 -v { version } 00254 -nosb { set ::cl_sidebar 0 } 00255 -e { set ::cl_exit_on_close 1 } 00256 -m { set ::cl_minimal 1 } 00257 -n { set ::cl_new 1 } 00258 -s { incr i; set ::cl_use_session [lindex $argv $i] } 00259 -p { set ::cl_profile 1 } 00260 -port { incr i; set ::cl_testport [lindex $argv $i] } 00261 default { 00262 if {[lindex $argv $i] ne ""} { 00263 get_files [file normalize [lindex $argv $i]] ::cl_files 00264 } 00265 } 00266 } 00267 incr i 00268 } 00269 00270 if {$::cl_testport ne ""} { 00271 sockappsetup tkreplay.tcl $::cl_testport 00272 } 00273 00274 } 00275 00276 ###################################################################### 00277 # Checks the given filename to see if it is something that we should 00278 # request to import. Returns 0 if the file is not importable and can 00279 # be handled as a regular file; otherwise, returns 1 to indicate that 00280 # the file should not be treated as a normal file. 00281 proc check_file_for_import {fname} { 00282 00283 switch -exact -- [string tolower [file extension $fname]] { 00284 .tmtheme { 00285 set ans [tk_messageBox -default yes -icon question -message [msgcat::mc "Import TextMate theme?"] -parent . -type yesnocancel] 00286 if {$ans eq "yes"} { 00287 themer::import_tm $fname 00288 return 1 00289 } 00290 } 00291 .tkethemz { 00292 set ans [tk_messageBox -default yes -icon question -message [msgcat::mc "Import TKE theme?"] -parent . -type yesnocancel] 00293 if {$ans eq "yes"} { 00294 themer::import_tke $fname 00295 } 00296 return 1 00297 } 00298 .tkeplugz { 00299 set ans [tk_messageBox -default yes -icon question -message [msgcat::mc "Import TKE plugin?"] -parent . -type yesnocancel] 00300 if {$ans eq "yes"} { 00301 plugins::import_plugin $fname 00302 } 00303 return 1 00304 } 00305 } 00306 00307 return 0 00308 00309 } 00310 00311 if {$tcl_platform(platform) eq "windows"} { 00312 00313 ###################################################################### 00314 # Since we don't use the TclX platform on Windows, we need to supply 00315 # our own version of the lassign procedure. 00316 proc lassign {items args} { 00317 00318 set i 0 00319 foreach parg $args { 00320 upvar $parg arg 00321 set arg [lindex $items $i] 00322 incr i 00323 } 00324 00325 return [lrange $items $i end] 00326 00327 } 00328 00329 ###################################################################### 00330 # Returns the window geometry for windows. 00331 proc window_geometry {{w .}} { 00332 00333 # Get the geometry of the window 00334 scan [wm geometry $w] "%dx%d+%d+%d" width height decorationLeft decorationTop 00335 00336 # Get the height of the window from the registry and increase the height by this 00337 # value. 00338 if {![catch { registry get "HKEY_CURRENT_USER\\Control Panel\\Desktop\\WindowMetrics" MenuHeight } result]} { 00339 incr height [expr {-$result / 15}] 00340 } 00341 00342 # Return the adjusted window geometry 00343 return [format "%dx%d+%d+%d" $width $height $decorationLeft $decorationTop] 00344 00345 } 00346 00347 } else { 00348 00349 ###################################################################### 00350 # Returns the window geometry on Mac OS X and Linux. 00351 proc window_geometry {{w .}} { 00352 00353 return [wm geometry $w] 00354 00355 } 00356 00357 # If we are using aqua, define a few tk::mac procedures that the application can use 00358 if {[tk windowingsystem] eq "aqua"} { 00359 00360 ###################################################################### 00361 # Opens the specified documents 00362 proc open_document_helper {args} { 00363 00364 # Add the files 00365 foreach name $args { 00366 if {[file isdirectory $name]} { 00367 sidebar::add_directory $name 00368 } elseif {![check_file_for_import $name]} { 00369 gui::add_file end $name 00370 } 00371 } 00372 00373 # Make sure that the window is raised 00374 ::tk::mac::ReopenApplication 00375 00376 } 00377 00378 ###################################################################### 00379 # Called whenever the user opens a document via drag-and-drop or within 00380 # the finder. 00381 proc ::tk::mac::OpenDocument {args} { 00382 00383 after 1000 [list open_document_helper {*}$args] 00384 00385 } 00386 00387 ###################################################################### 00388 # Called when the application exits. 00389 proc ::tk::mac::Quit {} { 00390 00391 menus::exit_command 00392 00393 } 00394 00395 # Change the right_click 00396 set ::right_click 2 00397 00398 ###################################################################### 00399 # Mapping the about window. 00400 proc tkAboutDialog {} { 00401 00402 gui::show_about 00403 00404 } 00405 00406 } 00407 00408 ###################################################################### 00409 # Handles an interrupt or terminate signal 00410 proc handle_signal {} { 00411 00412 # Kill the GUI 00413 catch { destroy . } 00414 00415 # Exit the logger 00416 logger::on_exit 00417 00418 # Exit the application 00419 exit 00420 00421 } 00422 00423 # Set signal handlers on non-Windows platforms 00424 signal trap TERM handle_signal 00425 signal trap INT handle_signal 00426 00427 } 00428 00429 ###################################################################### 00430 # Runs a command that was started by another process. 00431 proc run_remote {cmd args} { 00432 00433 if {[catch { $cmd {*}$args }]} { 00434 return -code error 00435 } 00436 00437 } 00438 00439 if {[catch { 00440 00441 # Set the application name to tke 00442 tk appname tke 00443 00444 # Parse the command-line options 00445 parse_cmdline $argc $argv 00446 00447 # If we need to start profiling, do it now 00448 if {[info exists ::env(TKE_DEVEL)] && $::cl_profile} { 00449 profile on 00450 } 00451 00452 # Set the comm port that we will use 00453 set comm_port 51807 00454 set already_running 0 00455 00456 # Change our comm port to a known value (if we fail, TKE is already running at that port so 00457 # connect to it. 00458 if {[catch { ::comm::comm config -port $comm_port }]} { 00459 00460 set already_running 1 00461 00462 # Attempt to add files or raise the existing application 00463 if {!$cl_new} { 00464 if {[llength $cl_files] > 0} { 00465 if {![catch { ::comm::comm send $comm_port run_remote gui::add_files_and_raise [info hostname] end $cl_files } rc]} { 00466 destroy . 00467 exit 00468 } 00469 } elseif {$cl_use_session ne ""} { 00470 if {![catch { ::comm::comm send $comm_port run_remote sessions::load_and_raise_window $cl_use_session } rc]} { 00471 destroy . 00472 exit 00473 } 00474 } else { 00475 if {![catch { ::comm::comm send $comm_port run_remote gui::raise_window } rc]} { 00476 destroy . 00477 exit 00478 } 00479 } 00480 } 00481 00482 } 00483 00484 # Create the ~/.tke directory if it doesn't already exist 00485 if {![file exists $tke_home]} { 00486 file mkdir $tke_home 00487 } 00488 00489 # Allow the share settings to be setup prior to doing anything else 00490 share::initialize $already_running 00491 00492 # Preload the session information 00493 sessions::preload 00494 00495 # Load the preferences 00496 preferences::load 00497 00498 # Initialize the themes 00499 themes::load 00500 00501 # Initialize the diagnostic logger 00502 logger::initialize 00503 00504 # If we need to check for updates on start, do that now 00505 if {[preferences::get General/UpdateCheckOnStart]} { 00506 if {[preferences::get General/UpdateReleaseType] eq "devel"} { 00507 specl::check_for_update 1 [expr $specl::RTYPE_STABLE | $specl::RTYPE_DEVEL] -title [msgcat::mc "TKE Updater"] 00508 } else { 00509 specl::check_for_update 1 $specl::RTYPE_STABLE -title [msgcat::mc "TKE Updater"] 00510 } 00511 } 00512 00513 # Load the plugins 00514 plugins::load 00515 00516 # Load the snippets 00517 snippets::load 00518 00519 # Load the clipboard history 00520 cliphist::load 00521 00522 # Load the syntax highlighting information 00523 syntax::load 00524 00525 # Load the favorites information 00526 favorites::load 00527 00528 # Load the template information 00529 templates::preload 00530 00531 # Load Emmet customizations 00532 emmet::load 00533 00534 # Set the delay to 1 second 00535 tooltip::tooltip delay 1000 00536 00537 # Create GUI 00538 gui::create 00539 00540 # Initialize the remote namespace 00541 remote::initialize 00542 00543 # Update the UI 00544 themes::handle_theme_change 00545 00546 # Run any plugins that are required at application start 00547 plugins::handle_on_start 00548 00549 # Load a session file 00550 if {[preferences::get General/LoadLastSession] || ($cl_use_session ne "")} { 00551 sessions::load [expr {($cl_use_session eq "") ? "last" : "nosave"}] $cl_use_session $cl_new 00552 } 00553 00554 # Populate the GUI with the command-line filelist (if specified) 00555 if {[llength $cl_files] > 0} { 00556 set tab "" 00557 foreach cl_file $cl_files { 00558 set name [file normalize $cl_file] 00559 if {[file isdirectory $name]} { 00560 sidebar::add_directory $name 00561 } elseif {[file exists $name]} { 00562 if {![check_file_for_import $name]} { 00563 set tab [gui::add_file end $name -lazy 1] 00564 } 00565 } else { 00566 set tab [gui::add_new_file end -name $name -sidebar 1] 00567 } 00568 } 00569 if {$tab ne ""} { 00570 gui::set_current_tab [gui::get_info $tab tab tabbar] $tab 00571 } 00572 } 00573 00574 # If we are in development mode and preferences are telling us to open the 00575 # diagnostic logfile, do it now. 00576 if {[::tke_development] && [preferences::get Debug/ShowDiagnosticLogfileAtStartup]} { 00577 logger::view_log -lazy 1 00578 } 00579 00580 # If the number of loaded files is still zero, add a new blank file 00581 if {[files::get_file_num] == 0} { 00582 gui::add_new_file end -sidebar $::cl_sidebar 00583 } 00584 00585 # This will hide hidden files/directories but provide a button in the dialog boxes to show/hide theme 00586 catch { 00587 catch { tk_getOpenFile foo bar } 00588 # set ::tk::dialog::file::showHiddenBtn 1 00589 set ::tk::dialog::file::showHiddenVar 0 00590 } 00591 00592 # Show the application 00593 wm deiconify . 00594 00595 } rc]} { 00596 puts "rc: $rc" 00597 puts $::errorInfo 00598 bgerror $rc 00599 }