./0000700000175000017500000000000012705661033010522 5ustar sergeisergei./tkcon/0000755000175000017500000000000012705661035011654 5ustar sergeisergei./tkcon/icons/0000755000175000017500000000000012705661035012767 5ustar sergeisergei./tkcon/icons/tkcon-small48.png0000644000175000017500000001012711326716364016102 0ustar sergeisergeiPNG  IHDR0.nޚlsBIT|d pHYs B(xtEXtSoftwarewww.inkscape.org< tEXtTitletkcontEXtAuthorPat Thoyts,W]tEXtDescriptionTcl feather icon blended with the console icon fron the tango theme icon package..YHtEXtCreation Time23 Jan 2010@/hItEXtCopyrightPublic Domain http://creativecommons.org/licenses/publicdomain/YIDATh͚{p\}?݇zKOyِ@m`C[ !C&`x̤iH:i4$ QP^mazJ]iwsNW+$B9s{9WBkgՄ"z pXP=A&0?m +@T1 piKO^=66.S LvX|d56( X UEgnN}=)EB@?{l3STBn6\*}뭷*nw-E9oL `Wڳ$ k? )!Ϛ?/[s w~[(X %TV&DWfEtk?֛~_GFD$R3^c6MqJѠ!6<,~ؖU(gy-EKFWW~eZiغ(&0!0J>o%+i!S^>#rDZ VǑv~CJW_s Wy;Ƴoa*<%&K2lApt)}OW(uV-s?w ֌~l>Gji "ET4MHg2OȔT(iym]2,m}B+/{3~ISy4z_jt!'DQ;_ÞA\sehM/DZh#w)A*R ZHp.񋇟c,9.n*[^fok/y {V^aVO\LZKQm:jBtaclFkpDIhJƲdyb=O2b>vK/zQ E]dd(NEԯ-H !A:P(t*_6"888r2?y ((D&Fy]$=tnxv4DU^{L:GUDO !f&_ cx?S. W* >5#rljRH}=,^﹗XG^ñUYPvküU /#Ҡ,vׄ6rɱB |_َv>朳qU.\5)=.P`€-m yBMSV"0\hCr?FǼvno5=q(S }|th[INY5R9hU"{h0ΞKSktGviԶ6zRhi!o1:֚u]܈!fw'J2;lfF J.v( h@iy3 3Y*CDjjX~F3hbЮ"S6 rBB= jE"m p1:Zޱe(L +7Frf{zJeZ>jk-f3<ucτR6RJضM4A0cp"C| &>z8TUDK5E>Ug U1֓%Dl: d)1@ЏU(1{˱u5 P\BsNnh$]D(ĭ^B8< $=)UZS"hMo a^yTJƓ=aZpJlaf(Fw2SP҅P!g(>8t8}H5 HHG*i4 TV,ZhIE n.&w:'#SdY6C$>xe)N#Ѷp_SL(iaTy@N bǦFw+)bbk1L!̟}/Krk_09cĩ4:yDR\J(40<*&2  ޼ ҂S?1MY`5Vg92S(5 IYV2wIB0Z USٙM),4E AJUa0}IO`| ;OBJ+o{pc(]4455# %l  p"GNZK&BT 8RqlǦD27Y|-&s/Ueh   + qVɱDZJI]L-?y ?a[xF޳ `0c XUq gef| ~ll_w!e~`jk?[E2D*p_$`~QSUFt\UUxj)7!C!vOē;xu{/RSS@0{"蔕m7R>S7OycC)Uy tkcon image/svg+xml tkcon 23 Jan 2010 Pat Thoyts Tcl feather icon blended with the console icon fron the tango theme icon package. Pat Thoyts, The Tango Project ./tkcon/docs/0000755000175000017500000000000012705661035012604 5ustar sergeisergei./tkcon/docs/todo.html0000755000175000017500000000560610101276642014443 0ustar sergeisergei tkcon: To Do Ideas
tkcon: To Do Ideas SourceForge Logo
Documentation Purpose & Features Limitations To Do License
Online Demo (requires Tk plugin) Using TkCon with other Tk Languages

Future Ideas

  • Add encoding auto-conversion to exec commands
  • keep history file, also keep history of sourced files 
  • set mimetype(extension,au) "audio/u-law"
set mimetype(extension,wav) "audio/wave"
set mimetype(extension,mid) "audio/midi"
/etc/magic
proc run {file} {
    global mimetype

    if {[file executable $file]} {
        exec $file
        return
    }

    catch {set mimetype $mimetype(extension,[file extension $file])}

    if {![info exists mimetype]} {
        set mimetype $mimetype(magic,[exec /bin/file $file])
    }

    exec $mimetype(application,$mimetype) $file
}
  • Add socket level communication model
  • Enhance the true debugging capabilities - I'm looking at tcl-debug and into what I can adopt from the tkInspect philosophy.
  • I'm taking ideas...

Known Bugs/Quirks

  • Command highlighting isn't perfect because I try to make it too efficient.
  • All interpreters have the same current working directory. This is a limitation of tcl.
  • You can't 'attach' on machines where send does not exist. John Loverso has a comm.tcl replacement. In any case, you can still attach to internal interpreters and namespaces.
  • Need to clean up checkpointed states when the associated interp dies. Works with slaves, but not foreign interps.
  • Can't identify non-Tcl or pre-Tk4 interpreters automagically...
  • You tell me...
© Jeffrey Hobbs
./tkcon/docs/tkconrc.5.man0000644000175000017500000001733112067147165015120 0ustar sergeisergei[comment {-*- tcl -*- tkconrc manpage}] [manpage_begin tkconrc 5 2.5] [copyright {Jeffrey Hobbs }] [moddesc {TkCon}] [titledesc {TkCon resource file}] [description] [para] TkCon will search for a resource file in [file ~/.tkconrc]. TkCon never sources the [file ~/.wishrc] file. The resource file is sourced by each new instance of the console. An example resource file is provided below. [para] The file itself is a Tcl script, so it is required that the file conforms to Tcl script conventions. [section VARIABLES] [para] Certain variables in TkCon can be modified to suit your needs. It's easiest to do this in the resource file, but you can do it when time the program is running (and some can be changed via the [arg Prefs] menu). All these are part of the master interpreter's [cmd ::tkcon] namespace. The modifiable array variables are [cmd ::tkcon::COLOR] and [cmd ::tkcon::OPT]. You can call [example_begin] tkcon set ::tkcon::COLOR [example_end] when the program is running to check its state. Here is an explanation of certain variables you might change or use: [list_begin definitions] [def [cmd ::tkcon::COLOR(bg)]] The background color for tkcon text widgets. Defaults to the operating system default (determined at startup). [def [cmd ::tkcon::COLOR(blink)]] The background color of the electric brace highlighting, if on. Defaults to yellow. [def [cmd ::tkcon::COLOR(cursor)]] The background color for the insertion cursor in tkcon. Defaults to black. [def [cmd ::tkcon::COLOR(disabled)]] The foreground color for disabled menu items. Defaults to dark grey. [def [cmd ::tkcon::COLOR(proc)]] The foreground color of a recognized proc, if command highlighting is on. Defaults to dark green. [def [cmd ::tkcon::COLOR(var)]] The background color of a recognized var, if command highlighting is on. Defaults to pink. [def [cmd ::tkcon::COLOR(prompt)]] The foreground color of the prompt as output in the console. Defaults to brown. [def [cmd ::tkcon::COLOR(stdin)]] The foreground color of the stdin for the console. Defaults to black. [def [cmd ::tkcon::COLOR(stdout)]] The foreground color of the stdout as output in the console. Defaults to blue. [def [cmd ::tkcon::COLOR(stderr)]] The foreground color of stderr as output in the console. Defaults to red. [def [cmd ::tkcon::OPT(autoload)]] Packages to automatically load into the slave interpreter (i.e. 'Tk'). This is a list. Defaults to {} (none). [def [cmd ::tkcon::OPT(blinktime)]] The amount of time (in millisecs) that braced sections should blink for. Defaults to 500 (0.5 secs), must be at least 100. [def [cmd ::tkcon::OPT(blinkrange)]] Whether to blink the entire range for electric brace matching or to just blink the actual matching braces (respectively 1 or 0, defaults to 1). [def [cmd ::tkcon::OPT(buffer)]] The size of the console scroll buffer (in lines). Defaults to 512. [def [cmd ::tkcon::OPT(calcmode)]] Whether to allow expr commands to be run at the command line without prefixing them with expr (just a convenience). [def [cmd ::tkcon::OPT(cols)]] Number of columns for the console to start out with. Defaults to 80. [def [cmd ::tkcon::OPT(dead)]] What to do with dead connected interpreters. If dead is leave, TkCon automatically exits the dead interpreter. If dead is ignore then it remains attached waiting for the interpreter to reappear. Otherwise TkCon will prompt you. [def [cmd ::tkcon::OPT(exec)]] This corresponds to the [cmd -exec] tkcon option (see [cmd tkcon](1)). [def [cmd ::tkcon::OPT(font)]] Font to use for tkcon text widgets (also specified with [cmd -font] option). Defaults to the system default, or a fixed width equivalent. [def [cmd ::tkcon::OPT(gets)]] Controls whether tkcon will overload the gets command to work with tkcon. The valid values are: congets (the default), which will redirect stdin requests to the tkcon window; gets, which will pop up a dialog to get input; and {} (empty string) which tells tkcon not to overload gets. This value must be set at startup to alter tkcon's behavior. [def [cmd ::tkcon::OPT(history)]] The size of the history list to keep. Defaults to 48. [def [cmd ::tkcon::OPT(hoterrors)]] Whether hot errors are enabled or not. When enabled, errors that are returned to the console are marked with a link to the error info that will pop up in an minimal editor. This requires more memory because each error that occurs will maintain bindings for this feature, as long as the error is in the text widget. Defaults to on. [def [cmd ::tkcon::OPT(library)]] The path to any tcl library directories (these are appended to the [cmd auto_path] when the after the resource file is loaded in). [def [cmd ::tkcon::OPT(lightbrace)]] Whether to use the brace highlighting feature or not (respectively 1 or 0, defaults to 1). [def [cmd ::tkcon::OPT(lightcmd)]] Whether to use the command highlighting feature or not (respectively 1 or 0, defaults to 1). [def [cmd ::tkcon::OPT(maineval)]] A tcl script to execute in the main interpreter after the slave interpreter is created and the user interface is initialized. [def [cmd ::tkcon::OPT(maxlinelen)]] A number that specifies the limit of long result lines. True result is still captured in $_ (and 'puts $_' works). Defaults to 0 (unlimited). [def [cmd ::tkcon::OPT(maxmenu)]] A number that specifies the maximum number of packages to show vertically in the [arg Interp->Packages] menu before breaking into another column. Defaults to 15. [def [cmd ::tkcon::OPT(nontcl)]] For those who might be using non-Tcl based Tk attachments, set this to 1. It prevents TkCon from trying to evaluate its own Tcl code in an attached interpreter. Also see my notes for non-Tcl based Tk interpreters. [def [cmd ::tkcon::OPT(prompt1)]] Like [cmd tcl_prompt1], except it doesn't require you use [cmd puts]. No equivalent for [cmd tcl_prompt2] is available (it's unnecessary IMHO). Defaults to {([lb]file tail [lb]pwd[rb][rb]) [lb]history nextid[rb] % }. [def [cmd ::tkcon::OPT(rows)]] Number of rows for the console to start out with. Defaults to 20. [def [cmd ::tkcon::OPT(scollypos)]] Y scrollbar position. Valid values are left or right. Defaults to right. [def [cmd ::tkcon::OPT(showmenu)]] Show the menubar on startup (1 or 0, defaults to 1). [def [cmd ::tkcon::OPT(showmultiple)]] Show multiple matches for path/proc/var name expansion (1 or 0, defaults to 1). [def [cmd ::tkcon::OPT(slaveeval)]] A tcl script to execute in each slave interpreter right after it's created. This allows the user to have user defined info always available in a slave. [para] Example: [example_begin] set ::tkcon::OPT(slaveeval) { proc foo args { puts $args } lappend auto_path . } [example_end] [def [cmd ::tkcon::OPT(slaveexit)]] Allows the prevention of exit in slaves from exitting the entire application. If it is equal to exit, exit will exit as usual, otherwise it will just close down that interpreter (and any children). Defaults to close. [def [cmd ::tkcon::OPT(subhistory)]] Allow history substitution to occur (0 or 1, defaults to 1). The history list is maintained in a single interpreter per TkCon console instance. Thus you have history which can range over a series of attached interpreters. [list_end] [section EXAMPLES] [para] An example TkCon resource file might look like: [example_begin] ###################################################### ## My TkCon Resource File # Use a fixed default font #tkcon font fixed; # valid on unix #tkcon font systemfixed; # valid on win tkcon font Courier 12; # valid everywhere # Keep 50 commands in history set ::tkcon::OPT(history) 50 # Use a pink prompt set ::tkcon::COLOR(prompt) pink ###################################################### [example_end] [see_also [cmd tkcon](1)] [see_also [cmd dump](n) [cmd tkcon](n) [cmd idebug](n)] [see_also [cmd observe](n)] [keywords Tk console] [manpage_end] ./tkcon/docs/tkcon.n.man0000644000175000017500000001171711151627245014661 0ustar sergeisergei[comment {-*- tcl -*- tkcon manpage}] [manpage_begin tkcon n 2.5] [copyright {Jeffrey Hobbs }] [moddesc {TkCon}] [titledesc {Controlling TkCon console}] [description] [para] This provides lots of useful control over a console: [list_begin definitions] [call [cmd tkcon] [arg attach] [arg interpreter]] Attaches tkcon to the named interpreter. The name must be that returned by [lb][cmd tk] [arg appname][rb] or a valid path to a slave interpreter. It's best to use this via the [arg {Console->Attach Console}] menu. [call [cmd tkcon] [arg buffer] [opt [arg size]]] Sets or queries the allowed size of the console text widget in lines. The text widget will automatically delete leading lines once this number has been exceeded (read: this is the scroll buffer size). [call [cmd tkcon] [arg bgerror] [opt "[arg msg] [arg errorInfo]"]] Does bgerror stuff in the tkcon master interpreter. [call [cmd tkcon] [arg close] or [cmd tkcon] [arg destroy]] Destroys this tkcon widget. [call [cmd tkcon] [arg congets]] Behaves like the traditional Tcl gets, but instead of using stdin, it uses the tkcon console window. By default, tkcon replaces the standard gets with this command. This behavior can be controlled by altering the [cmd ::tkcon::OPT(gets)] parameter at startup. This should not be called directly - instead rely on the overloaded gets, which has support for the optional varName parameter. [call [cmd tkcon] [arg console] [arg args]] Passes the args to the tkcon text widget (the console). [call [cmd tkcon] [arg error]] Pops up a dialog that gives the user a full trace of the last error received in the tkcon console. [call [cmd tkcon] [arg find] [arg string]\ [opt "[arg -case] [arg TCL_BOOLEAN] [arg -regexp] [arg TCL_BOOLEAN]"]] Highlights all instances of string in the console. If the string is empty, it clears any previous highlighting. [call [cmd tkcon] [arg font] [opt [arg fontname]]] Sets or returns the font used by tkcon text widgets. [call [cmd tkcon] [arg gets]] Behaves like the traditional Tcl gets, but instead of needing stdin, it pops a dialog box up for the user. The overloaded gets has support for the optional varName parameter. [call [cmd tkcon] [arg getcommand]] A variation of the congets method that requires a full command to be input before returning. [call [cmd tkcon] [arg hide]] Withdraw the tkcon display from the screen (make sure you have a way to get it back). [call [cmd tkcon] [arg history] [opt [arg -newline]]] Displays the tkcon history in sourceable form. If [arg -newline] is specified, it separates each command by an extra newline. [call [cmd tkcon] [arg iconify]] Iconifies the tkcon display. [call [cmd tkcon] [arg linelength] [opt [arg value]]] Sets or displays the number that specifies the limit of long result lines. True result is still captured in $_ (and 'puts $_' works). [call [cmd tkcon] [arg load] [arg filename]] Sources named file into the slave interpreter. If no filename is given, it will attempt to call [cmd tk_getOpenFile] to pop up the file select box. [call [cmd tkcon] [arg main] [opt "[arg arg] [arg arg] [arg ...]"]] Passes the args to the main tkcon interpreter to be evaluated and returns the result. [call [cmd tkcon] [arg master] [arg args]] Passes the args to the master interpreter to be evaluated and returns the result. [call [cmd tkcon] [arg new]] Creates a new tkcon widget. [call [cmd tkcon] [arg resultfilter] [opt [arg command]]] Specify a command to process the results before outputting it to the console window. The command receives one argument (the result string) and the string returned is placed in the console. [call [cmd tkcon] [arg save] [opt "[arg filename] [opt [arg type]]"]] Saves the console buffer to the given filename. If no filename is given, it will attempt to call [cmd tk_getSaveFile] to pop up the file select box. If no type is given, a dialog will ask you to specify what portion of the text you want to save. [call [cmd tkcon] [arg set] [arg var] [opt [arg value]]] Queries or sets a master interpreter variable. [call [cmd tkcon] [arg append] [arg var] [opt [arg value]]] Like set, but uses append on the variable. [call [cmd tkcon] [arg lappend] [arg var] [opt [arg value]]] Like set, but uses lappend on the variable. [call [cmd tkcon] [arg show] or [cmd tkcon] [arg deiconify]] Redisplays tkcon on the screen. [call [cmd tkcon] [arg slave] [opt "[arg slavename] [opt [arg {arg arg ...}]]"]] If called with no args, it returns the name of all the tkcon interpreters. Otherwise given an interp name it passes the args to the named interpreter to be evaluated and returns the result. If no args are passed, then it returns the [lb][cmd tk] [arg appname][rb] of that interpreter. [call [cmd tkcon] [arg title] [opt [arg title]]] Sets or returns the title for tkcon. [call [cmd tkcon] [arg version]] Returns of version of tkcon. [list_end] [see_also [cmd tkcon](1)] [see_also [cmd tkconrc](5) [cmd tkcon](n) [cmd dump](n)] [see_also [cmd observe](n)] [keywords Tk console debug] [manpage_end] ./tkcon/docs/tkcon.html0000755000175000017500000001600111151630377014610 0ustar sergeisergei tkcon: tkcon procedure
tkcon: tkcon procedure SourceForge Logo
Documentation Purpose & Features Limitations To Do License
Online Demo (requires Tk plugin) Using TkCon with other Tk Languages
Getting Started Special Bindings Procedures Screenshot
dump tkcon idebug observe

This provides lots of useful control over a console:

tkcon attach interpreter
Attaches tkcon to the named interpreter. The name must be that returned by [tk appname] or a valid path to a slave interpreter. It's best to use this via the Console->Attach Console menu.
tkcon buffer ?size?
Sets or queries the allowed size of the console text widget in lines. The text widget will automatically delete leading lines once this number has been exceeded (read: this is the scroll buffer size).
tkcon bgerror ?msg errorInfo?
Does bgerror stuff in the tkcon master interpreter.
tkcon close or tkcon destroy
Destroys this tkcon widget.
tkcon congets
Behaves like the traditional Tcl gets, but instead of using stdin, it uses the tkcon console window. By default, tkcon replaces the standard gets with this command. This behavior can be controlled by altering the ::tkcon::OPT(gets) parameter at startup. This should not be called directly - instead rely on the overloaded gets, which has support for the optional varName parameter.
tkcon console args
Passes the args to the tkcon text widget (the console).
tkcon error
Pops up a dialog that gives the user a full trace of the last error received in the tkcon console.
tkcon find string ?-case TCL_BOOLEAN -regexp TCL_BOOLEAN?
Highlights all instances of string in the console. If the string is empty, it clears any previous highlighting.
tkcon font ?fontname?
Sets or returns the font used by tkcon text widgets.
tkcon gets
Behaves like the traditional Tcl gets, but instead of needing stdin, it pops a dialog box up for the user. The overloaded gets has support for the optional varName parameter.
tkcon getcommand
A variation of the congets method that requires a full command to be input before returning.
tkcon hide
Withdraw the tkcon display from the screen (make sure you have a way to get it back).
tkcon history ?-newline?
Displays the tkcon history in sourceable form. If -newline is specified, it separates each command by an extra newline.
tkcon iconify
Iconifies the tkcon display.
tkcon linelength ?value?
Sets or displays the number that specifies the limit of long result lines. True result is still captured in $_ (and 'puts $_' works).
tkcon load filename
Sources named file into the slave interpreter. If no filename is given, it will attempt to call tk_getOpenFile to pop up the file select box.
tkcon main ?arg arg ...?
Passes the args to the main tkcon interpreter to be evaluated and returns the result.
tkcon master args
Passes the args to the master interpreter to be evaluated and returns the result.
tkcon new
Creates a new tkcon widget.
tkcon resultfilter ?command?
Specify a command to process the results before outputting it to the console window. The command receives one argument (the result string) and the string returned is placed in the console.
tkcon save ?filename ?type??
Saves the console buffer to the given filename. If no filename is given, it will attempt to call tk_getSaveFile to pop up the file select box. If no type is given, a dialog will ask you to specify what portion of the text you want to save.
tkcon set var ?value?
Queries or sets a master interpreter variable.
tkcon append var ?value?
Like set, but uses append on the variable.
tkcon lappend var ?value?
Like set, but uses lappend on the variable.
tkcon show or tkcon deiconify
Redisplays tkcon on the screen.
tkcon slave ?slavename ?arg arg ...??
If called with no args, it returns the name of all the tkcon interpreters. Otherwise given an interp name it passes the args to the named interpreter to be evaluated and returns the result. If no args are passed, then it returns the [tk appname] of that interpreter.
tkcon title ?title?
Sets or returns the title for tkcon.
tkcon version
Returns of version of tkcon.
© Jeffrey Hobbs
./tkcon/docs/tkcon.1.man0000644000175000017500000003035412067147165014567 0ustar sergeisergei[comment {-*- tcl -*- tkcon manpage}] [manpage_begin tkcon 1 2.5] [copyright {Jeffrey Hobbs (jeff at hobbs.org)}] [moddesc {TkCon}] [titledesc {Tk console replacement}] [description] [para] TkCon is a replacement for the standard console that comes with Tk (on Windows/Mac, but also works on Unix). The console itself provides many more features than the standard console. TkCon works on all platforms where Tcl/Tk is available. It is meant primarily to aid one when working with the little details inside Tcl and Tk, giving Unix users the GUI console provided by default in the Mac and Windows Tk. [list_begin definitions] [call [cmd tkcon] [lb]\{[arg option] [arg value] | [arg tcl_script]\} ...[rb]] [list_end] [section OPTIONS] [para] Except for [cmd -rcfile], command line arguments are handled after the TkCon resource file is sourced, but before the slave interpreter or the TkCon user interface is initialized. [para] [cmd -rcfile] is handled right before it would be sourced, allowing you to specify any alternate file. Command line arguments are passed to each new console and will be evaluated by each. To prevent this from happening, you have to say [example_begin] tkcon main set argv {}; tkcon main set argc 0 [example_end] [para] For these options, any unique substring is allowed. [list_begin definitions] [def "[cmd -argv] (also [cmd --])"] Causes TkCon to stop evaluating arguments and set the remaining args to be argv/argc (with [cmd --] prepended). This carries over for any further consoles. This is meant only for wrapping TkCon around programs that require their own arguments. [def "[cmd -color-] [arg color]"] Sets the requested color type to the specified color for tkcon. See [cmd tkconrc](5) for the recognized [cmd ] names. [def "[cmd -eval] [arg tcl_script] (also [cmd -main] or [cmd -e])"] A Tcl script to eval in each main interpreter. This is evaluated after the resource file is loaded and the slave interpreter is created. Multiple [cmd -eval] switches will be recognized (in order). [def "[cmd -exec] [arg slavename]"] Sets the named slave that tkcon operates in. In general, this is only useful to set to [arg {""}] (empty), indicating to tkcon to avoid the multi-interpreter model and operate in the main environment. When this is empty, any further arguments will be only used in the first tkcon console and not passed onto further new consoles. This is useful when using tkcon as a console for extended wish executables that don't load there commands into slave interpreters. [def "[cmd -font] [arg font]"] Sets the font that tkcon uses for its text windows. If this isn't a fixed width font, tkcon will override it. [def "[cmd -nontcl] [arg TCL_BOOLEAN]"] Sets [cmd ::tkcon::OPT(nontcl)] to [arg TCL_BOOLEAN] (see [cmd tkconrc](5)). Needed when attaching to non-Tcl interpreters. [def "[cmd -package] [arg package_name] (also [cmd -load])"] Packages to automatically load into the slave interpreters (i.e. "Tk"). [def "[cmd -rcfile] [arg filename]"] Specify an alternate tkcon resource file name. [def "[cmd -root] [arg widgetname]"] Makes the named widget the root name of all consoles (i.e. .tkcon). [def "[cmd -slave] [arg tcl_script]"] A Tcl script to eval in each slave interpreter. This will append the one specified in the tkcon resource file, if any. [list_end] [section {KEY BINDINGS}] [para] Most of the bindings are the same as for the [cmd text] widget. Some have been modified to make sure that the integrity of the console is maintained. Others have been added to enhance the usefulness of the console. Only the modified or new bindings are listed here. [list_begin definitions] [def "[cmd Control-x] or [cmd Cut] (on Sparc5 keyboards)"] Cut. [def "[cmd Control-c] or [cmd Copy] (on Sparc5 keyboards)"] Copy. [def "[cmd Control-v] or [cmd Paste] (on Sparc5 keyboards)"] Paste. [def [cmd Insert]] Insert (duh). [def [cmd Up]] Goes up one level in the commands line history when cursor is on the prompt line, otherwise it moves through the buffer. [def [cmd Down]] Goes down one level in the commands line history when cursor is on the last line of the buffer, otherwise it moves through the buffer. [def [cmd Control-p]] Goes up one level in the commands line history. [def [cmd Control-n]] Goes down one level in the commands line history. [def [cmd Tab]] Tries to expand file path names, then variable names, then proc names. [def [cmd Escape]] Tries to expand file path names. [def [cmd Control-P]] Tries to expand procedure names. The procedure names will be those that are actually in the attached interpreter (unless nontcl is specified, in which case it always does the lookup in the default slave interpreter). [def [cmd Control-V]] Tries to expand variable names (those returned by [lb]info vars[rb]). It's search behavior is like that for procedure names. [def "[cmd Return] or [cmd Enter]"] Evaluates the current command line if it is a complete command, otherwise it just goes to a new line. [def [cmd Control-a]] Go to the beginning of the current command line. [def [cmd Control-l]] Clear the entire console buffer. [def [cmd Control-r]] Searches backwards in the history for any command that contains the string in the current command line. Repeatable to search farther back. The matching substring off the found command will blink. [def [cmd Control-s]] As above, but searches forward (only useful if you searched too far back). [def [cmd Control-t]] Transposes characters. [def [cmd Control-u]] Clears the current command line. [def [cmd Control-z]] Saves current command line in a buffer that can be retrieved with another [cmd Control-z]. If the current command line is empty, then any saved command is retrieved without being overwritten, otherwise the current contents get swapped with what's in the saved command buffer. [def [cmd Control-Key-1]] Attaches console to the console's slave interpreter. [def [cmd Control-Key-2]] Attaches console to the console's master interpreter. [def [cmd Control-Key-3]] Attaches console to main TkCon interpreter. [def [cmd Control-A]] Pops up the "About" dialog. [def [cmd Control-N]] Creates a new console. Each console has separate state, including it's own widget hierarchy (it's a slave interpreter). [def [cmd Control-q]] Close the current console OR Quit the program (depends on the value of [cmd ::tkcon::TKCON(slaveexit)]). [def [cmd Control-w]] Closes the current console. Closing the main console will exit the program (something has to control all the slaves...). [list_end] [para] TkCon also has electric bracing (similar to that in emacs). It will highlight matching pairs of {}'s, [lb][rb]'s, ()'s and ""'s. For the first three, if there is no matching left element for the right, then it blinks the entire current command line. For the double quote, if there is no proper match then it just blinks the current double quote character. It does properly recognize most escaping (except escaped escapes), but does not look for commenting (why would you interactively put comments in?). [section COMMANDS] [para] There are several new procedures introduced in TkCon to improve productivity and/or account for lost functionality in the Tcl environment that users are used to in native environments. There are also some redefined procedures. Here is a non-comprehensive list: [list_begin definitions] [def "[cmd alias] ?[arg sourceCmd] [arg targetCmd] ?[arg arg] [arg arg] ...??"] Simple alias mechanism. It will overwrite existing commands. When called without args, it returns current aliases. Note that TkCon makes some aliases for you (in slaves). Don't delete those. [def "[cmd clear] ?[arg percentage]?"] Clears the text widget. Same as the <[cmd Control-l]> binding, except this will accept a percentage of the buffer to clear (1-100, 100 default). [def "[cmd dir] ?[arg -all]? ?[arg -full]? ?[arg -long]?\ ?[arg pattern] [arg pattern] ...?"] Cheap way to get directory listings. Uses glob style pattern matching. [def "[cmd dump] [arg type] ?[arg -nocomplain]? ?[arg {-filter pattern}]?\ ?[cmd --]? [arg pattern] ?[arg pattern] ...?"] The dump command provides a way for the user to spit out state information about the interpreter in a Tcl readable (and human readable) form. See [cmd dump](n) for details. [def "[cmd echo] ?[arg arg] [arg arg] ...?"] Concatenates the args and spits the result to the console (stdout). [def "[cmd edit] ?[arg {-type type}]? ?[arg {-find str}]?\ ?[arg {-attach interp}]? [arg arg]"] Opens an editor with the data from arg. The optional type argument can be one of: [arg proc], [arg var] or [arg file]. For proc or var, the arg may be a pattern. [def "[cmd idebug] [arg command] ?[arg args]?"] Interactive debugging command. See [cmd idebug](n) for details. [def "[cmd lremove] ?[arg -all]? ?[arg -regexp] [arg -glob]?\ [arg list] [arg items]"] Removes one or more items from a list and returns the new list. If [arg -all] is specified, it removes all instances of each item in the list. If [arg -regexp] or [arg -glob] is specified, it interprets each item in the items list as a regexp or glob pattern to match against. [def [cmd less]] Aliased to [cmd edit]. [def [cmd ls]] Aliased to [cmd dir] [arg -full]. [def [cmd more]] Aliased to [cmd edit]. [def "[cmd observe] [arg type] ?[arg args]?"] This command provides passive runtime debugging output for variables and commands. See [cmd observe](n) for details. [def "[cmd puts] (same options as always)"] Redefined to put the output into TkCon. [def "[cmd tkcon] [arg method] ?[arg args]?"] Multi-purpose command. See [cmd tkcon](n) for details. [def "[cmd tclindex] [arg {?-extensions patternlist? ?-index TCL_BOOLEAN?\ ?-package TCL_BOOLEAN? ?dir1 dir2 ...?}]"] Convenience proc to update the [file tclIndex] (controlled by [arg -index] switch) and/or [file pkgIndex.tcl] (controlled by [arg -package] switch) file in the named directories based on the given pattern for files. It defaults to creating the [file tclIndex] but not the [file pkgIndex.tcl] file, with the directory defaulting to [lb]pwd[rb]. The extension defaults to *.tcl, with *.[lb]info sharelibextension[rb] added when [arg -package] is true. [def "[cmd unalias] [arg cmd]"] unaliases command. [def "[cmd what] [arg string]"] The what command will identify the word given in string in the Tcl environment and return a list of types that it was recognized as. Possible types are: alias, procedure, command, array variable, scalar variable, directory, file, widget, and executable. Used by procedures dump and which. [def "[cmd which] [arg command]"] Like the [syscmd which] command of Unix shells, this will tell you if a particular command is known, and if so, whether it is internal or external to the interpreter. If it is an internal command and there is a slot in [cmd auto_index] for it, it tells you the file that [cmd auto_index] would load. This does not necessarily mean that that is where the file came from, but if it were not in the interpreter previously, then that is where the command was found. [list_end] [para] There are several procedures that I use as helpers that some may find helpful in there coding (i.e. expanding pathnames). Feel free to lift them from the code (but do assign proper attribution). [section EXAMLPES] [para] Some examples of tkcon command line startup situations: [example_begin] [cmd megawish] /usr/bin/tkcon [cmd -exec] "" [cmd -root] .tkcon [arg mainfile.tcl] [example_end] Use tkcon as a console for your [cmd megawish] application. You can avoid starting the line with megawish if that is the default [cmd wish] that TkCon would use. The [cmd -root] ensures that tkcon will not conflict with the application root window. [example_begin] [cmd tkcon] [cmd -font] "Courier 12" [cmd -load] Tk [example_end] Use the courier font for TkCon and always load Tk in slave interpreters at startup. [example_begin] [cmd tkcon] [cmd -rcfile] ~/.wishrc [cmd -color-bg] white [example_end] Use the ~/.wishrc file as the resource file, and a white background for TkCon's text widgets. [section FILES] TkCon will search for a resource file in [file ~/.tkconrc]. TkCon never sources the [file ~/.wishrc] file. The resource file is sourced by each new instance of the console. An example resource file is provided in [cmd tkconrc](5). [see_also [cmd tkconrc](5)] [see_also [cmd dump](n) [cmd tkcon](n) [cmd idebug](n)] [see_also [cmd observe](n) [cmd text](n)] [keywords Tk console] [manpage_end] ./tkcon/docs/style.css0000644000175000017500000000147210636603020014451 0ustar sergeisergeibody, div, p, th, td, li, dd, ul, ol, dl, dt, blockquote { font-family: Arial, Helvetica, sans-serif; } body { background-color: #FFFFFF; font-size: 12px; line-height: 1.25; letter-spacing: .2px; } th { font-style: bold; text-align: left; } a { text-decoration: none } .hi, .hi2 { font-weight: bold; color: #B82619; background: #FFFFCC; text-decoration: none; } .hi2 { background: #CCFFCC; } .indent { margin: 3px; } /* general styles */ .heading { font-size: 14px; font-weight: bold; color: #B82619; } .subheading { font-weight: bold; color: #B82619; } .err { font-weight: bold; color: #B82619; } .smallText{ font-size: 10px; } .notsosmallText { font-size: 11px; } /* unordered list without bullets */ ul.sans { list-style-type: none; list-style-postition: inside; } ./tkcon/docs/start.html0000755000175000017500000003327511151630377014643 0ustar sergeisergei tkcon: Getting Started
tkcon: Getting Started SourceForge Logo
Documentation Purpose & Features Limitations To Do License
Online Demo (requires Tk plugin) Using TkCon with other Tk Languages
Getting Started Special Bindings Procedures Screenshot
dump tkcon idebug observe

Resource File:

TkCon will search for a resource file in "$env(HOME)/.tkconrc" (Unix), "$env(HOME)/tkcon.cfg" (Windows) or "$env(PREF_FOLDER)/tkcon.cfg" (Macintosh). On DOS machines, "$env(HOME)" usually refers to "C:\". TkCon never sources the "~/.wishrc" file. The resource file is sourced by each new instance of the console. An example resource file is provided below.

Command Line Arguments

Except for -rcfile, command line arguments are handled after the TkCon resource file is sourced, but before the slave interpreter or the TkCon user interface is initialized. -rcfile is handled right before it would be sourced, allowing you to specify any alternate file. Command line arguments are passed to each new console and will be evaluated by each. To prevent this from happening, you have to say tkcon main set argv {}; tkcon main set argc 0.

For these options, any unique substring is allowed.

-argv (also --)
Causes TkCon to stop evaluating arguments and set the remaining args to be argv/argc (with -- prepended). This carries over for any further consoles. This is meant only for wrapping TkCon around programs that require their own arguments.
-color-<color> color
Sets the requested color type to the specified color for tkcon. See the Variables section for the recognized <color> names.
-eval (also -main or -e)
A tcl script to eval in each main interpreter. This is evaluated after the resource file is loaded and the slave interpreter is created. Multiple -eval switches will be recognized (in order).
-exec slavename
Sets the named slave that tkcon operates in. In general, this is only useful to set to "" (empty), indicating to tkcon to avoid the multi-interpreter model and operate in the main environment. When this is empty, any further arguments will be only used in the first tkcon console and not passed onto further new consoles. This is useful when using tkcon as a console for extended wish executables that don't load there commands into slave interpreters.
-font font
Sets the font that tkcon uses for its text windows. If this isn't a fixed width font, tkcon will override it.
-nontcl TCL_BOOLEAN
Sets ::tkcon::OPT(nontcl) to TCL_BOOLEAN. Needed when attaching to non-Tcl interpreters.
-package package_name (also -load)
Packages to automatically load into the slave interpreters (ie - "Tk").
-rcfile filename
Specify an alternate tkcon resource file name.
-root widgetname
Makes the named widget the root name of all consoles (ie - .tkcon).
-slave tcl_script
A tcl script to eval in each slave interpreter. This will append the one specified in the tkcon resource file, if any.
Some examples of tkcon command line startup situations:
megawish tkcon.tcl -exec "" -root .tkcon mainfile.tcl
Use tkcon as a console for your megawish application. You can avoid starting the line with megawish if that is the default wish that tkcon would use. The -root ensures that tkcon will not conflict with the
tkcon.tcl -font "Courier 12" -load Tk
Use the courier font for tkcon and always load Tk in slave interpreters at startup.
tkcon.tcl -rcfile ~/.wishrc -color,bg white
Use the ~/.wishrc file as the resource file, and a white background for tkcon's text widgets.

Variables:

Certain variables in TkCon can be modified to suit your needs. It's easiest to do this in the resource file, but you can do it when time the program is running (and some can be changed via the Prefs menu). All these are part of the master interpreter's ::tkcon namespace. The modifiable array variables are ::tkcon::COLOR and ::tkcon::OPT. You can call 'tkcon set ::tkcon::COLOR' when the program is running to check its state. Here is an explanation of certain variables you might change or use:
::tkcon::COLOR(bg)
The background color for tkcon text widgets. Defaults to the operating system default (determined at startup).
::tkcon::COLOR(blink)
The background color of the electric brace highlighting, if on. Defaults to yellow.
::tkcon::COLOR(cursor)
The background color for the insertion cursor in tkcon. Defaults to black.
::tkcon::COLOR(disabled)
The foreground color for disabled menu items. Defaults to dark grey.
::tkcon::COLOR(proc)
The foreground color of a recognized proc, if command highlighting is on. Defaults to dark green.
::tkcon::COLOR(var)
The background color of a recognized var, if command highlighting is on. Defaults to pink.
::tkcon::COLOR(prompt)
The foreground color of the prompt as output in the console. Defaults to brown.
::tkcon::COLOR(stdin)
The foreground color of the stdin for the console. Defaults to black.
::tkcon::COLOR(stdout)
The foreground color of the stdout as output in the console. Defaults to blue.
::tkcon::COLOR(stderr)
The foreground color of stderr as output in the console. Defaults to red.

::tkcon::OPT(autoload)
Packages to automatically load into the slave interpreter (ie - 'Tk'). This is a list. Defaults to {} (none).
::tkcon::OPT(blinktime)
The amount of time (in millisecs) that braced sections should blink for. Defaults to 500 (.5 secs), must be at least 100.
::tkcon::OPT(blinkrange)
Whether to blink the entire range for electric brace matching or to just blink the actual matching braces (respectively 1 or 0, defaults to 1).
::tkcon::OPT(buffer)
The size of the console scroll buffer (in lines). Defaults to 512.
::tkcon::OPT(calcmode)
Whether to allow expr commands to be run at the command line without prefixing them with expr (just a convenience).
::tkcon::OPT(cols)
Number of columns for the console to start out with. Defaults to 80.
::tkcon::OPT(dead)
What to do with dead connected interpreters. If dead is leave, TkCon automatically exits the dead interpreter. If dead is ignore then it remains attached waiting for the interpreter to reappear. Otherwise TkCon will prompt you.
::tkcon::OPT(exec)
This corresponds to the -exec option above
::tkcon::OPT(font)
Font to use for tkcon text widgets (also specified with -font). Defaults to the system default, or a fixed width equivalent.
::tkcon::OPT(gets)
Controls whether tkcon will overload the gets command to work with tkcon. The valid values are: congets (the default), which will redirect stdin requests to the tkcon window; gets, which will pop up a dialog to get input; and {} (empty string) which tells tkcon not to overload gets. This value must be set at startup to alter tkcon's behavior.
::tkcon::OPT(history)
The size of the history list to keep. Defaults to 48.
::tkcon::OPT(hoterrors)
Whether hot errors are enabled or not. When enabled, errors that are returned to the console are marked with a link to the error info that will pop up in an minimal editor. This requires more memory because each error that occurs will maintain bindings for this feature, as long as the error is in the text widget. Defaults to on.
::tkcon::OPT(library)
The path to any tcl library directories (these are appended to the auto_path when the after the resource file is loaded in).
::tkcon::OPT(lightbrace)
Whether to use the brace highlighting feature or not (respectively 1 or 0, defaults to 1).
::tkcon::OPT(lightcmd)
Whether to use the command highlighting feature or not (respectively 1 or 0, defaults to 1).
::tkcon::OPT(maineval)
A tcl script to execute in the main interpreter after the slave interpreter is created and the user interface is initialized.
::tkcon::OPT(maxlinelen)
A number that specifies the limit of long result lines. True result is still captured in $_ (and 'puts $_' works). Defaults to 0 (unlimited).
::tkcon::OPT(maxmenu)
A number that specifies the maximum number of packages to show vertically in the Interp->Packages menu before breaking into another column. Defaults to 15.
::tkcon::OPT(nontcl)
For those who might be using non-Tcl based Tk attachments, set this to 1. It prevents TkCon from trying to evaluate its own Tcl code in an attached interpreter. Also see my notes for non-Tcl based Tk interpreters.
::tkcon::OPT(prompt1)
Like tcl_prompt1, except it doesn't require you use 'puts'. No equivalent for tcl_prompt2 is available (it's unnecessary IMHO).
Defaults to {([file tail [pwd]]) [history nextid] % }.
::tkcon::OPT(rows)
Number of rows for the console to start out with. Defaults to 20.
::tkcon::OPT(scollypos)
Y scrollbar position. Valid values are left or right. Defaults to left.
::tkcon::OPT(showmenu)
Show the menubar on startup (1 or 0, defaults to 1).
::tkcon::OPT(showmultiple)
Show multiple matches for path/proc/var name expansion (1 or 0, defaults to 1).
::tkcon::OPT(slaveeval)
A tcl script to execute in each slave interpreter right after it's created. This allows the user to have user defined info always available in a slave. Example: 
	set ::tkcon::OPT(slaveeval) {
		proc foo args { puts $args }
		lappend auto_path .
	}
::tkcon::OPT(slaveexit)
Allows the prevention of exit in slaves from exitting the entire application. If it is equal to exit, exit will exit as usual, otherwise it will just close down that interpreter (and any children). Defaults to close.
::tkcon::OPT(subhistory)
Allow history substitution to occur (0 or 1, defaults to 1). The history list is maintained in a single interpreter per TkCon console instance. Thus you have history which can range over a series of attached interpreters.

An example TkCon resource file might look like: 

######################################################
## My TkCon Resource File
 
# Use a fixed default font
#tkcon font fixed; # valid on unix
#tkcon font systemfixed; # valid on win
tkcon font Courier 12; # valid everywhere

# Keep 50 commands in history
set ::tkcon::OPT(history) 50

# Use a pink prompt
set ::tkcon::COLOR(prompt) pink
######################################################

© Jeffrey Hobbs
./tkcon/docs/purpose.html0000755000175000017500000000555510101276642015176 0ustar sergeisergei tkcon: Purpose & Features
tkcon: Purpose & Features SourceForge Logo
Documentation Purpose & Features Limitations To Do License
Online Demo (requires Tk plugin) Using TkCon with other Tk Languages

Purpose:

tkcon is a replacement for the standard console that comes with Tk (on Windows/Mac, but also works on Unix). The console itself provides many more features than the standard console. tkcon works on all platforms where Tcl/Tk is available. It is meant primarily to aid one when working with the little details inside tcl and tk, giving Unix users the GUI console provided by default in the Mac and Windows Tk. It's also not a bad replacement for the default MS-DOS shell (although it needs lots of fine tuning).

See Limitations for a good idea of what tkcon can't do for you.

Features:

Just in case you don't run across them while playing, here are some of the extras in tkcon:
  • Command history
  • Path (Unix style) / Proc / Variable name expansion
  • Multiple consoles, each with its own state (via multiple interpreters)
  • Captures stdout and stderr to console window
  • Electric character matching (a la emacs)
  • Electric proc highlighting
  • Enhanced history searching
  • Configurable
  • Cut / Copy / Paste between windows
  • Communication between consoles and other Tk interpreters (including non-tcl ones)
  • Hot Errors (click on error result to see stack trace)
  • Works on all Tk platforms
Read the documentation for how to take advantage of these features.
© Jeffrey Hobbs
./tkcon/docs/procs.html0000755000175000017500000001447711151630377014637 0ustar sergeisergei tkcon: Procedures
tkcon: Procedures SourceForge Logo
Documentation Purpose & Features Limitations To Do License
Online Demo (requires Tk plugin) Using TkCon with other Tk Languages
Getting Started Special Bindings Procedures Screenshot
dump tkcon idebug observe

There are several new procedures introduced in TkCon to improve productivity and/or account for lost functionality in the Tcl environment that users are used to in native environments. There are also some redefined procedures. Here is a non-comprehensive list:

alias ?sourceCmd targetCmd ?arg arg ...??
Simple alias mechanism. It will overwrite existing commands. When called without args, it returns current aliases. Note that TkCon makes some aliases for you (in slaves). Don't delete those.
clear ?percentage?
Clears the text widget. Same as the <Control-l> binding, except this will accept a percentage of the buffer to clear (1-100, 100 default).
dir ?-all? ?-full? ?-long? ?pattern pattern ...?
Cheap way to get directory listings. Uses glob style pattern matching.
dump type ?-nocomplain? ?-filter pattern? ?--? pattern ?pattern ...?
The dump command provides a way for the user to spit out state information about the interpreter in a Tcl readable (and human readable) form. See further dump docs for details.
echo ?arg arg ...?
Concatenates the args and spits the result to the console (stdout).
edit ?-type type? ?-find str? ?-attach interp? arg NEW in v1.4, still under construction
Opens an editor with the data from arg. The optional type argument can be one of: proc, var or file. For proc or var, the arg may be a pattern.
idebug command ?args?
Interactive debugging command. See further idebug docs for details.
lremove ?-all? ?-regexp -glob? list items
Removes one or more items from a list and returns the new list. If -all is specified, it removes all instances of each item in the list. If -regexp or -glob is specified, it interprets each item in the items list as a regexp or glob pattern to match against.
less
Aliased to edit.
ls
Aliased to dir -full.
more
Aliased to edit.
observe type ?args?
This command provides passive runtime debugging output for variables and commands. See further observe docs for details.
puts (same options as always)
Redefined to put the output into TkCon
tkcon method ?args?
Multi-purpose command. See further tkcon docs for details.
tclindex ?-extensions patternlist? ?-index TCL_BOOLEAN? ?-package TCL_BOOLEAN? ?dir1 dir2 ...?
Convenience proc to update the tclIndex (controlled by -index switch) and/or pkgIndex.tcl (controlled by -package switch) file in the named directories based on the given pattern for files. It defaults to creating the tclIndex but not the pkgIndex.tcl file, with the directory defaulting to [pwd]. The extension defaults to *.tcl, with *.[info sharelibextension] added when -package is true.
unalias cmd
unaliases command
what string
The what command will identify the word given in string in the Tcl environment and return a list of types that it was recognized as. Possible types are: alias, procedure, command, array variable, scalar variable, directory, file, widget, and executable. Used by procedures dump and which.
which command
Like the 'which' command of Unix shells, this will tell you if a particular command is known, and if so, whether it is internal or external to the interpreter. If it is an internal command and there is a slot in auto_index for it, it tells you the file that auto_index would load. This does not necessarily mean that that is where the file came from, but if it were not in the interpreter previously, then that is where the command was found.
There are several procedures that I use as helpers that some may find helpful in there coding (ie - expanding pathnames). Feel free to lift them from the code (but do assign proper attribution).
© Jeffrey Hobbs
./tkcon/docs/plugin.html0000755000175000017500000001034410636602244014773 0ustar sergeisergei tkcon: Tcl Plugin Stripped Demo
tkcon Documentation (May 2001) SourceForge Logo
Documentation Purpose & Features Limitations To Do License
Online Demo (requires Tk plugin) Using TkCon with other Tk Languages

This is the full tkcon script when run inside the plugin. It feels like a stripped down version of tkcon, but the only limitations are those established by the plugin. You can test the basic console features and get a feel for the mutli-color output. Below the demo are some ideas to try out. v2+ of the plugin is distributed with a megawidget version of tkcon for debugging tclets. The demo below uses the CVS head of tkcon.

Have a look at some of the features: (culled from the tkcon documentation)
  • Variable / Path / Procedure Name Expansion. Type in set tc at the prompt. Hit <Control-Shift-V>. set tcl_ should now be visible. Hit <Control-Shift-V> again. You should see the rest of the completions printed out for you. Works the same for procedures and files paths (file access restricted from plugin). Works properly when spaces or other funny characters are including in the name.
  • Command Highlighting. Note that set should be in green, denoting it is a recognized command in that interpreter.
  • Electric Character Matching. Watch while you type the following: proc foo { a b } { puts [list $a $b] }. Did you notice the blink matching of the braces? Yes, it's smart.
  • Command History. Use the Up/Down arrows or <Control-p>/<Control-n> to peruse the command history. <Control-r>/<Control-s> Actually does command history matching (like tcsh or other advanced Unix shells).
  • Useful Colorization. Having defined foo above, type in foo hey. Note that the error comes back in red. Go up one in the command history and add you and see that regular stdout output comes through in blue (the colors are configurable).
  • Cut/Copy/Paste. You should be able to do that between outside windows and TkCon. The default keys are <Control-x>/<Control-c>/<Control-v>.
© Jeffrey Hobbs
./tkcon/docs/perl.txt0000755000175000017500000000462507161727554014332 0ustar sergeisergei#!/usr/local/bin/perl -w # tkcon.pl - a Perl/Tk "shell" companion for tkcon.tcl. # # Variable $MW is an object reference to the main window, from which you can # create and manipulate child widgets. Variable names beginning with an # underscore are reserved for this application. # # Stephen O. Lidie, 96/08/25 require 5.002; use English; use Tk; use Tk::Pretty qw(Pretty); use Tk::Dialog; use strict; use subs qw(doit tkcon); my($MW, $_TKCON, $_VERSION, $_HELP, $_SHELL, $_TAB, $_PARA, @_ERRORS, $_MES); tkcon; # main sub doit { # Eval some code without use strict constraints. my($code) = @ARG; { no strict; if ($_MES) { $_MES->packForget; $_MES->destroy; $_MES = 0; } @_ERRORS = (); $SIG{'__WARN__'} = sub {push @_ERRORS, @ARG}; my $_res = eval $code; push @_ERRORS, $EVAL_ERROR if $EVAL_ERROR; push @_ERRORS, $_res; } } # end doit sub tkcon { # Nothing fancy here, just create the main window and the help dialog # object, and display a pointer to the help. $_TKCON = 'tkcon.pl'; $_VERSION = '0.2'; $_SHELL = '/bin/sh'; $_SHELL = $ENV{'SHELL'} if $ENV{'SHELL'}; $_TAB = 0; $_PARA = ''; $MW = MainWindow->new; $MW->title($_TKCON); $MW->iconname($_TKCON); $_HELP = $MW->Dialog( -title => "$_TKCON Help", -font => 'fixed', -wraplength => '6i', -justify => 'left', -text => "? - this text.\n" . "| - pass arguments to your shell (default /bin/sh).\n" . "p - use Tk::Pretty to \"pretty-print\" arguments.\n" . "+ - a tab starts/stops multiline input mode.\n" . "exit - quit $_TKCON.\n" . "\nOther input is assumed to be a Perl/Tk command.\n" . "\n\$MW is the MainWindow.\n", ); $_HELP->configure(-foreground => 'blue'); $_MES = $MW->Label(-text => "\nEnter ? for help.\n")->pack; MainLoop; } # end tkcon sub Tk::Receive { shift(); $ARG = shift(); if (/^\?(.*)/) { # help $_HELP->Show; } elsif (/^\|(.*)/) { # bang @_ERRORS = (); push @_ERRORS, `$_SHELL -c $1 2>&1`; } elsif (/^\+$/) { $_TAB++; if ($_TAB % 2) { @_ERRORS = (); $_PARA = ''; push @_ERRORS, '+'; } else { doit $_PARA; } } else { # Perl/Tk command $ARG = "Pretty($1)" if (/^p\s(.*)$/); if ($_TAB % 2) { $_PARA .= $ARG; push @_ERRORS, '+'; } else { doit $ARG; } } # ifend return @_ERRORS; } # end Tk::Receive ./tkcon/docs/observe.n.man0000644000175000017500000000347110636602244015205 0ustar sergeisergei[comment {-*- tcl -*- observe manpage}] [manpage_begin observe n 2.5] [copyright {Jeffrey Hobbs }] [moddesc {TkCon}] [titledesc {Runtime debugging output in TkCon}] [description] [para] This command provides runtime debugging output for variables and commands without the need to edit your code. For variables, the underlying mechanism uses [cmd trace] and [cmd dump] var. For commands, it renames the observed procedure and uses a special wrapper procedure. WARNING: using this procedure after checkpointing state will result in major problems if you clean state because the renamed (true) commands will be lost. [para] This procedure is experimental. Comments are encouraged. [list_begin definitions] [call [cmd observe] [arg command] [arg cmdname] [opt [arg maxlevel]]] This will create a wrapper command which prints out (using [cmd dump]) the call stack to the console. maxlevel represents the maximum number of levels of the call stack which will be printed (defaults to 4). [call [cmd observe] [arg cdelete] [arg cmdname]] Removes the wrapper around an observed command. [call [cmd observe] [arg cinfo] [arg cmdname]] Prints out useless info. [call [cmd observe] [arg variable] [arg varname] [arg operation] [opt [arg args]]] Currently a wrapper around trace that uses [cmd dump] to print out the value of the named variable whenever the specified operation on that variable occurs (must be [arg read], [arg write] or [arg unset]). [call [cmd observe] [arg vdelete] [arg varname] [arg operation]] Deletes the trace wrapper around the named variable. [call [cmd observe] [arg vinfo] [arg varname]] Prints out trace info about the named variable. [list_end] [see_also [cmd tkcon](1)] [see_also [cmd tkconrc](5) [cmd tkcon](n) [cmd dump](n)] [see_also [cmd idebug](n)] [keywords Tk console debug] [manpage_end] ./tkcon/docs/observe.html0000755000175000017500000000715111151630377015145 0ustar sergeisergei tkcon: observe procedure
tkcon: observe procedure SourceForge Logo
Documentation Purpose & Features Limitations To Do License
Online Demo (requires Tk plugin) Using TkCon with other Tk Languages
Getting Started Special Bindings Procedures Screenshot
dump tkcon idebug observe

This command provides runtime debugging output for variables and commands without the need to edit your code. For variables, the underlying mechanism uses trace and dump var. For commands, it renames the observed procedure and uses a special wrapper procedure. WARNING: using this procedure after checkpointing state will result in major problems if you clean state because the renamed (true) commands will be lost.

This procedure is experimental. Comments are encouraged.

observe command cmdname ?maxlevel?
This will create a wrapper command which prints out (using dump) the call stack to the console. maxlevel represents the maximum number of levels of the call stack which will be printed (defaults to 4).
observe cdelete cmdname
Removes the wrapper around an observed command.
observe cinfo cmdname
Prints out useless info.
observe variable varname operation ?args?
Currently a wrapper around trace that uses dump to print out the value of the named variable whenever the specified operation on that variable occurs (must be read, write or unset).
observe vdelete varname operation
Deletes the trace wrapper around the named variable.
observe vinfo varname
Prints out trace info about the named variable.
© Jeffrey Hobbs
./tkcon/docs/nontcl.html0000755000175000017500000000476511174406737015013 0ustar sergeisergei tkcon for Non-Tcl Users
tkcon: Non-Tcl Usage SourceForge Logo
Documentation Purpose & Features Limitations To Do License
Online Demo (requires Tk plugin) Using TkCon with other Tk Languages
This document is for those users who are trying to use TkCon with a non-Tcl based Tk language (ie - SchemeTk, PerlTk, PythonTk...).

TkCon requires Tcl/Tk 8.4+ to run. However, it can attach to any language with Tk4+ embedded into it with the use of the Tk 'send' command. I have been able to succesfully talk to SchemeTk-3.0 and Perl/Tk. When using TkCon attached to these interpreters, you must remember to talk to the connected interpreter in its language.

I welcome further comments from users of Tk-embedded languages on their experiences or ideas. Of course, you can always try to port TkCon in full to your language. I'd like to see the results from any such efforts.

Special Language Notes:

Perl Tk

Read the man page on Perl/Tk's send command. You have to define Tk::Receive before it will work. Stephen Lidie (lusol@Turkey.CC.Lehigh.EDU) contributed a companion Perl/Tk program that does the trick with some extras.
© Jeffrey Hobbs
./tkcon/docs/limits.html0000755000175000017500000000553511174406737015013 0ustar sergeisergei tkcon: Limitations
tkcon: Limitations SourceForge Logo
Documentation Purpose & Features Limitations To Do License
Online Demo (requires Tk plugin) Using TkCon with other Tk Languages

Limitations:

TkCon requires Tk8.4+. Since TkCon is meant to behave like the original Tk console, it does not separate itself from the environment (it does not use send to function, except when attached to foreign Tk interpreters). This means that it can be can be altered or destroyed by any sourced applications, and it will respond to an application's 'exit' call by exiting (by default, slave consoles will only close themselves instead of exiting the entire TkCon environment). However, the widget tree of TkCon is hidden from the user environment.

Since TkCon is built for cross-platform capability, in Unix/Windows environments it does not have tty/shell behavior. This means programs like vi and less (those that rely on tty/shell settings) will not function appropriately (currently they may hang TkCon). Programs like ls and more will just spit output to the TkCon screen without any special control or formatting (note that ls has been rewritten for TkCon). You also do not get any job (process) control outside of what tcl normally can provide. Currently there is no way to handle stdin input.

When connecting to non-Tcl Tk interpreters (ie - PerlTk, SchemeTk, ...), you must use the syntax of the target environment. See my notes on using other Tk-embedded languages for more info.

© Jeffrey Hobbs
./tkcon/docs/license.terms0000755000175000017500000000321311652543300015276 0ustar sergeisergei * COPYRIGHT AND LICENSE TERMS * This software is copyrighted by Jeffrey Hobbs . The following terms apply to all files associated with the software unless explicitly disclaimed in individual files. The authors hereby grant permission to use, copy, modify, distribute, and license this software and its documentation for any purpose, provided that existing copyright notices are retained in all copies and that this notice is included verbatim in any distributions. No written agreement, license, or royalty fee is required for any of the authorized uses. IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. SPECIAL NOTES: This software is also falls under the bourbon_ware clause v2: This software is free, but should you find this software useful in your daily work and would like to compensate the author, donations in the form of aged bourbon and scotch are welcome by the author. The user may feel exempt from this clause if they are below drinking age or think the author has already partaken of too many drinks. ./tkcon/docs/index.html0000755000175000017500000000465111151630377014611 0ustar sergeisergei tkcon: Documentation
tkcon Documentation (June 2001) SourceForge Logo
Documentation Purpose & Features Limitations To Do License
Online Demo (requires Tk plugin) Using TkCon with other Tk Languages

Release Archives (high speed server)

Screenshot

Please read the following pages carefully to fully understand the features AND limitations of TkCon. I'm always open to suggestions for improvement.

Getting Started Special Bindings tkcon Procedures Screenshot
dump proc tkcon proc idebug proc observe proc
© Jeffrey Hobbs
./tkcon/docs/idebug.n.man0000644000175000017500000000562210636602244014777 0ustar sergeisergei[comment {-*- tcl -*- idebug manpage}] [manpage_begin idebug n 2.5] [copyright {Jeffrey Hobbs }] [moddesc {TkCon}] [titledesc {Interactive debugging environment in TkCon}] [description] [para] The idebug command provides an interactive debugging environment for procedures via TkCon. You can place idebug break commands into your procedure to create breakpoints. It will pop up the TkCon console and put you into a "debugging" mode. The [arg body], [arg show] & [arg trace] methods are intended for internal use only. This procedure works for minimal debugging sessions. Comments are encouraged. [list_begin definitions] [call [cmd idebug] [arg body] [opt [arg level]]] Prints out the body of the command (if it is a procedure) at the specified level. level defaults to the current level. [call [cmd idebug] [arg break] [opt [arg id]]] Creates a breakpoint within a procedure. This will only trigger if idebug is on and the [arg id] matches the pattern. If so, TkCon will pop to the front with the prompt changed to an idebug prompt. You are given the basic ability to observe the call stack an query/set variables or execute Tcl commands at any level. A separate history is maintained in debugging mode. To see the special commands available at the debug prompt, type ? and hit return. [call [cmd idebug] \{[arg "[arg echo] [opt [arg id]]"]\} [opt [arg args]]] Behaves just like [cmd echo], but only triggers when idebug is on. You can specify an optional [arg id] to further restrict triggering. If no id is specified, it defaults to the name of the command in which the call was made. [call [cmd idebug] [arg id] [opt [arg id]]] Query or set the idebug id. This id is used by other idebug methods to determine if they should trigger or not. The idebug id can be a glob pattern and defaults to *. [call [cmd idebug] [arg off]] Turns idebug off. [call [cmd idebug] [arg on] [opt [arg id]]] Turns idebug on. If [arg id] is specified, it sets the id to it. [call [cmd idebug] \{[arg "[arg puts] [opt [arg id]]"]\} [arg args]] Behaves just like [cmd puts], but only triggers when idebug is on. You can specify an optional [arg id] to further restrict triggering. If no id is specified, it defaults to the name of the command in which the call was made. [call [cmd idebug] [arg show] [arg type] [opt [arg level]] [opt [arg VERBOSE]]] type must be one of vars, locals or globals. This method will output the variables/locals/globals present in a particular level. If [arg VERBOSE] is added, then it actually [cmd dump]s out the values as well. level defaults to the level in which this method was called. [call [cmd idebug] [arg trace] [opt [arg level]]] Prints out the stack trace from the specified level up to the top level. level defaults to the current level. [list_end] [see_also [cmd tkcon](1)] [see_also [cmd tkconrc](5) [cmd tkcon](n) [cmd dump](n)] [see_also [cmd observe](n)] [keywords Tk console debug] [manpage_end] ./tkcon/docs/idebug.html0000755000175000017500000001124111151630377014732 0ustar sergeisergei tkcon: idebug procedure
tkcon: idebug procedure SourceForge Logo
Documentation Purpose & Features Limitations To Do License
Online Demo (requires Tk plugin) Using TkCon with other Tk Languages
Getting Started Special Bindings Procedures Screenshot
dump tkcon idebug observe

The idebug command provides an interactive debugging environment for procedures via TkCon. You can place idebug break commands into your procedure to create breakpoints. It will pop up the TkCon console and put you into a "debugging" mode. The body, show & trace methods are intended for internal use only.

This procedure works for minimal debugging sessions. Comments are encouraged.

idebug body ?level?
Prints out the body of the command (if it is a procedure) at the specified level. level defaults to the current level.
idebug break ?id?
Creates a breakpoint within a procedure. This will only trigger if idebug is on and the id matches the pattern. If so, TkCon will pop to the front with the prompt changed to an idebug prompt. You are given the basic ability to observe the call stack an query/set variables or execute Tcl commands at any level. A separate history is maintained in debugging mode. To see the special commands available at the debug prompt, type ? and hit return.
idebug {echo ?id?} ?args?
Behaves just like echo, but only triggers when idebug is on. You can specify an optional id to further restrict triggering. If no id is specified, it defaults to the name of the command in which the call was made.
idebug id ?id?
Query or set the idebug id. This id is used by other idebug methods to determine if they should trigger or not. The idebug id can be a glob pattern and defaults to *.
idebug off
Turns idebug off.
idebug on ?id?
Turns idebug on. If id is specified, it sets the id to it.
idebug {puts ?id?} args
Behaves just like puts, but only triggers when idebug is on. You can specify an optional id to further restrict triggering. If no id is specified, it defaults to the name of the command in which the call was made.
idebug show type ?level? ?VERBOSE?
type must be one of vars, locals or globals. This method will output the variables/locals/globals present in a particular level. If VERBOSE is added, then it actually 'dump's out the values as well. level defaults to the level in which this method was called.
idebug trace ?level?
Prints out the stack trace from the specified level up to the top level. level defaults to the current level.
© Jeffrey Hobbs
./tkcon/docs/dump.n.man0000644000175000017500000000332612067147165014512 0ustar sergeisergei[comment {-*- tcl -*- dump manpage}] [manpage_begin dump n 2.5] [copyright {Jeffrey Hobbs }] [moddesc {TkCon}] [titledesc {Dump information about Tcl interpreter in TkCon}] [description] [para] The dump command provides a way for the user to spit out state information about the interpreter in a Tcl readable (and human readable) form. It takes the general form: [list_begin definitions] [call [cmd dump] [arg method]\ [opt [arg -nocomplain]]\ [opt [arg "-filter pattern"]]\ [opt [cmd --]]\ [arg pattern]\ [opt [arg "pattern ..."]]] [list_end] [para] The patterns represent glob-style patterns (as in [cmd string] [arg {match pattern $str}]). [arg -nocomplain] will prevent dump from throwing an error if no items matched the pattern. [arg -filter] is interpreted as appropriate for the method. The various methods are: [list_begin definitions] [def "[cmd dump] [arg command] [arg args]"] Outputs one or more commands. [def "[cmd dump] [arg procedure] [arg args]"] Outputs one or more procs in sourceable form. [def "[cmd dump] [arg variable] [arg args]"] Outputs the values of variables in sourceable form. Recognizes nested arrays. The -filter pattern is used as to filter array element names and is interepreted as a glob pattern (defaults to {*}). It is passed down for nested arrays. [def "[cmd dump] [arg widget] [arg args]"] Outputs one or more widgets by giving their configuration options. The -filter pattern is used as to filter the config options and is interpreted as a case insensitive regexp pattern (defaults to {.*}). [list_end] [see_also [cmd tkcon](1)] [see_also [cmd tkconrc](5) [cmd tkcon](n) [cmd idebug](n)] [see_also [cmd observe](n)] [keywords Tk console dump] [manpage_end] ./tkcon/docs/dump.html0000755000175000017500000000664011151630377014447 0ustar sergeisergei tkcon: dump procedure
tkcon: dump procedure SourceForge Logo
Documentation Purpose & Features Limitations To Do License
Online Demo (requires Tk plugin) Using TkCon with other Tk Languages
Getting Started Special Bindings Procedures Screenshot
dump tkcon idebug observe

The dump command provides a way for the user to spit out state information about the interpreter in a Tcl readable (and human readable) form. It takes the general form:

dump method ?-nocomplain? ?-filter pattern? ?--? pattern ?pattern ...?
The patterns represent glob-style patterns (as in string match pattern $str). -nocomplain will prevent dump from throwing an error if no items matched the pattern. -filter is interpreted as appropriate for the method. The various methods are:
dump command args
Outputs one or more commands.
dump procedure args
Outputs one or more procs in sourceable form.
dump variable args
Outputs the values of variables in sourceable form. Recognizes nested arrays. The -filter pattern is used as to filter array element names and is interepreted as a glob pattern (defaults to {*}). It is passed down for nested arrays.
dump widget args
Outputs one or more widgets by giving their configuration options. The -filter pattern is used as to filter the config options and is interpreted as a case insensitive regexp pattern (defaults to {.*})
© Jeffrey Hobbs
./tkcon/docs/demopic.png0000644000175000017500000012241510636602244014735 0ustar sergeisergeiPNG  IHDRt8%FsRGBgAMA a cHRMz&u0`:pQ<IDATx^ipG3=#:޷Ḋ/1&ޘޞwp/vK7ش F`1fel E`Y1HH:Gmܶۖ>OV=/*~J?O?^IDw{8[g7NQG,$* @ {ll_t?,]+[!ꄗvDKz U&*Y"bTh@PT  bBm[IŊ@mE)@=ik0y PUt.X_^4c޿#)DPTY@VYK~ nkņ+v%u Mt *AP..0}B* W`W >.\z U:!@b]-_{w(, /].J_DMp j] +./owX^"1,yI(<_'y*`_1N +WfTAD|2 |>B?A!6r_@ST7 0b:4 u -* \WG( uRbuDu"kX7<v17p',yr 8MSmT \_Xʕ]y-n8C W #\cx* 3p؝ ;k?%Ð}ŧެxu<|8:@Vz @lzF =Sէ]GʻFv=Xy̎ 66_]O.z<5xZmiS*V6/m,\`юu۟mrk^RUP,EPT \|\PSl8?Ț+w2$Uߡt5GoN[ې&U*5}Yj 0sty«?i'[&f*^R.ݲa5{ZW6,Rzm5M/4=#Ѷ)^_jBuO 8;ÅgXBT@BQA¢ %9w=HC֝/9\a@֧~S~76%ߒgs*?re /֤KVKM[=eaĺ|~ԑIJT\~ךuUKZ_iY\pYKM{9~Wy:tX4 @ ]!ksK??\dӎuc{?fm /"TUiu)jYSS㫻]XiÅFhg}w\%ZU;W$k5U44"n`۔ڍ]y$t|,#* a*k]+F饲꺫@V|׮ >_{ߏ~#m*t@BOpe!ꚐFi YM)~᢮QE]-6r{'P裸•KUܧWȫi ˶.FS5O:yƉ/λ@ i0{.FPT \*^,q::d]wuW]W_ߺvlᴻV5-@I>.1Id[1-w7Pgsg'/HI=1 Gt,#?7\'TF.\R @-u/npw<3wm_8'J!Eum+5 @ 8pwt㶒[g:Q\Oپm~Pjga]g@ hٕ&] =yQzq5+SF/L ?ixމ;peR#TpKU ȫ`qs՚k>k5w)swLa3*W<^y"\h@P+@ :ѪWg}n]?pjsoCYm?e \)qŋlg.9=RWΛ8'>=.DMѪ􈊞J+J7yy@MR.U W!@ƙV6W64WyM˛)oTyB1EWL5} @h \Wp[qcsnc)PR$We@K)%um?M>b`Sաc_,y空v#^{JwϺ˼XRMX3~~غj{ RU4t@TkJ5߹R2iRkO3"pvu[4 @ pK:wCV ??lij\?R-El%줮-^4%fEu7Ͻqwō_ܕmX$פ"Ts\i*X\DkXR\kB)- zt>U܁+@ƻcPT_7e>YΆBT\7l rt #lz+ V}uVB֭]@=]2㞇GIX`-Pvg.9OݺCsnX{_n/#p=I5UNqJyӬڦWjKٲ%wΞҝSZ&:.|ȫbU\8u@xs oڿ! "Bsg}c+r+N.rq蟪>=ӣz]MPyw~=cXC"v\ H}rU6/n*^TufeԒg fm~*%[X% <zf¡CY|7No[=+53>+@P "'?!i{ _qoѕJ,ۊ;Fw_wsX~ǰim`P!~!{{5@ buqUe6ۮaw7y<i&?;W4avP8Or‰Ls緧*_q~P-T{ka;-bUW<@"cCXyPMO ;Or/l"&ϑ! ߤH?qB\3j?Yd9!\w4Q 1 * Q=߶M- ?,\zBsn9Np Oz?9n0iX π_U;ϴ 7`Q(>)Iz`/3*cT Ǜ{x#\a)\G:@G2x;@(`B[|x;sj+X^MC\ۧ>uJq8@ }݋Mq XPE c.{^M_Y7;]pg8@00 K % cV_,FL,.@F{{7Օ>"f9n̓'>τp A&^\a1 D *0 4e {7;]Zx&Wj-MW[K^z.K-JO=Q=ݏwq&SRO@~7},oOoȝx#\]I#Yk>v/P`)iCY2t֖ =†ːކ ,\.]!=gMpUjݓvu&2^SY0 '+ ر-UY ZPaǛ{7}}ywpeRV墲i%/~Olx@ʟ;~om:q,-oի7xK=U|u$gd=\p $=ުWyv}-xۅpEvn!ʅlFbyCJžs)YN1 D *Q xs&\;\4&rpZU 9\]u@VqzQ-A;vES=>:W9*ׁ#7GW&-HO^0=i~z\M#ũ S)~KNG&".\R!@^4]\y1iTnʫ\x  + [81C] \[|(zWvSG;UIG+GVZW[phΥ!I<#q{OԤJ蹯4}_I}ܝw7ITaTpKE!go*[\\k\LyW)ț$W|PGX W|7}x.fp9jAp/ws3{b@퓋L#jCǾYxMSu=\7cT`ops -lmR qg\xyݰ{O,[2pگ׏yQ]Tz42?0b&W|7yx[+{^b|Ì!!&Cց&d=^ H,퓌T]"p@`vA0ꛗ9P:@ߗ"~fH#pG | "p@=ޡ;zg0V8@ =ØW71jNǽEW(2o+:*Qk:Uak*,-=\sb\p[j'7?l ߒ@nRDJOGi"ZڳQe~jx3>3=_M g<8=ӤRR=fhA2 {҈vh"Y>@(ϙ#N_ GH+7vhNp?؞|s*,`b}`ʙ矬mgCނO!LZr Đ-H{IÄ66Vv-vg]=40~`{6Tpbc0Prզka.oZ V'+$(@ZpA вY">\C5YU= \0cД4\d 3k!ۃ*@48@ɊGJt,zWXϘo#ǟp] \iSrhuĨೖ֊ Wb!WxeC ^R>>5,ZՆ+,8X<@, ū%uC4ZJB!CKHY;6\*YV\,^4 aх;yIpY%2OW ok]OMs_lXXpE;fmv޶UM({eJmkڑk.\CǏ+\9U4Q! lBe4+8h\PmSE ]DW$[*뿋Y!kkˊcr.CdY a4aћ֥6IJM_{?]9϶vɖ7Iul\]p~"s39/Ðug gWoXT~2yW G_٢|TUk%Sϥ-{b]SU]Wt>Ztm~ރiR2p=rn5{wq_몖eԿTjmSyCclVs"p%/Ga8*8ĊΙQFx•._Le}eqP`Ov\U2׷ >$1ǡI#7ZgٱC&;dmpspp?Klڱny\`RB ^_1ӣ X#35y kjR}j|uU]˺+|ڈ?T^ĥ7C;+꥝ZwIR5׬khh,YE>})'T=7*w!;pN0,Єk3Z؞jje3]чqIeҚ:H KA\mu~IRً< dpPᴼ@kя~$ MҺ ɶ 'Y [R\sjJHkMhT7R0);dY:Po];p| >\xW$l6~k ޽Ԍe=3K?$=yAz|M9ݏv?T={d!|y: pV\TM%[^y빩i3swL6ՉsWJյۮ:5)[5m AWU5K5e4Vbgs^*.eXRlv-+MQ]jJ"S,BNdME8HtTV&߀ Xu 83}[ǁ^T@XY9+grâGnLMZ(=yaz㕩GS#S~S ̿4<2ѹTpKU ȫ`qs՚k>k54Nc۟ܔWȫtEWp^mJ7#U%:=ŻkFziT@ 0׵+Ds:KaF#/+peki<:QxQmyuiFw( ]IIq^a5&g<#q{OԤJ蹯4}_I}ܝw7IZ67.\RUpj9leseCsKj\LyW)ʖ^|%gΕ4@BxpDf)uQǬ' Pڂ=W7p&җcy0֊1V } 5_\Z1 \45LI~#zyA#^{JwϺ˼ԋK5aA=czT`KU$H8dYs-ei-SK&t1!/W_ag\>Ƨ5>uzI†!iu'ϕ>Snn=-)[ir}lot&uVMY??IJ% qX(@Ͷ wjW[{+UsNܺ#Us77˒ {лZkR \9kATS4,h.]JVh)d!s▉[Z=:I±&j_Sbp%W%kD-)K j4fdvf ʎX#UboؓuM!. h?O.q# $AD,(KH\^+YS-М\S{]ת\|Aj5UNqJyӬڦWjKٲ%wΞҝSZ&:.|ȫbU\C4F~t\U\) Wn&B+?߹u?1ud 5S +ΰ4uɁ>=ӣz]MPyw~=cXC"Ur}, ɥ;fT5ήk,ZTxQSт֙SKZ)lʛn ]v0PL \|/m 1"\aCfsgJ!@['?!i{X(ٟxzt[t+#˯)6Wŝ(1lZۃ3O:FzS*|֦ozj̚gnQuz֩['m͛eO毚T y9Ǡ(\mh29A#\#0T@;҉JV\.1{歸Ni՚RemR*\+3έ'}up]c5Xidd;*2ĥ߹fQdp-Wq2rDI07[t5`g^697Ҭũ\_fi]S0"nM"vEJm\h:]NwI]LY6Z5W|ď >ʖIRZSAk[jF*EFp@d.0|kFmܫ*è~Bm+[Si蹆%a)EF 2fa@pqjD"k\ \` p˖@trvU[vD`9`Ȣ c {wUM:_`=)\:EɃ(`A in --wU~6f kX#\Rw{"^ \jkX"\#PջfV"\Rv-TpW0Uk5Y \p!4mBR9pG9Q;/.49J4j~*Z CDfWp Es K=W4Yi_Ir p ^Eզװoݤp2s ~.gyAGР^xuI3a)!\Yl-VW/SָV*cndp͍vU +VT:ﹲ.X=n"q(kS:\ :Vvm}t5A,լHq‚K/N"aPt8z+ W*q#|$1`Æ+ygO'hk#52QăJHp{j" I .!lTfC (x5\-=ƥ†Ry"KTWQrUU#Z(eMI墹6W[l3\9ׅSښb|骑8Njxb.R^HLcUq\@H>\USM(bcXj:hJ^;Y@ݼfݣj bX#lQ*2^j~=&II \U)*,HOPjrE \aDs%H6=U* ]U$j9i4)ppfL9ڤlaEy fdpTF H[8\keCÐKF=3v+]1AIv'#hHaU<>gޟL%Xyb"\UWs1À̕NJ/h,_a\5= r:{+Aʊp5QC?CאE>`NGܾ|(]"e%Wh^{&81_Bt}=̖nJp IX4CPͥq2Id &q1{&1+lI%f6W\GI \UMŵmTFV'\ALZΘl KkṵkbzݤCS֮aJ@XpNa=+6́*\Rfpa "م+WCVDT2\H̼.U9TBkH¢Y ؅`X)`[v \[XpUs \xએp ? \R;tAmæyvc"\tkװZـd0L˰!\O퉧 -kQK%21:绚^͹a*P>iO~`ł! eG:5SH,{XWA`Lt0:&p5)8bئk^\ 0 yy-,W٪aUEL'en#WKq; 5TKTlQU 1y\sRZڊ5bEeV=\MVh,\ac@C!BR5$h`N" ETH]a)B?t" ml ƒ;! { TBUۻ hP(q۱`+\EVA.᪡F&MU5>?D"!>hE5Βh5S:r IŊ@mPE)P@=ik`@@LJG($WwVr A b|"ي% LAm&ZO\ZAzVzd`'ċ!X_^4c޿঑M`;|ҵZ A,],h n]w1Q*\]A5 l`M05Ap' @P6T|岆˅K/L)~_=jB .=KBvpd nn 1 뮖(^~ar/5Hµ<)P%h*φKNp`bvLۋ^P$EA`y +~0}I42y;Wԣ ͗.S*Q*a\k0@v` ' t B:L(ENpt \nj=lC {ؘu 俰X9*0HCPHjh\Ap 4p]7<v17p',yr 8☦ph'.+ ZpqvŇ@g\ @9ps|dsڴ}7+n3+,=0Eh$ Ӯ,\a:aɫWQBeEq'GWuQ]v7ႶWST \$ ok]OMs_lXXpE;fmv޶UM({eJmk Wgf Yk>.ZxăM[e8?Ț+wk2$*)PzBW@k p'GoN[ې&U*5}Yj 0sty«?i'[&%xI;HպtΆݻi]ԲdsK݆Ms4UX܎Eۦ{y| {j> &\r,PM6{ YwppUOYO7ddTugC9 9 0]hJ#7]ߐrjMdu*ԴSvO~G>8O{0M&(2p=rn5{wq_몖eԿTjmSyCclVs"pu4e}Ѽ P;dmp3pp?Klڱny\qAm X )x͑J&4R,.0КCpf?dMMO~ktYc^1GWJ*2dEsVsU;IuM %ȟۧ/6vㄪFA^x pRً`uU +lpPᴼ@kя~$IŚHuv ኺ; >jhͷWO?1(}tМj19yFx t}xutu:}CqsScʻ+zkTQo y ;CJ¦ Oi ˶.FS5O:yƉ/λ@ g0xa;T!u9/_ukN/?o/_#߲v{ Id򭘖^dU8\4xi4%ֵ:\*>KaO`@l3ӪYj"'&mռ@CMjƲϥ] =&ĜGK*Q=>t޼rTM}KWTe+. US򖺗a7yzxf&W:qOB^%muޅEJn@tcGqqgV?5g?Aի/uakoҋldeb uovX kVJ+-dN^f b2i7\kz)xݷvʢaW O .X ;]n&k츲5W#U^4wNbCǾYxMSu=V#^{JwϺ˼ԑK5aA=czT`KUR5Ni*Y\~>kKroҦI%=]zlȋW&\aG۩Ynr '-]8WBWٖ"R6n~^/3&rJ#qkUPU/~kEp<'y\5IլRT+zsA0!?Z6y4V:sR:q뾒T]3ρ"Ⱥ޸/Kzʿ6,C~NIE,p欹R5NTt)Z֒ϝS[&l7k|ȫ|Wp)pr {qJȺ Z#ӢKf?I BBJ?_X#i`m/r6FFvyiV W:MDq8!DJn$2tÜVbpҙbϧn[|97>717U7]qׇkʵ UYME Ֆe-KZ=w糥;Lu\1WʫֵPyN(;׻G79r,Pp@\:VzKNf1!3ES\'-"K@VwD I幚vpJ5j }oXkעp՟aϧ0@yzTUϣ=>2C_ﶖ^Vgt ;}[R^SURm\cFUƢMŋ5-h)mY:¦Y_ p}+p{klQ@)?Og^l"z2%Dsfs65se 2rWԸ*\Z:*Y8S&TSY@:K b" YqQs:-@镑W[PyLjߔ_^_v6k*8ozj̚gnQuz֩['m͛eO毚T y9Ǡ(\x•xtO>*]bSR59@Hp5[WTkbI(?dWl9x}Tٹ{f<}3wW?kæ~83:yOj4mpDeh5kO 5=TsEs6lS_-'Ȅ=?{~{緝8SmMUZڊyW+V8n+\ W8- yae5T~qCw?8G 5,o|fC6 K{ޝq ;.d $7!\i1nF&مW,+8P$7$?b4oJID=##Ik|4c8׈( W2U"nɗ3k.&fR5e3bk5V=^yʫ%:W&n=tNv{&5i$/q^RΌ&Y}Z[h_z-yHFdf=WqΕObSO[OްkU-;hRWKbXHQ&9Ip|[iVLI].Um+;n5ł*V-X/ ੲzϕ-ISrMebsG\4s*65%z*Xfia|,DxQǫ;>za1c W`6Ҙ"\̵rUkJ`I]sa ,T1UZ 1bh:LUJSWGS~RsLD0#E&w5ov&DG5\EI})s+HDR6XU}*']fY jsM{*.V&qNj*-$u u+7\;uVՇdJo* KJ2jhSJG2Wc 5Iˆ WvtRV!Np^+=2kt_, T0]\ !-1'?$OU036jBjHZ4&l\;Xp%s7uU8b*~"XFT,dpjhZEjt&-vo$!zvRJ׉O^ܹW4lX7HDgʤᥛɪ-S/% kM/ziW6Mk`&]L=$0# \c5]A"\Q \SWp{'>c3` \C-Sj>N#kP%b0Up1HWT @ @"\]u,L AkZahT :sP*\fיL];!;'tĿؠnμB{ $E*:-4}1=  zJI/*]!p;oi߱߾7y7W~WM-x5[E(\G70 9P;n®z9O:3nwc>zG}o;p껽} 9vk@19*J >hW]''^^aK"?hWXsWUH\1Dzђ}a WY;\Muz'wP?A4h? W)(XFrʺ6S<[ 4pE g$'Yk w>'/V!= L6 8x-oC4h?We4GOe[H̚ù0*'՜Ҙ\̗a/,\7g++^$z2)Zk| [\UƑ"3\ầ¨*cj}cv[p`7:;Ôz\c W)äȔlW^[#YRHt5i^lL#KjrgM+g&LʒNS}6 GkÅWەhߢ)*X|k uѯl0)|~\AO~8vma:q&de1Hc0(3"8OKG"U:HwT]Lyp4UB\FlnUt@=#p !p ז#_On'Ws>k=ov*I*7}5i~kV> 8\WFw;Ө9q9MBX*?Ob̘5YPk؍u_oou s=gvk:x컖9Z+wxIJ>V Te)kH\xհFb4o0a@tMu[_mo~{L~֦;p0(cM*=\^&i նsor*F%u!)p IXjֿ|{O:8S= ZO6x÷ m4.~3] {&|l%=57hBWMhj#$B n "\}I(p"vεؽr+]ڵf2FR0εj CkJ=_|/W|<g+8gB$Tohes[aQ+ \ȈF|(p!$sM=#1Q $r'z~Ļ^}(p!$W/K=WO`dT [ Ws^pX#\n#ɻ]ٗ{ vӠW:\iQ;ϙh4lzl[OtկTH:=5l%>lݏnCp}g±~aؒ}Tv§ן,2OND + 3*[¢W >[<49A4KƳASG_\>%TԵ̞"H)ɂ*@v\.٫XRď&>:\58"}9;J<]/Q[zmtYuKߩ \] mEijN W3mqry -2Dq(U|"nM]P\9pz6"Z&5_qK65S2Wdu/ d^TKL% W`tɒ4q&}ujz6s&];tv!EQWzWN=Q\:Uz_=\ŕfQ]'i4 WHpuaGȥ)2le g &|5dž>IR \{oaOph_@*)\_Ѽ5TxQ=>pe>z\{fFLL"gY[TJХyl?R$MpFesy&]=W}rr5 QicX0|6SƴqS.\)T4W_䙭+8R5i$a'G ;ZR/S>QzLu1aWgׁ2Jl>(.+8W8M!\n! W# ٬PpNawv*R?U9#]q(zJh&Kek-pWjǣ>8잁#P lox!=mmq}A%: k͇p \U`,*\ōb Ҵ6,uUEJP1aMIbk&+kkuϱ~{|/G!}[g ;O=%)^nezj6-k ~HpUGh+vC>5pқ{jZüh?@k+EZX04tbפˋ(p { \Fk1|)p%&ՂZ װUCVdD#>@S'r4_$ 5ɭ#\n?k '~r %O$^ˎp a+,5Kcp  \V8 Yj%^x5Nxrn•~*}/+q'K_)-@֎%'q {i?$rLQO0|̓Ǫ61|cMװ*JdqT$9T1M,ly_e$t Lh$,LOf+ITHioYr-ICC$LvJ)!8vp+_ 9[JE0*f-0 VF:⌘Yfe•\yz 8R(*H~2n,ejd(+]T*7QODNW(唖\OWڴԘ 3k p \i9LHL#K=A;c\EvjY3!}p+ u;Sk@]1m׊-lF6W)=W[Ҧ59-ҋaK|\. \IɌD'үz"UWpuW;Hk =$*q/ra7&=T5k^L$";^WvX"_]h4qiMi\(e3"aڏs[*RSRΔFZ*lE˚o f 65Ad|$]k(r$}*"B&$QVW) OkxWwv((ǎYo k|&Kp sakC\N M M>YPװFRy؊95E0Gb5&A0Gbm|FYO}rĨ8DPh0R - poǀ Dhkp' ` y: J$k_M*e{+/Jo}94 T pd>:!;u p%6+kSOA}Nݫ} 瀞80bw^?s¹þ};O>AA]ٗ{7`q{⶙ӟ޾AZ)zITYp* D@n•$+׈:f @+p(er;ͷUr`PT@AlK!jto *s ]92QmלX!T@)kp5<$UU$bbT@rQ!WRFr*ߣ΃uBPT+SpE'9* @)AP,* *p> * XVjYP4 * \* @Z͡* W* er~D' $2AEЋMgAOȫ<%Ȩ* Rr UVN'ZW뒢AT \|R0S7Bs%lj?DPT@+KA*X䒪,p1' T@(pe Wj!VIB*p2* ,\8{}|nCx7B~ߞ}{O;Wm ۧ>9bnUm ͜- lCQkܵhf * \s]V* YTE1kT@PT᚛튵BPTȢWxg ׬ M,8* * *SpeigN> WMj5v8T@P@•mN)RzE˪bf'=0؊Oֶ!o&-ar@bb JJÄ66-E%0wT^+9L77{ _t?,]+[!ꄗvD)@4$J Y" txb(5\ #lD7_pU)(mOTpbcv[7S5{ə@jd12*kd-"]me %piƼ6b.\Y_a%B*1p0΁ೖ֊ Wb!TobAKpUxeC^.k\”ѣ YY\ "^amLj/2\\{D$n ì]¥!bI(^,C܍$aWeeVCKHf?.%HbvGK/@(â Ns@`y +~0}Icxfwa͗拆WF@jOX\WV~3fI{0_9R6~K)cl~hp(e78̳ t B:L(ENpt @{8!РeP$ #d7bdȚp5.VK ˬF pnB__Xh?-Ck# ),ruO| ?;BqrЁbph'.+ ZpqvŇ@gNb8Ct-jagrN=WO5ϙh/<38xKps)rdsڴ}7+n3~ 8mC@ Ұ+[(xgtޢԸݣ_HyרҮ ;pA櫋)I)5xZmiS*V6/m,\`юu۟mrk^RUq_ &V4]d}a466KhE9ps쫣= mo>~{ [iOuC7`q{⶙ӟ޾!J!kE Jؽ$tsڲ| k]eHۡaհbfu 9kRRӗ.;s;Gw*zmvnRCTKlؽk֕͞M-K6mh^4wMS E_mʼǗPݼp \cl.|,q0"pKv(gokj3/Ps2t0d™V=d}?5! R$Y?re /֤KVKM[=eaĺ|~ԑ$G2p=rn5{wq_몖eԿTjmSyCclVs"pu4 5!O!j' ~b#Y0pRPwѼ 0!ksrKK??\dӎuc{?fm 8d&'.HVL~ȚT_dU貮J;.6bF=;t4mT%K.:+꥝ZwIR5׬khh,YE>})'T=7jq1dk|ς%N6Fp|**3uq|L(e2 \m-]7J/踭V]†] 'Nd}GTD;#7ONNY/u:nnjLyc%]u*m3/;}zT&R>)R5yueh['8z㥐yȱap!ŖΞ@b;$iaWk ٨[6̌kjvXG/l!u9/_v]}}ڱ[ȷlp`<W vM4L,^qIҒ{5zf>~vIzs-~{DAB92{ubMmå+\AdHTe nk1zW'}RȫbQ]zC2^MXĉˆRq⣙|$IZ=WQx\](]中V+YD7v}|fSo8p[TY@XY9欽F*|{3}`!}&1p=rstej҂E ӓդL=RQ0n80`y'Izr |l,X\yZ5@_SLnv:ccsnc)+PZʡh e3`~gӂYirI _(б/F<^T]'ȹﭼ>瞒ݳ2w># T3HvT  Uew-L-mTĔ\b[.b uʚ2"n$ia4W[ͧQ[bzmY3g2ڊpO4 >)C &wmiWLd!+?矟Xdv_5 pٖ"R6~ʒ1LZn$1]K"rĭJ?Ru}<#n {,+ڰ91IE,p欹R5NTt)Z֒ϝS[&l7k|ȫ|WZ\ q!OQT W<ђ0ꇫ֔b2WTE3?xd5tj1BN>y%zJF5kc38uVB֭]@=]2㞇GIX`-PJ^Yz5yr}R S-М\S{]ת\|A zMUjR4h!RtIk|t產_=&Xy׺6 W[!n=予1\?qk#M*Տ&ZFp|5%ɪW@z j>bJC''kbAplvDUsg}c+ee2up5ILTdSI|{ GU3=_M g<8=ӤR=ZuESz /ׯPzR٪+'Xℒ/>9Y毚\k'7(\t[5΋!oq!Y{Mega$5g46DvdF'jKaJ4Apnn v[7pUݖ4o9d/BTsEsу©/|Ndžß==U %gH橶*xs\{ml+xRmx.4WQ8Y^)([^0Ca4b <[ײ`mn [.ne-ɁWLJ @xfgފsgZ6#Ã+4_a%z0qnYbHDmG1*|F ,EBՒ3={{AEEƬA'pu~+\<ݷw*nlMg9r/, o![g"Vp\ڜ1mB&D&䱂kNyCsC&<юpM\#\vqky99pndǘ!0kKp O۰-<\x6j?V+G}N8Vؗ{-3 \MxH ɬI| E*f!Y#y|eE[#OUpT!nEz;@Sοr.\Tοd27;hΑ8lbNOvWQdp59\M%%NpP.pU s[xp٣h٘U?ԧ`$ɲW*A\Bb4=kE+ddj::ir{,:МkV>J#\ÂPxuϕŕ8{NBiBW,=dڙ_[ eUֈJyeaht•CRXuh'T)7R⪈ڔއѦ%5,lq0*Շt׻Rqhiƒf!'yU]lHS0p7q=X \tB M!I=dq%$jlsDEѹ^*Ր Ylle%(*X{e-f [E&՟n1J \t5Rv8Y hQȊEQ-e\b \67!+eIRW6Hx6Z#q[g Wdn WEE⪥يr-{\Y+r%JoR(ͪ`)YW bu"h`+g7C.d!5J 5bq v-*" \&DSh!\fn!UlZkpך_TFVY+ggC.dh[HpYDVp9>>65ZmpfWSh!\fnWjFn \swfP5ܶ#\Â+Kȍ#\ێY!8ʹDGvnF*61VI،g8xo}>zs!}g{!{oɾ'{+nl=1x|vr&ߌ,RNƝȟIAD\;x+0dLIAo7"\אFQ@sA4p7_`(s c IKf 8FW|圏aF8ۤ،4CC`8$H&Ք-+VJIxDx W 3WMલiZo@eKp ^Y[-B9H7hR"MΤTvn5Dx WvU F˅[ӫ5)b^E&>-*FLUA"\}N,a޸,).ZEJeE2"U$_p5*Ѽ•[yjAYW~ȳYUZV1'Wyo3JW8G&)猪aĥwE,kWWb\9LU5)tJYA2Uո\splW24PE)p뇮aLx钂ÿa#"\ a4pe1\UFqFj mWT=W\{K+ WٜC,(E;Q$1]#~}+u;Tpٿc+\Ŝpa^NiĮ͚t6r]SG`WR<Y6/eΣrєD+ =W\];x`x"͓v>Dq\5?kϕ-UsE+)?5#wIf/Ssd+rmarz|Vk|هf[8H3#\Uj ixk͝=A&LW p%{܎+]AW;v=WP 7z*3לҴve^<^Q GHiEV@Yֈ 4D z׼}R±RGcIvj1e$pv [Ka^l$īU\V'.85\3WH$=m#>8IÕt` 6+>E#SdYsh=Z&*3Np% \g"8SIƉ\GG¿~tnu¾3}}d_BM-7.Z=`q{⶙ӟ޾!N\5kUOp藴*HXv!DdƓ֎NhU S`\rHK^nJk%r|+}t7"\i' Ƶ 9R>F$&pWo#\=T"{+jU?D\Y߲bTs]JW"E?U{iÛ WI4p q(GA5׹GS!\}$>*:m&V*Lĭ}Uz"$^EpLK1B+ȹ*g먋@q&S5m^JWx1fO]p:A9N6Ulb.#^ײU WxW)>]=W=q٥+C&+}k؏䶌؅RN\+@\M&o~ 뭊W-?.=0&5I~.R|Cȕډ[pVO3zq蹺{l ʾm`k7q`>ɟ7eF!\èfmpr[ПZ_$BYL8W pe׍9g Qټ/"\͵bLkuHp X*Ln&\7F(/}g0gbiI.Eރp5Q)qYo@. I5jR \ p-]"\WͶp.p ^ΤE&)m;(9\VzU}7{ {^C =WsEfp (`v#\5ܳ#FEpRmy!\5+g WEbgHD=eSl'Cfp] R"\>urhHp|S%Ck쵒< iXPdVʃpEx U+Kf⛪L%tF\YI{E&&Cde9ɂՐrriXkW\1O>C]SʔO,'jɁpլxT~ͪSؤcշ+G"\}vhʹ)tKwnę&|Ͱ6ٹ=^4-mS&qL$ ǫ*SyM|RaPqp>s շ+g\9]HgȢqWS>0Yx+ je*f_H{x 3+)1qu1inE"# Qg:s}G?p>'{?;۷t~Kf{㢕9CÃ+:+_%~U>y6Ai5Pʊ):|rޏt=$qg4>O'hZ=6ZƘ?R*pe[3 nꍹz㬷iDW]gpnz_ʁΊڈk#V+}k!5e \ x+]F0>pWBv5̢5+؉1kaÕ]ʻe­h-yv RWCVI*eW-y5꫐4̢Y+`iɉÕ53/⤜+\SJ2}r*np%kkdÌ \mµ#8r_ uK3)D~ *NuI_\=U #+\UcƼTbLk b_ڬ@,v Oۡ }+؋a5c.D`6H l:9ަ4 {rPpMn#\vPr&+,kkcH&v{2C5|~{ ]hUa:\beX1"WjY[Tp@p%97{M֞)jך6r-_|vݼq ͝[(UڹE:bS5fRVʚmAUhH_irV†B0Zxꇘj!\iװ~dp4kp=<NUI142_h#\C e*\YVE'W]q0rKFe"_bfbo]Ҷxϕm#9۲ WjYjUN\Q Eb7SpkY/)i#j 2La_&zh0*SAz5zjP#gtKG~xP* kp&"X \M(q†f&,vѩ_wX5lq1.]qkx+OObVpnW*_}Fפ<#!{f,yqtQ`s54N W pWٚ}l_g׳ Y:rh|);eʦ5bh:PsP1\YsR<_: #2pVej\5'qǿ~|߱󷏞}mo^so} Z޸h%t[X9|yGĘ!)p IF WEs,WG Y ,VA\kk7f8컿JSe1JkrFxpM& *95pW%h$QU-G5W\nO ڿ0rD W.RZL2婐>^C Yv:{m!^dU"|GtRS^ i<\,Z@"\}v?OM\U$pgO8/HY IĘs(R*om??bO"\} mJ+GBIe?_qWXjyK,6Ѷzkn1G+gwB.dY+br$&WW-#k@kdR_EX!$dG:\bp suuYTt}+yc($ϕʫSⰐ&۰l DϘKE^1 Wua?WE3LŵؠRm}dd4v6JAe= pzQ5?D_J3tBS0/bM\wxΒ֫ih0THmGc}/m}C}Yz-p)\"+THmKLq3t_&F~r tENlJnAf=jvD|W\\ٗБ)NgEcg6bv XCZ4 !5MNpUI09L]x 0|圪*6)Փ\يp͖ WWQy 1lZ箰{!4F$~ob\-x⃅ڒyX ,Ҍ<.fJ:5 \]%CkZ_D03:Dd?H!VG+eA-J&%1oJ6B_Lڇ!5 >*zY@_=Es"}9BWas)%=rXT6/._.GNTd+u# \} m2kz\9Ե@Iڇr;*4:kRYWBkXpֺwk <15իbYp͊V2 W 9\bk*R TjtWa芳8pigym jK+?zUj4+k-] pڜY7.fJPrs%pA"\}Na)\{|r!\V|I55\$WϾPJ7|JdWk6 ri p9UEF`UZ=& e#YHp7L\{Myȓl.ϐjjyW};©TJ6=M>6Ydp]-=3j_NW~]=כW>L㹊{ ܊G6 ߥpK4T:PX69բћ\w𹾣B8Qyov%nlqJUm ͜- 7X|r Wu&DU%B\i6d]^E^ 34U6foV՚,}UCQR'nO@3bkq녎y7޻/i?!аD̳S9.M"+GpոRvz]T;&V??U>ŌT6Zo}W|abPRGPJ>CRƯWʮ̫ik4OŰHʟu˕Ml<[ug0gùڍV6_M?&O=4|$s*1\ m=\= ]|k=BFQCFGl w,&:\_!|y~W͗~Moz{pw{/ 1)WWYCTp"^*2OzwtWפ0r(ń@ZQ2?U,g@r/4 {6?Ed/AQYp4hpٝhYLM~,8^lpR"r 51#un"\ÂPy܂䇿NOCgUI;5̺5;Wfw|_\Mud&kk};8+pM@W;^irIEJ}PVF"\}I+Cz>;zykRvs>d`qL*e+gzĨgG^2p2Ox|IhⶰtX<+z\q[Xl/>5S>0UkcHix!++z!w148vV qpUͤY(ᚅnYFn Gys (`v#\큘{D \#^6W{Zf&\H1hD"WTؼhzѵ[g7o`@F ,v5,Rr4 WMZ=;ɷjG&*EVBZ1[F*ɥz٤(uL9T]d=~;e&8ĵ/5qM)\Y rD WƲK* vn%e~%zoٌT?qo?Kp Rxkmep\& Wjʇ[p=T2UJE.րIk.Ji t;*Y-ppՃsP2 WQ8}OȤQp QGz"j vYmaVfY]̏5q9zĥ\5seQFW\ŽȮ-AkpU\nr?a[aF䚗xL=$@T 皊(cO3I:\E >C@ZK / UvIj5fi| S&f$mDĈ?2gj +<]kȹ]"k 4pe"&EDqWDʺXJJ詇:x0ڌUt#4ΐ8uN ;<nC:**&zZUVDQ|e!f\QюBD-bg54BMf-1wT@]t}U:Ϫ#,,NC&28 '^-u5 Wby[pE6$y X+*n y Wq"6Aެ:ak Wq㚅'j|M1#E դi|'02*TSIjR5 9DWں>*./Yh$ J\6G.w̢ACa%Y\oάN,x:[`oNس ,n9[̋1Q*%\] t1,E8jh! ?faTJyO<_q=Ǿ}Gj:׶o!W.#\~ WA҄§dj$u8)t>+ڊɂ轸V0#@/tSn?{l߁S}Kh֞xg>{1fFmNM pVjBqp h(,bq U54{PY;\Muz'wOb WO٤r͠Ob;ۖ&M ɾAJ{ikSk⚌-!\Ib;~C|֓?u\p<זQDƭY4ґf$^ +qaZNvk*:RAh1oeD \TS:J!>u[kZSy|UC LM,\7g++^N= B pݲ8UfL<&$N*_̈6E_4yLs5t2HaFg*#Nrr9WA8X58MqO,\'?{ZY @񍳉tsm*Q9CP]`'n,"Ř&* UTRŊ'K/UIRr:W׸XqX`*p7BxCVsunyգ]EgsRC W[oV\OC _d"-31\YO}rĨ68D\'7d++ } J>:U USkFz`p(Y1î\jY_?㸭M'zwmts5q(+F"{bSU?ِ"VYs9 5B䟣{ uֿ|{O:8S=bj=|[ ko=Za oÕE{d}$dzo{nIpBѿe;>riG1:u @ $WEBYb ?2k1za1* @0b ٺJ ŗ[rye7xbs}P,LBƏV6_Mz=u>x^ qF怒澈X^xSxe[\LʝkrPp.uHj%,FCF+#\-v_4 Q JyI5v:gWG'IIpMJKa9s^(jBt9?ecfqpE"\oOʄ匏׸ӵ<X a}\ϕ6*UՊm<,0T7$2o 4pT$t#았hO"U4 1))kzlIl jXլAr1*mh*p yYo 4&p8G25pLJ\JZI\uĜӮ4pEյ`D(o LIEL}52kBL#eצW ˕|WN=*_ܰ`10 $6WOqȆve#z@pJEhJdL#H6Y6 qaE qhG.PT WnѸ 0 Mr)T6AkAI#pfN ^"E S$65Oh;oEŮ\ܛ,F*`9\f! We}:j \-ڔPD,%r~'%(k~f'e*Wiw$E s:* y*{ •TMS4YhDnSkI*TUE,~=:H.7Y`PT\PL%mL8YLqk3TR,p8VX|bLT= *cJ5ZxTumlmaa%hM4p`PT 0#\~Jr'r`C*VUwZ8+3EPTW+5cS@@"\WT@,+pE"\--*!W8(Bh@P(Ȗud_@#ϳ \,X^-y2* 2wET6 \񕊨* @n)@_@&XrT@PTUxG^p8, wyIENDB`./tkcon/docs/changes.txt0000755000175000017500000006312707161772600014772 0ustar sergeisergeiENHANCED TK CONSOLE changes ------------------------------------------------------------------------- Changes file begun Tue May 7 19:09:51 PDT 1996 Newest changes at top of file. Release dates between '----'s. Changes for a particular version are BELOW the release date line. Attribution for code is specified after change, a preceding slash indicates an idea/bug report attribution fixed by myself. Where no attribution is made, assume (Hobbs). ------------------------------------------------------------------------- THIS FILE IS NO LONGER PERTINENT. All changes are now recorded in the ChangeLog. ---- March 31 1999 v1.6 ---- Changed tkConInsert to not use catch (avoids any error generation). Changed if check on auto_load in tcl_unknown to an llength on the args (from [info tclversion]) as 8.0p0 also used just one arg. Added -exec command line arg, so that users could do the -exec "" trick (causes tkcon to skip multi-interpreter model) and makes it easier to drop tkcon as a console on extended wish executables. Changed handling of fixed font for all tkcon text widgets, adding new -font option, TKCON(font) var, and redoing 'tkcon font'. Added color,(disabled|cursor|bg) variables as per Becker's recommendations, allowing for old defaults. Changed multiple instances of string comparisons with llength, where appropriate. Changed dump proc to not try and auto_load a proc arg and improved recognition of procs in namespaces. Added new 'what' proc to environment that tells you what a string is recognized as. Now used in various other procs. Improved hot errors to not pop up edit dialog when the mouse moved. ---- March 5 1999 v1.5 ---- Expanded tkConSave to support use in 'edit'. Added tkConGarbageCollect proc for periodic cleanup tasks (currently, cleaning up error tags in the console widget), with new gc-delay TKCON var. Revised error handling (errors are now hot in the console). Changed tkConExpandPathname to recognise that NT for 8.1+ is case-sensitive, and to not change case for other Windows configs when no further expansion was made. Made changes to tkConEvalOther and the aliasing of tkConEvalAttached for "Main" for more accurate evaluation. Changed the conditional 'update' in tkcon_puts (that overrides the core puts) to 'update idletasks'. This prevents problems with using puts in fileevent triggers and such. Added check to prevent lower-casing during pathname expansion when no further expansion can be made on a string. New auto-buffer (default 512 lines, set in TKCON(buffer)) for the console widget. Set this ridiculously high if you liked the text widget holding all that data. New tkcon buffer method to go with it. Rewrote edit command. Previous version was mostly bogus when used outside the original slave. Change tkcon error to use updated 'edit' command. Massaged tkConEvalOther & tkConInterpEval. Fixed problem with Show Last Error where a TkCon generated error was always appearing (from Package Submenu) and moved it above the packages submenu. Removed auto_execok from the slaveprocs list. Removed slaveappalias as it didn't work correctly. Made 'edit' a slavealias, with tkConAttach used to determine where it was called from Changed some regexps around to pass tclCheck's mistaken warnings (tclCheck's bad matching, not bad regexps). Changed dump to not try widgets before commands, as otherwise it won't automatically complain. Fixed pathname completion to only beep when trying to expand on a non-existent subdirectory (instead of throwing no-directory error). Fixed a few notes that TclPro's checker picked up (only one actual bug in the all switch of 'edit', otherwise it was mostly blowing wind...). (lvirden) ---- February 17 1999 v1.4 ---- Changed "changes" file to "changes.txt". Added edit/more/less proc that allows for the viewing/editing and returning back to the slave of vars/procs or files. Modified history to not got below 0. lremove extended with -pattern arg. Added code in tcl_unknown to ask about loading Tk when someone tries a Tk command without Tk being loaded. Had to change regexps because \E in Tcl8.1a2 was removed in 8.1b1 (arg!). Added "Make Xauth Secure" button for Unix. (heiko.federhenn@stest.ch) Fixed tkConInitInterp (used by "Send TkCon Commands") to reattach to the named namespace when appropriate. Fixed bug in popup-menu for Tk8 (bound to wrong toplevel). Fixed bug in tcl_unknown confusing auto_load between 8.0 and 7.x. Made Interp->Package menu more dynamic, so it recognizes changes in auto_path and updates itself when Interp is torn-off. Removed list from $new in exec redirect for tcl_unknown. (found by Imai) Changed package menu to handle multiple package versions. Added bogus package require statement to master and slaves to ensure that pkgIndex.tcl files were properly loaded into interps. If "Main" is passed to tkConAttachNamespace, it is interpreted as "::". Changed "Attach Namespace" menu to provide a listbox popup when more than $TKCON(maxmenu) namespaces are present. ---- June 1998 v1.3 ---- fixed long-standing expr bug (missing '$') in tkConSafeBind - found by TclPro! took out the use of tkcon_gets because it only worked for global vars. ---- March 1998 v1.2 unreleased ---- updated regexps in some places to support 8.1 regexps. dump now outputs only non-default options for widgets. (ridgway) Sorted output list for multiple tab matched items. Several minor changes for the plugin (user should see no difference). Known problems with dump command understanding namespaces have been fixed, but only for the 8.0 only version. Changed tkConTagProc to recognize ';' as not part of a proc name. Changed tkConNew to reuse slave numbers. Fixed problem with TKCON(exec) == {} (needed uplevel #0 instead of eval). On Mac, tries to source itself using -rsrc (8.0). (nijtmans) Changed to use 8.0 menu scheme if possible. (nijtmans) Changed tkConInitSlave and tkConNew to only set argv0 in new slave if it exists (it won't in the plugin). (demailly) Changed tkConInit to only checkpoint state once if the slave interp and main interp are the same (TKCON(exec) == {}). ---- 08 October 1997 v1.1 ---- For Tk8, made TkCon use a fixed font {Courier, size 10} if the current font is not of fixed type. Startup errors should now be found in the TkCon last error function. Changed the Triple-1 binding to not include last newline. Added fix to make sure that double-evaluation of the command line didn't occur (might occur for commands that used vwait or something). TKCON(errorInfo) is now set with all the errors that occur during start-up, so that you don't lose stack trace information. ---- July 03 1997 v1.03 ---- Updated namespace eval stuff for Tk8.0b2. rewrote tkConSepCmd. ls is now "dir -full" by default. changed the puts renaming from tcl_puts to tkcon_tcl_puts (so that it specifies what renamed it). added variable highlighting to command highlighting as a background (so that a command and var can be seen for the same word). increased default history size to 48. Fixed problem where aliased exit couldn't take extra args. replaced old [tkcon gets] with a new UI version to be used with the new tkcon_gets that, like tkcon_puts, replaces the Tcl gets with a version that doesn't rely on stdin being present. [tkcon gets] now accepts no args. **** POTENTIAL INCOMPATIBILITY **** ---- June 10 1997 v1.02 ---- Changed calculator mode commands to be put in the history (but the output still looks like an error). Fixed bug where "source" was assumed to work for primary interp, causing failure to load in Tk plugin. Fixed problem with the id'ing of the primary TkCon interpreter that would affect attaching to like named interps. ---- June 8 1997 v1.01 ---- minor streamlining in tkConEvalCmd. added file menu and separated some items from console menu. added support for connecting directly to a namespace (itcl or Tcl8). Fixed several potential problems where args to tkConEvalAttached where not properly protected from eval. added slaveexit variable to allow for exit in slaves to be non-destructive, which is the new default. enhanced Tab binding, made Escape the default pathname-only expansion. enhanced dump and which commands. Removed auto_execok redefinition for Tcl7.5-. TkCon is now intended to only run in Tcl7.6+ interpreters (though attaching to 7.5- is still OK). Added Load/Save menus and expanded Save functionality. ---- June 1 1997 v1.00 ---- TkCon now use virtual events for bindings (REQUIRES TK4.2+) and changed Console to TkConsole (to not conflict with new Console megawidget). Updated tcl_unknown to match Tcl8's unknown. Changed handling of preferences directory for macintosh. **** POTENTIAL INCOMPATIBILITY **** Changed tkCon global var to TKCON. **** POTENTIAL INCOMPATIBILITY **** Changed colors to use absolute #RRGGBB format for color-name disadvantaged systems. Removed use of tkCon(font) variable. **** POTENTIAL INCOMPATIBILITY **** Fixed procname expansion to work on/in namespaces. Fixed pathname expansion to expand on a directory. Fixed all if's to use {}s (better for Tcl8). Fixed potential paste problems, it now tries to get the general selection first, then the CLIPBOARD selection. Fixed problem with 'puts' being renamed too early. Added calcmode variable to allow typing expr commands write at the tkCon command line without always saying expr (handled in tkConEvalCmd). ---- no official release v0.72 ---- Changed tkConAbout to use text widget so info could be selected. Fixed problem with pathname expansion on windows due to case insensitivity. (how can anyone work with such an insensitive OS?) Fixed off-by-one error in history substitution reported by . Fixed error in the handling of packages with a space in the name. Removed general return of output from rcfile, now only errors are returned. New tkConEvent proc to handle event movement, fixed search event problem where cached event would become incorrect. new blinkrange variable to change electric bracing style. ---- December 20th 1996 v0.71 ---- changed to not use upvar for nested arrays (bad for Tcl8). catch package require statement for detecting loadable libraries. ---- November 15th 1996 v0.70 ---- Fixed problem with virtual event C/C/P bindings. (reported by robin@jessikat.demon.co.uk) ---- November 15th 1996 v0.69 ---- Added auto_execok to tkCon(slaveprocs), fixes "unknown" command bug. Fix for 'event' to work with plugin. (nijtmans) Added '--' and '-filter' options to 'dump'. ---- November 13th 1996 v0.68 ---- Added $tk_library to auto_path for safe slaves loading Tk. (nijtmans) Made "r" the default mode for tkConSafeOpen. (nijtmans) Changed global delcarations in tkConInit to avoid conflicts with Nijtmans' plus patch. ---- November 11th 1996 v0.67 ---- Fixed weird backslashing in tkConSafeWindow ---- November 8th 1996 v0.66 ---- Further changes for Tk plugin compatibility. (nijtmans) ---- November 7th 1996 v0.65 ---- Started to add to plugin compatible code. (nijtmans) Reworked tkConFind* to accept optional args. Added History menu which display last ten commands in history. Removed 'auto_execpath' and changed for new version of 'auto_execok' (in 'which' and 'unknown'), which will be redefined when TkCon is run in Tcl7.5. The attached environment is now checkpointed at startup (by default this is the slave). Fixed 'dump var' to use list when printing out nested array elements Added 'update' to puts, as well as better error reporting for tcl_puts. (nijtmans) Improved bracing around elseif statements. Removed 'warn' alias from distribution. Seemed superfluous. Added support for requiring Tk in Tcl8+. Made TkCon use tkCon(cols) and tkCon(rows) for startup text size. ---- September 30th 1996 v0.64 ---- Changed the way 'idebug' integrates with TkCon. Changed to require Tk of version [expr $tcl_version-3.4]. Fixed bug in observe_var (upvar shouldn't have had the \#0). Made Interp->Inspect menu disappear if TkConInspect package was not present. Made package handling only enabled for Tcl7.5+ interps and reworked how packages were recognized. ! Removed virtual events from Console bindings so that they don't screw ! up the Console bindings (temporary fix). Changed how initially loaded packages were detected. (nijtmans) Made all globals visible in tkConInit. (/nijtmans) ---- September 23rd 1996 v0.63 ---- Changed 'tkConFindBox' to not screw up search string. ---- September 20th 1996 v0.62 ---- Added option for automagically ignoring dead interpreter problems. (wart) Fixed bug for reattaching to default slave via menu. (wart) Changed how 'observe' spit out trace info for commands. Modified 'idebug' internals. Made 'idebug' create its own tkCon(exec) slave for maintaining history. Fixed long-standing bug in 'lremove' for -all switch. Made tkCon(SCRIPT) follow links to the true source script. Added 'idebug puts' and 'idebug echo' methods. Fixed 'idebug break' to not work at level 0. Removed line that could improperly set $name and placed a 'catch' around the 'interp alias' for 'ls' in tkConInitInterp. tkConInit(Slave|Interp) now just 'catch'es the renaming of puts. Added 'tkcon set' and 'tkcon upvar' methods. (nijtmans) ---- September 17th 1996 v0.61 ---- Added 'idebug' interactive debugging proc based off Stephen Uhler's all-Tcl debugger (Oct'95 _Linux_Journal_). Should work w/ or w/o TkCon. Added back accidental removal of 'ls' alias in slaves. ---- September 15th 1996 v0.60 ---- Added 'tkcon find str' method and find box to TkCon. Added 'observe{_var}' command for simple tracing of vars/cmds with output in the TkCon console window. Reworked tkConFillAppsMenu to be more efficient and correct. Added 'echo' as an internal proc and included it in tkCon(slaveprocs). Removed tkCon(prompt2). Changed tkCon(lightcmd) default to 1 from 0. Improved 'tkcon error' to allow it to check the errorInfo of other apps. 'dump var' now outputs nested array values. (loverso) Changed tkCon(Load|Save) to use the new Tk4.2 dialogs if available. Fixed tkConPrompt problem where marks were set incorrectly sometimes when it was called by an event (such as ). Added bgerror to slaves and 'tkcon bgerror' method. (nijtmans) Added tcl_unknown along with other minor mods to get TkCon to work better with IncrTcl. (nijtmans) Made binding not include the prompt. Add null Console bindings for the tkCon(root) bindings to avoid them getting generated spuriously. (Hobbs / Wart) Added -argv/-- command line option. This has very limited use, but is very good for wrapping TkCon around an existing application which has it's own command line args. It resets $argv in the main interpreter to what remains on the command line and TkCon ignores argv. This carries over to any "New Consoles". Reintroduced state procedures, placed them in Interp menu. These should only be used if you really understand what they do. Added 'dump command' method. Usefulness over 'dump proc' is minimal. Tightened up the command line args, dropped several optional switches. Placed all the Console bindings into tkConBindings, which is called in tkConInitUI. Added 'tkConInitInterp' which places the tkCon shell commands (already available in any tkCon slave) in the interpreter. It also rewires puts to send the result back to tkCon. Fixed dead attachment problem where attaching to another interp after being connected to a dead interp would munge the new interp's name. (H / Wart) Added 'tkConEvalOther' which evals in the named interpreter. Removed 'tkConCheckPackages'. Package handling is now separated into the autoloading part in tkConInit and into tkConInterpMenu which determines available static libraries and packages for an interpreter. Menus redesigned. Changed 'tkcon eval' to 'tkcon master' since eval gave the wrong connotation. Made '-nontcl' option take a TCL_BOOLEAN argument. Made 'which' return unknown commands as an error. Added button into the help window to send the help URL to netscape. Made history substitution spit out a correctly translated command if evaluation doesn't return an error. Changed history search to use the same event id as regular command line history. Added tkCon(meta) variable which varies the Meta definition based on the platform (Unix == Meta; Win == Alt; Mac == Command) Added 'dump widget' method. Spits out current widget state as returned by '.widget configure'. Changed 'dump proc' and 'which' to try and auto_load an unknown procedure. Added 'tkcon history' command to return a source'able history stack. Fixed off-by-one error in tkConExpand (caused expansion to not work unless you were expanding the last thing on the line and also not if a special char was the first on the line). Fixed TkCon package handling to work properly for IncrTcl. (nijtmans) ---- July 31 1996 v0.52 ---- Reversed changes file to have newest at top. Added 'tkcon version' command. Fixed scoping problem when attaching to the master interpreter of a particular console. Rewrote the expansion routines to handle spaces in names better (no longer requires the user to use grouping as it puts in '\ ' for spaces). Fixed off-by-one bug in tkConExpandBestMatch(2). Rewired attachments so that when 'send' is used to attach to an app and an error occurs, TkCon determines whether the app still exists to prevent multiple errors from arising due to a dead attachment. If this occurs, it prompts the user on whether to return to the primary slave or to check periodically for the attached interpreter to come back. tkConEvalSend was added to facilitate this. Command highlighting is now only attempted when a non-empty character is inserted into the command line (%A != {}). Added Ctrl-2 accelerator to get attach to master interpreter of a console and Ctrl-3 to get to attach to the Main interpreter. Made the attachment to Main set the tkCon(app) to Main (to get around the menu -value {} bug) and also set tkConEvalAttached alias to 'tkConMain eval'. Rewrote tkConPrompt to accept "pre" and "post" args to place before and after the prompt is printed. pre is tagged stdout, post is tagged stdin. Rewrote 'dump var' to recognize nested arrays, but not output them (it's too complicated to do that in source'able form), as well as recognize empty arrays. Rewrote tkConEvalCmd to keep track of errorInfo when errors occur. Added 'tkcon error' to display the last errorInfo. Changed dumpproc and dumpvar to dump (proc|var) ... Added -root argument to set the tkCon(root) variable explicitly. Changed the -(slave)eval args to append to rather than set their vars so that they can be specified multiple times on the command line. Added a limit argument to tkConMatch{Quote,Pair}. Rewrote dumpvar to recognize a single array value name (ie: a(b)). Renamed default non-Unix resource filename from from tkcon.bat to tkcon.cfg. No longer 'catch' the renaming of puts in a slave, because we'd want to know if that threw an error, although it never should... ---- July 14 1996 v0.51 ---- Removed tkConUsage since it was never called. Changed tkCon(Load|Save) to use tkFileSelect, if it exists. Added -load and -pkg equivalents for -package. Added Ctrl-Key-1 binding to reattach to primary slave. TkCon now will create itself in a different toplevel if there are already children of . when tkConInit is called. Changed tkConInitSlave not to overwrite tcl_puts in a slave if it exists. Created tkCon(slaveprocs) to identify what procs get dumped into a slave each time and tkCon(slavealias) to identify what will be aliased back into the main interpreter. ---- July 4 1996 v0.50 ---- Number of history events to keep now set by tkCon(history). 'unknown' reworked (yet again) to properly handle itself in either the slave or another interpreter. History substition was moved into tkConEvalCmd and made an option (via tkCon(subhistory)). Inlined _dir into dir/ls. It doesn't save any cycles, but it removes the need to manage _dir. Fixed 'dir/ls -f' to denote executable files with a *. Fixed dir/ls to not die on 'dir -f '. (Thanks to steven@indra.com) Changed tkConExpand to stop at $ as well. Changed tkConTagProc binding from Console to PostCon . It seems to miss a lot less now. ---- July 3 1996 v0.49 ---- Slight mod to . Fixed binding to not allow deletions of pre-Prompt text when a selection is made. Fixed tkConEvalCmd to properly send commands to foreign interpreters even if $tkCon(nontcl) was set. Made tkConEvalAttached be some type of alias at all times. Changed 'slavescript' to 'slaveeval' and added an 'eval' option. ---- June 25 1996 v0.48 ---- Fixed 'alias' problem with multiple args. Updated binding system to automatically set Console bindings to equivalent Text bindings, then redefine what we want. Updated tkConTagProc to eval in attached slaves. This can make it really slow when attached to foreign interpreters. ---- June 25 1996 v0.47 ---- Fixed tkConExpandBest* to be more accurate ([string first] is only valid for us when it returns 0). Updated tkConExpandPathname to work better for attached interpreters. Renamed tkExpand* to tkConExpand* (they'd become too TkCon oriented). Changed tkConEvalCmd to 'list' instead of 'concat' command for attached interpreters, and to ignore the whole thing if [string match {} $cmd]. Removed many bindings that were exactly duplicated by "Text" binding. Added tkCon(blinktime) option to allow user to specify blink duration. Value must be at least 100 (millisecs). Removed tkConUpDownLine. It never varied from tkTextUpDownLine. Improved package loading to handle bad pkgIndex.tcl entries. ---- June 21 1996 v0.46 ---- Improved package loading to be correct. Made 'dir' more Mac/Windows friendly (I hope). ---- June 21 1996 v0.45 (skipped v0.44) ---- Added "Non-Tcl Attachments" preference to disallow sends to interpreters which may not understand Tcl (ie - SchemeTk, PerlTk). Rewrote tkConCheckPackages to allow calling it without a widget reference. Updated tkConEvalCmd. Added tkConEvalAttached to evaluate more things in the right place. Rewrote tkConAttach to allow for attaching directly to slave interpreters (no send required). "Attach Console" menu now lists all slave interpreters by slave path (with Tk interp name in ()s), separate from foreign interps. Add tkConInitSlave to create a TkCon slave. Renamed tkExpand* to tclExpand*. Updated 'dir' for better output. Added command line argument support, rearranged tkConInit to support it. ---- June 18 1996 v0.43 ---- Fixed 'unknown' to work in both slave and master interpreter. Modified 'dir' to be dumpproc'ed into slave. Rewrote 'clear' to be dumpproc'ed as well. Fixed 'puts' bug for slaves. ---- June 17 1996 v0.42 ---- Added extra loop to tkConCheckPackages to account for packages that may auto-load Tk itself (like Tix or Tksteal). ---- June 15 1996 v0.41 ---- Added 'warn' as an alias back into the main interpreter. Fixed documentation leftovers (and updated upgrade.html) to include the move of the 'main' and 'slave' commands into 'tkcon'. Fixed problem in 'clear' command ---- June 14 1996 v0.40 Released ---- OK, I need to add some MAJOR changes here... Added package handling. Moved to two-level interpreter model (master control/slave execution). ---- June 13 1996 v0.38 ---- Fixed auto_execpath to work on windows ---- June 11 1996 v0.37 ---- Improved 'tkConResource' to get the right script name on all platforms under all manner of circumstances Improved sourcing of tkCon resource file to not throw bogus errors ---- Jun 10 1996 v0.36 ---- Fixed bug (incr $tkCon(event) --> incr tkCon(event)) ---- June 8 1996 v0.35 ---- Removed "Resource" from 'Edit' menu Rewrote 'clear' to accept percentage level Fixed forward history search bug ---- June 6 1996 v0.34 ---- Added 'clean' alias to revert a slave to its "pristine" state Added tkConState* procs to monitor state and be able to revert it Enhanced 'which' and added an 'auto_execpath' proc. Removed all known global uses of 'tmp*' variables. Fixed problem in tkExpandPathname that munged pathnames with spaces. Fixed problem in many places where spaces in directories and command names might get things confused. Fixed problem with non-interactive slaves. Commented out binding that recreates a deleted console window. Add tclindex command. Added support for -full to ls/dir. Added command buffer save and command buffer search bindings. Added Prefs menu. Changed File menu name to Console. Removed 'Load/Save File' command from File menu (to easy to source) and added 'save' command. Changed dumpvar to use "array set ..." when outputting array values. Changed tkCon to use tkcon.rc on non-unix machines. Revamped tkConInit and source file to make sure nothing specific to tkCon was set until an Init proc was called. ---- May 10 1996 Made 0.27 Available to the public ---- ---- May 8 1996 Released 0.26 Third semi-public release ---- tkConNew now returns the name of the newly created interpreter. Added 'main' and 'slave' inter-console communication commands. Also, all slave interpreters become commands in all slave consoles (make sure not to name procs "slave#") when created. tkConOtherInterp proc added to handle the communication. Moved tkConDestroy and tkConNew into new proc tkConMainInit to prevent resourcing problems with slave interpreters Fixed 'puts' bug by removing all 'uplevel subst ...' and placing an 'eval ...' at the beginning. ---- May 7 1996 Released 0.25 Second semi-public release ---- Discovered bug in puts/output sequence - still searching Added unalias command, fixed alias command to not unalias commands if not enough args were passed Updated 'unknown' to mirror current tcl7.5 'unknown' Changed var names inside some procs Added comments to most procs Fixed off-by-one bug in tkExpandPathname ---- May 4 1996 Released 0.24 First semi-public release ---- Changes file begun Tue May 7 19:09:51 PDT 1996 ./tkcon/docs/bindings.html0000755000175000017500000001337711151630377015304 0ustar sergeisergei tkcon: Special Bindings
tkcon: Special Bindings SourceForge Logo
Documentation Purpose & Features Limitations To Do License
Online Demo (requires Tk plugin) Using TkCon with other Tk Languages
Getting Started Special Bindings Procedures Screenshot
dump tkcon idebug observe

Most of the bindings are the same as for the Text widget. Some have been modified to make sure that the integrity of the console is maintained. Others have been added to enhance the usefulness of the console. Only the modified or new bindings are listed here.

Control-x or Cut (on Sparc5 keyboards)
Cut
Control-c or Copy (on Sparc5 keyboards)
Copy
Control-v or Paste (on Sparc5 keyboards)
Paste
Insert
Insert (duh).

Up
Goes up one level in the commands line history when cursor is on the prompt line, otherwise it moves through the buffer
Down
Goes down one level in the commands line history when cursor is on the last line of the buffer, otherwise it moves through the buffer
Control-p
Goes up one level in the commands line history
Control-n
Goes down one level in the commands line history

Tab
Tries to expand file path names, then variable names, then proc names.
Escape
Tries to expand file path names.
Control-P
Tries to expand procedure names. The procedure names will be those that are actually in the attached interpreter (unless nontcl is specified, in which case it always does the lookup in the default slave interpreter).
Control-V
Tries to expand variable names (those returned by [info vars]). It's search behavior is like that for procedure names.

Return or Enter
Evaluates the current command line if it is a complete command, otherwise it just goes to a new line
Control-a
Go to the beginning of the current command line
Control-l
Clear the entire console buffer
Control-r
Searches backwards in the history for any command that contains the string in the current command line. Repeatable to search farther back. The matching substring off the found command will blink.
Control-s
As above, but searches forward (only useful if you searched too far back).
Control-t
Transposes characters
Control-u
Clear the current command line
Control-z
Saves current command line in a buffer that can be retrieved with another Control-z. If the current command line is empty, then any saved command is retrieved without being overwritten, otherwise the current contents get swapped with what's in the saved command buffer.

Control-Key-1
Attaches console to the console's slave interpreter
Control-Key-2
Attaches console to the console's master interpreter
Control-Key-3
Attaches console to main TkCon interpreter
Control-A
Pops up the "About" dialog
Control-N
Creates a new console. Each console has separate state, including it's own widget hierarchy (it's a slave interpreter).
Control-q
Close the current console OR Quit the program (depends on the value of TKCON(slaveexit)).
Control-w
Closes the current console. Closing the main console will exit the program (something has to control all the slaves...)
TkCon also has electric bracing (similar to that in emacs). It will highlight matching pairs of {}'s, []'s, ()'s and ""'s. For the first three, if there is no matching left element for the right, then it blinks the entire current command line. For the double quote, if there is no proper match then it just blinks the current double quote character. It does properly recognize most escaping (except escaped escapes), but does not look for commenting (why would you interactively put comments in?).
© Jeffrey Hobbs
./tkcon/tkcon.tcl0000755000175000017500000060342712611532420013504 0ustar sergeisergei#!/bin/sh # -*- tcl -*- # \ exec wish "$0" ${1+"$@"} # ## tkcon.tcl ## Enhanced Tk Console, part of the VerTcl system ## ## Originally based off Brent Welch's Tcl Shell Widget ## (from "Practical Programming in Tcl and Tk") ## ## Thanks to the following (among many) for early bug reports & code ideas: ## Steven Wahl, Jan Nijtmans, Mark Crimmins, Wart ## ## Copyright (c) 1995-2011 Jeffrey Hobbs, jeff(a)hobbs(.)org ## Initiated: Thu Aug 17 15:36:47 PDT 1995 ## ## source standard_disclaimer.tcl ## source bourbon_ware.tcl ## # Proxy support for retrieving the current version of Tkcon. # # Mon Jun 25 12:19:56 2001 - Pat Thoyts # # In your tkcon.cfg or .tkconrc file put your proxy details into the # `proxy' member of the `PRIV' array. e.g.: # # set ::tkcon::PRIV(proxy) wwwproxy:8080 # # If you want to be prompted for proxy authentication details (eg for # an NT proxy server) make the second element of this variable non-nil - eg: # # set ::tkcon::PRIV(proxy) {wwwproxy:8080 1} # # Or you can set the above variable from within tkcon by calling # # tkcon master set ::tkcon:PRIV(proxy) wwwproxy:8080 # if {$tcl_version < 8.4} { return -code error "tkcon requires at least Tcl/Tk 8.4" } else { package require Tk 8.4 } # We need to load some package to get what's available, and we # choose ctext because we'll use it if its available in the editor catch {package require ctext} foreach pkg [info loaded {}] { set file [lindex $pkg 0] set name [lindex $pkg 1] if {![catch {set version [package require $name]}]} { if {[package ifneeded $name $version] eq ""} { package ifneeded $name $version [list load $file $name] } } } # Unset temporary global vars catch {unset pkg file name version} # Initialize the ::tkcon namespace # namespace eval ::tkcon { # when modifying this line, make sure that the auto-upgrade check # for version still works. variable VERSION "2.7" # The OPT variable is an array containing most of the optional # info to configure. COLOR has the color data. variable OPT variable COLOR # PRIV is used for internal data that only tkcon should fiddle with. variable PRIV set PRIV(WWW) [info exists embed_args] set PRIV(AQUA) [expr {$::tcl_version >= 8.4 && [tk windowingsystem] == "aqua"}] set PRIV(CTRL) [expr {$PRIV(AQUA) ? "Command-" : "Control-"}] set PRIV(ACC) [expr {$PRIV(AQUA) ? "Command-" : "Ctrl+"}] variable EXPECT 0 } ## ::tkcon::Init - inits tkcon # # Calls: ::tkcon::InitUI # Outputs: errors found in tkcon's resource file ## proc ::tkcon::Init {args} { variable VERSION variable OPT variable COLOR variable PRIV global tcl_platform env tcl_interactive errorInfo set tcl_interactive 1 set argc [llength $args] ## ## When setting up all the default values, we always check for ## prior existence. This allows users who embed tkcon to modify ## the initial state before tkcon initializes itself. ## # bg == {} will get bg color from the main toplevel (in InitUI) foreach {key default} { bg {} blink \#FFFF00 cursor \#000000 disabled \#4D4D4D proc \#008800 var \#FFC0D0 prompt \#8F4433 stdin \#000000 stdout \#0000FF stderr \#FF0000 } { if {![info exists COLOR($key)]} { set COLOR($key) $default } } # expandorder could also include 'Methodname' for XOTcl/NSF methods foreach {key default} { autoload {} blinktime 500 blinkrange 1 buffer 512 maxlinelen 0 calcmode 0 cols 80 debugPrompt {(level \#$level) debug [history nextid] > } dead {} edit edit expandorder {Pathname Variable Procname} font {} history 48 hoterrors 1 library {} lightbrace 1 lightcmd 1 maineval {} maxmenu 18 nontcl 0 prompt1 {ignore this, it's set below} rows 20 scrollypos right showmenu 1 showmultiple 1 showstatusbar 1 slaveeval {} slaveexit close subhistory 1 tabspace 8 gc-delay 60000 gets {congets} overrideexit 1 usehistory 1 resultfilter {} exec slave } { if {![info exists OPT($key)]} { set OPT($key) $default } } foreach {key default} { app {} appname {} apptype slave namesp :: cmd {} cmdbuf {} cmdsave {} event 1 deadapp 0 deadsock 0 debugging 0 displayWin . histid 0 find {} find,case 0 find,reg 0 errorInfo {} protocol exit showOnStartup 1 slaveprocs { alias clear dir dump echo idebug lremove tkcon_puts tkcon_gets observe observe_var unalias which what } RCS {RCS: @(#) $Id: tkcon.tcl,v 1.123 2015/10/20 21:41:36 hobbs Exp $} HEADURL {http://tkcon.cvs.sourceforge.net/viewvc/tkcon/tkcon/tkcon.tcl} docs "http://tkcon.sourceforge.net/" email {jeff(a)hobbs(.)org} root . uid 0 tabs {} } { if {![info exists PRIV($key)]} { set PRIV($key) $default } } foreach {key default} { slavealias { $OPT(edit) more less tkcon } } { if {![info exists PRIV($key)]} { set PRIV($key) [subst $default] } } set PRIV(version) $VERSION if {[info exists PRIV(name)]} { set title $PRIV(name) } else { MainInit # some main initialization occurs later in this proc, # to go after the UI init set MainInit 1 set title Main } ## NOTES FOR STAYING IN PRIMARY INTERPRETER: ## ## If you set ::tkcon::OPT(exec) to {}, then instead of a multiple ## interp model, you get tkcon operating in the main interp by default. ## This can be useful when attaching to programs that like to operate ## in the main interpter (for example, based on special wish'es). ## You can set this from the command line with -exec "" ## A side effect is that all tkcon command line args will be used ## by the first console only. #set OPT(exec) {} if {$PRIV(WWW)} { lappend PRIV(slavealias) history set OPT(prompt1) {[history nextid] % } } else { lappend PRIV(slaveprocs) tcl_unknown unknown set OPT(prompt1) {([file tail [pwd]]) [history nextid] % } } ## If we are using the default '.' toplevel, and there appear to be ## children of '.', then make sure we use a disassociated toplevel. if {$PRIV(root) == "." && [llength [winfo children .]]} { set PRIV(root) .tkcon } ## Do platform specific configuration here, other than defaults ### Use tkcon.cfg filename for resource filename on non-unix systems ### Determine what directory the resource file should be in switch $tcl_platform(platform) { macintosh { if {![interp issafe]} {cd [file dirname [info script]]} set envHome PREF_FOLDER set rcfile tkcon.cfg set histfile tkcon.hst catch {console hide} } windows { set envHome HOME set rcfile tkcon.cfg set histfile tkcon.hst } unix { set envHome HOME set rcfile .tkconrc set histfile .tkcon_history } } if {[info exists env($envHome)]} { set home $env($envHome) if {[file pathtype $home] == "volumerelative"} { # Convert 'C:' to 'C:/' if necessary, innocuous otherwise append home / } if {![info exists PRIV(rcfile)]} { set PRIV(rcfile) [file join $home $rcfile] } if {![info exists PRIV(histfile)]} { set PRIV(histfile) [file join $home $histfile] } } ## Handle command line arguments before sourcing resource file to ## find if resource file is being specified (let other args pass). if {[set i [lsearch -exact $args -rcfile]] != -1} { set PRIV(rcfile) [lindex $args [incr i]] } if {!$PRIV(WWW) && [file exists $PRIV(rcfile)]} { set code [catch {uplevel \#0 [list source $PRIV(rcfile)]} err] } if {[info exists env(TK_CON_LIBRARY)]} { lappend ::auto_path $env(TK_CON_LIBRARY) } elseif {$OPT(library) != ""} { lappend ::auto_path $OPT(library) } if {![info exists ::tcl_pkgPath]} { set dir [file join [file dirname [info nameofexec]] lib] if {[llength [info commands @scope]]} { set dir [file join $dir itcl] } catch {source [file join $dir pkgIndex.tcl]} } catch {tclPkgUnknown dummy-name dummy-version} ## Handle rest of command line arguments after sourcing resource file ## and slave is created, but before initializing UI or setting packages. set slaveargs {} set slavefiles {} set slaveargv0 {} set truth {^(1|yes|true|on)$} for {set i 0} {$i < $argc} {incr i} { set arg [lindex $args $i] if {[string match {-*} $arg]} { set val [lindex $args [incr i]] ## Handle arg based options switch -glob -- $arg { -- - -argv - -args { set slaveargs [concat $slaveargs [lrange $args $i end]] set ::argv $slaveargs set ::argc [llength $::argv] break } -color-* { set COLOR([string range $arg 7 end]) $val } -exec { set OPT(exec) $val } -main - -e - -eval { append OPT(maineval) \n$val\n } -package - -load { lappend OPT(autoload) $val if {$val eq "nsf" || $val eq "nx" || $val eq "XOTcl" } { # If xotcl is loaded, prepend expand order for it set OPT(expandorder) [concat Methodname $OPT(expandorder)] } } -slave { append OPT(slaveeval) \n$val\n } -nontcl { set OPT(nontcl) [regexp -nocase $truth $val]} -root { set PRIV(root) $val } -font { set OPT(font) $val } -rcfile {} default { lappend slaveargs $arg; incr i -1 } } } elseif {[file isfile $arg]} { if {$i == 0} { set slaveargv0 $arg } lappend slavefiles $arg } else { lappend slaveargs $arg } } ## Create slave executable if {"" != $OPT(exec)} { InitSlave $OPT(exec) $slaveargs $slaveargv0 } else { set argc [llength $slaveargs] set args $slaveargs uplevel \#0 $slaveargs } # Try not to make tkcon override too many standard defaults, and only # do it for the tkcon bits set optclass [tk appname]$PRIV(root) option add $optclass*Menu.tearOff 0 option add $optclass*Menu.borderWidth 1 option add $optclass*Menu.activeBorderWidth 1 if {!$PRIV(AQUA)} { option add $optclass*Scrollbar.borderWidth 1 } ## Attach to the slave, EvalAttached will then be effective Attach $PRIV(appname) $PRIV(apptype) InitUI $title if {"" != $OPT(exec)} { # override exit to DeleteTab now that tab has been created $OPT(exec) alias exit ::tkcon::DeleteTab $PRIV(curtab) $OPT(exec) } ## swap puts and gets with the tkcon versions to make sure all ## input and output is handled by tkcon if {![catch {rename ::puts ::tkcon_tcl_puts}]} { interp alias {} ::puts {} ::tkcon_puts if {[llength [info commands ::tcl::chan::puts]]} { interp alias {} ::tcl::chan::puts {} ::tkcon_puts } } if {($OPT(gets) != "") && ![catch {rename ::gets ::tkcon_tcl_gets}]} { interp alias {} ::gets {} ::tkcon_gets if {[llength [info commands ::tcl::chan::gets]]} { interp alias {} ::tcl::chan::gets {} ::tkcon_gets } } EvalSlave history keep $OPT(history) if {[info exists MainInit]} { # Source history file only for the main console, as all slave # consoles will adopt from the main's history, but still # keep separate histories if {!$PRIV(WWW) && $OPT(usehistory) && [file exists $PRIV(histfile)]} { puts -nonewline "loading history file ... " # The history file is built to be loaded in and # understood by tkcon if {[catch {uplevel \#0 [list source $PRIV(histfile)]} herr]} { puts stderr "error:\n$herr" append PRIV(errorInfo) $errorInfo\n } set PRIV(event) [EvalSlave history nextid] puts "[expr {$PRIV(event)-1}] events added" } } ## Autoload specified packages in slave set pkgs [EvalSlave package names] foreach pkg $OPT(autoload) { puts -nonewline "autoloading package \"$pkg\" ... " if {[lsearch -exact $pkgs $pkg]>-1} { if {[catch {EvalSlave package require [list $pkg]} pkgerr]} { puts stderr "error:\n$pkgerr" append PRIV(errorInfo) $errorInfo\n } else { puts "OK" } } else { puts stderr "error: package does not exist" } } ## Evaluate maineval in slave if {($OPT(maineval) ne "") && [catch {uplevel \#0 $OPT(maineval)} merr]} { puts stderr "error in eval:\n$merr" append PRIV(errorInfo) $errorInfo\n } ## Source extra command line argument files into slave executable foreach fn $slavefiles { puts -nonewline "slave sourcing \"$fn\" ... " if {[catch {EvalSlave uplevel \#0 [list source $fn]} fnerr]} { puts stderr "error:\n$fnerr" append PRIV(errorInfo) $errorInfo\n } else { puts "OK" } } ## Evaluate slaveeval in slave if {($OPT(slaveeval) ne "") && [catch {interp eval $OPT(exec) $OPT(slaveeval)} serr]} { puts stderr "error in slave eval:\n$serr" append PRIV(errorInfo) $errorInfo\n } ## Output any error/output that may have been returned from rcfile if {[info exists code] && $code && ($err ne "")} { puts stderr "error in $PRIV(rcfile):\n$err" append PRIV(errorInfo) $errorInfo } if {$OPT(exec) ne ""} { StateCheckpoint [concat $PRIV(name) $OPT(exec)] slave } StateCheckpoint $PRIV(name) slave puts "buffer line limit:\ [expr {$OPT(buffer)?$OPT(buffer):{unlimited}}] \ max line length:\ [expr {$OPT(maxlinelen)?$OPT(maxlinelen):{unlimited}}]" Prompt "$title console display active (Tcl$::tcl_patchLevel / Tk$::tk_patchLevel)\n" } ## ::tkcon::InitSlave - inits the slave by placing key procs and aliases in it ## It's arg[cv] are based on passed in options, while argv0 is the same as ## the master. tcl_interactive is the same as the master as well. # ARGS: slave - name of slave to init. If it does not exist, it is created. # args - args to pass to a slave as argv/argc ## proc ::tkcon::InitSlave {slave {slaveargs {}} {slaveargv0 {}}} { variable OPT variable COLOR variable PRIV global argv0 tcl_interactive tcl_library env auto_path tk_library if {$slave eq ""} { return -code error "Don't init the master interpreter, goofball" } if {![interp exists $slave]} { interp create $slave } if {[interp eval $slave info command source] == ""} { $slave alias source SafeSource $slave $slave alias load SafeLoad $slave $slave alias open SafeOpen $slave $slave alias file file interp eval $slave \ [list set auto_path [lremove $auto_path $tk_library]] interp eval $slave [dump var -nocomplain tcl_library env] interp eval $slave { catch {source [file join $tcl_library init.tcl]} } interp eval $slave { catch unknown } } # This will likely be overridden to call DeleteTab where possible $slave alias exit exit interp eval $slave { # Do package require before changing around puts/gets catch {set __tkcon_error ""; set __tkcon_error $errorInfo} catch {package require bogus-package-name} catch {rename ::puts ::tkcon_tcl_puts} set errorInfo ${__tkcon_error} unset __tkcon_error } foreach cmd $PRIV(slaveprocs) { $slave eval [dump proc $cmd] } foreach cmd $PRIV(slavealias) { $slave alias $cmd $cmd } interp alias $slave ::ls $slave ::dir -full interp alias $slave ::puts $slave ::tkcon_puts if {[llength [info commands ::tcl::chan::puts]]} { interp alias $slave ::tcl::chan::puts $slave ::tkcon_puts } if {$OPT(gets) != ""} { interp eval $slave { catch {rename ::gets ::tkcon_tcl_gets} } interp alias $slave ::gets $slave ::tkcon_gets if {[llength [info commands ::tcl::chan::gets]]} { interp alias $slave ::tcl::chan::gets $slave ::tkcon_gets } } if {$slaveargv0 != ""} { # If tkcon was invoked with 1 or more filenames, then make the # first filename argv0 in the slave, as tclsh/wish would do it. interp eval $slave [list set argv0 $slaveargv0] } else { if {[info exists argv0]} {interp eval $slave [list set argv0 $argv0]} } interp eval $slave set tcl_interactive $tcl_interactive \; \ set auto_path [list [lremove $auto_path $tk_library]] \; \ set argc [llength $slaveargs] \; \ set argv [list $slaveargs] \; { if {![llength [info command bgerror]]} { proc bgerror err { global errorInfo set body [info body bgerror] rename ::bgerror {} if {[auto_load bgerror]} { return [bgerror $err] } proc bgerror err $body tkcon bgerror $err $errorInfo } } } foreach pkg [lremove [package names] Tcl] { foreach v [package versions $pkg] { interp eval $slave [list package ifneeded $pkg $v \ [package ifneeded $pkg $v]] } } } ## ::tkcon::InitInterp - inits an interpreter by placing key ## procs and aliases in it. # ARGS: name - interp name # type - interp type (slave|interp) ## proc ::tkcon::InitInterp {name type} { variable OPT variable PRIV ## Don't allow messing up a local master interpreter if {($type eq "namespace") || (($type eq "slave") && [regexp {^([Mm]ain|Slave[0-9]+)$} $name])} { return } set old [Attach] set oldname $PRIV(namesp) catch { Attach $name $type EvalAttached { catch {rename ::puts ::tkcon_tcl_puts} } foreach cmd $PRIV(slaveprocs) { EvalAttached [dump proc $cmd] } switch -exact $type { slave { foreach cmd $PRIV(slavealias) { Main [list interp alias $name ::$cmd $PRIV(name) ::$cmd] } } interp { set thistkcon [::send::appname] foreach cmd $PRIV(slavealias) { EvalAttached "proc $cmd args { ::send::send [list $thistkcon] $cmd \$args }" } } } ## Catch in case it's a 7.4 (no 'interp alias') interp EvalAttached { catch {interp alias {} ::ls {} ::dir -full} if {[catch {interp alias {} ::puts {} ::tkcon_puts}]} { catch {rename ::tkcon_puts ::puts} } elseif {[llength [info commands ::tcl::chan::puts]]} { catch {interp alias {} ::tcl::chan::puts {} ::tkcon_puts} } } if {$OPT(gets) != ""} { EvalAttached { catch {rename ::gets ::tkcon_tcl_gets} if {[catch {interp alias {} ::gets {} ::tkcon_gets}]} { catch {rename ::tkcon_gets ::gets} } elseif {[llength [info commands ::tcl::chan::gets]]} { catch {interp alias {} ::tcl::chan::gets {} ::tkcon_gets} } } } return } {err} eval Attach $old AttachNamespace $oldname if {$err ne ""} { return -code error $err } } ## ::tkcon::InitUI - inits UI portion (console) of tkcon ## Creates all elements of the console window and sets up the text tags # ARGS: root - widget pathname of the tkcon console root # title - title for the console root and main (.) windows # Calls: ::tkcon::InitMenus, ::tkcon::Prompt ## proc ::tkcon::InitUI {title} { variable OPT variable PRIV variable COLOR set root $PRIV(root) if {$root eq "."} { set w {} } else { set w [toplevel $root] } if {!$PRIV(WWW)} { wm withdraw $root wm protocol $root WM_DELETE_WINDOW $PRIV(protocol) } set PRIV(base) $w catch {font create tkconfixed -family Courier -size -12} catch {font create tkconfixedbold -family Courier -size -12 -weight bold} set PRIV(statusbar) [set sbar [frame $w.fstatus]] set PRIV(tabframe) [frame $sbar.tabs] set PRIV(X) [button $sbar.deltab -text "X" -command ::tkcon::DeleteTab \ -activeforeground red -fg red -font tkconfixedbold \ -highlightthickness 0 -padx 2 -pady 0 -borderwidth 1 \ -state disabled -relief flat -takefocus 0] catch {$PRIV(X) configure -overrelief raised} label $sbar.cursor -relief sunken -borderwidth 1 -anchor e -width 6 \ -textvariable ::tkcon::PRIV(StatusCursor) set padx [expr {![info exists ::tcl_platform(os)] || ($::tcl_platform(os) ne "Windows CE")}] grid $PRIV(X) $PRIV(tabframe) $sbar.cursor -sticky news -padx $padx grid configure $PRIV(tabframe) -sticky nsw grid configure $PRIV(X) -pady 0 -padx 0 grid columnconfigure $sbar 1 -weight 1 grid rowconfigure $sbar 0 -weight 1 grid rowconfigure $PRIV(tabframe) 0 -weight 1 if {$PRIV(AQUA)} { # resize control space and correct "X" button space grid columnconfigure $sbar [lindex [grid size $sbar] 0] -minsize 16 $PRIV(X) configure -pady 5 -padx 4 } ## Create console tab set con [InitTab $w] set PRIV(curtab) $con # Only apply this for the first console $con configure -setgrid 1 -width $OPT(cols) -height $OPT(rows) bind $PRIV(root) { if {"%W" == $::tkcon::PRIV(root)} { scan [wm geometry [winfo toplevel %W]] "%%dx%%d" \ ::tkcon::OPT(cols) ::tkcon::OPT(rows) if {[info exists ::tkcon::EXP(spawn_id)]} { catch {stty rows $::tkcon::OPT(rows) columns \ $::tkcon::OPT(cols) < $::tkcon::EXP(slave,name)} } } } # scrollbar set sy [scrollbar $w.sy -takefocus 0 -command [list $con yview]] if {!$PRIV(WWW) && ($::tcl_platform(os) eq "Windows CE")} { $w.sy configure -width 10 } $con configure -yscrollcommand [list $sy set] set PRIV(console) $con set PRIV(scrolly) $sy ## Menus ## catch against use in plugin if {[catch {menu $w.mbar} PRIV(menubar)]} { set PRIV(menubar) [frame $w.mbar -relief raised -borderwidth 1] } InitMenus $PRIV(menubar) $title Bindings if {$OPT(showmenu)} { $root configure -menu $PRIV(menubar) } grid $con -row 1 -column 1 -sticky news grid $sy -row 1 -column [expr {$OPT(scrollypos)=="left"?0:2}] -sticky ns grid $sbar -row 2 -column 0 -columnspan 3 -sticky ew grid columnconfigure $root 1 -weight 1 grid rowconfigure $root 1 -weight 1 if {!$OPT(showstatusbar)} { grid remove $sbar } # If we can locate the XDG icon file then make use of it. if {[package vsatisfies [package provide Tk] 8.6]} { if {[tk windowingsystem] eq "x11"} { if {[set icon [locate_xdg_icon tkcon-icon.png]] ne ""} { image create photo tkcon_icon -file $icon wm iconphoto $root tkcon_icon } } } if {!$PRIV(WWW)} { wm title $root "tkcon $PRIV(version) $title" if {$PRIV(showOnStartup)} { # this may throw an error if toplevel is embedded catch {wm deiconify $root} } } if {$PRIV(showOnStartup)} { focus -force $PRIV(console) } if {$OPT(gc-delay)} { after $OPT(gc-delay) ::tkcon::GarbageCollect } } # Hunt around the XDG defined directories for the icon. # Note: hicolor is the standard theme used by xdg-icon-resource. proc ::tkcon::locate_xdg_icon {name} { global env set dirs [list /usr/local/share /usr/share] if {[info exists env(XDG_DATA_DIRS)]} { set dirs [split $env(XDG_DATA_DIRS) :] } if {[file isdirectory ~/.local/share]} { set dirs [linsert $dirs 0 ~/.local/share] } foreach dir $dirs { foreach path [list icons icons/hicolor/48x48/apps] { set path [file join $dir $path $name] if {[file exists $path]} { return $path } } } return "" } proc ::tkcon::InitTab {w} { variable OPT variable PRIV variable COLOR variable ATTACH # text console set con $w.tab[incr PRIV(uid)] text $con -wrap char -foreground $COLOR(stdin) \ -insertbackground $COLOR(cursor) -borderwidth 1 -highlightthickness 0 $con mark set output 1.0 $con mark set limit 1.0 if {$COLOR(bg) ne ""} { $con configure -background $COLOR(bg) } set COLOR(bg) [$con cget -background] if {$OPT(font) ne ""} { ## Set user-requested font, if any $con configure -font $OPT(font) } elseif {$::tcl_platform(platform) ne "unix"} { ## otherwise make sure the font is monospace set font [$con cget -font] if {![font metrics $font -fixed]} { $con configure -font tkconfixed } } else { $con configure -font tkconfixed } set OPT(font) [$con cget -font] bindtags $con [list $con TkConsole TkConsolePost $PRIV(root) all] # scrollbar if {!$PRIV(WWW)} { if {$::tcl_platform(os) eq "Windows CE"} { font configure tkconfixed -family Tahoma -size 8 $con configure -font tkconfixed -borderwidth 0 -padx 0 -pady 0 set cw [font measure tkconfixed "0"] set ch [font metrics tkconfixed -linespace] set sw [winfo screenwidth $con] set sh [winfo screenheight $con] # We need the magic hard offsets until I find a way to # correctly assume size if {$cw*($OPT(cols)+2) > $sw} { set OPT(cols) [expr {($sw / $cw) - 2}] } if {$ch*($OPT(rows)+3) > $sh} { set OPT(rows) [expr {($sh / $ch) - 3}] } # Place it so that the titlebar underlaps the CE titlebar wm geometry $PRIV(root) +0+0 } } $con configure -height $OPT(rows) -width $OPT(cols) foreach col {prompt stdout stderr stdin proc} { $con tag configure $col -foreground $COLOR($col) } $con tag configure var -background $COLOR(var) $con tag raise sel $con tag configure blink -background $COLOR(blink) $con tag configure find -background $COLOR(blink) set ATTACH($con) [Attach] set rb [radiobutton $PRIV(tabframe).cb[winfo name $con] -takefocus 0 \ -textvariable ::tkcon::ATTACH($con) \ -selectcolor white -relief sunken \ -indicatoron 0 -padx 0 -pady 0 -borderwidth 1 \ -variable ::tkcon::PRIV(curtab) -value $con \ -command [list ::tkcon::GotoTab $con]] if {$::tcl_version >= 8.4} { $rb configure -offrelief flat -overrelief raised } if {$PRIV(AQUA)} { $rb configure -padx 4 -pady 4 -highlightthickness 0 } grid $rb -row 0 -column [lindex [grid size $PRIV(tabframe)] 0] -sticky ns grid $con -row 1 -column 1 -sticky news lappend PRIV(tabs) $con return $con } proc ::tkcon::GotoTab {con} { variable PRIV variable ATTACH set numtabs [llength $PRIV(tabs)] #if {$numtabs == 1} { return } if {[regexp {^[0-9]+$} $con]} { set curtab [lsearch -exact $PRIV(tabs) $PRIV(console)] set nexttab [expr {$curtab + $con}] if {$nexttab >= $numtabs} { set nexttab 0 } elseif {$nexttab < 0} { set nexttab "end" } set con [lindex $PRIV(tabs) $nexttab] } elseif {$con == $PRIV(console)} { return } # adjust console if {[winfo exists $PRIV(console)]} { lower $PRIV(console) $PRIV(console) configure -yscrollcommand {} set ATTACH($PRIV(console)) [Attach] } set PRIV(console) $con $con configure -yscrollcommand [list $PRIV(scrolly) set] $PRIV(scrolly) configure -command [list $con yview] # adjust attach eval [linsert $ATTACH($con) 0 Attach] set PRIV(curtab) $con raise $con if {[$con compare 1.0 == end-1c]} { Prompt } # set StatusCursor set PRIV(StatusCursor) [$con index insert] focus -force $con } proc ::tkcon::NewTab {{con {}}} { variable PRIV variable ATTACH set con [InitTab $PRIV(base)] set slave [GetSlave] InitSlave $slave $slave alias exit ::tkcon::DeleteTab $con $slave if {$PRIV(name) != ""} { set ATTACH($con) [list [list $PRIV(name) $slave] slave] } else { set ATTACH($con) [list $slave slave] } $PRIV(X) configure -state normal MenuConfigure Console "Delete Tab" -state normal GotoTab $con } # The extra code arg is for the alias of exit to this function proc ::tkcon::DeleteTab {{con {}} {slave {}} {code 0}} { variable PRIV set numtabs [llength $PRIV(tabs)] if {$numtabs <= 2} { $PRIV(X) configure -state disabled MenuConfigure Console "Delete Tab" -state disabled } if {$numtabs == 1} { # in the master, it should do the right thing # currently the first master still exists - need rearch to fix exit # we might end up here, depending on how exit is rerouted return } if {$con == ""} { set con $PRIV(console) } catch {unset ATTACH($con)} set curtab [lsearch -exact $PRIV(tabs) $con] set PRIV(tabs) [lreplace $PRIV(tabs) $curtab $curtab] set numtabs [llength $PRIV(tabs)] set nexttab $curtab if {$nexttab >= $numtabs} { set nexttab end } set nexttab [lindex $PRIV(tabs) $nexttab] GotoTab $nexttab if {$slave != "" && $slave != $::tkcon::OPT(exec)} { interp delete $slave } destroy $PRIV(tabframe).cb[winfo name $con] destroy $con } ## ::tkcon::GarbageCollect - do various cleanup ops periodically to our setup ## proc ::tkcon::GarbageCollect {} { variable OPT variable PRIV foreach w $PRIV(tabs) { if {[winfo exists $w]} { ## Remove error tags that no longer span anything ## Make sure the tag pattern matches the unique tag prefix foreach tag [$w tag names] { if {[string match _tag* $tag] && ![llength [$w tag ranges $tag]]} { $w tag delete $tag } } } } if {$OPT(gc-delay)} { after $OPT(gc-delay) ::tkcon::GarbageCollect } } ## ::tkcon::Eval - evaluates commands input into console window ## This is the first stage of the evaluating commands in the console. ## They need to be broken up into consituent commands (by ::tkcon::CmdSep) in ## case a multiple commands were pasted in, then each is eval'ed (by ## ::tkcon::EvalCmd) in turn. Any uncompleted command will not be eval'ed. # ARGS: w - console text widget # Calls: ::tkcon::CmdGet, ::tkcon::CmdSep, ::tkcon::EvalCmd ## proc ::tkcon::Eval {w} { set complete [CmdSep [CmdGet $w] cmds last] $w mark set insert end-1c $w insert end \n if {[llength $cmds]} { foreach c $cmds {EvalCmd $w $c} $w insert insert $last {} } elseif {$complete} { EvalCmd $w $last } if {[winfo exists $w]} { $w see insert } } ## ::tkcon::EvalCmd - evaluates a single command, adding it to history # ARGS: w - console text widget # cmd - the command to evaluate # Calls: ::tkcon::Prompt # Outputs: result of command to stdout (or stderr if error occured) # Returns: next event number ## proc ::tkcon::EvalCmd {w cmd} { variable OPT variable PRIV $w mark set output end if {$cmd ne ""} { set code 0 if {$OPT(subhistory)} { set ev [EvalSlave history nextid] incr ev -1 ## FIX: calcmode doesn't work with requesting history events if {$cmd eq "!!"} { set code [catch {EvalSlave history event $ev} cmd] if {!$code} {$w insert output $cmd\n stdin} } elseif {[regexp {^!(.+)$} $cmd dummy event]} { ## Check last event because history event is broken set code [catch {EvalSlave history event $ev} cmd] if {!$code && ![string match ${event}* $cmd]} { set code [catch {EvalSlave history event $event} cmd] } if {!$code} {$w insert output $cmd\n stdin} } elseif {[regexp {^\^([^^]*)\^([^^]*)\^?$} $cmd dummy old new]} { set code [catch {EvalSlave history event $ev} cmd] if {!$code} { regsub -all -- $old $cmd $new cmd $w insert output $cmd\n stdin } } elseif {$OPT(calcmode) && ![catch {expr $cmd} err]} { AddSlaveHistory $cmd set cmd $err set code -1 } } if {$code} { $w insert output $cmd\n stderr } else { ## We are about to evaluate the command, so move the limit ## mark to ensure that further s don't cause double ## evaluation of this command - for cases like the command ## has a vwait or something in it $w mark set limit end if {$OPT(nontcl) && ($PRIV(apptype) eq "interp")} { set code [catch {EvalSend $cmd} res] if {$code == 1} { set PRIV(errorInfo) "Non-Tcl errorInfo not available" } } elseif {$PRIV(apptype) eq "socket"} { set code [catch {EvalSocket $cmd} res] if {$code == 1} { set PRIV(errorInfo) "Socket-based errorInfo not available" } } else { set code [catch {EvalAttached $cmd} res] if {$code == 1} { if {[catch {EvalAttached [list set errorInfo]} err]} { set PRIV(errorInfo) "Error getting errorInfo:\n$err" } else { set PRIV(errorInfo) $err } } } if {![winfo exists $w]} { # early abort - must be a deleted tab return } AddSlaveHistory $cmd # Run any user defined result filter command. The command is # passed result code and data. if {[llength $OPT(resultfilter)]} { set cmd [linsert $OPT(resultfilter) end $code $res] if {[catch {EvalAttached $cmd} res2]} { $w insert output "Filter failed: $res2" stderr \n stdout } else { set res $res2 } } catch {EvalAttached [list set _ $res]} set maxlen $OPT(maxlinelen) set trailer "" if {($maxlen > 0) && ([string length $res] > $maxlen)} { # If we exceed maximum desired output line length, truncate # the result and add "...+${num}b" in error coloring set trailer ...+[expr {[string length $res]-$maxlen}]b set res [string range $res 0 $maxlen] } if {$code} { if {$OPT(hoterrors)} { set tag [UniqueTag $w] $w insert output $res [list stderr $tag] \n$trailer stderr $w tag bind $tag \ [list $w tag configure $tag -under 1] $w tag bind $tag \ [list $w tag configure $tag -under 0] $w tag bind $tag \ "if {!\[info exists tk::Priv(mouseMoved)\] || !\$tk::Priv(mouseMoved)} \ {[list $OPT(edit) -attach [Attach] -type error -- $PRIV(errorInfo)]}" } else { $w insert output $res\n$trailer stderr } } elseif {$res ne ""} { $w insert output $res stdout $trailer stderr \n stdout } } } Prompt set PRIV(event) [EvalSlave history nextid] } ## ::tkcon::EvalSlave - evaluates the args in the associated slave ## args should be passed to this procedure like they would be at ## the command line (not like to 'eval'). # ARGS: args - the command and args to evaluate ## proc ::tkcon::EvalSlave args { interp eval $::tkcon::OPT(exec) $args } ## ::tkcon::EvalOther - evaluate a command in a foreign interp or slave ## without attaching to it. No check for existence is made. # ARGS: app - interp/slave name # type - (slave|interp) ## proc ::tkcon::EvalOther { app type args } { if {$type eq "slave"} { return [Slave $app $args] } else { return [uplevel 1 ::send::send [list $app] $args] } } ## ::tkcon::AddSlaveHistory - ## Command is added to history only if different from previous command. ## This also doesn't cause the history id to be incremented, although the ## command will be evaluated. # ARGS: cmd - command to add ## proc ::tkcon::AddSlaveHistory cmd { set ev [EvalSlave history nextid] incr ev -1 set code [catch {EvalSlave history event $ev} lastCmd] if {$code || $cmd ne $lastCmd} { EvalSlave history add $cmd # Save history every time so it's not lost in case of an abnormal termination. # Do not warn in case of an error: we don't want an error message # after each command if the history file is not writable. catch {SaveHistory} } } ## ::tkcon::EvalSend - sends the args to the attached interpreter ## Varies from 'send' by determining whether attachment is dead ## when an error is received # ARGS: cmd - the command string to send across # Returns: the result of the command ## proc ::tkcon::EvalSend cmd { variable OPT variable PRIV if {$PRIV(deadapp)} { if {[lsearch -exact [::send::interps] $PRIV(app)]<0} { return } else { set PRIV(appname) [string range $PRIV(appname) 5 end] set PRIV(deadapp) 0 Prompt "\n\"$PRIV(app)\" alive\n" [CmdGet $PRIV(console)] } } set code [catch {::send::send -displayof $PRIV(displayWin) $PRIV(app) $cmd} result] if {$code && [lsearch -exact [::send::interps] $PRIV(app)]<0} { ## Interpreter disappeared if {($OPT(dead) ne "leave") && (($OPT(dead) eq "ignore") || [tk_messageBox -title "Dead Attachment" -type yesno \ -icon info -message \ "\"$PRIV(app)\" appears to have died.\ \nReturn to primary slave interpreter?"] eq "no")} { set PRIV(appname) "DEAD:$PRIV(appname)" set PRIV(deadapp) 1 } else { set err "Attached Tk interpreter \"$PRIV(app)\" died." Attach {} set PRIV(deadapp) 0 EvalSlave set errorInfo $err } Prompt \n [CmdGet $PRIV(console)] } return -code $code $result } ## ::tkcon::EvalSocket - sends the string to an interpreter attached via ## a tcp/ip socket ## ## In the EvalSocket case, ::tkcon::PRIV(app) is the socket id ## ## Must determine whether socket is dead when an error is received # ARGS: cmd - the data string to send across # Returns: the result of the command ## proc ::tkcon::EvalSocket cmd { variable OPT variable PRIV global tcl_version if {$PRIV(deadapp)} { if {![info exists PRIV(app)] || \ [catch {eof $PRIV(app)} eof] || $eof} { return } else { set PRIV(appname) [string range $PRIV(appname) 5 end] set PRIV(deadapp) 0 Prompt "\n\"$PRIV(app)\" alive\n" [CmdGet $PRIV(console)] } } # Sockets get \'s interpreted, so that users can # send things like \n\r or explicit hex values set cmd [subst -novariables -nocommands $cmd] #puts [list $PRIV(app) $cmd] set code [catch {puts $PRIV(app) $cmd ; flush $PRIV(app)} result] if {$code && [eof $PRIV(app)]} { ## Interpreter died or disappeared puts "$code eof [eof $PRIV(app)]" EvalSocketClosed $PRIV(app) } return -code $code $result } ## ::tkcon::EvalSocketEvent - fileevent command for an interpreter attached ## via a tcp/ip socket ## Must determine whether socket is dead when an error is received # ARGS: args - the args to send across # Returns: the result of the command ## proc ::tkcon::EvalSocketEvent {sock} { variable PRIV if {[gets $sock line] == -1} { if {[eof $sock]} { EvalSocketClosed $sock } return } puts $line } ## ::tkcon::EvalSocketClosed - takes care of handling a closed eval socket ## # ARGS: args - the args to send across # Returns: the result of the command ## proc ::tkcon::EvalSocketClosed {sock} { variable OPT variable PRIV catch {close $sock} if {$sock ne $PRIV(app)} { # If we are not still attached to that socket, just return. # Might be nice to tell the user the socket closed ... return } if {$OPT(dead) ne "leave" && ($OPT(dead) eq "ignore" || [tk_messageBox -title "Dead Attachment" -type yesno \ -icon question \ -message "\"$PRIV(app)\" appears to have died.\ \nReturn to primary slave interpreter?"] eq "no")} { set PRIV(appname) "DEAD:$PRIV(appname)" set PRIV(deadapp) 1 } else { set err "Attached Tk interpreter \"$PRIV(app)\" died." Attach {} set PRIV(deadapp) 0 EvalSlave set errorInfo $err } Prompt \n [CmdGet $PRIV(console)] } ## ::tkcon::EvalNamespace - evaluates the args in a particular namespace ## This is an override for ::tkcon::EvalAttached for when the user wants ## to attach to a particular namespace of the attached interp # ARGS: attached # namespace the namespace to evaluate in # args the args to evaluate # RETURNS: the result of the command ## proc ::tkcon::EvalNamespace { attached namespace args } { if {[llength $args]} { uplevel \#0 $attached \ [list [concat [list namespace eval $namespace] $args]] } } ## ::tkcon::Namespaces - return all the namespaces descendent from $ns ## # ## proc ::tkcon::Namespaces {{ns ::} {l {}}} { if {$ns ne ""} { lappend l $ns } foreach i [EvalAttached [list namespace children $ns]] { set l [Namespaces $i $l] } return $l } ## ::tkcon::CmdGet - gets the current command from the console widget # ARGS: w - console text widget # Returns: text which compromises current command line ## proc ::tkcon::CmdGet w { if {![llength [$w tag nextrange prompt limit end]]} { $w tag add stdin limit end-1c return [$w get limit end-1c] } } ## ::tkcon::CmdSep - separates multiple commands into a list and remainder # ARGS: cmd - (possible) multiple command to separate # list - varname for the list of commands that were separated. # last - varname of any remainder (like an incomplete final command). # If there is only one command, it's placed in this var. # Returns: constituent command info in varnames specified by list & rmd. ## proc ::tkcon::CmdSep {cmd list last} { upvar 1 $list cmds $last inc set inc {} set cmds {} foreach c [split [string trimleft $cmd] \n] { if {$inc ne ""} { append inc \n$c } else { append inc [string trimleft $c] } if {[info complete $inc] && ![regexp {[^\\]\\$} $inc]} { if {[regexp "^\[^#\]" $inc]} {lappend cmds $inc} set inc {} } } set i [string equal $inc {}] if {$i && $cmds ne "" && ![string match *\n $cmd]} { set inc [lindex $cmds end] set cmds [lreplace $cmds end end] } return $i } ## ::tkcon::CmdSplit - splits multiple commands into a list # ARGS: cmd - (possible) multiple command to separate # Returns: constituent commands in a list ## proc ::tkcon::CmdSplit {cmd} { set inc {} set cmds {} foreach cmd [split [string trimleft $cmd] \n] { if {$inc ne ""} { append inc \n$cmd } else { append inc [string trimleft $cmd] } if {[info complete $inc] && ![regexp {[^\\]\\$} $inc]} { #set inc [string trimright $inc] if {[regexp "^\[^#\]" $inc]} {lappend cmds $inc} set inc {} } } if {[regexp "^\[^#\]" $inc]} {lappend cmds $inc} return $cmds } ## ::tkcon::UniqueTag - creates a uniquely named tag, reusing names ## Called by ::tkcon::EvalCmd # ARGS: w - text widget # Outputs: tag name guaranteed unique in the widget ## proc ::tkcon::UniqueTag {w} { set tags [$w tag names] set idx 0 while {[lsearch -exact $tags _tag[incr idx]] != -1} {} return _tag$idx } ## ::tkcon::ConstrainBuffer - This limits the amount of data in the text widget ## Called by ::tkcon::Prompt and in tkcon proc buffer/console switch cases # ARGS: w - console text widget # size - # of lines to constrain to # Outputs: may delete data in console widget ## proc ::tkcon::ConstrainBuffer {w size} { if {$size && ([$w index end] > $size)} { $w delete 1.0 [expr {int([$w index end])-$size}].0 } } ## ::tkcon::Prompt - displays the prompt in the console widget # ARGS: w - console text widget # Outputs: prompt (specified in ::tkcon::OPT(prompt1)) to console ## proc ::tkcon::Prompt {{pre {}} {post {}} {prompt {}}} { variable OPT variable PRIV set w $PRIV(console) if {![winfo exists $w]} { return } if {$pre ne ""} { $w insert end $pre stdout } set i [$w index end-1c] if {!$OPT(showstatusbar)} { if {$PRIV(appname) ne ""} { $w insert end ">$PRIV(appname)< " prompt } if {$PRIV(namesp) ne "::"} { $w insert end "<$PRIV(namesp)> " prompt } } if {$prompt ne ""} { $w insert end $prompt prompt } else { $w insert end [EvalSlave subst $OPT(prompt1)] prompt } $w mark set output $i $w mark set insert end $w mark set limit insert $w mark gravity limit left if {$post ne ""} { $w insert end $post stdin } ConstrainBuffer $w $OPT(buffer) set ::tkcon::PRIV(StatusCursor) [$w index insert] $w see end } proc ::tkcon::RePrompt {{pre {}} {post {}} {prompt {}}} { # same as prompt, but does nothing for those actions where we # only wanted to refresh the prompt on attach change when the # statusbar is showing (which carries that info instead) variable OPT if {!$OPT(showstatusbar)} { Prompt $pre $post $prompt } } ## ::tkcon::About - gives about info for tkcon ## proc ::tkcon::About {} { variable OPT variable PRIV variable COLOR set w $PRIV(base).about if {![winfo exists $w]} { global tk_patchLevel tcl_patchLevel tcl_version toplevel $w wm withdraw $w wm transient $w $PRIV(root) wm group $w $PRIV(root) catch {wm attributes $w -type dialog} wm title $w "About tkcon v$PRIV(version)" wm resizable $w 0 0 button $w.b -text Dismiss -command [list wm withdraw $w] text $w.text -height 9 -width 60 \ -foreground $COLOR(stdin) \ -background $COLOR(bg) \ -font $OPT(font) -borderwidth 1 -highlightthickness 0 grid $w.text -sticky news grid $w.b -sticky se -padx 6 -pady 4 $w.text tag config center -justify center $w.text tag config title -justify center -font {Courier -18 bold} # strip down the RCS info displayed in the about box regexp {,v ([0-9\./: ]*)} $PRIV(RCS) -> RCS $w.text insert 1.0 "About tkcon v$PRIV(version)" title \ "\n\nCopyright 1995-2002 Jeffrey Hobbs, $PRIV(email)\ \nRelease Info: v$PRIV(version), CVS v$RCS\ \nDocumentation available at:\n$PRIV(docs)\ \nUsing: Tcl v$tcl_patchLevel / Tk v$tk_patchLevel" center $w.text config -state disabled bind $w [list destroy $w] } wm deiconify $w } ## ::tkcon::InitMenus - inits the menubar and popup for the console # ARGS: w - console text widget ## proc ::tkcon::InitMenus {w title} { variable OPT variable PRIV variable COLOR global tcl_platform if {[catch {menu $w.pop}]} { label $w.label -text "Menus not available in plugin mode" grid $w.label -sticky ew return } menu $w.context -disabledforeground $COLOR(disabled) set PRIV(context) $w.context set PRIV(popup) $w.pop proc MenuButton {w m l} { $w add cascade -label $m -underline 0 -menu $w.$l return $w.$l } proc MenuConfigure {m l args} { variable PRIV eval [list $PRIV(menubar).[string tolower $m] entryconfigure $l] $args eval [list $PRIV(popup).[string tolower $m] entryconfigure $l] $args } foreach m [list File Console Edit Interp Prefs History Help] { set l [string tolower $m] MenuButton $w $m $l $w.pop add cascade -label $m -underline 0 -menu $w.pop.$l } ## File Menu ## foreach m [list [menu $w.file -disabledforeground $COLOR(disabled)] \ [menu $w.pop.file -disabledforeground $COLOR(disabled)]] { $m add command -label "Load File" -underline 0 -command ::tkcon::Load $m add cascade -label "Save ..." -underline 0 -menu $m.save $m add separator $m add command -label "Quit" -underline 0 -accel $PRIV(ACC)q \ -command exit ## Save Menu ## set s $m.save menu $s -disabledforeground $COLOR(disabled) $s add command -label "All" -underline 0 \ -command {::tkcon::Save {} all} $s add command -label "History" -underline 0 \ -command {::tkcon::Save {} history} $s add command -label "Stdin" -underline 3 \ -command {::tkcon::Save {} stdin} $s add command -label "Stdout" -underline 3 \ -command {::tkcon::Save {} stdout} $s add command -label "Stderr" -underline 3 \ -command {::tkcon::Save {} stderr} } ## Console Menu ## foreach m [list [menu $w.console -disabledfore $COLOR(disabled)] \ [menu $w.pop.console -disabledfore $COLOR(disabled)]] { $m add command -label "$title Console" -state disabled $m add command -label "New Console" -underline 0 -accel $PRIV(ACC)N \ -command ::tkcon::New $m add command -label "New Tab" -underline 4 -accel $PRIV(ACC)T \ -command ::tkcon::NewTab $m add command -label "Delete Tab" -underline 0 \ -command ::tkcon::DeleteTab -state disabled $m add command -label "Close Console" -underline 0 -accel $PRIV(ACC)w \ -command ::tkcon::Destroy $m add command -label "Clear Console" -underline 1 -accel Ctrl-l \ -command { clear; ::tkcon::Prompt } if {[tk windowingsystem] eq "x11"} { $m add separator $m add command -label "Make Xauth Secure" -und 5 \ -command ::tkcon::XauthSecure } $m add separator $m add cascade -label "Attach To ..." -underline 0 -menu $m.attach ## Attach Console Menu ## set sub [menu $m.attach -disabledforeground $COLOR(disabled)] $sub add cascade -label "Interpreter" -underline 0 -menu $sub.apps $sub add cascade -label "Namespace" -underline 0 -menu $sub.name ## Attach Console Menu ## menu $sub.apps -disabledforeground $COLOR(disabled) \ -postcommand [list ::tkcon::AttachMenu $sub.apps] ## Attach Namespace Menu ## menu $sub.name -disabledforeground $COLOR(disabled) \ -postcommand [list ::tkcon::NamespaceMenu $sub.name] ## Attach Socket Menu ## $sub add cascade -label "Socket" -underline 0 -menu $sub.sock menu $sub.sock -disabledforeground $COLOR(disabled) \ -postcommand [list ::tkcon::SocketMenu $sub.sock] if {[tk windowingsystem] eq "x11"} { ## Attach Display Menu ## $sub add cascade -label "Display" -underline 0 -menu $sub.disp menu $sub.disp -disabledforeground $COLOR(disabled) \ -postcommand [list ::tkcon::DisplayMenu $sub.disp] } } ## Edit Menu ## set text $PRIV(console) foreach m [list [menu $w.edit] [menu $w.pop.edit]] { $m add command -label "Cut" -underline 2 -accel $PRIV(ACC)x \ -command [list ::tkcon::Cut $text] $m add command -label "Copy" -underline 0 -accel $PRIV(ACC)c \ -command [list ::tkcon::Copy $text] $m add command -label "Paste" -underline 0 -accel $PRIV(ACC)v \ -command [list ::tkcon::Paste $text] $m add separator $m add command -label "Find" -underline 0 -accel $PRIV(ACC)F \ -command [list ::tkcon::FindBox $text] } ## Interp Menu ## foreach m [list $w.interp $w.pop.interp] { menu $m -disabledforeground $COLOR(disabled) \ -postcommand [list ::tkcon::InterpMenu $m] } ## Prefs Menu ## foreach m [list [menu $w.prefs] [menu $w.pop.prefs]] { $m add check -label "Brace Highlighting" \ -underline 0 -variable ::tkcon::OPT(lightbrace) $m add check -label "Command Highlighting" \ -underline 0 -variable ::tkcon::OPT(lightcmd) $m add check -label "History Substitution" \ -underline 0 -variable ::tkcon::OPT(subhistory) $m add check -label "Hot Errors" \ -underline 4 -variable ::tkcon::OPT(hoterrors) $m add check -label "Non-Tcl Attachments" \ -underline 0 -variable ::tkcon::OPT(nontcl) $m add check -label "Calculator Mode" \ -underline 1 -variable ::tkcon::OPT(calcmode) $m add check -label "Show Multiple Matches" \ -underline 0 -variable ::tkcon::OPT(showmultiple) if {!$PRIV(AQUA)} { $m add check -label "Show Menubar" \ -underline 5 -variable ::tkcon::OPT(showmenu) \ -command { $::tkcon::PRIV(root) configure \ -menu [expr {$::tkcon::OPT(showmenu) ? $::tkcon::PRIV(menubar) : {}}] } } $m add check -label "Show Statusbar" \ -underline 5 -variable ::tkcon::OPT(showstatusbar) \ -command { if {$::tkcon::OPT(showstatusbar)} { grid $::tkcon::PRIV(statusbar) } else { grid remove $::tkcon::PRIV(statusbar) } } $m add cascade -label "Scrollbar" -underline 2 -menu $m.scroll ## Scrollbar Menu ## set m [menu $m.scroll] $m add radio -label "Left" -value left \ -variable ::tkcon::OPT(scrollypos) \ -command { grid configure $::tkcon::PRIV(scrolly) -column 0 } $m add radio -label "Right" -value right \ -variable ::tkcon::OPT(scrollypos) \ -command { grid configure $::tkcon::PRIV(scrolly) -column 2 } } ## History Menu ## foreach m [list $w.history $w.pop.history] { menu $m -disabledforeground $COLOR(disabled) \ -postcommand [list ::tkcon::HistoryMenu $m] } ## Help Menu ## foreach m [list [menu $w.help] [menu $w.pop.help]] { $m add command -label "About " -underline 0 -accel $PRIV(ACC)A \ -command ::tkcon::About $m add command -label "Retrieve Latest Version" -underline 0 \ -command ::tkcon::Retrieve if {![catch {package require ActiveTcl} ver]} { set cmd "" if {$tcl_platform(platform) == "windows"} { package require registry set ver [join [lrange [split $ver .] 0 3] .] set key {HKEY_LOCAL_MACHINE\SOFTWARE\ActiveState\ActiveTcl} if {![catch {registry get "$key\\$ver\\Help" ""} help] && [file exists $help]} { set cmd [list exec $::env(COMSPEC) /c start {} $help] } } elseif {$tcl_platform(os) == "Darwin"} { set ver ActiveTcl-[join [lrange [split $ver .] 0 1] .] set rsc "/Library/Frameworks/Tcl.framework/Resources" set help "$rsc/English.lproj/$ver/index.html" if {[file exists $help]} { set cmd [list exec open $help] } } elseif {$tcl_platform(platform) == "unix"} { set help [file dirname [info nameofexe]] append help /../html/index.html if {[file exists $help]} { set cmd [list puts "Start $help"] } } if {$cmd != ""} { $m add separator $m add command -label "ActiveTcl Help" -underline 10 \ -command $cmd } } } } ## ::tkcon::HistoryMenu - dynamically build the menu for attached interpreters ## # ARGS: m - menu widget ## proc ::tkcon::HistoryMenu m { variable PRIV if {![winfo exists $m]} return set id [EvalSlave history nextid] if {$PRIV(histid)==$id} return set PRIV(histid) $id $m delete 0 end while {($id>1) && ($id>$PRIV(histid)-10) && \ ![catch {EvalSlave history event [incr id -1]} tmp]} { set lbl $tmp if {[string len $lbl]>32} { set lbl [string range $tmp 0 28]... } $m add command -label "$id: $lbl" -command " $::tkcon::PRIV(console) delete limit end $::tkcon::PRIV(console) insert limit [list $tmp] $::tkcon::PRIV(console) see end ::tkcon::Eval $::tkcon::PRIV(console)" } } ## ::tkcon::InterpMenu - dynamically build the menu for attached interpreters ## # ARGS: w - menu widget ## proc ::tkcon::InterpMenu w { variable OPT variable PRIV variable COLOR if {![winfo exists $w]} return $w delete 0 end foreach {app type} [Attach] break $w add command -label "[string toupper $type]: $app" -state disabled if {($OPT(nontcl) && $type eq "interp") || $PRIV(deadapp)} { $w add separator $w add command -state disabled -label "Communication disabled to" $w add command -state disabled -label "dead or non-Tcl interps" return } ## Show Last Error ## $w add separator $w add command -label "Show Last Error" \ -command [list tkcon error $app $type] ## Packages Cascaded Menu ## $w add separator $w add command -label "Manage Packages" -underline 0 \ -command [list ::tkcon::InterpPkgs $app $type] ## State Checkpoint/Revert ## $w add separator $w add command -label "Checkpoint State" \ -command [list ::tkcon::StateCheckpoint $app $type] $w add command -label "Revert State" \ -command [list ::tkcon::StateRevert $app $type] $w add command -label "View State Change" \ -command [list ::tkcon::StateCompare $app $type] ## Init Interp ## $w add separator $w add command -label "Send tkcon Commands" \ -command [list ::tkcon::InitInterp $app $type] } ## ::tkcon::PkgMenu - fill in in the applications sub-menu ## with a list of all the applications that currently exist. ## proc ::tkcon::InterpPkgs {app type} { variable PRIV set t $PRIV(base).interppkgs if {![winfo exists $t]} { toplevel $t wm withdraw $t wm title $t "$app Packages" wm transient $t $PRIV(root) wm group $t $PRIV(root) catch {wm attributes $t -type dialog} bind $t [list destroy $t] label $t.ll -text "Loadable:" -anchor w label $t.lr -text "Loaded:" -anchor w listbox $t.loadable -font tkconfixed -background white -borderwidth 1 \ -yscrollcommand [list $t.llsy set] -selectmode extended listbox $t.loaded -font tkconfixed -background white -borderwidth 1 \ -yscrollcommand [list $t.lrsy set] scrollbar $t.llsy -command [list $t.loadable yview] scrollbar $t.lrsy -command [list $t.loaded yview] button $t.load -borderwidth 1 -text ">>" \ -command [list ::tkcon::InterpPkgLoad $app $type $t.loadable] if {$::tcl_version >= 8.4} { $t.load configure -relief flat -overrelief raised } set f [frame $t.btns] button $f.refresh -width 8 -text "Refresh" -command [info level 0] button $f.dismiss -width 8 -text "Dismiss" -command [list destroy $t] grid $f.refresh $f.dismiss -padx 4 -pady 3 -sticky ew if {$PRIV(AQUA)} { # corner resize control space grid columnconfigure $f [lindex [grid size $f] 0] -minsize 16 } grid $t.ll x x $t.lr x -sticky ew grid $t.loadable $t.llsy $t.load $t.loaded $t.lrsy -sticky news grid $t.btns -sticky e -columnspan 5 grid columnconfigure $t {0 3} -weight 1 grid rowconfigure $t 1 -weight 1 grid configure $t.load -sticky "" bind $t.loadable "[list $t.load invoke]; break" } $t.loaded delete 0 end $t.loadable delete 0 end # just in case stuff has been added to the auto_path # we have to make sure that the errorInfo doesn't get screwed up EvalAttached { set __tkcon_error $errorInfo catch {package require bogus-package-name} set errorInfo ${__tkcon_error} unset __tkcon_error } # get all packages loaded into current interp foreach pkg [EvalAttached [list info loaded {}]] { set pkg [lindex $pkg 1] set loaded($pkg) [package provide $pkg] } # get all package names currently visible foreach pkg [lremove [EvalAttached {package names}] Tcl] { set version [EvalAttached [list package provide $pkg]] if {$version ne ""} { set loaded($pkg) $version } elseif {![info exists loaded($pkg)]} { set loadable($pkg) package } } # get packages that are loaded in any interp foreach pkg [EvalAttached {info loaded}] { set pkg [lindex $pkg 1] if {![info exists loaded($pkg)] && ![info exists loadable($pkg)]} { set loadable($pkg) load } } foreach pkg [lsort -dictionary [array names loadable]] { foreach v [EvalAttached [list package version $pkg]] { $t.loadable insert end [list $pkg $v "($loadable($pkg))"] } } foreach pkg [lsort -dictionary [array names loaded]] { $t.loaded insert end [list $pkg $loaded($pkg)] } wm deiconify $t raise $t } proc ::tkcon::InterpPkgLoad {app type lb} { # load the lb entry items into the interp foreach sel [$lb curselection] { foreach {pkg ver method} [$lb get $sel] { break } if {$method == "(package)"} { set code [catch {::tkcon::EvalOther $app $type \ package require $pkg $ver} msg] } elseif {$method == "(load)"} { set code [catch {::tkcon::EvalOther $app $type load {} $pkg} msg] } else { set code 1 set msg "Incorrect entry in Loadable selection" } if {$code} { tk_messageBox -icon error -title "Error requiring $pkg" -type ok \ -message "Error requiring $pkg $ver:\n$msg\n$::errorInfo" } } # refresh package list InterpPkgs $app $type } ## ::tkcon::AttachMenu - fill in in the applications sub-menu ## with a list of all the applications that currently exist. ## proc ::tkcon::AttachMenu m { variable OPT variable PRIV array set interps [set tmp [Interps]] foreach {i j} $tmp { set tknames($j) {} } $m delete 0 end set cmd {::tkcon::RePrompt \n [::tkcon::CmdGet $::tkcon::PRIV(console)]} $m add radio -label {None (use local slave) } -accel $PRIV(ACC)1 \ -variable ::tkcon::PRIV(app) \ -value [concat $::tkcon::PRIV(name) $::tkcon::OPT(exec)] \ -command "::tkcon::Attach {}; $cmd" $m add separator $m add command -label "Foreign Tk Interpreters" -state disabled foreach i [lsort [lremove [::send::interps] [array names tknames]]] { $m add radio -label $i -variable ::tkcon::PRIV(app) -value $i \ -command "::tkcon::Attach [list $i] interp; $cmd" } $m add separator $m add command -label "tkcon Interpreters" -state disabled foreach i [lsort [array names interps]] { if {$interps($i) eq ""} { set interps($i) "no Tk" } if {[regexp {^Slave[0-9]+} $i]} { set opts [list -label "$i ($interps($i))" \ -variable ::tkcon::PRIV(app) -value $i \ -command "::tkcon::Attach [list $i] slave; $cmd"] if {$PRIV(name) eq $i} { append opts " -accel $PRIV(ACC)2" } eval [list $m add radio] $opts } else { set name [concat Main $i] if {$name eq "Main"} { $m add radio -label "$name ($interps($i))" -accel $PRIV(ACC)3 \ -variable ::tkcon::PRIV(app) -value Main \ -command "::tkcon::Attach [list $name] slave; $cmd" } else { $m add radio -label "$name ($interps($i))" \ -variable ::tkcon::PRIV(app) -value $i \ -command "::tkcon::Attach [list $name] slave; $cmd" } } } } ## Displays Cascaded Menu ## proc ::tkcon::DisplayMenu m { $m delete 0 end set cmd {::tkcon::RePrompt \n [::tkcon::CmdGet $::tkcon::PRIV(console)]} $m add command -label "New Display" -command ::tkcon::NewDisplay foreach disp [Display] { $m add separator $m add command -label $disp -state disabled set res [Display $disp] set win [lindex $res 0] foreach i [lsort [lindex $res 1]] { $m add radio -label $i -variable ::tkcon::PRIV(app) -value $i \ -command "::tkcon::Attach [list $i] [list dpy:$win]; $cmd" } } } ## Sockets Cascaded Menu ## proc ::tkcon::SocketMenu m { $m delete 0 end set cmd {::tkcon::RePrompt \n [::tkcon::CmdGet $::tkcon::PRIV(console)]} $m add command -label "Create Connection" \ -command "::tkcon::NewSocket; $cmd" foreach sock [file channels sock*] { $m add radio -label $sock -variable ::tkcon::PRIV(app) -value $sock \ -command "::tkcon::Attach $sock socket; $cmd" } } ## Namepaces Cascaded Menu ## proc ::tkcon::NamespaceMenu m { variable PRIV variable OPT $m delete 0 end if {($PRIV(deadapp) || $PRIV(apptype) eq "socket" || \ ($OPT(nontcl) && $PRIV(apptype) eq "interp"))} { $m add command -label "No Namespaces" -state disabled return } ## Same command as for ::tkcon::AttachMenu items set cmd {::tkcon::RePrompt \n [::tkcon::CmdGet $::tkcon::PRIV(console)]} set names [lsort [Namespaces ::]] if {[llength $names] > $OPT(maxmenu)} { $m add command -label "Attached to $PRIV(namesp)" -state disabled $m add command -label "List Namespaces" \ -command [list ::tkcon::NamespacesList $names] } else { foreach i $names { if {$i eq "::"} { $m add radio -label "Main" -value $i \ -variable ::tkcon::PRIV(namesp) \ -command "::tkcon::AttachNamespace [list $i]; $cmd" } else { $m add radio -label $i -value $i \ -variable ::tkcon::PRIV(namesp) \ -command "::tkcon::AttachNamespace [list $i]; $cmd" } } } } ## Namepaces List ## proc ::tkcon::NamespacesList {names} { variable PRIV set f $PRIV(base).namespaces catch {destroy $f} toplevel $f catch {wm attributes $f -type dialog} listbox $f.names -width 30 -height 15 -selectmode single \ -yscrollcommand [list $f.scrollv set] \ -xscrollcommand [list $f.scrollh set] \ -background white -borderwidth 1 scrollbar $f.scrollv -command [list $f.names yview] scrollbar $f.scrollh -command [list $f.names xview] -orient horizontal frame $f.buttons button $f.cancel -text "Cancel" -command [list destroy $f] grid $f.names $f.scrollv -sticky nesw grid $f.scrollh -sticky ew grid $f.buttons -sticky nesw grid $f.cancel -in $f.buttons -pady 6 grid columnconfigure $f 0 -weight 1 grid rowconfigure $f 0 -weight 1 #fill the listbox foreach i $names { if {$i eq "::"} { $f.names insert 0 Main } else { $f.names insert end $i } } #Bindings bind $f.names { ## Catch in case the namespace disappeared on us catch { ::tkcon::AttachNamespace [%W get [%W nearest %y]] } ::tkcon::RePrompt "\n" [::tkcon::CmdGet $::tkcon::PRIV(console)] destroy [winfo toplevel %W] } } # ::tkcon::XauthSecure -- # # This removes all the names in the xhost list, and secures # the display for Tk send commands. Of course, this prevents # what might have been otherwise allowable X connections # # Arguments: # none # Results: # Returns nothing # proc ::tkcon::XauthSecure {} { global tcl_platform if {[tk windowingsystem] ne "x11"} { # This makes no sense outside of Unix return } set hosts [exec xhost] # the first line is info only foreach host [lrange [split $hosts \n] 1 end] { exec xhost -$host } exec xhost - tk_messageBox -title "Xhost secured" -message "Xhost secured" -icon info } ## ::tkcon::FindBox - creates minimal dialog interface to ::tkcon::Find # ARGS: w - text widget # str - optional seed string for ::tkcon::PRIV(find) ## proc ::tkcon::FindBox {w {str {}}} { variable PRIV set base $PRIV(base).find if {![winfo exists $base]} { toplevel $base wm withdraw $base catch {wm attributes $base -type dialog} wm title $base "tkcon Find" wm resizable $base 1 0 label $base.l -text "Find:" -anchor e entry $base.e -textvariable ::tkcon::PRIV(find) checkbutton $base.case -text "Case Sensitive" \ -variable ::tkcon::PRIV(find,case) checkbutton $base.re -text "Use Regexp" \ -variable ::tkcon::PRIV(find,reg) frame $base.sep -borderwidth 1 -relief sunken -height 2 frame $base.btn grid $base.l $base.e - - -sticky ew grid $base.case - $base.re -sticky ew grid $base.sep -columnspan 4 -sticky ew grid $base.btn -columnspan 4 -sticky ew grid columnconfigure $base 3 -weight 1 button $base.btn.fnd -text "Find" -width 6 button $base.btn.clr -text "Clear" -width 6 button $base.btn.dis -text "Dismiss" -width 6 eval grid [winfo children $base.btn] -padx 4 -pady 2 -sticky ew if {$PRIV(AQUA)} { # corner resize control space grid columnconfigure $base.btn \ [lindex [grid size $base.btn] 0] -minsize 16 } focus $base.e bind $base.e [list $base.btn.fnd invoke] bind $base.e [list $base.btn.dis invoke] } $base.btn.fnd config -command "::tkcon::Find [list $w] \$::tkcon::PRIV(find) \ -case \$::tkcon::PRIV(find,case) -reg \$::tkcon::PRIV(find,reg)" $base.btn.clr config -command " [list $w] tag remove find 1.0 end set ::tkcon::PRIV(find) {} " $base.btn.dis config -command " [list $w] tag remove find 1.0 end wm withdraw [list $base] " if {$str ne ""} { set PRIV(find) $str $base.btn.fnd invoke } if {[wm state $base] ne "normal"} { wm deiconify $base } else { raise $base } $base.e select range 0 end } ## ::tkcon::Find - searches in text widget $w for $str and highlights it ## If $str is empty, it just deletes any highlighting # ARGS: w - text widget # str - string to search for # -case TCL_BOOLEAN whether to be case sensitive DEFAULT: 0 # -regexp TCL_BOOLEAN whether to use $str as pattern DEFAULT: 0 ## proc ::tkcon::Find {w str args} { $w tag remove find 1.0 end set truth {^(1|yes|true|on)$} set opts {} foreach {key val} $args { switch -glob -- $key { -c* { if {[regexp -nocase $truth $val]} { set case 1 } } -r* { if {[regexp -nocase $truth $val]} { lappend opts -regexp } } default { return -code error "Unknown option $key" } } } if {![info exists case]} { lappend opts -nocase } if {$str eq ""} { return } $w mark set findmark 1.0 while {[set ix [eval $w search $opts -count numc -- \ [list $str] findmark end]] ne ""} { $w tag add find $ix ${ix}+${numc}c $w mark set findmark ${ix}+1c } $w tag configure find -background $::tkcon::COLOR(blink) catch {$w see find.first} return [expr {[llength [$w tag ranges find]]/2}] } ## ::tkcon::Attach - called to attach tkcon to an interpreter # ARGS: name - application name to which tkcon sends commands # This is either a slave interperter name or tk appname. # type - (slave|interp) type of interpreter we're attaching to # slave means it's a tkcon interpreter # interp means we'll need to 'send' to it. # Results: ::tkcon::EvalAttached is recreated to evaluate in the # appropriate interpreter ## proc ::tkcon::Attach {{name } {type slave} {ns {}}} { variable PRIV variable OPT variable ATTACH if {[llength [info level 0]] == 1} { # no args were specified, return the attach info instead return [AttachId] } set path [concat $PRIV(name) $OPT(exec)] set PRIV(displayWin) . if {$type eq "namespace"} { return [uplevel 1 ::tkcon::AttachNamespace $name] } elseif {[string match dpy:* $type]} { set PRIV(displayWin) [string range $type 4 end] } elseif {[string match sock* $type]} { global tcl_version if {[catch {eof $name} res]} { return -code error "No known channel \"$name\"" } elseif {$res} { catch {close $name} return -code error "Channel \"$name\" returned EOF" } set app $name set type socket } elseif {$name ne ""} { array set interps [Interps] if {[string match {[Mm]ain} [lindex $name 0]]} { set name [lrange $name 1 end] } if {$name eq $path} { set name {} set app $path set type slave } elseif {[info exists interps($name)]} { if {$name eq ""} { set name Main; set app Main } set type slave } elseif {[interp exists $name]} { set name [concat $PRIV(name) $name] set type slave } elseif {[interp exists [concat $OPT(exec) $name]]} { set name [concat $path $name] set type slave } elseif {[lsearch -exact [::send::interps] $name] > -1} { if {[EvalSlave info exists tk_library] && $name eq [EvalSlave tk appname]} { set name {} set app $path set type slave } elseif {[set i [lsearch -exact \ [Main set ::tkcon::PRIV(interps)] $name]] != -1} { set name [lindex [Main set ::tkcon::PRIV(slaves)] $i] if {[string match {[Mm]ain} $name]} { set app Main } set type slave } else { set type interp } } else { return -code error "No known interpreter \"$name\"" } } else { set app $path } if {![info exists app]} { set app $name } array set PRIV [list app $app appname $name apptype $type deadapp 0] ## ::tkcon::EvalAttached - evaluates the args in the attached interp ## args should be passed to this procedure as if they were being ## passed to the 'eval' procedure. This procedure is dynamic to ## ensure evaluation occurs in the right interp. # ARGS: args - the command and args to evaluate ## set PRIV(namesp) :: set namespOK 0 switch -glob -- $type { slave { if {$name eq ""} { interp alias {} ::tkcon::EvalAttached {} \ ::tkcon::EvalSlave uplevel \#0 } elseif {$PRIV(app) eq "Main"} { interp alias {} ::tkcon::EvalAttached {} ::tkcon::Main } elseif {$PRIV(name) eq $PRIV(app)} { interp alias {} ::tkcon::EvalAttached {} uplevel \#0 } else { interp alias {} ::tkcon::EvalAttached {} \ ::tkcon::Slave $::tkcon::PRIV(app) } set namespOK 1 } sock* { interp alias {} ::tkcon::EvalAttached {} \ ::tkcon::EvalSlave uplevel \#0 # The file event will just puts whatever data is found # into the interpreter fconfigure $name -buffering line -blocking 0 fileevent $name readable [list ::tkcon::EvalSocketEvent $name] } dpy:* - interp { if {$OPT(nontcl)} { interp alias {} ::tkcon::EvalAttached {} ::tkcon::EvalSlave } else { interp alias {} ::tkcon::EvalAttached {} ::tkcon::EvalSend set namespOK 1 } } default { return -code error "[lindex [info level 0] 0] did not specify\ a valid type: must be slave or interp" } } if {$ns ne "" && $namespOK} { AttachNamespace $ns } return [AttachId] } proc ::tkcon::AttachId {} { # return Attach info in a form that Attach accepts again variable PRIV if {$PRIV(appname) eq ""} { variable OPT set appname [concat $PRIV(name) $OPT(exec)] } else { set appname $PRIV(appname) } set id [list $appname $PRIV(apptype)] # only display ns info if it isn't "::" as that is what is also # used to indicate no eval in namespace if {$PRIV(namesp) ne "::"} { lappend id $PRIV(namesp) } if {[info exists PRIV(console)]} { variable ATTACH set ATTACH($PRIV(console)) $id } return $id } ## ::tkcon::AttachNamespace - called to attach tkcon to a namespace # ARGS: name - namespace name in which tkcon should eval commands # Results: ::tkcon::EvalAttached will be modified ## proc ::tkcon::AttachNamespace { name } { variable PRIV variable OPT # We could enable 'socket' bound Tcl interps, but we'd have to create # a return listening socket if {($OPT(nontcl) && $PRIV(apptype) eq "interp") || $PRIV(apptype) eq "socket" || $PRIV(deadapp)} { return -code error "can't attach to namespace in attached environment" } if {$name eq "Main"} {set name ::} if {$name ne "" && [lsearch [Namespaces ::] $name] == -1} { return -code error "No known namespace \"$name\"" } if {[regexp {^(|::)$} $name]} { ## If name=={} || ::, we want the primary namespace set alias [interp alias {} ::tkcon::EvalAttached] if {[string match ::tkcon::EvalNamespace* $alias]} { eval [list interp alias {} ::tkcon::EvalAttached {}] \ [lindex $alias 1] } set name :: } else { interp alias {} ::tkcon::EvalAttached {} ::tkcon::EvalNamespace \ [interp alias {} ::tkcon::EvalAttached] [list $name] } set PRIV(namesp) $name return [AttachId] } ## ::tkcon::NewSocket - called to create a socket to connect to # ARGS: none # Results: It will create a socket, and attach if requested ## proc ::tkcon::NewSocket {} { variable PRIV set t $PRIV(base).newsock if {![winfo exists $t]} { toplevel $t wm withdraw $t catch {wm attributes $t -type dialog} wm title $t "tkcon Create Socket" wm resizable $t 1 0 label $t.lhost -text "Host: " entry $t.host -width 16 -takefocus 1 label $t.lport -text "Port: " entry $t.port -width 4 -takefocus 1 button $t.ok -text "OK" -command {set ::tkcon::PRIV(grab) 1} -width 4 \ -takefocus 1 bind $t.host [list focus $t.port] bind $t.port [list focus $t.ok] bind $t.ok [list $t.ok invoke] grid $t.lhost $t.host $t.lport $t.port $t.ok -sticky ew grid configure $t.ok -padx 4 -pady 2 grid columnconfig $t 1 -weight 1 grid rowconfigure $t 1 -weight 1 if {$PRIV(AQUA)} { # corner resize control space grid columnconfigure $t [lindex [grid size $t] 0] -minsize 16 } wm transient $t $PRIV(root) wm group $t $PRIV(root) wm geometry $t +[expr {([winfo screenwidth $t]-[winfo \ reqwidth $t]) / 2}]+[expr {([winfo \ screenheight $t]-[winfo reqheight $t]) / 2}] bind $t [list destroy $t] } #$t.host delete 0 end #$t.port delete 0 end wm deiconify $t raise $t grab $t focus $t.host vwait ::tkcon::PRIV(grab) grab release $t wm withdraw $t set host [$t.host get] set port [$t.port get] if {$host == ""} { return } if {[catch { set sock [socket $host $port] } err]} { tk_messageBox -title "Socket Connection Error" \ -message "Unable to connect to \"$host:$port\":\n$err" \ -icon error -type ok } else { Attach $sock socket } } ## ::tkcon::Load - sources a file into the console ## The file is actually sourced in the currently attached's interp # ARGS: fn - (optional) filename to source in # Returns: selected filename ({} if nothing was selected) ## proc ::tkcon::Load { {fn ""} } { set types { {{Tcl Files} {.tcl .tk}} {{Text Files} {.txt}} {{All Files} *} } # Allow for VFS directories, use Tk dialogs automatically when in # VFS-based areas set check [expr {$fn == "" ? [pwd] : $fn}] if {$::tcl_version >= 8.4 && [lindex [file system $check] 0] == "tclvfs"} { set opencmd [list ::tk::dialog::file:: open] } else { set opencmd [list tk_getOpenFile] } if {$fn eq "" && ([catch {tk_getOpenFile -filetypes $types \ -title "Source File"} fn] || $fn eq "") } { return } EvalAttached [list source $fn] } ## ::tkcon::Save - saves the console or other widget buffer to a file ## This does not eval in a slave because it's not necessary # ARGS: w - console text widget # fn - (optional) filename to save to ## proc ::tkcon::Save { {fn ""} {type ""} {opt ""} {mode w} } { variable PRIV if {![regexp -nocase {^(all|history|stdin|stdout|stderr|widget)$} $type]} { array set s { 0 All 1 History 2 Stdin 3 Stdout 4 Stderr 5 Cancel } ## Allow user to specify what kind of stuff to save set type [tk_dialog $PRIV(base).savetype "Save Type" \ "What part of the text do you want to save?" \ questhead 0 $s(0) $s(1) $s(2) $s(3) $s(4) $s(5)] if {$type == 5 || $type == -1} return set type $s($type) } # Allow for VFS directories, use Tk dialogs automatically when in # VFS-based areas set check [expr {$opt == "" ? [pwd] : $opt}] if {$::tcl_version >= 8.4 && [lindex [file system $check] 0] == "tclvfs"} { set savecmd [list ::tk::dialog::file:: save] } else { set savecmd [list tk_getSaveFile] } if {$fn eq ""} { set types { {{Tcl Files} {.tcl .tk}} {{Text Files} {.txt}} {{All Files} *} } if {[catch {eval $savecmd [list -defaultextension .tcl \ -filetypes $types \ -title "Save $type"]} fn] || $fn eq ""} return } set type [string tolower $type] switch $type { stdin - stdout - stderr { set data {} foreach {first last} [$PRIV(console) tag ranges $type] { lappend data [$PRIV(console) get $first $last] } set data [join $data \n] } history { set data [tkcon history] } all - default { set data [$PRIV(console) get 1.0 end-1c] } widget { set data [$opt get 1.0 end-1c] } } if {[catch {open $fn $mode} fid]} { return -code error "Save Error: Unable to open '$fn' for writing\n$fid" } puts -nonewline $fid $data close $fid } ## ::tkcon::MainInit ## This is only called for the main interpreter to include certain procs ## that we don't want to include (or rather, just alias) in slave interps. ## proc ::tkcon::MainInit {} { variable PRIV variable OPT if {![info exists PRIV(slaves)]} { array set PRIV [list slave 0 slaves Main name {} \ interps [list [tk appname]]] } interp alias {} ::tkcon::Main {} ::tkcon::InterpEval Main interp alias {} ::tkcon::Slave {} ::tkcon::InterpEval proc ::tkcon::GetSlave {{slave {}}} { set i 0 while {[Slave $slave [list interp exists Slave[incr i]]]} { # oh my god, an empty loop! } set interp [Slave $slave [list interp create Slave$i]] return $interp } ## ::tkcon::New - create new console window ## Creates a slave interpreter and sources in this script. ## All other interpreters also get a command to eval function in the ## new interpreter. ## proc ::tkcon::New {} { variable PRIV global argv0 argc argv set tmp [GetSlave] lappend PRIV(slaves) $tmp load {} Tk $tmp # If we have tbcload, then that should be autoloaded into slaves. set idx [lsearch [info loaded] "* Tbcload"] if {$idx != -1} { catch {load {} Tbcload $tmp} } lappend PRIV(interps) [$tmp eval [list tk appname \ "[tk appname] $tmp"]] if {[info exists argv0]} {$tmp eval [list set argv0 $argv0]} if {[info exists argc]} {$tmp eval [list set argc $argc]} if {[info exists argv]} {$tmp eval [list set argv $argv]} $tmp eval [list namespace eval ::tkcon {}] $tmp eval [list set ::tkcon::PRIV(name) $tmp] $tmp eval [list set ::tkcon::PRIV(SCRIPT) $::tkcon::PRIV(SCRIPT)] $tmp alias exit ::tkcon::Exit $tmp $tmp alias ::tkcon::Destroy ::tkcon::Destroy $tmp $tmp alias ::tkcon::New ::tkcon::New $tmp alias ::tkcon::GetSlave ::tkcon::GetSlave $tmp $tmp alias ::tkcon::Main ::tkcon::InterpEval Main $tmp alias ::tkcon::Slave ::tkcon::InterpEval $tmp alias ::tkcon::Interps ::tkcon::Interps $tmp alias ::tkcon::NewDisplay ::tkcon::NewDisplay $tmp alias ::tkcon::Display ::tkcon::Display $tmp alias ::tkcon::StateCheckpoint ::tkcon::StateCheckpoint $tmp alias ::tkcon::StateCleanup ::tkcon::StateCleanup $tmp alias ::tkcon::StateCompare ::tkcon::StateCompare $tmp alias ::tkcon::StateRevert ::tkcon::StateRevert $tmp eval { if [catch {source -rsrc tkcon}] { source $::tkcon::PRIV(SCRIPT) } } return $tmp } ## ::tkcon::Exit - full exit OR destroy slave console ## This proc should only be called in the main interpreter from a slave. ## The master determines whether we do a full exit or just kill the slave. ## proc ::tkcon::Exit {slave args} { variable PRIV variable OPT ## Slave interpreter exit request if {$OPT(slaveexit) eq "exit" || [llength $PRIV(interps)] == 1} { ## Only exit if it specifically is stated to do so, or this ## is the last interp uplevel 1 exit $args } else { ## Otherwise we will delete the slave interp and associated data Destroy $slave } } ## ::tkcon::Destroy - destroy console window ## This proc should only be called by the main interpreter. If it is ## called from there, it will ask before exiting tkcon. All others ## (slaves) will just have their slave interpreter deleted, closing them. ## proc ::tkcon::Destroy {{slave {}}} { variable PRIV # Just close on the last one if {[llength $PRIV(interps)] == 1} { exit } if {"" == $slave} { ## Main interpreter close request if {[tk_messageBox -parent $PRIV(root) -title "Quit tkcon?" \ -message "Close all windows and exit tkcon?" \ -icon question -type yesno] == "yes"} { exit } return } elseif {$slave == $::tkcon::OPT(exec)} { set name [tk appname] set slave "Main" } else { ## Slave interpreter close request set name [InterpEval $slave] interp delete $slave } set PRIV(interps) [lremove $PRIV(interps) [list $name]] set PRIV(slaves) [lremove $PRIV(slaves) [list $slave]] StateCleanup $slave } if {$OPT(overrideexit)} { ## We want to do a couple things before exiting... if {[catch {rename ::exit ::tkcon::FinalExit} err]} { puts stderr "tkcon might panic:\n$err" } proc ::exit args { if {$::tkcon::OPT(usehistory)} { if {[catch {::tkcon::SaveHistory} msg]} { puts stderr "unable to save history file:\n$msg" # pause a moment, because we are about to die finally... after 1000 } } uplevel 1 ::tkcon::FinalExit $args } } ## ::tkcon::SaveHistory - saves history to history file ## If the history file is not writable it raises an error proc ::tkcon::SaveHistory {} { if {$::tkcon::OPT(usehistory)} { if {[catch {open $::tkcon::PRIV(histfile) w} fid]} { error $fid } else { set max [::tkcon::EvalSlave history nextid] set id [expr {$max - $::tkcon::OPT(history)}] if {$id < 1} { set id 1 } ## FIX: This puts history in backwards!! while {($id < $max) && ![catch \ {::tkcon::EvalSlave history event $id} cmd]} { if {$cmd ne ""} { puts $fid "::tkcon::EvalSlave\ history add [list $cmd]" } incr id } close $fid } } } ## ::tkcon::InterpEval - passes evaluation to another named interpreter ## If the interpreter is named, but no args are given, it returns the ## [tk appname] of that interps master (not the associated eval slave). ## proc ::tkcon::InterpEval {{slave {}} args} { variable PRIV if {[llength [info level 0]] == 1} { # no args given return $PRIV(slaves) } elseif {[string match {[Mm]ain} $slave]} { set slave {} } if {[llength $args]} { return [interp eval $slave uplevel \#0 $args] } else { # beware safe interps with Tk if {[interp eval $slave {llength [info commands tk]}]} { if {[catch {interp eval $slave tk appname} name]} { return "safetk" } return $name } } } proc ::tkcon::Interps {{ls {}} {interp {}}} { if {$interp eq ""} { lappend ls {} [tk appname] } foreach i [interp slaves $interp] { if {$interp ne ""} { set i "$interp $i" } if {[interp eval $i package provide Tk] ne ""} { # beware safe interps with Tk if {[catch {interp eval $i tk appname} name]} { set name {} } lappend ls $i $name } else { lappend ls $i {} } set ls [Interps $ls $i] } return $ls } proc ::tkcon::Display {{disp {}}} { variable DISP set res {} if {$disp != ""} { if {![info exists DISP($disp)]} { return } return [list $DISP($disp) [winfo interps -displayof $DISP($disp)]] } return [lsort -dictionary [array names DISP]] } proc ::tkcon::NewDisplay {} { variable PRIV variable DISP set t $PRIV(base).newdisp if {![winfo exists $t]} { toplevel $t wm withdraw $t catch {wm attributes $t -type dialog} wm title $t "tkcon Attach to Display" label $t.gets -text "New Display: " entry $t.data -width 32 button $t.ok -text "OK" -command {set ::tkcon::PRIV(grab) 1} bind $t.data [list $t.ok invoke] bind $t.ok [list $t.ok invoke] grid $t.gets $t.data -sticky ew grid $t.ok - -sticky ew grid columnconfig $t 1 -weight 1 grid rowconfigure $t 1 -weight 1 wm transient $t $PRIV(root) wm geometry $t +[expr {([winfo screenwidth $t]-[winfo \ reqwidth $t]) / 2}]+[expr {([winfo \ screenheight $t]-[winfo reqheight $t]) / 2}] } $t.data delete 0 end wm deiconify $t raise $t grab $t focus $t.data vwait ::tkcon::PRIV(grab) grab release $t wm withdraw $t set disp [$t.data get] if {$disp == ""} { return } regsub -all {\.} [string tolower $disp] ! dt set dt $PRIV(base).$dt destroy $dt if {[catch { toplevel $dt -screen $disp set interps [winfo interps -displayof $dt] if {![llength $interps]} { error "No other Tk interpreters on $disp" } ::send::send -displayof $dt [lindex $interps 0] [list info tclversion] } err]} { global env if {[info exists env(DISPLAY)]} { set myd $env(DISPLAY) } else { set myd "myDisplay:0" } tk_messageBox -title "Display Connection Error" \ -message "Unable to connect to \"$disp\":\n$err\ \nMake sure you have xauth-based permissions\ (xauth add $myd . `mcookie`), and xhost is disabled\ (xhost -) on \"$disp\"" \ -icon error -type ok destroy $dt return } set DISP($disp) $dt wm withdraw $dt bind $dt [subst {catch {unset ::tkcon::DISP($disp)}}] tk_messageBox -title "$disp Connection" \ -message "Connected to \"$disp\", found:\n[join $interps \n]" \ -type ok } ## ## The following state checkpoint/revert procedures are very sketchy ## and prone to problems. They do not track modifications to currently ## existing procedures/variables, and they can really screw things up ## if you load in libraries (especially Tk) between checkpoint and ## revert. Only with this knowledge in mind should you use these. ## ## ::tkcon::StateCheckpoint - checkpoints the current state of the system ## This allows you to return to this state with ::tkcon::StateRevert # ARGS: ## proc ::tkcon::StateCheckpoint {app type} { variable CPS variable PRIV if {[info exists CPS($type,$app,cmd)] && \ [tk_dialog $PRIV(base).warning "Overwrite Previous State?" \ "Are you sure you want to lose previously checkpointed\ state of $type \"$app\"?" questhead 1 "Do It" "Cancel"]} return set CPS($type,$app,cmd) [EvalOther $app $type info commands *] set CPS($type,$app,var) [EvalOther $app $type info vars *] return } ## ::tkcon::StateCompare - compare two states and output difference # ARGS: ## proc ::tkcon::StateCompare {app type {verbose 0}} { variable CPS variable PRIV variable OPT variable COLOR if {![info exists CPS($type,$app,cmd)]} { return -code error \ "No previously checkpointed state for $type \"$app\"" } set w $PRIV(base).compare if {[winfo exists $w]} { $w.text config -state normal $w.text delete 1.0 end } else { toplevel $w catch {wm attributes $w -type dialog} frame $w.btn scrollbar $w.sy -command [list $w.text yview] text $w.text -yscrollcommand [list $w.sy set] -height 12 \ -foreground $COLOR(stdin) \ -background $COLOR(bg) \ -insertbackground $COLOR(cursor) \ -font $OPT(font) -borderwidth 1 -highlightthickness 0 $w.text tag config red -foreground red button $w.close -text "Dismiss" -width 8 \ -command [list destroy $w] button $w.check -text "Recheckpoint" -width 11 button $w.revert -text "Revert" -width 8 button $w.expand -text "Verbose" -width 8 button $w.update -text "Update" -width 8 grid $w.text - - - - - $w.sy -sticky news grid x $w.check $w.revert $w.expand $w.update $w.close grid configure $w.close -padx {4 0} grid rowconfigure $w 0 -weight 1 grid columnconfigure $w 0 -weight 1 } wm title $w "Compare State: $type [list $app]" $w.check config \ -command "::tkcon::StateCheckpoint [list $app] $type; \ ::tkcon::StateCompare [list $app] $type $verbose" $w.revert config \ -command "::tkcon::StateRevert [list $app] $type; \ ::tkcon::StateCompare [list $app] $type $verbose" $w.update config -command [info level 0] if {$verbose} { $w.expand config -text Brief \ -command [list ::tkcon::StateCompare $app $type 0] } else { $w.expand config -text Verbose \ -command [list ::tkcon::StateCompare $app $type 1] } ## Don't allow verbose mode unless 'dump' exists in $app ## We're assuming this is tkcon's dump command set hasdump [llength [EvalOther $app $type info commands dump]] if {$hasdump} { $w.expand config -state normal } else { $w.expand config -state disabled } set cmds [lremove [EvalOther $app $type info commands *] \ $CPS($type,$app,cmd)] set vars [lremove [EvalOther $app $type info vars *] \ $CPS($type,$app,var)] if {$hasdump && $verbose} { set cmds [EvalOther $app $type eval dump c -nocomplain $cmds] set vars [EvalOther $app $type eval dump v -nocomplain $vars] } $w.text insert 1.0 "NEW COMMANDS IN \"$app\":\n" red \ $cmds {} "\n\nNEW VARIABLES IN \"$app\":\n" red $vars {} raise $w $w.text config -state disabled } ## ::tkcon::StateRevert - reverts interpreter to previous state # ARGS: ## proc ::tkcon::StateRevert {app type} { variable CPS variable PRIV if {![info exists CPS($type,$app,cmd)]} { return -code error \ "No previously checkpointed state for $type \"$app\"" } if {![tk_dialog $PRIV(base).warning "Revert State?" \ "Are you sure you want to revert the state in $type \"$app\"?"\ questhead 1 "Do It" "Cancel"]} { foreach i [lremove [EvalOther $app $type info commands *] \ $CPS($type,$app,cmd)] { catch {EvalOther $app $type rename $i {}} } foreach i [lremove [EvalOther $app $type info vars *] \ $CPS($type,$app,var)] { catch {EvalOther $app $type unset $i} } } } ## ::tkcon::StateCleanup - cleans up state information in master array # ## proc ::tkcon::StateCleanup {args} { variable CPS if {![llength $args]} { foreach state [array names CPS slave,*] { if {![interp exists [string range $state 6 end]]} { unset CPS($state) } } } else { set app [lindex $args 0] set type [lindex $args 1] if {[regexp {^(|slave)$} $type]} { foreach state [array names CPS "slave,$app\[, \]*"] { if {![interp exists [string range $state 6 end]]} { unset CPS($state) } } } else { catch {unset CPS($type,$app)} } } } } ## ::tkcon::Event - get history event, search if string != {} ## look forward (next) if $int>0, otherwise look back (prev) # ARGS: W - console widget ## proc ::tkcon::Event {int {str {}}} { if {!$int} return variable PRIV set w $PRIV(console) set nextid [EvalSlave history nextid] if {$str ne ""} { ## String is not empty, do an event search set event $PRIV(event) if {$int < 0 && $event == $nextid} { set PRIV(cmdbuf) $str } set len [string len $PRIV(cmdbuf)] incr len -1 if {$int > 0} { ## Search history forward while {$event < $nextid} { if {[incr event] == $nextid} { $w delete limit end $w insert limit $PRIV(cmdbuf) break } elseif { ![catch {EvalSlave history event $event} res] && [set p [string first $PRIV(cmdbuf) $res]] > -1 } { set p2 [expr {$p + [string length $PRIV(cmdbuf)]}] $w delete limit end $w insert limit $res Blink $w "limit + $p c" "limit + $p2 c" break } } set PRIV(event) $event } else { ## Search history reverse while {![catch {EvalSlave history event [incr event -1]} res]} { if {[set p [string first $PRIV(cmdbuf) $res]] > -1} { set p2 [expr {$p + [string length $PRIV(cmdbuf)]}] $w delete limit end $w insert limit $res set PRIV(event) $event Blink $w "limit + $p c" "limit + $p2 c" break } } } } else { ## String is empty, just get next/prev event if {$int > 0} { ## Goto next command in history if {$PRIV(event) < $nextid} { $w delete limit end if {[incr PRIV(event)] == $nextid} { $w insert limit $PRIV(cmdbuf) } else { $w insert limit [EvalSlave history event $PRIV(event)] } } } else { ## Goto previous command in history if {$PRIV(event) == $nextid} { set PRIV(cmdbuf) [CmdGet $w] } if {[catch {EvalSlave history event [incr PRIV(event) -1]} res]} { incr PRIV(event) } else { $w delete limit end $w insert limit $res } } } $w mark set insert end $w see end } ## ::tkcon::Highlight - magic highlighting ## beware: voodoo included # ARGS: ## proc ::tkcon::Highlight {w type} { variable COLOR variable OPT switch -exact $type { "error" { HighlightError $w } "tcl" - "test" { if {[winfo class $w] != "Ctext"} { return } foreach {app type} [tkcon attach] {break} set cmds [::tkcon::EvalOther $app $type info commands] set classes [list \ [list comment ClassForRegexp "^\\s*#\[^\n\]*" $COLOR(stderr)] \ [list var ClassWithOnlyCharStart "\$" $COLOR(stdout)] \ [list syntax ClassForSpecialChars "\[\]{}\"" $COLOR(prompt)] \ [list command Class $cmds $COLOR(proc)] \ ] # Remove all highlight classes from a widget ctext::clearHighlightClasses $w foreach class $classes { foreach {cname ctype cptn ccol} $class break ctext::addHighlight$ctype $w $cname $ccol $cptn } $w highlight 1.0 end } } } ## ::tkcon::HighlightError - magic error highlighting ## beware: voodoo included # ARGS: ## proc ::tkcon::HighlightError w { variable COLOR variable OPT ## do voodoo here set app [Attach] # we have to pull the text out, because text regexps are screwed on \n's. set info [$w get 1.0 end-1c] # Check for specific line error in a proc set exp(proc) "\"(\[^\"\]+)\"\n\[\t \]+\\\(procedure \"(\[^\"\]+)\"" # Check for too few args to a proc set exp(param) "parameter \"(\[^\"\]+)\" to \"(\[^\"\]+)\"" set start 1.0 while { [regexp -indices -- $exp(proc) $info junk what cmd] || [regexp -indices -- $exp(param) $info junk what cmd] } { foreach {w0 w1} $what {c0 c1} $cmd {break} set what [string range $info $w0 $w1] set cmd [string range $info $c0 $c1] if {[string match *::* $cmd]} { set res [uplevel 1 ::tkcon::EvalOther $app namespace eval \ [list [namespace qualifiers $cmd] \ [list info procs [namespace tail $cmd]]]] } else { set res [uplevel 1 ::tkcon::EvalOther $app info procs [list $cmd]] } if {[llength $res]==1} { set tag [UniqueTag $w] $w tag add $tag $start+${c0}c $start+1c+${c1}c $w tag configure $tag -foreground $COLOR(stdout) $w tag bind $tag [list $w tag configure $tag -under 1] $w tag bind $tag [list $w tag configure $tag -under 0] $w tag bind $tag "if {!\$tk::Priv(mouseMoved)} \ {[list $OPT(edit) -attach $app -type proc -find $what -- $cmd]}" } set info [string range $info $c1 end] set start [$w index $start+${c1}c] } ## Next stage, check for procs that start a line set start 1.0 set exp(cmd) "^\"\[^\" \t\n\]+" while { [string compare {} [set ix \ [$w search -regexp -count numc -- $exp(cmd) $start end]]] } { set start [$w index $ix+${numc}c] # +1c to avoid the first quote set cmd [$w get $ix+1c $start] if {[string match *::* $cmd]} { set res [uplevel 1 ::tkcon::EvalOther $app namespace eval \ [list [namespace qualifiers $cmd] \ [list info procs [namespace tail $cmd]]]] } else { set res [uplevel 1 ::tkcon::EvalOther $app info procs [list $cmd]] } if {[llength $res]==1} { set tag [UniqueTag $w] $w tag add $tag $ix+1c $start $w tag configure $tag -foreground $COLOR(proc) $w tag bind $tag [list $w tag configure $tag -under 1] $w tag bind $tag [list $w tag configure $tag -under 0] $w tag bind $tag "if {!\$tk::Priv(mouseMoved)} \ {[list $OPT(edit) -attach $app -type proc -- $cmd]}" } } } proc ::tkcon::ExpectInit {{termcap 1} {terminfo 1}} { global env if {$termcap} { set env(TERM) "tt" set env(TERMCAP) {tt: :ks=\E[KS: :ke=\E[KE: :cm=\E[%d;%dH: :up=\E[A: :nd=\E[C: :cl=\E[H\E[J: :do=^J: :so=\E[7m: :se=\E[m: :k1=\EOP: :k2=\EOQ: :k3=\EOR: :k4=\EOS: :k5=\EOT: :k6=\EOU: :k7=\EOV: :k8=\EOW: :k9=\EOX: } } if {$terminfo} { set env(TERM) "tkterm" if {![info exists env(TEMP)]} { set env(TEMP) /tmp } set env(TERMINFO) $env(TEMP) set ttsrc [file join $env(TEMP) tt.src] set file [open $ttsrc w] puts $file {tkterm|Don Libes' tk text widget terminal emulator, smkx=\E[KS, rmkx=\E[KE, cup=\E[%p1%d;%p2%dH, cuu1=\E[A, cuf1=\E[C, clear=\E[H\E[J, ind=\n, cr=\r, smso=\E[7m, rmso=\E[m, kf1=\EOP, kf2=\EOQ, kf3=\EOR, kf4=\EOS, kf5=\EOT, kf6=\EOU, kf7=\EOV, kf8=\EOW, kf9=\EOX, } close $file if {[catch {exec tic $ttsrc} msg]} { return -code error \ "tic failed, you may not have terminfo support:\n$msg" } file delete $ttsrc } } # term_exit is called if the spawned process exits proc ::tkcon::term_exit {w} { variable EXP catch {exp_close -i $EXP(spawn_id)} set EXP(forever) 1 unset EXP } # term_chars_changed is called after every change to the displayed chars # You can use if you want matches to occur in the background (a la bind) # If you want to test synchronously, then just do so - you don't need to # redefine this procedure. proc ::tkcon::term_chars_changed {w args} { } # term_cursor_changed is called after the cursor is moved proc ::tkcon::term_cursor_changed {w args} { } proc ::tkcon::term_update_cursor {w args} { variable OPT variable EXP $w mark set insert $EXP(row).$EXP(col) $w see insert term_cursor_changed $w } proc ::tkcon::term_clear {w args} { $w delete 1.0 end term_init $w } proc ::tkcon::term_init {w args} { variable OPT variable EXP # initialize it with blanks to make insertions later more easily set blankline [string repeat " " $OPT(cols)]\n for {set i 1} {$i <= $OPT(rows)} {incr i} { $w insert $i.0 $blankline } set EXP(row) 1 set EXP(col) 0 $w mark set insert $EXP(row).$EXP(col) } proc ::tkcon::term_down {w args} { variable OPT variable EXP if {$EXP(row) < $OPT(rows)} { incr EXP(row) } else { # already at last line of term, so scroll screen up $w delete 1.0 2.0 # recreate line at end $w insert end [string repeat " " $OPT(cols)]\n } } proc ::tkcon::term_insert {w s} { variable OPT variable EXP set chars_rem_to_write [string length $s] set space_rem_on_line [expr {$OPT(cols) - $EXP(col)}] set tag_action [expr {$EXP(standout) ? "add" : "remove"}] ################## # write first line ################## if {$chars_rem_to_write > $space_rem_on_line} { set chars_to_write $space_rem_on_line set newline 1 } else { set chars_to_write $chars_rem_to_write set newline 0 } $w delete $EXP(row).$EXP(col) \ $EXP(row).[expr {$EXP(col) + $chars_to_write}] $w insert $EXP(row).$EXP(col) \ [string range $s 0 [expr {$space_rem_on_line-1}]] $w tag $tag_action standout $EXP(row).$EXP(col) \ $EXP(row).[expr {$EXP(col) + $chars_to_write}] # discard first line already written incr chars_rem_to_write -$chars_to_write set s [string range $s $chars_to_write end] # update EXP(col) incr EXP(col) $chars_to_write # update EXP(row) if {$newline} { term_down $w } ################## # write full lines ################## while {$chars_rem_to_write >= $OPT(cols)} { $w delete $EXP(row).0 $EXP(row).end $w insert $EXP(row).0 [string range $s 0 [expr {$OPT(cols)-1}]] $w tag $tag_action standout $EXP(row).0 $EXP(row).end # discard line from buffer set s [string range $s $OPT(cols) end] incr chars_rem_to_write -$OPT(cols) set EXP(col) 0 term_down $w } ################# # write last line ################# if {$chars_rem_to_write} { $w delete $EXP(row).0 $EXP(row).$chars_rem_to_write $w insert $EXP(row).0 $s $w tag $tag_action standout $EXP(row).0 $EXP(row).$chars_rem_to_write set EXP(col) $chars_rem_to_write } term_chars_changed $w } proc ::tkcon::Expect {cmd} { variable OPT variable PRIV variable EXP set EXP(standout) 0 set EXP(row) 0 set EXP(col) 0 set env(LINES) $OPT(rows) set env(COLUMNS) $OPT(cols) ExpectInit log_user 0 set ::stty_init "-tabs" uplevel \#0 [linsert $cmd 0 spawn] set EXP(spawn_id) $::spawn_id if {[info exists ::spawn_out(slave,name)]} { set EXP(slave,name) $::spawn_out(slave,name) catch {stty rows $OPT(rows) columns $OPT(cols) < $::spawn_out(slave,name)} } if {[string index $cmd end] == "&"} { set cmd expect_background } else { set cmd expect } bind $PRIV(console) { if {"%A" != ""} { exp_send -i $::tkcon::EXP(spawn_id) "\033%A" break } } bind $PRIV(console) { exp_send -i $::tkcon::EXP(spawn_id) -- %A break } bind $PRIV(console) {exp_send -null} set code [catch { term_init $PRIV(console) while {[info exists EXP(spawn_id)]} { $cmd { -i $::tkcon::EXP(spawn_id) -re "^\[^\x01-\x1f\]+" { # Text ::tkcon::term_insert $::tkcon::PRIV(console) \ $expect_out(0,string) ::tkcon::term_update_cursor $::tkcon::PRIV(console) } "^\r" { # (cr,) Go to beginning of line update idle set ::tkcon::EXP(col) 0 ::tkcon::term_update_cursor $::tkcon::PRIV(console) } "^\n" { # (ind,do) Move cursor down one line if {$::tcl_platform(platform) eq "windows"} { # Windows seems to get the LF without the CR update idle set ::tkcon::EXP(col) 0 } ::tkcon::term_down $::tkcon::PRIV(console) ::tkcon::term_update_cursor $::tkcon::PRIV(console) } "^\b" { # Backspace nondestructively incr ::tkcon::EXP(col) -1 ::tkcon::term_update_cursor $::tkcon::PRIV(console) } "^\a" { bell } "^\t" { # Tab, shouldn't happen send_error "got a tab!?" } eof { ::tkcon::term_exit $::tkcon::PRIV(console) } "^\x1b\\\[A" { # Cursor Up (cuu1,up) incr ::tkcon::EXP(row) -1 ::tkcon::term_update_cursor $::tkcon::PRIV(console) } "^\x1b\\\[B" { # Cursor Down incr ::tkcon::EXP(row) ::tkcon::term_update_cursor $::tkcon::PRIV(console) } "^\x1b\\\[C" { # Cursor Right (cuf1,nd) incr ::tkcon::EXP(col) ::tkcon::term_update_cursor $::tkcon::PRIV(console) } "^\x1b\\\[D" { # Cursor Left incr ::tkcon::EXP(col) ::tkcon::term_update_cursor $::tkcon::PRIV(console) } "^\x1b\\\[H" { # Cursor Home } -re "^\x1b\\\[(\[0-9\]*);(\[0-9\]*)H" { # (cup,cm) Move to row y col x set ::tkcon::EXP(row) [expr {$expect_out(1,string)+1}] set ::tkcon::EXP(col) $expect_out(2,string) ::tkcon::term_update_cursor $::tkcon::PRIV(console) } "^\x1b\\\[H\x1b\\\[J" { # (clear,cl) Clear screen ::tkcon::term_clear $::tkcon::PRIV(console) ::tkcon::term_update_cursor $::tkcon::PRIV(console) } "^\x1b\\\[7m" { # (smso,so) Begin standout mode set ::tkcon::EXP(standout) 1 } "^\x1b\\\[m" { # (rmso,se) End standout mode set ::tkcon::EXP(standout) 0 } "^\x1b\\\[KS" { # (smkx,ks) start keyboard-transmit mode # terminfo invokes these when going in/out of graphics mode # In graphics mode, we should have no scrollbars #graphicsSet 1 } "^\x1b\\\[KE" { # (rmkx,ke) end keyboard-transmit mode # Out of graphics mode, we should have scrollbars #graphicsSet 0 } } } #vwait ::tkcon::EXP(forever) } err] bind $PRIV(console) {} bind $PRIV(console) {} bind $PRIV(console) {} catch {unset EXP} if {$code} { return -code $code -errorinfo $::errorInfo $err } } ## tkcon - command that allows control over the console ## This always exists in the main interpreter, and is aliased into ## other connected interpreters # ARGS: totally variable, see internal comments ## proc tkcon {cmd args} { variable ::tkcon::PRIV variable ::tkcon::OPT global errorInfo switch -glob -- $cmd { buf* { ## 'buffer' Sets/Query the buffer size if {[llength $args]} { if {[regexp {^[1-9][0-9]*$} $args]} { set OPT(buffer) $args # catch in case the console doesn't exist yet catch {::tkcon::ConstrainBuffer $PRIV(console) \ $OPT(buffer)} } else { return -code error "buffer must be a valid integer" } } return $OPT(buffer) } linelen* { ## 'linelength' Sets/Query the maximum line length if {[llength $args]} { if {[regexp {^-?[0-9]+$} $args]} { set OPT(maxlinelen) $args } else { return -code error "buffer must be a valid integer" } } return $OPT(maxlinelen) } bg* { ## 'bgerror' Brings up an error dialog set errorInfo [lindex $args 1] bgerror [lindex $args 0] } cl* { ## 'close' Closes the console ::tkcon::Destroy } cons* { ## 'console' - passes the args to the text widget of the console. set result [uplevel 1 $PRIV(console) $args] ::tkcon::ConstrainBuffer $PRIV(console) $OPT(buffer) return $result } congets { ## 'congets' a replacement for [gets stdin] # Use the 'gets' alias of 'tkcon_gets' command instead of # calling the *get* methods directly for best compatability if {[llength $args]} { return -code error "wrong # args: must be \"tkcon congets\"" } tkcon show set old [bind TkConsole <>] bind TkConsole <> { set ::tkcon::PRIV(wait) 0 } set w $PRIV(console) # Make sure to move the limit to get the right data $w mark set limit end-1c $w mark gravity limit left $w mark set insert end $w see end vwait ::tkcon::PRIV(wait) set line [::tkcon::CmdGet $w] $w insert end \n bind TkConsole <> $old return $line } exp* { ::tkcon::Expect [lindex $args 0] } getc* { ## 'getcommand' a replacement for [gets stdin] ## This forces a complete command to be input though if {[llength $args]} { return -code error "wrong # args: must be \"tkcon getcommand\"" } tkcon show set old [bind TkConsole <>] bind TkConsole <> { set ::tkcon::PRIV(wait) 0 } set w $PRIV(console) # Make sure to move the limit to get the right data $w mark set insert end $w mark set limit insert $w see end vwait ::tkcon::PRIV(wait) set line [::tkcon::CmdGet $w] $w insert end \n while {![info complete $line] || [regexp {[^\\]\\$} $line]} { vwait ::tkcon::PRIV(wait) set line [::tkcon::CmdGet $w] $w insert end \n $w see end } bind TkConsole <> $old return $line } get - gets { ## 'gets' - a replacement for [gets stdin] ## This pops up a text widget to be used for stdin (local grabbed) if {[llength $args]} { return -code error "wrong # args: should be \"tkcon gets\"" } set t $PRIV(base).gets if {![winfo exists $t]} { toplevel $t wm withdraw $t catch {wm attributes $t -type dialog} wm title $t "tkcon gets stdin request" label $t.gets -text "\"gets stdin\" request:" text $t.data -width 32 -height 5 -wrap none \ -xscrollcommand [list $t.sx set] \ -yscrollcommand [list $t.sy set] -borderwidth 1 scrollbar $t.sx -orient h -takefocus 0 -highlightthickness 0 \ -command [list $t.data xview] scrollbar $t.sy -orient v -takefocus 0 -highlightthickness 0 \ -command [list $t.data yview] button $t.ok -text "OK" -command {set ::tkcon::PRIV(grab) 1} bind $t.ok { %W invoke } grid $t.gets - -sticky ew grid $t.data $t.sy -sticky news grid $t.sx -sticky ew grid $t.ok - -sticky ew grid columnconfig $t 0 -weight 1 grid rowconfig $t 1 -weight 1 wm transient $t $PRIV(root) wm geometry $t +[expr {([winfo screenwidth $t]-[winfo \ reqwidth $t]) / 2}]+[expr {([winfo \ screenheight $t]-[winfo reqheight $t]) / 2}] } $t.data delete 1.0 end wm deiconify $t raise $t grab $t focus $t.data vwait ::tkcon::PRIV(grab) grab release $t wm withdraw $t return [$t.data get 1.0 end-1c] } err* { ## Outputs stack caused by last error. ## error handling with pizazz (but with pizza would be nice too) if {[llength $args]==2} { set app [lindex $args 0] set type [lindex $args 1] if {[catch {::tkcon::EvalOther $app $type set errorInfo} info]} { set info "error getting info from $type $app:\n$info" } } else { set info $PRIV(errorInfo) } if {[string match {} $info]} { set info "errorInfo empty" } ## If args is empty, the -attach switch just ignores it $OPT(edit) -attach $args -type error -- $info } fi* { ## 'find' string ::tkcon::Find $PRIV(console) $args } fo* { ## 'font' ?fontname? - gets/sets the font of the console if {[llength $args]} { if {[info exists PRIV(console)] && \ [winfo exists $PRIV(console)]} { $PRIV(console) config -font $args set OPT(font) [$PRIV(console) cget -font] } else { set OPT(font) $args } } return $OPT(font) } hid* - with* { ## 'hide' 'withdraw' - hides the console. if {[info exists PRIV(root)] && [winfo exists $PRIV(root)]} { wm withdraw $PRIV(root) } } his* { ## 'history' set sub {\2} if {[string match -new* $args]} { append sub "\n"} set h [::tkcon::EvalSlave history] regsub -all "( *\[0-9\]+ |\t)(\[^\n\]*\n?)" $h $sub h return $h } ico* { ## 'iconify' - iconifies the console with 'iconify'. if {[info exists PRIV(root)] && [winfo exists $PRIV(root)]} { wm iconify $PRIV(root) } } mas* - eval { ## 'master' - evals contents in master interpreter uplevel \#0 $args } result* { ## 'resultfilter' Sets/queries the result filter command if {[llength $args]} { set OPT(resultfilter) $args } return $OPT(resultfilter) } set { ## 'set' - set (or get, or unset) simple vars (not whole arrays) ## from the master console interpreter ## possible formats: ## tkcon set ## tkcon set ## tkcon set w ## tkcon set u ## tkcon set r if {[llength $args]==5} { ## This is for use w/ 'tkcon upvar' and only works with slaves foreach {var i var1 var2 op} $args break if {[string compare {} $var2]} { append var1 "($var2)" } switch $op { u { uplevel \#0 [list unset $var] } w { return [uplevel \#0 [list set $var \ [interp eval $i [list set $var1]]]] } r { return [interp eval $i [list set $var1 \ [uplevel \#0 [list set $var]]]] } } } elseif {[llength $args] == 1} { upvar \#0 [lindex $args 0] var if {[array exists var]} { return [array get var] } else { return $var } } return [uplevel \#0 set $args] } append { ## Modify a var in the master environment using append return [uplevel \#0 append $args] } lappend { ## Modify a var in the master environment using lappend return [uplevel \#0 lappend $args] } sh* - dei* { ## 'show|deiconify' - deiconifies the console. if {![info exists PRIV(root)]} { # We are likely in some embedded console configuration. # Make default setup reflect that. set PRIV(showOnStartup) 0 set PRIV(protocol) {tkcon hide} set PRIV(root) .tkcon set OPT(exec) "" } if {![winfo exists $PRIV(root)]} { eval [linsert $args 0 ::tkcon::Init] } # this may throw an error if toplevel is embedded catch {wm deiconify $PRIV(root); raise $PRIV(root)} focus -force $PRIV(console) } ti* { ## 'title' ?title? - gets/sets the console's title if {[llength $args]} { return [wm title $PRIV(root) [join $args]] } else { return [wm title $PRIV(root)] } } upv* { ## 'upvar' masterVar slaveVar ## link slave variable slaveVar to the master variable masterVar ## only works masters<->slave set masterVar [lindex $args 0] set slaveVar [lindex $args 1] if {[info exists $masterVar]} { interp eval $OPT(exec) \ [list set $slaveVar [set $masterVar]] } else { catch {interp eval $OPT(exec) [list unset $slaveVar]} } interp eval $OPT(exec) \ [list trace variable $slaveVar rwu \ [list tkcon set $masterVar $OPT(exec)]] return } v* { return $PRIV(version) } default { ## tries to determine if the command exists, otherwise throws error set new ::tkcon::[string toupper \ [string index $cmd 0]][string range $cmd 1 end] if {[llength [info command $new]]} { uplevel \#0 $new $args } else { return -code error "bad option \"$cmd\": must be\ [join [lsort [list attach close console destroy \ font hide iconify load main master new save show \ slave deiconify version title bgerror]] {, }]" } } } } ## ## Some procedures to make up for lack of built-in shell commands ## ## tkcon_puts - ## This allows me to capture all stdout/stderr to the console window ## This will be renamed to 'puts' at the appropriate time during init ## # ARGS: same as usual # Outputs: the string with a color-coded text tag ## proc tkcon_puts args { set len [llength $args] foreach {arg1 arg2 arg3} $args { break } if {$len == 1} { tkcon console insert output "$arg1\n" stdout } elseif {$len == 2} { if {![string compare $arg1 -nonewline]} { tkcon console insert output $arg2 stdout } elseif {![string compare $arg1 stdout] \ || ![string compare $arg1 stderr]} { tkcon console insert output "$arg2\n" $arg1 } else { set len 0 } } elseif {$len == 3} { if {![string compare $arg1 -nonewline] \ && (![string compare $arg2 stdout] \ || ![string compare $arg2 stderr])} { tkcon console insert output $arg3 $arg2 } elseif {(![string compare $arg1 stdout] \ || ![string compare $arg1 stderr]) \ && ![string compare $arg3 nonewline]} { tkcon console insert output $arg2 $arg1 } else { set len 0 } } else { set len 0 } ## $len == 0 means it wasn't handled by tkcon above. ## if {$len == 0} { global errorCode errorInfo if {[catch "tkcon_tcl_puts $args" msg]} { regsub tkcon_tcl_puts $msg puts msg regsub -all tkcon_tcl_puts $errorInfo puts errorInfo return -code error $msg } return $msg } ## WARNING: This update should behave well because it uses idletasks, ## however, if there are weird looping problems with events, or ## hanging in waits, try commenting this out. if {$len} { tkcon console see output update idletasks } } ## tkcon_gets - ## This allows me to capture all stdin input without needing to stdin ## This will be renamed to 'gets' at the appropriate time during init ## # ARGS: same as gets # Outputs: same as gets ## proc tkcon_gets args { set len [llength $args] if {$len != 1 && $len != 2} { return -code error \ "wrong # args: should be \"gets channelId ?varName?\"" } if {[string compare stdin [lindex $args 0]]} { return [uplevel 1 tkcon_tcl_gets $args] } set gtype [tkcon set ::tkcon::OPT(gets)] if {$gtype == ""} { set gtype congets } set data [tkcon $gtype] if {$len == 2} { upvar 1 [lindex $args 1] var set var $data return [string length $data] } return $data } ## edit - opens a file/proc/var for reading/editing ## # Arguments: # type proc/file/var # what the actual name of the item # Returns: nothing ## proc edit {args} { variable ::tkcon::PRIV variable ::tkcon::COLOR variable ::tkcon::OPT array set opts {-find {} -type {} -attach {} -wrap {none}} while {[string match -* [lindex $args 0]]} { switch -glob -- [lindex $args 0] { -f* { set opts(-find) [lindex $args 1] } -a* { set opts(-attach) [lindex $args 1] } -t* { set opts(-type) [lindex $args 1] } -w* { set opts(-wrap) [lindex $args 1] } -- { set args [lreplace $args 0 0]; break } default {return -code error "unknown option \"[lindex $args 0]\""} } set args [lreplace $args 0 1] } # determine who we are dealing with if {[llength $opts(-attach)]} { foreach {app type} $opts(-attach) {break} } else { foreach {app type} [tkcon attach] {break} } set word [lindex $args 0] if {$opts(-type) == {}} { if {[llength [::tkcon::EvalOther $app $type info commands [list $word]]]} { set opts(-type) "proc" } elseif {[llength [::tkcon::EvalOther $app $type info vars [list $word]]]} { set opts(-type) "var" } elseif {[::tkcon::EvalOther $app $type file isfile [list $word]]} { set opts(-type) "file" } } if {$opts(-type) == {}} { return -code error "unrecognized type '$word'" } # Create unique edit window toplevel set w $PRIV(base).__edit set i 0 while {[winfo exists $w[incr i]]} {} append w $i toplevel $w wm withdraw $w if {[string length $word] > 20} { wm title $w "[string range $word 0 16]... - tkcon Edit" } else { wm title $w "$word - tkcon Edit" } if {[package provide ctext] != ""} { set txt [ctext $w.text] } else { set txt [text $w.text] } $w.text configure -wrap $opts(-wrap) \ -xscrollcommand [list $w.sx set] \ -yscrollcommand [list $w.sy set] \ -foreground $COLOR(stdin) \ -background $COLOR(bg) \ -insertbackground $COLOR(cursor) \ -font $::tkcon::OPT(font) -borderwidth 1 -highlightthickness 0 \ -undo 1 catch { # 8.5+ stuff set tabsp [expr {$OPT(tabspace) * [font measure $OPT(font) 0]}] $w.text configure -tabs [list $tabsp left] -tabstyle wordprocessor } scrollbar $w.sx -orient h -command [list $w.text xview] scrollbar $w.sy -orient v -command [list $w.text yview] set menu [menu $w.mbar] $w configure -menu $menu ## File Menu ## set m [menu [::tkcon::MenuButton $menu File file]] $m add command -label "Save As..." -underline 0 \ -command [list ::tkcon::Save {} widget $w.text] $m add command -label "Append To..." -underline 0 \ -command [list ::tkcon::Save {} widget $w.text a+] $m add separator $m add command -label "Dismiss" -underline 0 -accel $PRIV(ACC)w \ -command [list destroy $w] bind $w <$PRIV(CTRL)w> [list destroy $w] bind $w [list destroy $w] ## Edit Menu ## set text $w.text set m [menu [::tkcon::MenuButton $menu Edit edit]] $m add command -label "Cut" -under 2 \ -command [list tk_textCut $text] $m add command -label "Copy" -under 0 \ -command [list tk_textCopy $text] $m add command -label "Paste" -under 0 \ -command [list tk_textPaste $text] $m add separator $m add command -label "Find" -under 0 \ -command [list ::tkcon::FindBox $text] ## Send To Menu ## set m [menu [::tkcon::MenuButton $menu "Send To..." send]] $m add command -label "Send To $app" -underline 0 \ -command "::tkcon::EvalOther [list $app] $type \ eval \[$w.text get 1.0 end-1c\]" set other [tkcon attach] if {[string compare $other [list $app $type]]} { $m add command -label "Send To [lindex $other 0]" \ -command "::tkcon::EvalOther $other \ eval \[$w.text get 1.0 end-1c\]" } grid $w.text - $w.sy -sticky news grid $w.sx - -sticky ew grid columnconfigure $w 0 -weight 1 grid columnconfigure $w 1 -weight 1 grid rowconfigure $w 0 -weight 1 switch -glob -- $opts(-type) { proc* { $w.text insert 1.0 \ [::tkcon::EvalOther $app $type dump proc [list $word]] after idle [::tkcon::Highlight $w.text tcl] } var* { $w.text insert 1.0 \ [::tkcon::EvalOther $app $type dump var [list $word]] after idle [::tkcon::Highlight $w.text tcl] } file { $w.text insert 1.0 [::tkcon::EvalOther $app $type eval \ [subst -nocommands { set __tkcon(fid) [open {$word} r] set __tkcon(data) [read \$__tkcon(fid)] close \$__tkcon(fid) after 1000 unset __tkcon return \$__tkcon(data) } ]] after idle [::tkcon::Highlight $w.text \ [string trimleft [file extension $word] .]] } error* { $w.text insert 1.0 [join $args \n] after idle [::tkcon::Highlight $w.text error] } default { $w.text insert 1.0 [join $args \n] } } # prevent stuff above being "undoable" in newer Tk catch { $w.text edit reset ; $w.text edit modified 0 } wm deiconify $w focus $w.text if {[string compare $opts(-find) {}]} { ::tkcon::Find $w.text $opts(-find) -case 1 } } interp alias {} ::more {} ::edit interp alias {} ::less {} ::edit ## echo ## Relaxes the one string restriction of 'puts' # ARGS: any number of strings to output to stdout ## proc echo args { puts stdout [concat $args] } ## clear - clears the buffer of the console (not the history though) ## This is executed in the parent interpreter ## proc clear {{pcnt 100}} { if {![regexp {^[0-9]*$} $pcnt] || $pcnt < 1 || $pcnt > 100} { return -code error \ "invalid percentage to clear: must be 1-100 (100 default)" } elseif {$pcnt == 100} { tkcon console delete 1.0 end } else { set tmp [expr {$pcnt/100.0*[tkcon console index end]}] tkcon console delete 1.0 "$tmp linestart" } } ## alias - akin to the csh alias command ## If called with no args, then it dumps out all current aliases ## If called with one arg, returns the alias of that arg (or {} if none) # ARGS: newcmd - (optional) command to bind alias to # args - command and args being aliased ## proc alias {{newcmd {}} args} { if {[string match {} $newcmd]} { set res {} foreach a [interp aliases] { lappend res [list $a -> [interp alias {} $a]] } return [join $res \n] } elseif {![llength $args]} { interp alias {} $newcmd } else { eval interp alias [list {} $newcmd {}] $args } } ## unalias - unaliases an alias'ed command # ARGS: cmd - command to unbind as an alias ## proc unalias {cmd} { interp alias {} $cmd {} } ## dump - outputs variables/procedure/widget info in source'able form. ## Accepts glob style pattern matching for the names # # ARGS: type - type of thing to dump: must be variable, procedure, widget # # OPTS: -nocomplain # don't complain if no items of the specified type are found # -filter pattern # specifies a glob filter pattern to be used by the variable # method as an array filter pattern (it filters down for # nested elements) and in the widget method as a config # option filter pattern # -- forcibly ends options recognition # # Returns: the values of the requested items in a 'source'able form ## proc dump {type args} { set whine 1 set code ok if {![llength $args]} { ## If no args, assume they gave us something to dump and ## we'll try anything set args $type set type any } while {[string match -* [lindex $args 0]]} { switch -glob -- [lindex $args 0] { -n* { set whine 0; set args [lreplace $args 0 0] } -f* { set fltr [lindex $args 1]; set args [lreplace $args 0 1] } -- { set args [lreplace $args 0 0]; break } default {return -code error "unknown option \"[lindex $args 0]\""} } } if {$whine && ![llength $args]} { return -code error "wrong \# args: [lindex [info level 0] 0] type\ ?-nocomplain? ?-filter pattern? ?--? pattern ?pattern ...?" } set res {} switch -glob -- $type { c* { # command # outputs commands by figuring out, as well as possible, what it is # this does not attempt to auto-load anything foreach arg $args { if {[llength [set cmds [info commands $arg]]]} { foreach cmd [lsort $cmds] { if {[lsearch -exact [interp aliases] $cmd] > -1} { append res "\#\# ALIAS: $cmd =>\ [interp alias {} $cmd]\n" } elseif { [llength [info procs $cmd]] || ([string match *::* $cmd] && [llength [namespace eval [namespace qual $cmd] \ info procs [namespace tail $cmd]]]) } { if {[catch {dump p -- $cmd} msg] && $whine} { set code error } append res $msg\n } else { append res "\#\# COMMAND: $cmd\n" } } } elseif {$whine} { append res "\#\# No known command $arg\n" set code error } } } v* { # variable # outputs variables value(s), whether array or simple. if {![info exists fltr]} { set fltr * } foreach arg $args { if {![llength [set vars [uplevel 1 info vars [list $arg]]]]} { if {[uplevel 1 info exists $arg]} { set vars $arg } elseif {$whine} { append res "\#\# No known variable $arg\n" set code error continue } else { continue } } foreach var [lsort $vars] { if {[uplevel 1 [list info locals $var]] == ""} { # use the proper scope of the var, but namespace which # won't id locals or some upvar'ed vars correctly set new [uplevel 1 \ [list namespace which -variable $var]] if {$new != ""} { set var $new } } upvar 1 $var v if {[array exists v] || [catch {string length $v}]} { set nst {} append res "array set [list $var] \{\n" if {[array size v]} { foreach i \ [lsort -dictionary [array names v $fltr]] { upvar 0 v\($i\) __a if {[array exists __a]} { append nst "\#\# NESTED ARRAY ELEM: $i\n" append nst "upvar 0 [list $var\($i\)] __a;\ [dump v -filter $fltr __a]\n" } else { append res " [list $i]\t[list $v($i)]\n" } } } else { ## empty array append res " empty array\n" if {$var == ""} { append nst "unset (empty)\n" } else { append nst "unset [list $var](empty)\n" } } append res "\}\n$nst" } else { append res [list set $var $v]\n } } } } p* { # procedure foreach arg $args { if { ![llength [set procs [info proc $arg]]] && ([string match *::* $arg] && [llength [set ps [namespace eval \ [namespace qualifier $arg] \ info procs [namespace tail $arg]]]]) } { set procs {} set namesp [namespace qualifier $arg] foreach p $ps { lappend procs ${namesp}::$p } } if {[llength $procs]} { foreach p [lsort $procs] { set as {} foreach a [info args $p] { if {[info default $p $a tmp]} { lappend as [list $a $tmp] } else { lappend as $a } } append res [list proc $p $as [info body $p]]\n } } elseif {$whine} { append res "\#\# No known proc $arg\n" set code error } } } w* { # widget ## The user should have Tk loaded if {![llength [info command winfo]]} { return -code error "winfo not present, cannot dump widgets" } if {![info exists fltr]} { set fltr .* } foreach arg $args { if {[llength [set ws [info command $arg]]]} { foreach w [lsort $ws] { if {[winfo exists $w]} { if {[catch {$w configure} cfg]} { append res "\#\# Widget $w\ does not support configure method" set code error } else { append res "\#\# [winfo class $w]\ $w\n$w configure" foreach c $cfg { if {[llength $c] != 5} continue ## Check to see that the option does ## not match the default, then check ## the item against the user filter if {[string compare [lindex $c 3] \ [lindex $c 4]] && \ [regexp -nocase -- $fltr $c]} { append res " \\\n\t[list [lindex $c 0]\ [lindex $c 4]]" } } append res \n } } } } elseif {$whine} { append res "\#\# No known widget $arg\n" set code error } } } a* { ## see if we recognize it, other complain if {[regexp {(var|com|proc|widget)} \ [set types [uplevel 1 what $args]]]} { foreach type $types { if {[regexp {(var|com|proc|widget)} $type]} { append res "[uplevel 1 dump $type $args]\n" } } } else { set res "dump was unable to resolve type for \"$args\"" set code error } } default { return -code error "bad [lindex [info level 0] 0] option\ \"$type\": must be variable, command, procedure,\ or widget" } } return -code $code [string trimright $res \n] } ## idebug - interactive debugger # # idebug body ?level? # # Prints out the body of the command (if it is a procedure) at the # specified level. level defaults to the current level. # # idebug break # # Creates a breakpoint within a procedure. This will only trigger # if idebug is on and the id matches the pattern. If so, TkCon will # pop to the front with the prompt changed to an idebug prompt. You # are given the basic ability to observe the call stack an query/set # variables or execute Tcl commands at any level. A separate history # is maintained in debugging mode. # # idebug echo|{echo ?id?} ?args? # # Behaves just like "echo", but only triggers when idebug is on. # You can specify an optional id to further restrict triggering. # If no id is specified, it defaults to the name of the command # in which the call was made. # # idebug id ?id? # # Query or set the idebug id. This id is used by other idebug # methods to determine if they should trigger or not. The idebug # id can be a glob pattern and defaults to *. # # idebug off # # Turns idebug off. # # idebug on ?id? # # Turns idebug on. If 'id' is specified, it sets the id to it. # # idebug puts|{puts ?id?} args # # Behaves just like "puts", but only triggers when idebug is on. # You can specify an optional id to further restrict triggering. # If no id is specified, it defaults to the name of the command # in which the call was made. # # idebug show type ?level? ?VERBOSE? # # 'type' must be one of vars, locals or globals. This method # will output the variables/locals/globals present in a particular # level. If VERBOSE is added, then it actually 'dump's out the # values as well. 'level' defaults to the level in which this # method was called. # # idebug trace ?level? # # Prints out the stack trace from the specified level up to the top # level. 'level' defaults to the current level. # ## proc idebug {opt args} { global IDEBUG if {![info exists IDEBUG(on)]} { array set IDEBUG { on 0 id * debugging 0 } } set level [expr {[info level]-1}] switch -glob -- $opt { on { # id is just arg0 [bug #50] if {[llength $args]} { set IDEBUG(id) [lindex $args 0] } return [set IDEBUG(on) 1] } off { return [set IDEBUG(on) 0] } id { if {![llength $args]} { return $IDEBUG(id) } else { return [set IDEBUG(id) [lindex $args 0]] } } break { if {!$IDEBUG(on) || $IDEBUG(debugging) || \ ([llength $args] && \ ![string match $IDEBUG(id) $args]) || [info level]<1} { return } set IDEBUG(debugging) 1 puts stderr "idebug at level \#$level: [lindex [info level -1] 0]" set tkcon [llength [info command tkcon]] if {$tkcon} { tkcon master eval set ::tkcon::OPT(prompt2) \$::tkcon::OPT(prompt1) tkcon master eval set ::tkcon::OPT(prompt1) \$::tkcon::OPT(debugPrompt) set slave [tkcon set ::tkcon::OPT(exec)] set event [tkcon set ::tkcon::PRIV(event)] tkcon set ::tkcon::OPT(exec) [tkcon master interp create debugger] tkcon set ::tkcon::PRIV(event) 1 } set max $level while 1 { set err {} if {$tkcon} { # tkcon's overload of gets is advanced enough to not need # this, but we get a little better control this way. tkcon evalSlave set level $level tkcon prompt set line [tkcon getcommand] tkcon console mark set output end } else { puts -nonewline stderr "(level \#$level) debug > " gets stdin line while {![info complete $line]} { puts -nonewline "> " append line "\n[gets stdin]" } } if {[string match {} $line]} continue set key [regexp -inline {\S+} $line] if {![regexp {^\s*\S+\s+([#-]?[0-9]+)} $line -> lvl]} { set lvl \#$level } set res {}; set c 0 switch -- $key { + { ## Allow for jumping multiple levels if {$level < $max} { idebug trace [incr level] $level 0 VERBOSE } } - { ## Allow for jumping multiple levels if {$level > 1} { idebug trace [incr level -1] $level 0 VERBOSE } } . { set c [catch {idebug trace $level $level 0 VERBOSE} res] } v { set c [catch {idebug show vars $lvl } res] } V { set c [catch {idebug show vars $lvl VERBOSE} res] } l { set c [catch {idebug show locals $lvl } res] } L { set c [catch {idebug show locals $lvl VERBOSE} res] } g { set c [catch {idebug show globals $lvl } res] } G { set c [catch {idebug show globals $lvl VERBOSE} res] } t { set c [catch {idebug trace 1 $max $level } res] } T { set c [catch {idebug trace 1 $max $level VERBOSE} res]} b { set c [catch {idebug body $lvl} res] } o { set res [set IDEBUG(on) [expr {!$IDEBUG(on)}]] } h - ? { puts stderr " + Move down in call stack - Move up in call stack . Show current proc name and params v Show names of variables currently in scope V Show names of variables currently in scope with values l Show names of local (transient) variables L Show names of local (transient) variables with values g Show names of declared global variables G Show names of declared global variables with values t Show a stack trace T Show a verbose stack trace b Show body of current proc o Toggle on/off any further debugging c,q Continue regular execution (Quit debugger) h,? Print this help default Evaluate line at current level (\#$level)" } c - q break default { set c [catch {uplevel \#$level $line} res] } } if {$tkcon} { tkcon set ::tkcon::PRIV(event) \ [tkcon evalSlave eval history add [list $line]\ \; history nextid] } if {$c} { puts stderr $res } elseif {[string compare {} $res]} { puts $res } } set IDEBUG(debugging) 0 if {$tkcon} { tkcon master interp delete debugger tkcon master eval set ::tkcon::OPT(prompt1) \$::tkcon::OPT(prompt2) tkcon set ::tkcon::OPT(exec) $slave tkcon set ::tkcon::PRIV(event) $event tkcon prompt } } bo* { if {[regexp {^([#-]?[0-9]+)} $args level]} { return [uplevel $level {dump c -no [lindex [info level 0] 0]}] } } t* { if {[llength $args]<2} return set min [set max [set lvl $level]] set exp {^#?([0-9]+)? ?#?([0-9]+) ?#?([0-9]+)? ?(VERBOSE)?} if {![regexp $exp $args junk min max lvl verbose]} return for {set i $max} { $i>=$min && ![catch {uplevel \#$i info level 0} info] } {incr i -1} { if {$i==$lvl} { puts -nonewline stderr "* \#$i:\t" } else { puts -nonewline stderr " \#$i:\t" } set name [lindex $info 0] if {[string compare VERBOSE $verbose] || \ ![llength [info procs $name]]} { puts $info } else { puts "proc $name {[info args $name]} { ... }" set idx 0 foreach arg [info args $name] { if {[string match args $arg]} { puts "\t$arg = [lrange $info [incr idx] end]" break } else { puts "\t$arg = [lindex $info [incr idx]]" } } } } } s* { #var, local, global set level \#$level if {![regexp {^([vgl][^ ]*) ?([#-]?[0-9]+)? ?(VERBOSE)?} \ $args junk type level verbose]} return switch -glob -- $type { v* { set vars [uplevel $level {lsort [info vars]}] } l* { set vars [uplevel $level {lsort [info locals]}] } g* { set vars [lremove [uplevel $level {info vars}] \ [uplevel $level {info locals}]] } } if {[string match VERBOSE $verbose]} { return [uplevel $level dump var -nocomplain $vars] } else { return $vars } } e* - pu* { if {[llength $opt]==1 && [catch {lindex [info level -1] 0} id]} { set id [lindex [info level 0] 0] } else { set id [lindex $opt 1] } if {$IDEBUG(on) && [string match $IDEBUG(id) $id]} { if {[string match e* $opt]} { puts [concat $args] } else { eval puts $args } } } default { return -code error "bad [lindex [info level 0] 0] option \"$opt\",\ must be: [join [lsort [list on off id break print body\ trace show puts echo]] {, }]" } } } ## observe - like trace, but not # ARGS: opt - option # name - name of variable or command ## proc observe {opt name args} { global tcl_observe switch -glob -- $opt { co* { if {[regexp {^(catch|lreplace|set|puts|for|incr|info|uplevel)$} \ $name]} { return -code error "cannot observe \"$name\":\ infinite eval loop will occur" } set old ${name}@ while {[llength [info command $old]]} { append old @ } rename $name $old set max 4 regexp {^[0-9]+} $args max # handle the observe'ing of 'proc' set proccmd "proc" if {[string match "proc" $name]} { set proccmd $old } ## idebug trace could be used here $proccmd $name args " for {set i \[info level\]; set max \[expr \[info level\]-$max\]} { \$i>=\$max && !\[catch {uplevel \#\$i info level 0} info\] } {incr i -1} { puts -nonewline stderr \" \#\$i:\t\" puts \$info } uplevel \[lreplace \[info level 0\] 0 0 $old\] " set tcl_observe($name) $old } cd* { if {[info exists tcl_observe($name)] && [catch { rename $name {} rename $tcl_observe($name) $name unset tcl_observe($name) } err]} { return -code error $err } } ci* { ## What a useless method... if {[info exists tcl_observe($name)]} { set i $tcl_observe($name) set res "\"$name\" observes true command \"$i\"" while {[info exists tcl_observe($i)]} { append res "\n\"$name\" observes true command \"$i\"" set i $tcl_observe($name) } return $res } } va* - vd* { set type [lindex $args 0] set args [lrange $args 1 end] if {![regexp {^[rwu]} $type type]} { return -code error "bad [lindex [info level 0] 0] $opt type\ \"$type\", must be: read, write or unset" } if {![llength $args]} { set args observe_var } foreach c [uplevel 1 [list trace vinfo $name]] { # don't double up on the traces if {[list $type $args] == $c} { return } } uplevel 1 [list trace $opt $name $type $args] } vi* { uplevel 1 [list trace vinfo $name] } default { return -code error "bad [lindex [info level 0] 0] option\ \"[lindex $args 0]\", must be: [join [lsort \ [list command cdelete cinfo variable vdelete vinfo]] {, }]" } } } ## observe_var - auxilary function for observing vars, called by trace ## via observe # ARGS: name - variable name # el - array element name, if any # op - operation type (rwu) ## proc observe_var {name el op} { if {[string match u $op]} { if {[string compare {} $el]} { puts "unset \"${name}($el)\"" } else { puts "unset \"$name\"" } } else { upvar 1 $name $name if {[info exists ${name}($el)]} { puts [dump v ${name}($el)] } else { puts [dump v $name] } } } ## which - tells you where a command is found # ARGS: cmd - command name # Returns: where command is found (internal / external / unknown) ## proc which cmd { ## This tries to auto-load a command if not recognized set types [uplevel 1 [list what $cmd 1]] if {[llength $types]} { set out {} foreach type $types { switch -- $type { alias { set res "$cmd: aliased to [alias $cmd]" } procedure { set res "$cmd: procedure" } command { set res "$cmd: internal command" } executable { lappend out [auto_execok $cmd] } variable { lappend out "$cmd: $type" } } if {[info exists res]} { global auto_index if {[info exists auto_index($cmd)]} { ## This tells you where the command MIGHT have come from - ## not true if the command was redefined interactively or ## existed before it had to be auto_loaded. This is just ## provided as a hint at where it MAY have come from append res " ($auto_index($cmd))" } lappend out $res unset res } } return [join $out \n] } else { return -code error "$cmd: command not found" } } ## what - tells you what a string is recognized as # ARGS: str - string to id # Returns: id types of command as list ## proc what {str {autoload 0}} { set types {} if {[llength [info commands $str]] || ($autoload && \ [auto_load $str] && [llength [info commands $str]])} { if {[lsearch -exact [interp aliases] $str] > -1} { lappend types "alias" } elseif { [llength [info procs $str]] || ([string match *::* $str] && [llength [namespace eval [namespace qualifier $str] \ info procs [namespace tail $str]]]) } { lappend types "procedure" } else { lappend types "command" } } if {[llength [uplevel 1 info vars $str]]} { upvar 1 $str var if {[array exists var]} { lappend types array variable } else { lappend types scalar variable } } if {[file isdirectory $str]} { lappend types "directory" } if {[file isfile $str]} { lappend types "file" } if {[llength [info commands winfo]] && [winfo exists $str]} { lappend types "widget" } if {[string compare {} [auto_execok $str]]} { lappend types "executable" } return $types } ## dir - directory list # ARGS: args - names/glob patterns of directories to list # OPTS: -all - list hidden files as well (Unix dot files) # -long - list in full format "permissions size date filename" # -full - displays / after directories and link paths for links # Returns: a directory listing ## proc dir {args} { array set s { all 0 full 0 long 0 0 --- 1 --x 2 -w- 3 -wx 4 r-- 5 r-x 6 rw- 7 rwx } while {[string match \-* [lindex $args 0]]} { set str [lindex $args 0] set args [lreplace $args 0 0] switch -glob -- $str { -a* {set s(all) 1} -f* {set s(full) 1} -l* {set s(long) 1} -- break default { return -code error "unknown option \"$str\",\ should be one of: -all, -full, -long" } } } set sep [string trim [file join . .] .] if {![llength $args]} { set args [list [pwd]] } if {$::tcl_version >= 8.3} { # Newer glob args allow safer dir processing. The user may still # want glob chars, but really only for file matching. foreach arg $args { if {[file isdirectory $arg]} { if {$s(all)} { lappend out [list $arg [lsort \ [glob -nocomplain -directory $arg .* *]]] } else { lappend out [list $arg [lsort \ [glob -nocomplain -directory $arg *]]] } } else { set dir [file dirname $arg] lappend out [list $dir$sep [lsort \ [glob -nocomplain -directory $dir [file tail $arg]]]] } } } else { foreach arg $args { if {[file isdirectory $arg]} { set arg [string trimright $arg $sep]$sep if {$s(all)} { lappend out [list $arg [lsort [glob -nocomplain -- $arg.* $arg*]]] } else { lappend out [list $arg [lsort [glob -nocomplain -- $arg*]]] } } else { lappend out [list [file dirname $arg]$sep \ [lsort [glob -nocomplain -- $arg]]] } } } if {$s(long)} { set old [clock scan {1 year ago}] set fmt "%s%9ld %s %s\n" foreach o $out { set d [lindex $o 0] append res $d:\n foreach f [lindex $o 1] { file lstat $f st set f [file tail $f] if {$s(full)} { switch -glob $st(type) { d* { append f $sep } l* { append f "@ -> [file readlink $d$sep$f]" } default { if {[file exec $d$sep$f]} { append f * } } } } if {[string match file $st(type)]} { set mode - } else { set mode [string index $st(type) 0] } foreach j [split [format %03o [expr {$st(mode)&0777}]] {}] { append mode $s($j) } if {$st(mtime)>$old} { set cfmt {%b %d %H:%M} } else { set cfmt {%b %d %Y} } append res [format $fmt $mode $st(size) \ [clock format $st(mtime) -format $cfmt] $f] } append res \n } } else { foreach o $out { set d [lindex $o 0] append res "$d:\n" set i 0 foreach f [lindex $o 1] { if {[string len [file tail $f]] > $i} { set i [string len [file tail $f]] } } set i [expr {$i+2+$s(full)}] set j 80 ## This gets the number of cols in the tkcon console widget if {[llength [info commands tkcon]]} { set j [expr {[tkcon master set ::tkcon::OPT(cols)]/$i}] } set k 0 foreach f [lindex $o 1] { set f [file tail $f] if {$s(full)} { switch -glob [file type $d$sep$f] { d* { append f $sep } l* { append f @ } default { if {[file exec $d$sep$f]} { append f * } } } } append res [format "%-${i}s" $f] if {$j == 0 || [incr k]%$j == 0} { set res [string trimright $res]\n } } append res \n\n } } return [string trimright $res] } interp alias {} ::ls {} ::dir -full ## lremove - remove items from a list # OPTS: # -all remove all instances of each item # -glob remove all instances matching glob pattern # -regexp remove all instances matching regexp pattern # ARGS: l a list to remove items from # args items to remove (these are 'join'ed together) ## proc lremove {args} { array set opts {-all 0 pattern -exact} while {[string match -* [lindex $args 0]]} { switch -glob -- [lindex $args 0] { -a* { set opts(-all) 1 } -g* { set opts(pattern) -glob } -r* { set opts(pattern) -regexp } -- { set args [lreplace $args 0 0]; break } default {return -code error "unknown option \"[lindex $args 0]\""} } set args [lreplace $args 0 0] } set l [lindex $args 0] foreach i [join [lreplace $args 0 0]] { if {[set ix [lsearch $opts(pattern) $l $i]] == -1} continue set l [lreplace $l $ix $ix] if {$opts(-all)} { while {[set ix [lsearch $opts(pattern) $l $i]] != -1} { set l [lreplace $l $ix $ix] } } } return $l } if {!$::tkcon::PRIV(WWW)} {; ## Unknown changed to get output into tkcon window # unknown: # Invoked automatically whenever an unknown command is encountered. # Works through a list of "unknown handlers" that have been registered # to deal with unknown commands. Extensions can integrate their own # handlers into the 'unknown' facility via 'unknown_handler'. # # If a handler exists that recognizes the command, then it will # take care of the command action and return a valid result or a # Tcl error. Otherwise, it should return "-code continue" (=2) # and responsibility for the command is passed to the next handler. # # Arguments: # args - A list whose elements are the words of the original # command, including the command name. proc unknown args { global unknown_handler_order unknown_handlers errorInfo errorCode # # Be careful to save error info now, and restore it later # for each handler. Some handlers generate their own errors # and disrupt handling. # set savedErrorCode $errorCode set savedErrorInfo $errorInfo if {![info exists unknown_handler_order] || \ ![info exists unknown_handlers]} { set unknown_handlers(tcl) tcl_unknown set unknown_handler_order tcl } foreach handler $unknown_handler_order { set status [catch {uplevel 1 $unknown_handlers($handler) $args} result] if {$status == 1} { # # Strip the last five lines off the error stack (they're # from the "uplevel" command). # set new [split $errorInfo \n] set new [join [lrange $new 0 [expr {[llength $new]-6}]] \n] return -code $status -errorcode $errorCode \ -errorinfo $new $result } elseif {$status != 4} { return -code $status $result } set errorCode $savedErrorCode set errorInfo $savedErrorInfo } set name [lindex $args 0] return -code error "invalid command name \"$name\"" } # tcl_unknown: # Invoked when a Tcl command is invoked that doesn't exist in the # interpreter: # # 1. See if the autoload facility can locate the command in a # Tcl script file. If so, load it and execute it. # 2. If the command was invoked interactively at top-level: # (a) see if the command exists as an executable UNIX program. # If so, "exec" the command. # (b) see if the command requests csh-like history substitution # in one of the common forms !!, !, or ^old^new. If # so, emulate csh's history substitution. # (c) see if the command is a unique abbreviation for another # command. If so, invoke the command. # # Arguments: # args - A list whose elements are the words of the original # command, including the command name. proc tcl_unknown args { global auto_noexec auto_noload env unknown_pending tcl_interactive global errorCode errorInfo # If the command word has the form "namespace inscope ns cmd" # then concatenate its arguments onto the end and evaluate it. set cmd [lindex $args 0] if {[regexp "^:*namespace\[ \t\n\]+inscope" $cmd] \ && [llength $cmd] == 4} { set arglist [lrange $args 1 end] set ret [catch {uplevel 1 $cmd $arglist} result] if {$ret == 0} { return $result } else { return -code $ret -errorcode $errorCode $result } } # Save the values of errorCode and errorInfo variables, since they # may get modified if caught errors occur below. The variables will # be restored just before re-executing the missing command. set savedErrorCode $errorCode set savedErrorInfo $errorInfo set name [lindex $args 0] if {![info exists auto_noload]} { # # Make sure we're not trying to load the same proc twice. # if {[info exists unknown_pending($name)]} { return -code error "self-referential recursion in \"unknown\" for command \"$name\"" } set unknown_pending($name) pending if {[llength [info args auto_load]]==1} { set ret [catch {auto_load $name} msg] } else { set ret [catch {auto_load $name [uplevel 1 {namespace current}]} msg] } unset unknown_pending($name) if {$ret} { return -code $ret -errorcode $errorCode \ "error while autoloading \"$name\": $msg" } if {![array size unknown_pending]} { unset unknown_pending } if {$msg} { set errorCode $savedErrorCode set errorInfo $savedErrorInfo set code [catch {uplevel 1 $args} msg] if {$code == 1} { # # Strip the last five lines off the error stack (they're # from the "uplevel" command). # set new [split $errorInfo \n] set new [join [lrange $new 0 [expr {[llength $new]-6}]] \n] return -code error -errorcode $errorCode \ -errorinfo $new $msg } else { return -code $code $msg } } } if {[info level] == 1 && [string match {} [info script]] \ && [info exists tcl_interactive] && $tcl_interactive} { if {![info exists auto_noexec]} { set new [auto_execok $name] if {[string compare {} $new]} { set errorCode $savedErrorCode set errorInfo $savedErrorInfo if {[info exists ::tkcon::EXPECT] && $::tkcon::EXPECT && [package provide Expect] != ""} { return [tkcon expect [concat $new [lrange $args 1 end]]] } else { return [uplevel 1 exec $new [lrange $args 1 end]] } #return [uplevel exec >&@stdout <@stdin $new [lrange $args 1 end]] } } set errorCode $savedErrorCode set errorInfo $savedErrorInfo ## ## History substitution moved into ::tkcon::EvalCmd ## if {[string compare $name "::"] == 0} { set name "" } if {$ret != 0} { return -code $ret -errorcode $errorCode \ "error in unknown while checking if \"$name\" is a unique command abbreviation: $msg" } set cmds [info commands $name*] if {[llength $cmds] == 1} { return [uplevel 1 [lreplace $args 0 0 $cmds]] } if {[llength $cmds]} { if {$name == ""} { return -code error "empty command name \"\"" } else { return -code error \ "ambiguous command name \"$name\": [lsort $cmds]" } } ## We've got nothing so far ## Check and see if Tk wasn't loaded, but it appears to be a Tk cmd if {![uplevel \#0 info exists tk_version]} { lappend tkcmds bell bind bindtags button \ canvas checkbutton clipboard destroy \ entry event focus font frame grab grid image \ label labelframe listbox lower menu menubutton message \ option pack panedwindow place radiobutton raise \ scale scrollbar selection send spinbox \ text tk tkwait toplevel winfo wm if {[lsearch -exact $tkcmds $name] >= 0 && \ [tkcon master tk_messageBox -icon question -parent . \ -title "Load Tk?" -type retrycancel -default retry \ -message "This appears to be a Tk command, but Tk\ has not yet been loaded. Shall I retry the command\ with loading Tk first?"] == "retry"} { return [uplevel 1 "load {} Tk; $args"] } } } return -code continue } } ; # end exclusionary code for WWW proc ::tkcon::Bindings {} { variable PRIV global tcl_platform tk_version #----------------------------------------------------------------------- # Elements of tk::Priv that are used in this file: # # mouseMoved - Non-zero means the mouse has moved a significant # amount since the button went down (so, for example, # start dragging out a selection). #----------------------------------------------------------------------- ## Get all Text bindings into TkConsole foreach ev [bind Text] { bind TkConsole $ev [bind Text $ev] } ## We really didn't want the newline insertion bind TkConsole {} ## in 8.6b3, the virtual events <> and <> # mess up our history feature bind TkConsole <> {} bind TkConsole <> {} ## Now make all our virtual event bindings set bindings { <> <$PRIV(CTRL)-q> <> <$PRIV(CTRL)-N> <> <$PRIV(CTRL)-T> <> <> <> <$PRIV(CTRL)-w> <> <$PRIV(CTRL)-A> <> <$PRIV(CTRL)F> <> <$PRIV(CTRL)Key-1> <> <$PRIV(CTRL)Key-2> <> <$PRIV(CTRL)Key-3> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> } if {$PRIV(AQUA)} { lappend bindings <> \ <> } else { lappend bindings <> } foreach {ev key} [subst -nocommand -noback $bindings] { event add $ev $key ## Make sure the specific key won't be defined bind TkConsole $key {} } ## Make the ROOT bindings bind $PRIV(root) <> exit bind $PRIV(root) <> { ::tkcon::New } bind $PRIV(root) <> { ::tkcon::NewTab } bind $PRIV(root) <> { ::tkcon::GotoTab 1 ; break } bind $PRIV(root) <> { ::tkcon::GotoTab -1 ; break } bind $PRIV(root) <> { ::tkcon::Destroy } bind $PRIV(root) <> { ::tkcon::About } bind $PRIV(root) <> { ::tkcon::FindBox $::tkcon::PRIV(console) } bind $PRIV(root) <> { ::tkcon::Attach {} ::tkcon::RePrompt "\n" [::tkcon::CmdGet $::tkcon::PRIV(console)] } bind $PRIV(root) <> { if {[string compare {} $::tkcon::PRIV(name)]} { ::tkcon::Attach $::tkcon::PRIV(name) } else { ::tkcon::Attach Main } ::tkcon::RePrompt "\n" [::tkcon::CmdGet $::tkcon::PRIV(console)] } bind $PRIV(root) <> { ::tkcon::Attach Main ::tkcon::RePrompt "\n" [::tkcon::CmdGet $::tkcon::PRIV(console)] } bind $PRIV(root) <> { ::tkcon::PopupMenu %X %Y } ## Menu items need null TkConsolePost bindings to avoid the TagProc ## foreach ev [bind $PRIV(root)] { bind TkConsolePost $ev { # empty } } # ::tkcon::ClipboardKeysyms -- # This procedure is invoked to identify the keys that correspond to # the copy, cut, and paste functions for the clipboard. # # Arguments: # copy - Name of the key (keysym name plus modifiers, if any, # such as "Meta-y") used for the copy operation. # cut - Name of the key used for the cut operation. # paste - Name of the key used for the paste operation. proc ::tkcon::ClipboardKeysyms {copy cut paste} { bind TkConsole <$copy> {::tkcon::Copy %W} bind TkConsole <$cut> {::tkcon::Cut %W} bind TkConsole <$paste> {::tkcon::Paste %W} } proc ::tkcon::GetSelection {w} { if { ![catch {selection get -displayof $w -type UTF8_STRING} txt] || ![catch {selection get -displayof $w} txt] || ![catch {selection get -displayof $w -selection CLIPBOARD} txt] } { return $txt } return -code error "could not find default selection" } proc ::tkcon::Cut w { if {[string match $w [selection own -displayof $w]]} { clipboard clear -displayof $w catch { set txt [selection get -displayof $w] clipboard append -displayof $w $txt if {[$w compare sel.first >= limit]} { $w delete sel.first sel.last } } } } proc ::tkcon::Copy w { if {[string match $w [selection own -displayof $w]]} { clipboard clear -displayof $w catch { set txt [selection get -displayof $w] clipboard append -displayof $w $txt } } } proc ::tkcon::Paste w { if {![catch {GetSelection $w} txt]} { catch { if {[$w compare sel.first >= limit]} { $w delete sel.first sel.last } } if {[$w compare insert < limit]} { $w mark set insert end } $w insert insert $txt $w see insert if {[string match *\n* $txt]} { ::tkcon::Eval $w } } } ## Redefine for TkConsole what we need ## event delete <> <$PRIV(CTRL)V> ::tkcon::ClipboardKeysyms bind TkConsole { catch { ::tkcon::Insert %W [::tkcon::GetSelection %W] } } bind TkConsole {+ catch { eval %W tag remove sel [%W tag nextrange prompt sel.first sel.last] eval %W tag remove sel sel.last-1c %W mark set insert sel.first } } ## binding editor needed ## binding for .tkconrc bind TkConsole <> { if {[%W compare insert > limit]} {::tkcon::Expand %W path} break ; # could check "%K" == "Tab" } bind TkConsole <> { if {[%W compare insert > limit]} {::tkcon::Expand %W proc} break ; # could check "%K" == "Tab" } bind TkConsole <> { if {[%W compare insert > limit]} {::tkcon::Expand %W var} break ; # could check "%K" == "Tab" } bind TkConsole <> { if {[%W compare insert > limit]} {::tkcon::Expand %W} break ; # could check "%K" == "Tab" } bind TkConsole <> { if {[%W compare insert >= limit]} { ::tkcon::Insert %W \t } } bind TkConsole <> { if {[%W compare insert >= limit]} { ::tkcon::Insert %W \n } } bind TkConsole <> { ::tkcon::Eval %W } bind TkConsole { if {[llength [%W tag nextrange sel 1.0 end]] \ && [%W compare sel.first >= limit]} { %W delete sel.first sel.last } elseif {[%W compare insert >= limit]} { %W delete insert %W see insert } } bind TkConsole { if {[llength [%W tag nextrange sel 1.0 end]] \ && [%W compare sel.first >= limit]} { %W delete sel.first sel.last } elseif {[%W compare insert != 1.0] && [%W compare insert > limit]} { %W delete insert-1c %W see insert } } bind TkConsole [bind TkConsole ] bind TkConsole { ::tkcon::Insert %W %A } bind TkConsole { if {[%W compare {limit linestart} == {insert linestart}]} { tk::TextSetCursor %W limit } else { tk::TextSetCursor %W {insert linestart} } } bind TkConsole [bind TkConsole ] bind TkConsole { if {[%W compare insert < limit]} break %W delete insert } bind TkConsole { if {[%W compare insert < limit]} break if {[%W compare insert == {insert lineend}]} { %W delete insert } else { %W delete insert {insert lineend} } } bind TkConsole <> { ## Clear console buffer, without losing current command line input set ::tkcon::PRIV(tmp) [::tkcon::CmdGet %W] clear ::tkcon::Prompt {} $::tkcon::PRIV(tmp) } bind TkConsole <> { if {[%W compare {insert linestart} != {limit linestart}]} { tk::TextSetCursor %W [tk::TextUpDownLine %W -1] } else { ::tkcon::Event -1 } } bind TkConsole <> { if {[%W compare {insert linestart} != {end-1c linestart}]} { tk::TextSetCursor %W [tk::TextUpDownLine %W 1] } else { ::tkcon::Event 1 } } bind TkConsole <> { ::tkcon::Event 1 } bind TkConsole <> { ::tkcon::Event -1 } bind TkConsole <> { ::tkcon::Event -1 [::tkcon::CmdGet %W] } bind TkConsole <> { ::tkcon::Event 1 [::tkcon::CmdGet %W] } bind TkConsole <> { ## Transpose current and previous chars if {[%W compare insert > "limit+1c"]} { tk::TextTranspose %W } } bind TkConsole <> { ## Clear command line (Unix shell staple) %W delete limit end } bind TkConsole <> { ## Save command buffer (swaps with current command) set ::tkcon::PRIV(tmp) $::tkcon::PRIV(cmdsave) set ::tkcon::PRIV(cmdsave) [::tkcon::CmdGet %W] if {[string match {} $::tkcon::PRIV(cmdsave)]} { set ::tkcon::PRIV(cmdsave) $::tkcon::PRIV(tmp) } else { %W delete limit end-1c } ::tkcon::Insert %W $::tkcon::PRIV(tmp) %W see end } catch {bind TkConsole { tk::TextScrollPages %W -1 }} catch {bind TkConsole { tk::TextScrollPages %W -1 }} catch {bind TkConsole { tk::TextScrollPages %W 1 }} catch {bind TkConsole { tk::TextScrollPages %W 1 }} bind TkConsole { if {[%W compare insert >= limit]} { %W delete insert {insert wordend} } } bind TkConsole { if {[%W compare {insert -1c wordstart} >= limit]} { %W delete {insert -1c wordstart} insert } } bind TkConsole { if {[%W compare insert >= limit]} { %W delete insert {insert wordend} } } bind TkConsole { if { (!$tk::Priv(mouseMoved) || $tk_strictMotif) && ![catch {::tkcon::GetSelection %W} ::tkcon::PRIV(tmp)] } { if {[%W compare @%x,%y < limit]} { %W insert end $::tkcon::PRIV(tmp) } else { %W insert @%x,%y $::tkcon::PRIV(tmp) } if {[string match *\n* $::tkcon::PRIV(tmp)]} {::tkcon::Eval %W} } } ## ## End TkConsole bindings ## ## ## Bindings for doing special things based on certain keys ## bind TkConsolePost { if {$::tkcon::OPT(lightbrace) && $::tkcon::OPT(blinktime)>99 && \ [string compare \\ [%W get insert-2c]]} { ::tkcon::MatchPair %W \( \) limit } set ::tkcon::PRIV(StatusCursor) [%W index insert] } bind TkConsolePost { if {$::tkcon::OPT(lightbrace) && $::tkcon::OPT(blinktime)>99 && \ [string compare \\ [%W get insert-2c]]} { ::tkcon::MatchPair %W \[ \] limit } set ::tkcon::PRIV(StatusCursor) [%W index insert] } bind TkConsolePost { if {$::tkcon::OPT(lightbrace) && $::tkcon::OPT(blinktime)>99 && \ [string compare \\ [%W get insert-2c]]} { ::tkcon::MatchPair %W \{ \} limit } set ::tkcon::PRIV(StatusCursor) [%W index insert] } bind TkConsolePost { if {$::tkcon::OPT(lightbrace) && $::tkcon::OPT(blinktime)>99 && \ [string compare \\ [%W get insert-2c]]} { ::tkcon::MatchQuote %W limit } set ::tkcon::PRIV(StatusCursor) [%W index insert] } bind TkConsolePost { if {[winfo exists "%W"]} { if {$::tkcon::OPT(lightcmd) && [string compare {} %A]} { ::tkcon::TagProc %W } set ::tkcon::PRIV(StatusCursor) [%W index insert] } } bind TkConsolePost { set ::tkcon::PRIV(StatusCursor) [%W index insert] } bind TkConsolePost { set ::tkcon::PRIV(StatusCursor) [%W index insert] } } ## # ::tkcon::PopupMenu - what to do when the popup menu is requested ## proc ::tkcon::PopupMenu {X Y} { variable PRIV variable OPT set w $PRIV(console) if {[string compare $w [winfo containing $X $Y]]} { tk_popup $PRIV(popup) $X $Y return } set x [expr {$X-[winfo rootx $w]}] set y [expr {$Y-[winfo rooty $w]}] if {[llength [set tags [$w tag names @$x,$y]]]} { if {[lsearch -exact $tags "proc"] >= 0} { lappend type "proc" foreach {first last} [$w tag prevrange proc @$x,$y] { set word [$w get $first $last]; break } } if {[lsearch -exact $tags "var"] >= 0} { lappend type "var" foreach {first last} [$w tag prevrange var @$x,$y] { set word [$w get $first $last]; break } } } if {![info exists type]} { set exp "(^|\[^\\\\\]\[ \t\n\r\])" set exp2 "\[\[\\\\\\?\\*\]" set i [$w search -backwards -regexp $exp @$x,$y "@$x,$y linestart"] if {[string compare {} $i]} { if {![string match *.0 $i]} {append i +2c} if {[string compare {} \ [set j [$w search -regexp $exp $i "$i lineend"]]]} { append j +1c } else { set j "$i lineend" } regsub -all $exp2 [$w get $i $j] {\\\0} word set word [string trim $word {\"$[]{}',?#*}] if {[llength [EvalAttached [list info commands $word]]]} { lappend type "proc" } if {[llength [EvalAttached [list info vars $word]]]} { lappend type "var" } if {[EvalAttached [list file isfile $word]]} { lappend type "file" } } } if {![info exists type] || ![info exists word]} { tk_popup $PRIV(popup) $X $Y return } $PRIV(context) delete 0 end $PRIV(context) add command -label "$word" -state disabled $PRIV(context) add separator set app [Attach] if {[lsearch $type proc] != -1} { $PRIV(context) add command -label "View Procedure" \ -command [list $OPT(edit) -attach $app -type proc -- $word] } if {[lsearch $type var] != -1} { $PRIV(context) add command -label "View Variable" \ -command [list $OPT(edit) -attach $app -type var -- $word] } if {[lsearch $type file] != -1} { $PRIV(context) add command -label "View File" \ -command [list $OPT(edit) -attach $app -type file -- $word] } tk_popup $PRIV(context) $X $Y } ## ::tkcon::TagProc - tags a procedure in the console if it's recognized ## This procedure is not perfect. However, making it perfect wastes ## too much CPU time... ## proc ::tkcon::TagProc w { set exp "\[^\\\\\]\[\[ \t\n\r\;{}\"\$\]" set i [$w search -backwards -regexp $exp insert-1c limit-1c] if {[string compare {} $i]} {append i +2c} else {set i limit} regsub -all "\[\[\\\\\\?\\*\]" [$w get $i "insert-1c wordend"] {\\\0} c if {[llength [EvalAttached [list info commands $c]]]} { $w tag add proc $i "insert-1c wordend" } else { $w tag remove proc $i "insert-1c wordend" } if {[llength [EvalAttached [list info vars $c]]]} { $w tag add var $i "insert-1c wordend" } else { $w tag remove var $i "insert-1c wordend" } } ## ::tkcon::MatchPair - blinks a matching pair of characters ## c2 is assumed to be at the text index 'insert'. ## This proc is really loopy and took me an hour to figure out given ## all possible combinations with escaping except for escaped \'s. ## It doesn't take into account possible commenting... Oh well. If ## anyone has something better, I'd like to see/use it. This is really ## only efficient for small contexts. # ARGS: w - console text widget # c1 - first char of pair # c2 - second char of pair # Calls: ::tkcon::Blink ## proc ::tkcon::MatchPair {w c1 c2 {lim 1.0}} { if {[string compare {} [set ix [$w search -back $c1 insert $lim]]]} { while { [string match {\\} [$w get $ix-1c]] && [string compare {} [set ix [$w search -back $c1 $ix-1c $lim]]] } {} set i1 insert-1c while {[string compare {} $ix]} { set i0 $ix set j 0 while {[string compare {} [set i0 [$w search $c2 $i0 $i1]]]} { append i0 +1c if {[string match {\\} [$w get $i0-2c]]} continue incr j } if {!$j} break set i1 $ix while {$j && [string compare {} \ [set ix [$w search -back $c1 $ix $lim]]]} { if {[string match {\\} [$w get $ix-1c]]} continue incr j -1 } } if {[string match {} $ix]} { set ix [$w index $lim] } } else { set ix [$w index $lim] } if {$::tkcon::OPT(blinkrange)} { Blink $w $ix [$w index insert] } else { Blink $w $ix $ix+1c [$w index insert-1c] [$w index insert] } } ## ::tkcon::MatchQuote - blinks between matching quotes. ## Blinks just the quote if it's unmatched, otherwise blinks quoted string ## The quote to match is assumed to be at the text index 'insert'. # ARGS: w - console text widget # Calls: ::tkcon::Blink ## proc ::tkcon::MatchQuote {w {lim 1.0}} { set i insert-1c set j 0 while {[string compare [set i [$w search -back \" $i $lim]] {}]} { if {[string match {\\} [$w get $i-1c]]} continue if {!$j} {set i0 $i} incr j } if {$j&1} { if {$::tkcon::OPT(blinkrange)} { Blink $w $i0 [$w index insert] } else { Blink $w $i0 $i0+1c [$w index insert-1c] [$w index insert] } } else { Blink $w [$w index insert-1c] [$w index insert] } } ## ::tkcon::Blink - blinks between n index pairs for a specified duration. # ARGS: w - console text widget # i1 - start index to blink region # i2 - end index of blink region # dur - duration in usecs to blink for # Outputs: blinks selected characters in $w ## proc ::tkcon::Blink {w args} { eval [list $w tag add blink] $args after $::tkcon::OPT(blinktime) [list $w] tag remove blink $args return } ## ::tkcon::Insert ## Insert a string into a text console at the point of the insertion cursor. ## If there is a selection in the text, and it covers the point of the ## insertion cursor, then delete the selection before inserting. # ARGS: w - text window in which to insert the string # s - string to insert (usually just a single char) # Outputs: $s to text widget ## proc ::tkcon::Insert {w s} { if {[string match {} $s] || [string match disabled [$w cget -state]]} { return } variable EXP if {[info exists EXP(spawn_id)]} { exp_send -i $EXP(spawn_id) -- $s return } if {[$w comp insert < limit]} { $w mark set insert end } if {[llength [$w tag ranges sel]] && \ [$w comp sel.first <= insert] && [$w comp sel.last >= insert]} { $w delete sel.first sel.last } $w insert insert $s $w see insert } ## ::tkcon::Expand - # ARGS: w - text widget in which to expand str # type - type of expansion (path / proc / variable) # Calls: ::tkcon::Expand(Pathname|Procname|Variable) # Outputs: The string to match is expanded to the longest possible match. # If ::tkcon::OPT(showmultiple) is non-zero and the user longest # match equaled the string to expand, then all possible matches # are output to stdout. Triggers bell if no matches are found. # Returns: number of matches found ## proc ::tkcon::Expand {w {type ""}} { set exp "\[^\\\\\]\[\[ \t\n\r\\\{\"$\]" set tmp [$w search -backwards -regexp $exp insert-1c limit-1c] if {[string compare {} $tmp]} {append tmp +2c} else {set tmp limit} set str [$w get $tmp insert] # Expand procs can return "break" to indicate not to try further # matches, otherwise "continue" says "I got nothing, continue on" # We can ignore return codes from the specific expand type checks switch -glob $type { pa* { set code [catch {ExpandPathname $str} res] } pr* { set code [catch {ExpandProcname $str} res] } v* { set code [catch {ExpandVariable $str} res] } default { # XXX could be extended to allow the results of all matches # XXX to be amalgamted ... may be confusing to user set res {} foreach t $::tkcon::OPT(expandorder) { set code [catch {Expand$t $str} res] if {$code == 0 || $code == 3} { break } set res {} } } } set len [llength $res] if {$len} { $w delete $tmp insert $w insert $tmp [lindex $res 0] if {$len > 1} { if {$::tkcon::OPT(showmultiple) && \ ![string compare [lindex $res 0] $str]} { puts stdout [lsort [lreplace $res 0 0]] } } } else { bell } return [incr len -1] } ## ::tkcon::ExpandPathname - expand a file pathname based on $str ## This is based on UNIX file name conventions # ARGS: str - partial file pathname to expand # Calls: ::tkcon::ExpandBestMatch # Returns: list containing longest unique match followed by all the # possible further matches ## proc ::tkcon::ExpandPathname str { # require at least a single character, otherwise continue if {$str eq ""} {return -code continue} set pwd [EvalAttached pwd] # Cause a string like {C:/Program\ Files/} to become "C:/Program Files/" regsub -all {\\([][ ])} $str {\1} str if {[catch {EvalAttached [list cd [file dirname $str]]} err]} { return -code error $err } set dir [file tail $str] ## Check to see if it was known to be a directory and keep the trailing ## slash if so (file tail cuts it off) if {[string match */ $str]} { append dir / } # Create a safely glob-able name regsub -all {([][])} $dir {\\\1} safedir if {[catch {lsort [EvalAttached [list glob $safedir*]]} m]} { set match {} } else { if {[llength $m] > 1} { global tcl_platform if {[string match windows $tcl_platform(platform)]} { ## Windows is screwy because it's case insensitive set tmp [ExpandBestMatch [string tolower $m] \ [string tolower $dir]] ## Don't change case if we haven't changed the word if {[string length $dir]==[string length $tmp]} { set tmp $dir } } else { set tmp [ExpandBestMatch $m $dir] } if {[string match */* $str]} { set tmp [string trimright [file dirname $str] /]/$tmp } regsub -all {([^\\])([][ ])} $tmp {\1\\\2} tmp set match [linsert $m 0 $tmp] } else { ## This may look goofy, but it handles spaces in path names eval append match $m if {[file isdirectory $match]} {append match /} if {[string match */* $str]} { set match [string trimright [file dirname $str] /]/$match } regsub -all {([^\\])([][ ])} $match {\1\\\2} match ## Why is this one needed and the ones below aren't!! set match [list $match] } } EvalAttached [list cd $pwd] return -code [expr {$match eq "" ? "continue" : "break"}] $match } ## ::tkcon::ExpandProcname - expand a tcl proc name based on $str # ARGS: str - partial proc name to expand # Calls: ::tkcon::ExpandBestMatch # Returns: list containing longest unique match followed by all the # possible further matches ## proc ::tkcon::ExpandProcname str { # require at least a single character, otherwise continue if {$str eq ""} {return -code continue} set match [EvalAttached [list info commands $str*]] if {[llength $match] == 0} { set ns [EvalAttached \ "namespace children \[namespace current\] [list $str*]"] if {[llength $ns]==1} { set match [EvalAttached [list info commands ${ns}::*]] } else { set match $ns } } if {[llength $match] > 1} { regsub -all {([^\\]) } [ExpandBestMatch $match $str] {\1\\ } str set match [linsert $match 0 $str] } else { regsub -all {([^\\]) } $match {\1\\ } match } return -code [expr {$match eq "" ? "continue" : "break"}] $match } ## ::tkcon::ExpandMethodname - expand an NSF/XOTcl method name based on $str # ARGS: str - partial proc name to expand # Calls: ::tkcon::ExpandBestMatch # Returns: list containing longest unique match followed by all the # possible further matches ## proc ::tkcon::ExpandMethodname str { # In a first step, obtain the typed-in cmd from the console set typedCmd [::tkcon::CmdGet $::tkcon::PRIV(console)] set obj [lindex $typedCmd 0] if {$obj eq $typedCmd} { # just a single word, can't be a method expansion return -code continue } # Get the full string after the object set sub [string trimleft [string range $typedCmd [string length [list $obj]] end]] if {[EvalAttached [list info exists ::nsf::version]]} { # Next Scripting Framework is loaded if {![EvalAttached [list ::nsf::object::exists $obj]]} {return -code continue} if {[string match ::* $sub]} { # NSF allows dispatch of unregistered methods via absolute # paths set cmd "concat \[info commands $sub*\] \[namespace children \[namespace qualifiers $sub\] $sub*\]" } else { set cmd [list $obj ::nsf::methods::object::info::lookupmethods -callprotection public -path -- $sub*] } } elseif {[EvalAttached [list info exists ::xotcl::version]]} { # XOTcl < 2.* is loaded if {![EvalAttached [list ::xotcl::Object isobject $obj]]} {return -code continue} set cmd [list $obj info methods $sub*] } else { # No NSF/XOTcl loaded return -code continue } set match [EvalAttached $cmd] if {[llength $match] > 1} { regsub -all {([^\\]) } [ExpandBestMatch $match $str] {\1\\ } bestMatch if {$str eq "" && [string match "* " $bestMatch]} { set match [linsert $match 0 ""] } else { regsub -all {\\ } $bestMatch { } bestMatch set match [linsert $match 0 [lindex $bestMatch end]] } } else { set match [lindex [lindex $match 0] end] } return -code break $match } ## ::tkcon::ExpandVariable - expand a tcl variable name based on $str # ARGS: str - partial tcl var name to expand # Calls: ::tkcon::ExpandBestMatch # Returns: list containing longest unique match followed by all the # possible further matches ## proc ::tkcon::ExpandVariable str { # require at least a single character, otherwise continue if {$str eq ""} {return -code continue} if {[regexp {([^\(]*)\((.*)} $str junk ary str]} { ## Looks like they're trying to expand an array. set match [EvalAttached [list array names $ary $str*]] if {[llength $match] > 1} { set vars $ary\([ExpandBestMatch $match $str] foreach var $match {lappend vars $ary\($var\)} return $vars } elseif {[llength $match] == 1} { set match $ary\($match\) } ## Space transformation avoided for array names. } else { set match [EvalAttached [list info vars $str*]] if {[llength $match] > 1} { regsub -all {([^\\]) } [ExpandBestMatch $match $str] {\1\\ } str set match [linsert $match 0 $str] } else { regsub -all {([^\\]) } $match {\1\\ } match } } return -code [expr {$match eq "" ? "continue" : "break"}] $match } ## ::tkcon::ExpandBestMatch2 - finds the best unique match in a list of names ## Improves upon the speed of the below proc only when $l is small ## or $e is {}. $e is extra for compatibility with proc below. # ARGS: l - list to find best unique match in # Returns: longest unique match in the list ## proc ::tkcon::ExpandBestMatch2 {l {e {}}} { set s [lindex $l 0] if {[llength $l]>1} { set i [expr {[string length $s]-1}] foreach l $l { while {$i>=0 && [string first $s $l]} { set s [string range $s 0 [incr i -1]] } } } return $s } ## ::tkcon::ExpandBestMatch - finds the best unique match in a list of names ## The extra $e in this argument allows us to limit the innermost loop a ## little further. This improves speed as $l becomes large or $e becomes long. # ARGS: l - list to find best unique match in # e - currently best known unique match # Returns: longest unique match in the list ## proc ::tkcon::ExpandBestMatch {l {e {}}} { set ec [lindex $l 0] if {[llength $l]>1} { set e [string length $e]; incr e -1 set ei [string length $ec]; incr ei -1 foreach l $l { while {$ei>=$e && [string first $ec $l]} { set ec [string range $ec 0 [incr ei -1]] } } } return $ec } # Here is a group of functions that is only used when Tkcon is # executed in a safe interpreter. It provides safe versions of # missing functions. For example: # # - "tk appname" returns "tkcon.tcl" but cannot be set # - "toplevel" is equivalent to 'frame', only it is automatically # packed. # - The 'source', 'load', 'open', 'file' and 'exit' functions are # mapped to corresponding functions in the parent interpreter. # # Further on, Tk cannot be really loaded. Still the safe 'load' # provedes a speciall case. The Tk can be divided into 4 groups, # that each has a safe handling procedure. # # - "::tkcon::SafeItem" handles commands like 'button', 'canvas' ...... # Each of these functions has the window name as first argument. # - "::tkcon::SafeManage" handles commands like 'pack', 'place', 'grid', # 'winfo', which can have multiple window names as arguments. # - "::tkcon::SafeWindow" handles all windows, such as '.'. For every # window created, a new alias is formed which also is handled by # this function. # - Other (e.g. bind, bindtag, image), which need their own function. # ## These functions courtesy Jan Nijtmans ## if {![llength [info commands tk]]} { proc tk {option args} { if {![string match app* $option]} { error "wrong option \"$option\": should be appname" } return "tkcon.tcl" } } if {![llength [info command toplevel]]} { proc toplevel {name args} { eval [linsert $args 0 frame $name] grid $name -sticky news } } proc ::tkcon::SafeSource {i f} { set fd [open $f r] set r [read $fd] close $fd if {[catch {interp eval $i $r} msg]} { error $msg } } proc ::tkcon::SafeOpen {i f {m r}} { set fd [open $f $m] interp transfer {} $fd $i return $fd } proc ::tkcon::SafeLoad {i f p} { global tk_version tk_patchLevel tk_library auto_path if {[string compare $p Tk]} { load $f $p $i } else { foreach command {button canvas checkbutton entry frame label listbox message radiobutton scale scrollbar spinbox text toplevel} { $i alias $command ::tkcon::SafeItem $i $command } $i alias image ::tkcon::SafeImage $i foreach command {pack place grid destroy winfo} { $i alias $command ::tkcon::SafeManage $i $command } if {[llength [info command event]]} { $i alias event ::tkcon::SafeManage $i $command } frame .${i}_dot -width 300 -height 300 -relief raised pack .${i}_dot -side left $i alias tk tk $i alias bind ::tkcon::SafeBind $i $i alias bindtags ::tkcon::SafeBindtags $i $i alias . ::tkcon::SafeWindow $i {} foreach var {tk_version tk_patchLevel tk_library auto_path} { $i eval [list set $var [set $var]] } $i eval { package provide Tk $tk_version if {[lsearch -exact $auto_path $tk_library] < 0} { lappend auto_path $tk_library } } return "" } } proc ::tkcon::SafeSubst {i a} { set arg1 "" foreach {arg value} $a { if {![string compare $arg -textvariable] || ![string compare $arg -variable]} { set newvalue "[list $i] $value" global $newvalue if {[interp eval $i info exists $value]} { set $newvalue [interp eval $i set $value] } else { catch {unset $newvalue} } $i eval trace variable $value rwu \{[list tkcon set $newvalue $i]\} set value $newvalue } elseif {![string compare $arg -command]} { set value [list $i eval $value] } lappend arg1 $arg $value } return $arg1 } proc ::tkcon::SafeItem {i command w args} { set args [::tkcon::SafeSubst $i $args] set code [catch "$command [list .${i}_dot$w] $args" msg] $i alias $w ::tkcon::SafeWindow $i $w regsub -all .${i}_dot $msg {} msg return -code $code $msg } proc ::tkcon::SafeManage {i command args} { set args1 "" foreach arg $args { if {[string match . $arg]} { set arg .${i}_dot } elseif {[string match .* $arg]} { set arg ".${i}_dot$arg" } lappend args1 $arg } set code [catch "$command $args1" msg] regsub -all .${i}_dot $msg {} msg return -code $code $msg } # # FIX: this function doesn't work yet if the binding starts with '+'. # proc ::tkcon::SafeBind {i w args} { if {[string match . $w]} { set w .${i}_dot } elseif {[string match .* $w]} { set w ".${i}_dot$w" } if {[llength $args] > 1} { set args [list [lindex $args 0] \ "[list $i] eval [list [lindex $args 1]]"] } set code [catch "bind $w $args" msg] if {[llength $args] <2 && $code == 0} { set msg [lindex $msg 3] } return -code $code $msg } proc ::tkcon::SafeImage {i option args} { set code [catch "image $option $args" msg] if {[string match cr* $option]} { $i alias $msg $msg } return -code $code $msg } proc ::tkcon::SafeBindtags {i w {tags {}}} { if {[string match . $w]} { set w .${i}_dot } elseif {[string match .* $w]} { set w ".${i}_dot$w" } set newtags {} foreach tag $tags { if {[string match . $tag]} { lappend newtags .${i}_dot } elseif {[string match .* $tag]} { lappend newtags ".${i}_dot$tag" } else { lappend newtags $tag } } if {[string match $tags {}]} { set code [catch {bindtags $w} msg] regsub -all \\.${i}_dot $msg {} msg } else { set code [catch {bindtags $w $newtags} msg] } return -code $code $msg } proc ::tkcon::SafeWindow {i w option args} { if {[string match conf* $option] && [llength $args] > 1} { set args [::tkcon::SafeSubst $i $args] } elseif {[string match itemco* $option] && [llength $args] > 2} { set args "[list [lindex $args 0]] [::tkcon::SafeSubst $i [lrange $args 1 end]]" } elseif {[string match cr* $option]} { if {[llength $args]%2} { set args "[list [lindex $args 0]] [::tkcon::SafeSubst $i [lrange $args 1 end]]" } else { set args [::tkcon::SafeSubst $i $args] } } elseif {[string match bi* $option] && [llength $args] > 2} { set args [list [lindex $args 0] [lindex $args 1] "[list $i] eval [list [lindex $args 2]]"] } set code [catch ".${i}_dot$w $option $args" msg] if {$code} { regsub -all .${i}_dot $msg {} msg } elseif {[string match conf* $option] || [string match itemco* $option]} { if {[llength $args] == 1} { switch -- $args { -textvariable - -variable { set msg "[lrange $msg 0 3] [list [lrange [lindex $msg 4] 1 end]]" } -command - updatecommand { set msg "[lrange $msg 0 3] [list [lindex [lindex $msg 4] 2]]" } } } elseif {[llength $args] == 0} { set args1 "" foreach el $msg { switch -- [lindex $el 0] { -textvariable - -variable { set el "[lrange $el 0 3] [list [lrange [lindex $el 4] 1 end]]" } -command - updatecommand { set el "[lrange $el 0 3] [list [lindex [lindex $el 4] 2]]" } } lappend args1 $el } set msg $args1 } } elseif {[string match cg* $option] || [string match itemcg* $option]} { switch -- $args { -textvariable - -variable { set msg [lrange $msg 1 end] } -command - updatecommand { set msg [lindex $msg 2] } } } elseif {[string match bi* $option]} { if {[llength $args] == 2 && $code == 0} { set msg [lindex $msg 2] } } return -code $code $msg } proc ::tkcon::RetrieveFilter {host} { variable PRIV set result {} if {[info exists PRIV(proxy)]} { if {![regexp "^(localhost|127\.0\.0\.1)" $host]} { set result [lrange [split [lindex $PRIV(proxy) 0] :] 0 1] } } return $result } proc ::tkcon::RetrieveAuthentication {} { package require Tk if {[catch {package require base64}]} { if {[catch {package require Trf}]} { error "base64 support not available" } else { set local64 "base64 -mode enc" } } else { set local64 "base64::encode" } set dlg [toplevel .auth] catch {wm attributes $dlg -type dialog} wm title $dlg "Authenticating Proxy Configuration" set f1 [frame ${dlg}.f1] set f2 [frame ${dlg}.f2] button $f2.b -text "OK" -command "destroy $dlg" pack $f2.b -side right label $f1.l2 -text "Username" label $f1.l3 -text "Password" entry $f1.e2 -textvariable "[namespace current]::conf_userid" entry $f1.e3 -textvariable "[namespace current]::conf_passwd" -show * grid $f1.l2 -column 0 -row 0 -sticky e grid $f1.l3 -column 0 -row 1 -sticky e grid $f1.e2 -column 1 -row 0 -sticky news grid $f1.e3 -column 1 -row 1 -sticky news grid columnconfigure $f1 1 -weight 1 pack $f2 -side bottom -fill x pack $f1 -side top -anchor n -fill both -expand 1 tkwait window $dlg set result {} if {[info exists [namespace current]::conf_userid]} { set data [subst $[namespace current]::conf_userid] append data : [subst $[namespace current]::conf_passwd] set data [$local64 $data] set result [list "Proxy-Authorization" "Basic $data"] } unset [namespace current]::conf_passwd return $result } proc ::tkcon::Retrieve {} { # A little bit'o'magic to grab the latest tkcon from CVS and # save it locally. It doesn't support proxies though... variable PRIV set defExt "" if {[string match "windows" $::tcl_platform(platform)]} { set defExt ".tcl" } set file [tk_getSaveFile -title "Save Latest tkcon to ..." \ -defaultextension $defExt \ -initialdir [file dirname $PRIV(SCRIPT)] \ -initialfile [file tail $PRIV(SCRIPT)] \ -parent $PRIV(root) \ -filetypes {{"Tcl Files" {.tcl .tk}} {"All Files" {*.*}}}] if {[string compare $file ""]} { package require http 2 set headers {} if {[info exists PRIV(proxy)]} { ::http::config -proxyfilter [namespace origin RetrieveFilter] if {[lindex $PRIV(proxy) 1] != {}} { set headers [RetrieveAuthentication] } } set token [::http::geturl $PRIV(HEADURL) \ -headers $headers -timeout 30000] ::http::wait $token set code [catch { set ncode [::http::ncode $token] set i 0 while {(($ncode >= 301) && ($ncode <= 307)) && [incr i] < 5} { # redirect to meta Location array set meta [::http::meta $token] ::http::cleanup $token if {![info exists meta(Location)]} { break } set url $meta(Location) if {![string match "http*" $url] && [regexp {https?://[^/]+} $PRIV(HEADURL) srvr]} { # attach the same http server info set url $srvr/$url } set token [::http::geturl $url -headers $headers -timeout 30000] ::http::wait $token set ncode [::http::ncode $token] } if {$ncode != 200} { return "expected http return code 200, received $ncode" } set status [::http::status $token] if {$status == "ok"} { set data [::http::data $token] regexp {Id: tkcon.tcl,v (\d+\.\d+)} $data -> rcsVersion regexp {VERSION\s+"(\d+\.\d+[^\"]*)"} $data -> tkconVersion if {(![info exists rcsVersion] || ![info exists tkconVersion]) && [tk_messageBox -type yesno -icon warning \ -parent $PRIV(root) \ -title "Invalid tkcon source code" \ -message "Source code retrieved does not appear\ to be correct.\nContinue with save to \"$file\"?"] \ == "no"} { return "invalid tkcon source code retrieved" } set fid [open $file w] # We don't want newline mode to change fconfigure $fid -translation binary puts -nonewline $fid $data close $fid } else { return "expected http status ok, received $status" } } err] ::http::cleanup $token if {$code == 2} { tk_messageBox -type ok -icon info -parent $PRIV(root) \ -title "Failed to retrieve source" \ -message "Failed to retrieve latest tkcon source:\n$err\n$PRIV(HEADURL)" } elseif {$code} { return -code error $err } else { if {![info exists rcsVersion]} { set rcsVersion "UNKNOWN" } if {![info exists tkconVersion]} { set tkconVersion "UNKNOWN" } if {[tk_messageBox -type yesno -icon info -parent $PRIV(root) \ -title "Retrieved tkcon v$tkconVersion, RCS $rcsVersion" \ -message "Successfully retrieved tkcon v$tkconVersion,\ RCS $rcsVersion. Shall I resource (not restart) this\ version now?"] == "yes"} { set PRIV(SCRIPT) $file set PRIV(version) $tkconVersion.$rcsVersion ::tkcon::Resource } } } } ## 'send' package that handles multiple communication variants ## # Try using Tk send first, then look for a winsend interp, # then try dde and finally have a go at comm namespace eval ::send {} proc ::send::send {args} { set winfoInterpCmd [list ::winfo interps] array set opts [list displayof {} async 0] while {[string match -* [lindex $args 0]]} { switch -exact -- [lindex $args 0] { -displayof { set opts(displayof) [Pop args 1] lappend winfoInterpCmd -displayof $opts(displayof) } -async { set opts(async) 1 } -- { Pop args ; break } default { return -code error "bad option \"[lindex $args 0]\":\ should be -displayof, -async or --" } } Pop args } set app [Pop args] if {[llength [info commands ::winfo]] && [lsearch -exact [eval $winfoInterpCmd] $app] > -1} { set cmd [list ::send] if {$opts(async) == 1} {lappend cmd -async} if {$opts(displayof) != {}} {lappend cmd -displayof $opts(displayof)} lappend cmd $app eval $cmd $args } elseif {[llength [info commands ::winsend]] && [lsearch -exact [::winsend interps] $app] > -1} { eval [list ::winsend send $app] $args } elseif {[llength [info commands ::dde]] && [lsearch -exact [dde services TclEval {}] \ [list TclEval $app]] > -1} { eval [list ::dde eval $app] $args } elseif {[package provide comm] != {} && [regexp {^[0-9]+$} [lindex $app 0]]} { #if {$opts(displayof) != {} && [llength $app] == 1} { # lappend app $opts(displayof) #} eval [list ::comm::comm send $app] $args } else { return -code error "bad interp: \"$app\" could not be found" } } proc ::send::interps {args} { set winfoInterpCmd [list ::winfo interps] array set opts [list displayof {}] while {[string match -* [lindex $args 0]]} { switch -exact -- [lindex $args 0] { -displayof { set opts(displayof) [Pop args 1] lappend winfoInterpCmd -displayof $opts(displayof) } -- { Pop args ; break } default { return -code error "bad option \"[lindex $args 0]\":\ should be -displayof or --" } } Pop args } set interps {} if {[llength [info commands ::winfo]]} { set interps [concat $interps [eval $winfoInterpCmd]] } if {[llength [info commands ::winsend]]} { set interps [concat $interps [::winsend interps]] } if {[llength [info commands ::dde]]} { set servers {} foreach server [::dde services TclEval {}] { lappend servers [lindex $server 1] } set interps [concat $interps $servers] } if {[package provide comm] != {}} { set interps [concat $interps [::comm::comm interps]] } return $interps } proc ::send::appname {args} { set appname {} if {[llength [info commands ::tk]]} { set appname [eval ::tk appname $args] } if {[llength [info commands ::winsend]]} { set appname [concat $appname [eval ::winsend appname $args]] } if {[llength [info commands ::dde]]} { set appname [concat $appname [eval ::dde servername $args]] } # comm? can set port num and local/global interface. return [lsort -unique $appname] } proc ::send::Pop {varname {nth 0}} { upvar $varname args set r [lindex $args $nth] set args [lreplace $args $nth $nth] return $r } ## ## end 'send' package ## special case 'tk appname' in Tcl plugin if {$::tkcon::PRIV(WWW)} { rename tk ::tkcon::_tk proc tk {cmd args} { if {$cmd == "appname"} { return "tkcon/WWW" } else { return [uplevel 1 ::tkcon::_tk [list $cmd] $args] } } } ## ::tkcon::Resource - re'source's this script into current console ## Meant primarily for my development of this program. It follows ## links until the ultimate source is found. ## proc ::tkcon::Resource {} { uplevel \#0 { if {[catch {source -rsrc tkcon}]} { source $::tkcon::PRIV(SCRIPT) } } Bindings InitSlave $::tkcon::OPT(exec) } ## Initialize only if we haven't yet, and do other stuff that prepares to ## run. It only actually inits (and runs) tkcon if it is the main script. ## proc ::tkcon::AtSource {} { variable PRIV # the info script assumes we always call this while being sourced set PRIV(SCRIPT) [info script] if {!$PRIV(WWW) && [string length $PRIV(SCRIPT)]} { if {[info tclversion] >= 8.4} { set PRIV(SCRIPT) [file normalize $PRIV(SCRIPT)] } else { # we use a catch here because some wrap apps choke on 'file type' # because TclpLstat wasn't wrappable until 8.4. catch { while {[string match link [file type $PRIV(SCRIPT)]]} { set link [file readlink $PRIV(SCRIPT)] if {[string match relative [file pathtype $link]]} { set PRIV(SCRIPT) \ [file join [file dirname $PRIV(SCRIPT)] $link] } else { set PRIV(SCRIPT) $link } } catch {unset link} if {[string match relative [file pathtype $PRIV(SCRIPT)]]} { set PRIV(SCRIPT) [file join [pwd] $PRIV(SCRIPT)] } } } } # normalize argv0 if it was tkcon to ensure that we'll be able # to load slaves correctly. if {[info exists ::argv0] && [info script] == $::argv0} { set ::argv0 $PRIV(SCRIPT) } if {(![info exists PRIV(root)] || ![winfo exists $PRIV(root)]) \ && ([info exists ::argv0] && $PRIV(SCRIPT) == $::argv0)} { global argv if {[info exists argv]} { eval ::tkcon::Init $argv } else { ::tkcon::Init } } } tkcon::AtSource package provide tkcon $::tkcon::VERSION ./tkcon/tkcon-console.desktop0000644000175000017500000000025711326716364016035 0ustar sergeisergei[Desktop Entry] Encoding=UTF-8 Name=tkcon GenericName=Tk console Comment=Tk console Exec=tkcon Icon=tkcon-icon Terminal=false Type=Application Categories=Development;Utility; ./tkcon/pkgIndex.tcl0000644000175000017500000000062311652543332014131 0ustar sergeisergei# pkgIndex.tcl to use tkcon as a package via 'package require tkcon' # # 'tkcon show' will do all that is necessary to display tkcon # # Defaults to: # * the main interp as the "slave" # * hiding tkcon when you click in the titlebar [X] # * using '.tkcon' as the root toplevel # * not displaying itself at 'package require' time # package ifneeded tkcon 2.7 [list source [file join $dir tkcon.tcl]] ./tkcon/install-desktop-menu.sh0000755000175000017500000000202411326716364016274 0ustar sergeisergei#!/bin/sh # # To install a tkcon entry into a FreeDesktop.org compatible menu system such # as used by GNOME, KDE or most modern X11 desktop environments the tkcon.desktop # and icons/* files are installed. This should be done using the xdg-desktop-menu # utility and xdg-icon-resource utility from the xdg-utils package. See # http://portland.freedesktop.org/xdg-utils-1.0/ for further details. # PROG_XDG_DESKTOP_MENU=`which xdg-desktop-menu` PROG_XDG_ICON_RESOURCE=`which xdg-icon-resource` ICONFILE=icons/tkcon-small48.png if [ -x $PROG_XDG_DESKTOP_MENU -a -x PROG_XDG_ICON_RESOURCE ] then $PROG_XDG_DESKTOP_MENU install tkcon-console.desktop $PROG_XDG_ICON_RESOURCE install --size 48 $ICONFILE tkcon-icon else [ -d $HOME/.local/share/applications ] || mkdirhier $HOME/.local/share/applications [ -d $HOME/.local/share/icons ] || mkdirhier $HOME/.local/share/icons install tkcon-console.desktop $HOME/.local/share/applications/tkcon-console.desktop install $ICONFILE $HOME/.local/share/icons/tkcon-icon.png fi ./tkcon/index.html0000755000175000017500000000415011151630377013653 0ustar sergeisergei Enhanced Tk Console: tkcon
Enhanced Tk Console: tkcon SourceForge Logo
Documentation Screenshot Online Demo! (requires Tk plugin) License
tkcon Release Archives

Latest Release is 2.5 (2009-02-26)

You can grab the latest sources from the tkcon CVS repository.

tkcon is a replacement for the standard console that comes with Tk (on Windows/Mac, but also works on Unix). The console itself provides many more features than the standard console. tkcon works on all platforms where Tcl/Tk is available. It is meant primarily to aid one when working with the little details inside tcl and tk, giving Unix users the GUI console provided by default in the Mac and Windows Tk. It's also not a bad replacement for the default MS-DOS shell (although it needs lots of fine tuning).

© Jeffrey Hobbs (jeff at hobbs dot org)
./tkcon/README.txt0000644000175000017500000000315611174406737013364 0ustar sergeisergeiWHAT: Enhanced Tk Console for all Tk platforms WHERE: http://tkcon.sourceforge.net/ http://www.purl.org/net/hobbs/tcl/script/ REQUIREMENTS: Tcl/Tk 8.4+ Tested through Tcl/Tk 8.6. tkcon is all Tcl/Tk code, no compiling required tkcon is a replacement for the standard console that comes with Tk (on Windows/Mac, but also works on Unix). tkcon provides many more features than the standard console and works on all platforms where Tcl/Tk is available. It is meant primarily to aid one when working with the little details inside tcl and tk and to give Unix users the GUI console provided by default in the Mac and Windows Tk. FEATURES: Command history Path (Unix style) / Proc / Variable name expansion Multiple and tabbed consoles, each with its own state (via multiple interpreters) Captures stdout and stderr to console window (puts overridden) Hot errors (click on error result to see stack trace) Electric character matching (a la emacs) Electric proc highlighting Enhanced history searching Configurable Cut / Copy / Paste between windows (interoperates with native platform) Communication between consoles and other Tk interpreters (including non-tcl ones) Works on all Tk platforms CONTACT: Jeffrey Hobbs, jeff at hobbs dot org GETTING STARTED: tkcon is a single drop-in file. On Windows, I place this on the desktop and double-click on it instead of wish/tclsh. On Unix and OS X, I place it in a directory on my path and run this instead of wish. Documentation can be reading by starting with index.html in the docs/ subdirectory. Happying Tcl'ing! ./tkcon/ChangeLog0000644000175000017500000005137212611532420013425 0ustar sergeisergei2015-10-20 Jeff Hobbs * tkcon.tcl (edit): prevent file edit from undoing loading of file [Bug #52] (budyak) 2014-09-09 Jeff Hobbs * tkcon.tcl (::tkcon::SaveHistory): save history at each command to prevent loss during abnormal termination. [bachmann] 2014-07-09 Jeff Hobbs * tkcon.tcl (idebug): allow multi-char patterns as debug id [Lama] 2013-01-22 Jeff Hobbs * tkcon.tcl (tkcon show): catch deiconify as it will throw an error if tkcon is embedded. 2012-12-27 Jeff Hobbs * tkcon.tcl (edit): add support for ::tkcon::OPT(tabspace) to adjust tab spacing in edit window (default: 8). [Bug #7] * tkcon.tcl (::tkcon::Bindings): minimal patch for 8.6b3+ event compatibility. Larger patch to come that addresses shift towards virtual events in core widgets. [Bug #48] (gollwitzer) * docs/{dump.man,tkcon.1.man,tkconc.5.man}: make dtplite happy for the docs [Bug #47] * tkcon.tcl (::tkcon::Init): update to use latest /viewvc/tkcon url to retrieve head version of tkcon. * tkcon.tcl (::tkcon::InitUI): catch deiconify to prevent error when embedding. [Bug #44] * tkcon.tcl (::tkcon::ExpandMethodname): improved expansion for xotcl methods. Also enhance expansion to allow break/continue signals to differentiate "I'm not responsible" results from "I don't have any results". (neumann) * tkcon.tcl (::tkcon::InitInterp): correct sending tkcon commands to user created interps [Bug #42] (kuhn) 2012-03-06 Jeff Hobbs * tkcon.tcl (idebug): better line handling to not use list functions. [Bug 111462] (goth) (tkcon): pass any init args to 'tkcon show' 2011-10-28 Jeff Hobbs * pkgIndex.tcl: update to v2.7 * tkcon.tcl: Improve UI to work on OS X. Adjust some dialogs, use Command- instead of Control- bindings on OS X. Handle right click properly. * docs/license.terms: removed outdated restricted rights section. 2010-01-24 Pat Thoyts * icons/*: Added an SVG icon and .desktop file suitable * tkcon-console.desktop: for use installing tkcon into the desktop * install-desktop-menu.sh: menus on a unix desktop. Also an install * tkcon.tcl: script to show how it is done. And for use with 8.6 on X11 - if we can locate the icon, use it as the tkcon iconphoto so it shows up associated with the running app. 2010-01-23 Pat Thoyts * tkcon.tcl: Make use of the extended window manager hints from tip 359 on unix for all the dialog windows. 2009-04-24 Jeff Hobbs * tkcon.tcl: override 8.5 [chan puts|gets]. [Bug 1876707] * tkcon.tcl: update pre-8.4 private text binding refs * tkcon.tcl: clean up cmd global var used [Bug 2441583] * tkcon.tcl (::tkcon::Retrieve): support http code redirect for downloading latest version. [Bug 1755500] * README.txt, docs/limits.html, docs/nontcl.html: bump to 2.6 * pkgIndex.tcl, tkcon.tcl: Use Tcl 8.4 code style. 2009-02-26 Jeff Hobbs **** TKCON 2.5 TAGGED FOR RELEASE **** * index.html, docs/*.html: update links and references 2009-02-25 Jeff Hobbs * docs/tkcon.html, docs/tkcon.n.man: add tkcon resultfilter docs. 2008-02-07 Jeff Hobbs * tkcon.tcl (::tkcon::Bindings): prevent Expand virtual events from triggering follow-on events (most important for ). (::tkcon::Retrieve): remove extraneous http::geturl call. 2007-06-22 Jeff Hobbs * tkcon.tcl (::tkcon::EvalCmd): add OPT(resultfilter) and 'tkcon resultfilter ?cmd?' to allow optional result filter command. Command will be passed result code and data and must return what tkcon will return to the user. Command is run in attached slave. Ensure that initial files are sources at level #0. Convert args after (--|-argv|-args) into slave arguments and set them as the main $::argv/$::argc for propagation. 2007-06-21 Jeff Hobbs * docs/tkcon.1.man, docs/tkcon.n.man, docs/tkconrc.5.man (new): * docs/dump.n.man, docs/observe.n.man, docs/idebug.n.man (new): * index.html, docs/demopic.gif (removed), docs/demopic.png (new): * docs/plugin.html, docs/start.html, docs/tkcon.html: Updated docs and added doctools equivalents courtesy Sergei Golovan * docs/style.css: updated stylesheet 2007-04-04 Jeff Hobbs *** BUMPED TO VERSION 2.5 *** * tkcon.tcl: ensure option overrides only effect tkcon and subwidgets. (edit): Add -wrap option to 'edit' command. (::tkcon::AtSource): adjust argv0 existence check 2006-09-05 Jeff Hobbs * tkcon.tcl (::tkcon::NewTab, ::tkcon::GetSlave): ensure that new tabs in other toplevel tkcon windows are built in the correct slave hierarchy. * pkgIndex.tcl: sample pkgIndex.tcl that allows using tkcon as a package. * tkcon.tcl (::tkcon::InitSlave): adjust to make the first file passed in to be argv0 in the slave 2006-08-25 Jeff Hobbs * tkcon.tcl (tkcon): default wm protocol to hide tkcon when used in embedded context. 2006-08-23 Jeff Hobbs * tkcon.tcl: remove use of -exact in package require Tk 2006-06-29 Jeff Hobbs * tkcon.tcl: updated to handle ttk scrollbars as well as other UI cleanup. 2006-06-15 Jeff Hobbs * tkcon.tcl: modify CVS location after SF changes * README.txt: correct reference email address 2006-02-28 Jeff Hobbs * tkcon.tcl (tkcon): update 'gets stdin' override (tkcon congets) to support usage at script load time. (decoster) 2006-01-25 Jeff Hobbs * tkcon.tcl (MenuConfigure): Fix ActiveTcl Help link when pointing to a file with space in path. [Bug 1408425] (::tkcon::Save, ::tkcon::Load): in VFS paths, use the X11 dialogs that support viewing in VFS dirs. 2005-09-12 Jeff Hobbs * tkcon.tcl (::tkcon::AtSource): do not require argv to be defined (edit): enable text -undo in editor (::tkcon::InitUI): shrink aqua resize control space alloted 2005-07-14 Jeff Hobbs * tkcon.tcl: add ::tkcon::OPT(maxlinelen) (default 0 == unlimited) and 'tkcon linelength ?value?' to optionally limit long result lines. True result is still captured in $_ (and 'puts $_' works). 2005-05-25 Jeff Hobbs * tkcon.tcl (InitMenus): add ActiveTcl Help menu item, if AT Help is found. 2005-04-06 Jeff Hobbs * tkcon.tcl (ExpandXotcl): allow for xotcl method name expansion, if you change ::tkcon::OPT(expandorder) to include Xotcl before Procname 2005-02-21 Jeff Hobbs * tkcon.tcl (::send::send): propagate -displayof to winfo interps call. [Bug 1124369] (mbec) 2004-11-17 Jeff Hobbs * tkcon.tcl (::tkcon::ExpandVariable): correct array keyname expansion. [Bug 1004508] (bold) 2004-11-12 Jeff Hobbs * tkcon.tcl (::tkcon::EvalSocket): pass sock arg. (allaert) 2004-11-11 Jeff Hobbs * tkcon.tcl (::tkcon::DeleteTab): allow for exit code to be passed when exit is aliased to DeleteTab. [Bug 1064462] (::tkcon::Expect): graphicsSet isn't valid yet 2004-10-10 Jeff Hobbs * tkcon.tcl (::tkcon::Highlight): use ctext for the 'edit' dialog if available 2004-07-26 Jeff Hobbs **** TKCON 2.4 TAGGED FOR RELEASE **** * index.html, docs/*.html: remove email links, update 2.4 info * docs/plugin.html: update plugin page embed code 2004-06-24 Jeff Hobbs * tkcon.tcl (DeleteTab, Destroy): improve the 'exit' handling so that 'exit' in the first created tab doesn't do a full exit. 'exit' in the last tab of the first created console still exits tkcon, fixing that requires a rearch of the console creation/management. (InitTab): Have the binding only fire for the root window, not for each tab. (GotoTab): Keep tabs around - just raise/lower instead of grid remove/add. break on Next/Prev Tab binding to get focus right. (Prompt): return if console w doesn't exist 2004-06-10 Jeff Hobbs * tkcon.tcl: add [X] tab delete button and Console -> Delete Tab menu item. [Bug 970785] 2004-05-12 Jeff Hobbs * tkcon.tcl (observe): allow observe of 'proc' 2004-03-20 Jeff Hobbs * tkcon.tcl (::tkcon::EvalSocketEvent): correctly handle socket events after attachment changes 2004-03-01 Jeff Hobbs * tkcon.tcl: correct 'exit' in extra tabs. make tkconfixed font Courier -12 (was Courier 10), use it on unix. Add extra space for OS X/Aqua in statusbar (for resize handle). Only use -overrelief in 8.4 2004-02-12 Jeff Hobbs * tkcon.tcl (::tkcon::InitUI): check existence of tcl_platform(os) as it doesn't exist in the Tcl plugin. Show Attach info in tab text, maintain namespace attachment between console switches. (::tkcon::InterpEval, Interps): beware safe interps with Tk 2004-02-05 Jeff Hobbs * tkcon.tcl: brought code back to 8.0 compatability. Use $_ as last cached result var (was ${}). Ensure hoterrors garbage collection occurs across all tabs. 2004-01-29 Jeff Hobbs * tkcon.tcl: first whack at tabbed consoles 2004-01-28 Jeff Hobbs * tkcon.tcl: don't use menu tearoffs remove recognizable email addresses from source enabled more send variants (comm, dde, winsend) [bug 649257] (thoyts) change Packages menu (that would be too large with many packages) to a Manage Packages dialog. tightened up Create Socket dialog, added dismiss binding. Moved source time initialization into ::tkcon::AtSource to guard against leftover vars and just better encapsulate it. (::tkcon::Retrieve): correct retrieve URL and add intelligence to sense whether what we retrieved is correct before overwriting file. 2003-11-18 Jeff Hobbs * tkcon.tcl (::tkcon::InitSlave): remove tk_library from the seeded auto_path. Do not add OPT(library) to auto_path if it is "". 2003-11-04 Jeff Hobbs * tkcon.tcl (::tkcon::EvalSocketClosed): use tk_messageBox instead of tk_dialog 2003-10-06 Jeff Hobbs * tkcon.tcl (dir): use %9ld instead of %9d to support large files 2003-04-08 Jeff Hobbs * tkcon.tcl (::tkcon::InitUI): WinCE code to resize the window to fit on the small screen 2003-03-31 Jeff Hobbs * tkcon.tcl (tkcon::Retrieve): correct the check for tkcon version when retrieving from http. 2003-02-20 Jeff Hobbs * tkcon.tcl (EvalCmd): set $:: (aka ${}) var to last command result. (EvalOther): use tk_messageBox instead of tk_dialog (Init): allow 'edit' to be overridden using OPT(edit) 2003-01-13 Jeff Hobbs * tkcon.tcl: add tk appname alias in WWW plugin case. 2002-10-08 Jeff Hobbs * tkcon.tcl (tcl_unknown): allow ::namespace (:'s) to be recognized. (koloska) (MainInit): add option for overriding exit command. (InitUI): add option to control the wm protocol for WM_DELETE_WINDOW. 2002-10-01 Jeff Hobbs * tkcon.tcl (InterpEval): correctly handle no args case. (New): autoload tbcload when it exists. 2002-06-22 Jeff Hobbs * tkcon.tcl: call Init with eval to break out argv into args. 2002-06-04 Jeff Hobbs * tkcon.tcl (Init): convert env(home) from 'C:' to 'C:/' if necessary. 2002-06-03 Jeff Hobbs * tkcon.tcl: fixed Retrieve to use the proxy info (Thoyts). Added code so that tkcon.tcl can be sourced in and used like a quasi-package. Once sourced, you can do a 'package require tkcon' (there is no pkgIndex.tcl for it), and the first 'tkcon show' will initialize anything that is needed. (observe): corrected variables tracing to not allow duplicates. (dump): improved check for empty named arrays as well as locally aliased vars in var dumps. Use the 'fixed' font on unix by default. 2002-02-22 Jeff Hobbs * tkcon.tcl (AddSlaveHistory): changed history to not add the command if it is the same as the previous command (it will still be evaluated). (soderstrom) Added panedwindow and labelframe as recognized Tk commands. 2002-01-24 Jeff Hobbs **** TKCON 2.3 RELEASE **** * tkcon.tcl: bumped to v2.3 2002-01-23 Jeff Hobbs * docs/procs.html: * tkcon.tcl (what): changed to differentiate between 'array' and 'scalar' instead of just returning 'variable'. (which): called what in uplevel to get scope right. 2002-01-22 Jeff Hobbs * tkcon.tcl (ExpandPathname): use a safer regsub to first unescape the str, then to protect it in the glob. (dir): Use -directory arg in 8.3+ for better results. * docs/idebug.html: added note about ? help at debug prompt. * tkcon.tcl (dir): prevented possible 'divide by zero' error. [Bug #496584] (Expand*): fixed ExpandPathname to better handle spaced pathnames. [Bug #497079] 2001-12-14 Jeff Hobbs * tkcon.tcl: 'tkcon show' causes loss of focus on Windows, so an extra focus to the console was added. 2001-12-12 Jeff Hobbs * tkcon.tcl (EvalSocketEvent): changed EvalSocketClosed to only occur after gets, then eof check. (Gerold Jury) 2001-11-14 Jeff Hobbs * tkcon.tcl: added catch around file type call 2001-10-14 Jeff Hobbs * tkcon.tcl (Init): corrected loading of rcfile when it was in a path including spaces. (siltberg) (About): clarified CVS info in about box. * docs/start.html: correct old refs to TKCON var. 2001-09-28 Jeff Hobbs * tkcon.tcl (ExpandPathname): recognize NT as a case *in*sensitive file system for pathname expansion. 2001-08-31 Jeff Hobbs * tkcon.tcl (InitSlave): propagate auto_path from master to slave. 2001-08-24 Jeff Hobbs * tkcon.tcl (NewSocket, NewDisplay): when nothing is specified, just return. (Display): fixed connecting to interps on other displays. 2001-08-22 Jeff Hobbs * docs/bindings.html: noted ^r/^s change. * tkcon.tcl (Event): changed event ^r/^s searching to search for any matching substring, and blink the substring. Added statusbar, default off (not much in status yet). 2001-08-20 Jeff Hobbs * tkcon.tcl (EvalNamespace): fixed to work when attached to a foreign interpreter. [Bug #453431] Added fix that allows access to Tk privates in 8.4. Still needs a long-term fix. [Bug #450865] (porter) 2001-08-03 Jeff Hobbs * tkcon.tcl (EvalCmd): protected against non-existent tkPriv(mouseMoved) variable 2001-07-05 Jeff Hobbs * tkcon.tcl (RetrieveFilter, RetrieveAuthentication): added support for retrieving latest tkcon via a proxy. (Thoyts) 2001-07-04 Jeff Hobbs * tkcon.tcl (tkcon): made tkcon console return whatever result it received. Fixed Bug #438281. 2001-06-20 Jeff Hobbs TKCON 2.2 RELEASE * README.txt: * index.html: * docs/index.html: updated for 2.2 release * tkcon.tcl (InitUI): moved wm protocol inside check to not run under plugin. (::tkcon::Retrieve): added a new method to allow tkcon to retrieve the latest version of itself. 2001-06-19 Jeff Hobbs * tkcon.tcl (dir): added fallback in generic dir command to not require being run in tkcon. (Init): Changed around how all options are initialized to allow for tkcon embedders to set their own defaults. Added a usehistory PRIV key that tells us whether to load/save history files. Added showOnStartup PRIV key to control whether tkcon should deiconify itself on startup. Changed setting root to .tkcon to ensure that root was just . before. 2001-06-18 Jeff Hobbs * tkcon.tcl: (InitUI) added WM_DELETE_WINDOW hook to exit to correctly deconstruct slave consoles. (tkcon congets/getc) added tkcon show to ensure that tkcon would be displayed when input is expected. (GetSelection) new command to handle getting selection, this supports the new UTF8_STRING type. (InitMenus) added version check around Attach to Socket menu, as 8.3 is need for the file channels call. 2001-05-28 Jeff Hobbs * docs/start.html: added note about ::tkcon::OPT(gets) var. * docs/tkcon.html: improved docs for tkcon *get* methods. * tkcon.tcl: reinstituted override of gets by default to use the tkcon console based gets. * tkcon.tcl (dump): corrected outputting local vars with dump. Added RCS info to PRIV array and About box. (tkcon congets) corrected congets to set the limit and insert properly to return data without needing to call the prompt. (tkcon set) corrected to return [array get] string for arrays, and scalar value for vars. Placed exact level value to all calls to uplevel and upvar. 2001-05-17 Jeff Hobbs * tkcon.tcl: make check for actual tkcon root existence to allow for setting the var ($::tkcon::PRIV(root)) in controlling apps to better control the root window. 2001-05-04 Jeff Hobbs TKCON 2.1 RELEASE * docs/style.css: new file for html files to use. * README.txt: * index.html: * doc/*: updated for 2.1 release. * tkcon.tcl: allowed 'tkcon font ...' and 'tkcon buffer ...' to work before the main console have been created. Changed "TkCon" -> "tkcon", updated for new release. 2001-03-28 Jeff Hobbs * tkcon.tcl (::tkcon::Init): added safe interp check around 'cd' call for Macs 2000-10-30 Jeff Hobbs * tkcon.tcl (dir): fixed bug where permissions wouldn't print correctly if user had no permissions. (kuchler) 2000-10-18 Jeff Hobbs * tkcon.tcl (::tkcon::NamespacesList): corrected to not use window starting with an uppercase letter (error). (reins) 2000-09-27 Jeff Hobbs * tkcon.tcl (::tkcon::About): added 'variable COLOR' decl (Zaers). 2000-09-20 Jeff Hobbs * tkcon.tcl (InitMenus): restricted the Attach Socket functionality to Tcl 8.3+ due to use of [file channels]. (InitUI): fixed Configure binding to use correct namespace for OPT (EvalSocket, EvalSend, EvalAttached): cleaned up to require that they accept only one arg as the command string to be evaluated. Prior behavior left some ambiguity as to what was eval'ed where. EvalOther, EvalSlave may need some sanitation as well. (EvalCmd): Changed EvalSocket functionality to have the \'s substituted before sending data, to allow for special chars to be added to the string. 2000-09-19 Jeff Hobbs * tkcon.tcl (::tkcon::InitUI): corrected plugin handling, as 'wm withdraw' worked, but 'wm deiconify' was disallowed. * docs/plugin.html: updated link to plugin source * docs/changes.txt: noted that changes.txt is no longer updated in favor of this ChangeLog * index.html: updated page with sourceforge links * index.html: added toplevel html index doc * tkcon.tcl: updated v2.0 to v2.1 alpha version All tkcon procedures have been namespaced, except for the ones that are visible to the user. TkCon has added the ability to attach to other displays or a socket. * tkcon.tcl: updated v1.6 to v2.0 version, tagged tkcon-2-0 This is the first version to require 8.0+ to run, although it will still connect to older interps. * tkcon.tcl: updated v1.5 to v1.6 version, tagged tkcon-1-6 * tkcon.tcl: updated v1.4 to v1.5 version, tagged tkcon-1-5 * tkcon.tcl: updated v1.3 to v1.4 version, tagged tkcon-1-4 * tkcon.tcl: updated v1.2 to v1.3 version, tagged tkcon-1-3 * tkcon.tcl: updated v1.1 to v1.2 version, tagged tkcon-1-2 * tkcon.tcl: updated v1.03 to v1.1 version, tagged tkcon-1-1 * tkcon.tcl: updated v1.02 to v1.03 version, tagged tkcon-1-03 * tkcon.tcl: updated v0.71 to v1.02 version, tagged tkcon-1-02 * tkcon.tcl: updated v0.69 to v0.71 version, tagged tkcon-0-71 * tkcon.tcl: updated v0.68 to v0.69 version, tagged tkcon-0-69 * tkcon.tcl: updated v0.67 to v0.68 version, tagged tkcon-0-68 * tkcon.tcl: updated v0.66 to v0.67 version, tagged tkcon-0-67 * tkcon.tcl: updated v0.65 to v0.66 version, tagged tkcon-0-66 * tkcon.tcl: updated v0.64 to v0.65 version, tagged tkcon-0-65 * tkcon.tcl: updated v0.63 to v0.64 version, tagged tkcon-0-64 * tkcon.tcl: updated v0.52 to v0.63 version, tagged tkcon-0-63 * ChangeLog: added a ChangeLog