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 }
