[ET] 2023-12-27 cooltip 1.6

This is an upgrade to '''tooltip 1.6''' found in the '''Tklib'''. It supports tips with 7 configurable color text tags and 3 styles. Another 9 extra tags can be configured by program control for advanced use. A separate '''GUI''' editor is included to build cool tips with style. Unicode up to \uFFFF is supported.

It is upwards compatible with existing tooltip code, as it uses the same namespace, tooltip:: and the same commands, including the configuration options from the latest tooltip version 1.6. The Tooltip 1.6 options for -index, -items, -tag, and -tab can be added as specified in the tooltip 1.6 manual.


https://www.amazon.com/photos/shared/_sI94t9zRtGkEcmi-DMQqQ.OOsisst3y_EaLh8bkoiBFY%|%Screen Shot%|%

----
===
Quick test drive:
===
   1. Expand the first discussion below, scroll to the code block and click the copy button in the upper right corner.
   2. Create a file '''cooltip-1.6.tm''' and paste in the code and save the file in a new directory.
   3. Repeat for the second discussion, name the file '''cool.tcl'''
   4. '''cd''' to the directory containing the 2 files, and run: '''wish cool.tcl'''
   5. You should see 2 windows, the cooltip GUI and a console. Hover the mouse over the various buttons in the cooltip GUI window. 
   6. Read ahead for more information or click exit in the console or close the GUI window.

----

===

See here for the documentation on tooltip 1.6:

https://core.tcl-lang.org/tklib/doc/trunk/embedded/md/tklib/files/modules/tooltip/tooltip.md
===
Cooltip is bundled with a GUI tip builder to build more stylish tips. The tip builder also demonstrates the kinds of tips that can be built using the tool. The cooltip 1.6 package is assumed to be a '''Tcl module''' and should therefore be placed in a file named: 
===
cooltip-1.6.tm
===
The GUI builder assumes that it and the cooltip module are in the same directory and is run with a '''wish file.tcl''' command. It uses [[info script]] to know where it and the cooltip module reside. It can have any name, but must be able to find the cooltip module.

Cooltip works with 2 types of tips, but uses the same command. The options are those from tooltip 1.6 used to designate such things as menu index, text widget tags, listbox items, and ttk::notebook tabs.
===
tooltip::tooltip <widget> ?options?  <tip>
===
If <tip> is a regular text string, then it should work the same as with tooltip 1.6. One builds a styled tip using the GUI builder, and when ready for use clicks the copy button. This will create the tip text as a '''text widget dump''' assigned to a variable with a 

===
'''set tooltipN {##<widget dump>}''' 
===

statement and places it onto the clipboard. Then <tip> would be '''$tooltipN''' rather than a litteral text string. N can be any text. A styled tip text is prefixed with ## to differentiate it from a non-styled tip.

This can then be pasted from the clipboard into the user program, possibly replacing an earlier version. To re-edit one copies this set statement and pastes it back into the GUI builder. This eliminates any need for intermediate files. However, the GUI is also able to save to and load from a pair of fixed filenames (in the [[pwd]] directory) for quick backups of text and configuration settings. 

If the user does any '''advanced configuration''' of the text tags, these are saved in the 2nd file of the pair as a single tcl source-able statement; this can be simply added to the user program if they were changed in the GUI console. The Config settings apply to all tips, so the config is not saved with each individual tip. 

All unicode chars inserted by the builder, are reverted back to their \uXXXX escapes before copied to the clipboard for pasting into the program.

When pasted back into the GUI builder it will parse the set statement extracting the text dump re-creating the tip in its text window. The GUI builder uses the Tk text widget, and so supports all the standard shortcuts. It also handles undo (control-z) but only the text, not the attributes. On windows, redo is control-y and shift-control-z on linux. In addition, a control-wheel will increase or decrease the config value for the font.

'''Note''': the GUI program's copy/paste buttons (on the menubar) are not raw copy/paste, but specialized to work only on the '''set''' statements exclusively. Regular copy/paste is supported by the text widget shortcuts (control-c/control-v).

[ET] 1/13/2024 - recent changes - mirror changes in the tooltip widget config (when entering config changes via the console window) into the editor widget and added the control-mousewheel for font size zooming. Load and Save should also remember any config changes too. New is the configure option with a dialog to configure most attributes of each color 1/14/2024. Reworked the clear command, added awdark if available 1/15. And fixed console on linux code for 9.0. Font chooser in configure. Bug fix, performance fix. 1/18
----

The '''user program''' would either find the cooltip module in a known module directory with a simple '''package require cooltip''', or similar to '''auto_path''', use the module command '''tcl::tm::path add <path>''' to let the package command find the module in the <path> folder specified. 

A user program could also just '''source''' the module or even simply '''embed''' it into the program (it's relatively small at ~800 lines). The GUI builder is not needed at runtime in the target user program.
----
Below in the discussion is the cooltip module, which as mentioned, should be named cooltip-1.6.tm and placed in either a known module directory, or in the same directory with the GUI builder that follows.

<<discussion>>
In most cases, the built in 7 colors and 3 styles with a single font should be sufficient for most tool tips. However, using the config option one can create very elaborate tips using multiple fonts, colors, and other attributes. For example, superscripts can be created using a smaller font with the -offset option.

Cooltip also includes 2 config options, -extraw and -extrah to increase the width and height of all tooltips and defaults to 0. In addition to the 7 colors, which can be configured if desired (e.g. to change the actual color) there are 9 extra tags grey51..grey59 which are available for full configuration using any option for a text widget tag. These are not used by the GUI program so changing them won't interfere with its own tips. When text is changed to one of those colors, it will have a grey background and when hovering over with the mouse pointer, a tooltip will identify the color assigned. 

When using a '''tooltip::tooltip config''' with no options, it will output all the current values. The color options can also include other attributes, such as -font as well as modifications to the color itself (e.g. note how -grey is actually set to grey80). Each option value is a list of text widget tag options. To remove a tag option, set to {}.

The GUI builder also includes an enhanced console for windows and linux. When it starts up, it pre-loads the history with a few sample configuration commands that can be retrieved and edited using the up arrow key. This provides a way to test config's of say the 9 grey5n tags with a quick feedback using the GUI's ->test widget.

In the below sample commands entered into the GUI's console, one can see all the config settings and change of grey51's font and relief settings. One could then select text and assign it to color grey51 which would also modify the other attributes.
===
% tooltip::tooltip config
-foreground black -background lightyellow -font {FixedSys 10} -red {-foreground red} -green {-foreground green} -blue {-foreground lightblue}
 -orange {-foreground orange} -violet {-foreground violet} -black {-foreground black} -grey {-foreground grey80} -grey51 {-background grey90 
-foreground black -selectbackground lightblue} -grey52 {-background grey90 -foreground black -selectbackground lightblue} -grey53 {-background 
grey90 -foreground black -selectbackground lightblue} -grey54 {-background grey90 -foreground black -selectbackground lightblue} -grey55
 {-background grey90 -foreground black -selectbackground lightblue} -grey56 {-background grey90 -foreground black -selectbackground lightblue}
 -grey57 {-background grey90 -foreground black -selectbackground lightblue} -grey58 {-background grey90 -foreground black -selectbackground 
lightblue} -grey59 {-background grey90 -foreground black -selectbackground lightblue} -extraw 0 -extrah 0

% tooltip::tooltip config -grey51
-background grey90 -foreground black -selectbackground lightblue

% tooltip::tooltip config -grey51 {-font {courier 12} -relief ridge -borderwidth 4}
% tooltip::tooltip config -grey51
-background grey90 -borderwidth 4 -font {courier 12} -foreground black -relief ridge -selectbackground lightblue

===

Note that with multiple fonts one will likely need to pad lines on the right with spaces so the geometry is accurate. Similarly, one may need extra blank lines at the bottom. The -extraw and -extrah are global options and effect all tips and could be used as well.
======
# #
# cooltip-1.6.tm
#
#
# tooltips with colors
#
# Copyright (c) 1996-2007 Jeffrey Hobbs
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: tooltip.tcl,v 1.16 2008/12/01 23:37:16 hobbs Exp $
#
# Initiated: 28 October 1996
# As modified by ET 25 dec 2023

package require Tk 8.5-
package require msgcat

#------------------------------------------------------------------------
# PROCEDURE
#   tooltip::tooltip
#
# DESCRIPTION
#   Implements a tooltip (balloon help) system
#
# ARGUMENTS
#   tooltip <option> ?arg?
#
# clear ?pattern?
#   Stops the specified widgets (defaults to all) from showing tooltips.
#
# configure ?opt ?val opt val ...??    if configureall returns even {} items on introspection
#       Configure foreground, background and font.
#       and 7+9 color replacements + wrap, extrah, extraw
#
# delay ?millisecs?
#   Query or set the delay.  The delay is in milliseconds and must
#   be at least 50.  Returns the delay.
#
# fade ?boolean?
#   Enables or disables fading of the tooltip.
#
# disable OR off
#   Disables all tooltips.
#
# enable OR on
#   Enables tooltips for defined widgets.
#
# <widget> ?-index index? ?-item(s) items? ?-tab tabId" ?-tag tag? ?message?
#   * If -index is specified, then <widget> is assumed to be a menu and
#     index represents what index into the menu (either the numerical index
#     or the label) to associate the tooltip message with.
#     Tooltips do not appear for disabled menu items.
#   * If -item(s) is specified, then <widget> is assumed to be a listbox,
#     ttk::treeview or canvas and items specifies one or more items.
#   * If -tab is specified, then <widget> is assumed to be a ttk::notebook
#     and tabId specifies a tab identifier.
#   * If -tag is specified, then <widget> is assumed to be a text and tag
#     specifies a tag name.
#   If message is {}, then the tooltip for that widget is removed.
#   The widget must exist prior to calling tooltip.  The current
#   tooltip message for <widget> is returned, if any.
#
# RETURNS: varies (see methods above)
#
# NAMESPACE & STATE
#   The namespace tooltip is used.
#   Control toplevel name via ::tooltip::wname.
#
# EXAMPLE USAGE:
#   tooltip .button "A Button"
#   tooltip .menu -index 5 "Loads a file" - index must be a number
# tooltip::G(alwayson) is a list of regular widgets (i.e. ones with no -index, etc.) that are always on
#   These apply only to buttons, checkboxes, entry, etc.
#------------------------------------------------------------------------

namespace eval ::tooltip {
    namespace export -clear tooltip
    variable tooltip
    variable G

    if {![info exists G]} {
        # config_done is set whenever the configure changes anything, so we can trace it in the gui program
        array set G {
            config_done 1
            enabled     1
            fade        1
            extraw       0
            extrah       0
            background lightyellow
            font        {FixedSys 10}
            FADESTEP    0.2
            FADEID      {}
            DELAY       500
            AFTERID     {}
            alwayson    {}
            LAST        -1
            TOPLEVEL    .__tooltip__
        }
        if {[tk windowingsystem] eq "x11"} {
            set G(fade) 0 ; # don't fade by default on X11
        }
    }

    # functional options
    option add *Tooltip.Label.highlightThickness 0
    option add *Tooltip.Label.relief             solid
    option add *Tooltip.Label.borderWidth        1
    option add *Tooltip.Label.padX               5
    option add *Tooltip.Label.padY               5
    # configurable options
    option add *Tooltip.Label.background         lightyellow
    option add *Tooltip.Label.foreground         black
    option add *Tooltip.Label.font               $G(font)   ;# was TkTooltipFont

    # The extra ::hide call in <Enter> is necessary to catch moving to
    # child widgets where the <Leave> event won't be generated
    bind Tooltip <Enter> [namespace code {
    #tooltip::hide
    variable tooltip
    variable G
    set G(LAST) -1
    if {($G(enabled) || ("%W" in $G(alwayson))) && [info exists tooltip(%W)]} {
        set G(AFTERID) \
        [after $G(DELAY) [namespace code [list show %W $tooltip(%W) cursor]]]
    }
    }]

    bind Menu <<MenuSelect>>    [namespace code { menuMotion %W }]
    bind Tooltip <Leave>    [namespace code [list hide 1]] ; # fade ok
    bind Tooltip <Any-KeyPress> [namespace code hide]
    bind Tooltip <Any-Button>   [namespace code hide]
}

proc ::tooltip::tooltip {w args} {
    variable tooltip
    variable G
    switch -glob -- $w {
    clear   {
        if {[llength $args]==0} { set args .* }
        clear [lindex $args 0]
    }
    delay   {
        if {[llength $args]} {
        set millisecs [lindex $args 0]
        if {![string is integer -strict $millisecs] || $millisecs<50} {
            return -code error "tooltip delay must be an integer\
                greater than or equal to 50 (delay is in millisecs)"
        }
        return [set G(DELAY) $millisecs]
        } else {
        return $G(DELAY)
        }
    }
    fade    {
        if {[llength $args]} {
        set G(fade) [string is true -strict [lindex $args 0]]
        }
        return $G(fade)
    }
    off - disable   {
        set G(enabled) 0
        hide
    }
    on - enable {
        set G(enabled) 1
    }
    con* {
            return [::tooltip::configure $w {*}$args]
    }
    default {
        set i $w
        if {[llength $args]} {
        set i [uplevel 1 [namespace code [list register $w {*}$args]]]
        }
        set b $G(TOPLEVEL)
        if {[info exists tooltip($i)]} { return $tooltip($i) }
    }
    }
}

proc ::tooltip::register {w args} {
    variable tooltip
    set key [lindex $args 0]
    while {[string match -* $key]} {
    switch -- $key {
        -- {
            set args [lreplace $args 0 0]
            set key [lindex $args 0]
            break
        }
        -index {
        if {[catch {$w entrycget 1 -label}]} {
            return -code error "widget \"$w\" does not seem to be a\
                menu, which is required for the -index switch"
        }
        set index [lindex $args 1]
        set args [lreplace $args 0 1]
        }
        -item - -items {
                if {[winfo class $w] in {Listbox Treeview}} {
                    set items [lindex $args 1]
                } else {
                    set namedItem [lindex $args 1]
                    if {[catch {$w find withtag $namedItem} items]} {
                        return -code error "widget \"$w\" is not a canvas, or\
                item \"$namedItem\" does not exist in the canvas"
                    }
                }
        set args [lreplace $args 0 1]
        }
        -tab {
        if {[winfo class $w] ne "TNotebook"} {
            return -code error "widget \"$w\" is not a ttk::notebook\
            widget"
        }
        set tabId [lindex $args 1]
        if {[catch {$w index $tabId} tabIndex]} {
            return -code error $tabIndex
        } elseif {$tabIndex < 0 || $tabIndex >= [$w index end]} {
            return -code error "tab index $tabId out of bounds"
        }
        set tabWin [lindex [$w tabs] $tabIndex]
        set args [lreplace $args 0 1]
        }
            -tag {
                set tag [lindex $args 1]
                set r [catch {lsearch -exact [$w tag names] $tag} ndx]
                if {$r || $ndx == -1} {
                    return -code error "widget \"$w\" is not a text widget or\
                        \"$tag\" is not a text tag"
                }
                set args [lreplace $args 0 1]
            }
        default {
        return -code error "unknown option \"$key\":\
            should be -index, -item(s), -tab, -tag or --"
        }
    }
    set key [lindex $args 0]
    }
    if {[llength $args] != 1} {
    return -code error "wrong # args: should be \"tooltip widget\
        ?-index index? ?-item(s) items? ?-tab tabId? ?-tag tag? ?--?\
        message\""
    }
    if {$key eq ""} {
    clear $w
    } else {
    if {![winfo exists $w]} {
        return -code error "bad window path name \"$w\""
    }
    if {[info exists index]} {
        set tooltip($w,$index) $key
        return $w,$index
    } elseif {[info exists items]} {
        foreach item $items {
        set tooltip($w,$item) $key
        set class [winfo class $w]
        if { $class eq "Listbox" || $class eq "Treeview"} {
            enableListbox $w $item
        } else {
            enableCanvas $w $item
        }
        }
        # Only need to return the first item for the purposes of
        # how this is called
        return $w,[lindex $items 0]
    } elseif {[info exists tabWin]} {
        set tooltip($w,$tabWin) $key
        enableNotebook $w $tabWin
        return $w,$tabWin
        } elseif {[info exists tag]} {
            set tooltip($w,t_$tag) $key
            enableTag $w $tag
            return $w,$tag
    } else {
        set tooltip($w) $key
        # Note: Add the necessary bindings only once.
        set tags [bindtags $w]
        if {[lsearch -exact $tags "Tooltip"] == -1} {
        bindtags $w [linsert $tags end "Tooltip"]
        }
        return $w
    }
    }
}

proc ::tooltip::createToplevel {} {
    variable G
    variable labelOpts
    set b $G(TOPLEVEL)

    toplevel $b -class Tooltip -borderwidth 0
    if {[tk windowingsystem] eq "aqua"} {
        ::tk::unsupported::MacWindowStyle style $b help none
    } else {
        wm overrideredirect $b 1
    }
    catch {wm attributes $b -topmost 1}
    # avoid the blink issue with 1 to <1 alpha on Windows
    catch {wm attributes $b -alpha 0.99}
    wm positionfrom $b program
    wm withdraw $b
    label $b.label {*}[expr {[info exists labelOpts] ? $labelOpts : ""}]
#                           cputs green "label create [linsert $labelOpts 0 label $b.label]\n"
                            text $b.text -background yellow -relief raised -bd 2 -wrap none -font $G(font)
                            pack $b.text  -ipadx 1 ;#create our text widget instead of the label, leave label alone though, just don't pack it
                            set_tags $b.text ;# setup our style and color tags
#               pack $b.text $b.label  -ipadx 1
}

proc ::tooltip::configure {config args} { ;# config is the entire word, if it's configureall, it's special returns even {} items
    set len [llength $args]
    if {$len >= 2 && ($len % 2) != 0} {
        return -level 2 -code error "wrong # args. Should be\
                \"tooltip configure ?opt ?val opt val ...??\""
    }
    
    variable G
    set b $G(TOPLEVEL)
    if {![winfo exists $b]} {
        createToplevel
    }
    set opts1 {-foreground -background -font}
    set opts2 {-red -green -blue -orange -violet -black -grey -grey51 -grey52 -grey53 -grey54 -grey55 -grey56 -grey57 -grey58 -grey59 -extraw -extrah -wrap}
    if { $len == 0 } {
        set keys {}
        foreach item $opts1 {
            lappend keys $item [::tooltip::configure $config $item] 
        }
        foreach item $opts2 {
            lappend keys $item [::tooltip::configure $config $item] 
        }
        return $keys
    }
    
    foreach {key value} $args {
        if       { $key eq "-fg" } {
            set key -foreground
        } elseif { $key eq "-bg"  } {
            set key -background
        }
        if       { $key in $opts1 } { ;# compatibility
            set keys {}
            foreach opt {-foreground -background -font} {
                set val [$b.label configure $opt]
                set opts($opt) [lindex $val 4]
                set defs($opt) [lindex $val 1]
                lappend keys $opt
            }
            if { $len == 1  } {
                
                set key [lindex $args 0]
                if       { $key eq "-fg" } {
                    set key -foreground
                } elseif { $key eq "-bg"  } {
                    set key -background
                }
                if {$key ni $keys} {
                    return -level 2 -code error "unknown option \"$key\""
                } else {
                    return $opts($key)
                }
            } else {
                # allow -fg and -bg as aliases
                lappend keys -fg -bg
                set defs(-fg) $defs(-foreground)
                set defs(-bg) $defs(-background)
                
                if {$key ni $keys} {
                    return -level 2 -code error "unknown option \"$key\""
                }
                
                if [catch {
                    $b.label configure $key $value
                    option add *Tooltip.Label.$defs($key) $value
#                   puts "option add *Tooltip.Label.$defs($key) $value"
                    if { $key eq "-font" } {
                         $b.text tag configure label -font $value
                         set G(font) $value
                         set_tags $b.text no
                         $b.text configure -font $value
                    }
                    if { $key eq "-background" } {
                         set G(background) $value
                    }
                } err] {
                    return -level 2 -code error $err
                }
                    
            }
            
        } elseif { $key in $opts2 }  {
#           puts  "in opt2 keyx= |$key| opts2= |$opts2| "
            if       { $len == 1 } {
                if { $key eq "-extraw" } {
                    return $G(extraw) 
                } elseif { $key eq "-wrap" } {
                    return [$G(TOPLEVEL).text cget -wrap]
                } elseif { $key eq "-extrah" } {
                    return $G(extrah) 
                }
                set cfig [$b.text tag configure [string range $key 1 end]]
                set cfig2 [list]
                foreach item $cfig {
                    if { [lindex $item end] ne "" || $config eq "configureall"} {
                        lappend cfig2 [lindex $item 0] [lindex $item end]
                    }   
                }
                return $cfig2
            } else {
                if { $key eq "-extraw" } {
                    set G(extraw) $value
                } elseif { $key eq "-extrah" } {
                    set G(extrah) $value
                } elseif { $key eq "-wrap" } {
                     $G(TOPLEVEL).text config -wrap $value
                    
                } else {
                    $b.text  tag configure [string range $key 1 end]   {*}$value
                }
            }
        } else {
            return -level 2 -code error "unknown option $key"
        }
    }
    incr G(config_done) 1 ;# write to this so config change can be traced
    return
    
    
}


proc ::tooltip::clear {{pattern .*}} {
    variable tooltip
    # cache the current widget at pointer
    set ptrw [winfo containing {*}[winfo pointerxy .]]
    foreach w [array names tooltip $pattern] {
    unset tooltip($w)
    if {[winfo exists $w]} {
        set tags [bindtags $w]
        if {[set i [lsearch -exact $tags "Tooltip"]] != -1} {
        bindtags $w [lreplace $tags $i $i]
        }
        ## We don't remove TooltipMenu because there
        ## might be other indices that use it

        # Withdraw the tooltip if we clear the current contained item
        if {$ptrw eq $w} { hide }
    }
    }
}

proc ::tooltip::show {w msg {i {}}} {
    if {![winfo exists $w]} { return }

    # Use string match to allow that the help will be shown when
    # the pointer is in any descendant of the desired widget
    if {([winfo class $w] ne "Menu")
    && ![string match $w* [winfo containing {*}[winfo pointerxy $w]]]} {
    return
    }

    variable G

    after cancel $G(FADEID)
    set b $G(TOPLEVEL)
    if {![winfo exists $b]} {
        createToplevel
    }
    # Use late-binding msgcat (lazy translation) to support programs
    # that allow on-the-fly l10n changes
    $b.label configure -text [::msgcat::mc $msg] -justify left
                                            if { [string range $msg 0 1] eq "##" } {
                                                set msg [string range $msg 2 end]
#                                               puts "\n---\nfound a complex one\n$msg\n---"
                                                $b.text delete 1.0 end
                                                tooltip::restore $b.text $msg
                                                lassign [w-h $b.text] wid ht
#                                               puts "Wid= |$wid| Ht= |$ht| complex one"
                                                $b.text config -width [expr {   $wid+$G(extraw)    }] -height [expr {   $ht-2+$G(extrah)   }] -background $G(background)
                                            } else {
                                                $b.text delete 1.0 end
                                                $b.text insert 1.0 $msg label
                                                lassign [w-h-l $msg] wid ht
#                                               puts "wid= |$wid| ht= |$ht| "
                                                set bg [$b.label cget -background]
                                                set fg [$b.label cget -foreground]
                                                set ft [$b.label cget -font]
                                                $b.text config -width [expr {   $wid+$G(extraw)    }] -height [expr {   $ht-1+$G(extrah)   }] -background $bg -foreground $fg -font $ft
                                            }
    update idletasks
    set screenw [winfo screenwidth $w]
    set screenh [winfo screenheight $w]
    set reqw [winfo reqwidth $b]
    set reqh [winfo reqheight $b]
    # When adjusting for being on the screen boundary, check that we are
    # near the "edge" already, as Tk handles multiple monitors oddly
    if {$i eq "cursor"} {
        set py [winfo pointery $w]
    set y [expr {$py + 20}]
# this is a wrong calculation?
#   if {($y < $screenh) && ($y+$reqh) > $screenh} {}
    if { ($y + $reqh) > $screenh } {
        set y [expr {$py - $reqh - 5}]
    }
    } elseif {$i ne ""} {
        # menu entry
    set y [expr {[winfo rooty $w]+[winfo vrooty $w]+[$w yposition $i]+25}]
    if {($y < $screenh) && ($y+$reqh) > $screenh} {
        # show above if we would be offscreen
        set y [expr {[winfo rooty $w]+[$w yposition $i]-$reqh-5}]
    }
    } else {
    set y [expr {[winfo rooty $w]+[winfo vrooty $w]+[winfo height $w]+5}]
    if {($y < $screenh) && ($y+$reqh) > $screenh} {
        # show above if we would be offscreen
        set y [expr {[winfo rooty $w]-$reqh-5}]
    }
    }
    if {$i eq "cursor"} {
    set x [winfo pointerx $w]
    } else {
    set x [expr {[winfo rootx $w]+[winfo vrootx $w]+
             ([winfo width $w]-$reqw)/2}]
    }
    # only readjust when we would appear right on the screen edge
    if {$x<0 && ($x+$reqw)>0} {
    set x 0
    } elseif {($x < $screenw) && ($x+$reqw) > $screenw} {
    set x [expr {$screenw-$reqw}]
    }
    if {[tk windowingsystem] eq "aqua"} {
    set focus [focus]
    }
    # avoid the blink issue with 1 to <1 alpha on Windows, watch half-fading
    catch {wm attributes $b -alpha 0.99}
    wm geometry $b +$x+$y
    wm deiconify $b
    raise $b
    if {[tk windowingsystem] eq "aqua" && $focus ne ""} {
    # Aqua's help window steals focus on display
    after idle [list focus -force $focus]
    }
}
proc ::tooltip::w-h {w} {
    set max 0
    for {set item 0} {$item < 100} {incr item} {
        set ind [$w index ${item}.end]  
        set wid [lindex [split $ind  .] 1]
        if { $wid > $max } {
            set max $wid
        }
    }
    set h [lindex [split [$w index end] .] 0 ]
    return [list $max $h]
}
proc ::tooltip::w-h-l {l} {
    set max 0
    set lines [split $l \n]
    foreach line $lines {
        set wid [string length $line]
        if { $wid > $max } {
            set max $wid
        }
    }
    return [list $max [llength $lines]]
}

proc ::tooltip::menuMotion {w} {
    variable G

    if {$G(enabled)} {
    variable tooltip

        # Menu events come from a funny path, map to the real path.
        set m [string map {"#" "."} [winfo name $w]]
    set cur [$w index active]

    # The next two lines (all uses of LAST) are necessary until the
    # <<MenuSelect>> event is properly coded for Unix/(Windows)?
#   puts "cur= |$cur| G(LAST)= |$G(LAST)| returning = [expr {  $cur == $G(LAST)    }]" ;# this is broken on 9.0b1 (if only 1 item)
#    if {$cur == $G(LAST)} return ;# I don't grok this, but it breaks the code in 9.0b1, and w/o it, it works in 8.6 and 9.0 ughhhh
    set G(LAST) $cur
    # a little inlining - this is :hide
    after cancel $G(AFTERID)

    catch {wm withdraw $G(TOPLEVEL)}
#               puts "[info exists tooltip($m,$cur)]  $m,$cur"
                if { ! [info exists tooltip($m,$cur)]} {
                    if { [info exists tooltip($w,$cur)] } {
                        set m $w
                    }
                    
                }
#               puts "[info exists tooltip($m,$cur)]  $m,$cur  [catch {$w entrycget $cur -label} cur] [info exists tooltip($m,$cur)]"
    if {[info exists tooltip($m,$cur)] || \
        (![catch {$w entrycget $cur -label} cur] && \
        [info exists tooltip($m,$cur)])} {
        set G(AFTERID) [after $G(DELAY) \
            [namespace code [list show $w $tooltip($m,$cur) cursor]]] 
    }
    }
}

proc ::tooltip::hide {{fadeOk 0}} {
    variable G

    after cancel $G(AFTERID)
    after cancel $G(FADEID)
    if {$fadeOk && $G(fade)} {
    fade $G(TOPLEVEL) $G(FADESTEP)
    } else {
    catch {wm withdraw $G(TOPLEVEL)}
    }
}

proc ::tooltip::fade {w step} {
    if {[catch {wm attributes $w -alpha} alpha] || $alpha <= 0.0} {
        catch { wm withdraw $w }
        catch { wm attributes $w -alpha 0.99 }
    } else {
    variable G
        wm attributes $w -alpha [expr {$alpha-$step}]
        set G(FADEID) [after 50 [namespace code [list fade $w $step]]]
    }
}

proc ::tooltip::wname {{w {}}} {
    variable G
    if {[llength [info level 0]] > 1} {
    # $w specified
    if {$w ne $G(TOPLEVEL)} {
        hide
        destroy $G(TOPLEVEL)
        set G(TOPLEVEL) $w
    }
    }
    return $G(TOPLEVEL)
}

proc ::tooltip::listitemTip {w x y} {
    variable tooltip
    variable G

    set G(LAST) -1
    if {[winfo class $w] eq "Listbox"} {
    set item [$w index @$x,$y]
    } else {
    set item [$w identify item $x $y]
    }
    if {$G(enabled) && [info exists tooltip($w,$item)]} {
    set G(AFTERID) [after $G(DELAY) \
        [namespace code [list show $w $tooltip($w,$item) cursor]]]
    }
}

# Handle the lack of <Enter>/<Leave> between listbox/treeview items using
# <Motion>
proc ::tooltip::listitemMotion {w x y} {
    variable tooltip
    variable G
    if {$G(enabled)} {
    if {[winfo class $w] eq "Listbox"} {
        set item [$w index @$x,$y]
    } else {
        set item {}
        set region [$w identify region $x $y]
        if {$region  eq "tree" || $region eq "cell"} {
        set item [$w identify item $x $y]
        }
    }
        if {$item ne $G(LAST)} {
            set G(LAST) $item
            after cancel $G(AFTERID)
            catch {wm withdraw $G(TOPLEVEL)}
            if {[info exists tooltip($w,$item)]} {
                set G(AFTERID) [after $G(DELAY) \
                   [namespace code [list show $w $tooltip($w,$item) cursor]]]
            }
        }
    }
}

# Initialize tooltip events for listbox/treeview widgets
proc ::tooltip::enableListbox {w args} {
    if {[string match *listitemTip* [bind $w <Enter>]]} { return }
    bind $w <Enter> +[namespace code [list listitemTip %W %x %y]]
    bind $w <Motion> +[namespace code [list listitemMotion %W %x %y]]
    bind $w <Leave> +[namespace code [list hide 1]] ; # fade ok
    bind $w <Any-KeyPress> +[namespace code hide]
    bind $w <Any-Button> +[namespace code hide]
}

proc ::tooltip::canvasitemTip {w args} {
    variable tooltip
    variable G

    set G(LAST) -1
    set item [$w find withtag current]
    if {$G(enabled) && [info exists tooltip($w,$item)]} {
    set G(AFTERID) [after $G(DELAY) \
        [namespace code [list show $w $tooltip($w,$item) cursor]]]
    }
}

proc ::tooltip::enableCanvas {w args} {
    if {[string match *canvasitemTip* [$w bind all <Enter>]]} { return }
    $w bind all <Enter> +[namespace code [list canvasitemTip $w]]
    $w bind all <Leave> +[namespace code [list hide 1]] ; # fade ok
    $w bind all <Any-KeyPress> +[namespace code hide]
    $w bind all <Any-Button> +[namespace code hide]
}

proc ::tooltip::notebooktabTip {w x y} {
    variable tooltip
    variable G

    set G(LAST) -1
    set tabIndex [$w index @$x,$y]
    set tabWin [lindex [$w tabs] $tabIndex]
    if {$G(enabled) && [info exists tooltip($w,$tabWin)]} {
    set G(AFTERID) [after $G(DELAY) \
        [namespace code [list show $w $tooltip($w,$tabWin) cursor]]]
    }
}

# Handle the lack of <Enter>/<Leave> between ttk::notebook items using <Motion>
proc ::tooltip::notebooktabMotion {w x y} {
    variable tooltip
    variable G
    if {$G(enabled)} {
    set tabIndex [$w index @$x,$y]
    set tabWin [lindex [$w tabs] $tabIndex]
        if {$tabWin ne $G(LAST)} {
            set G(LAST) $tabWin
            after cancel $G(AFTERID)
            catch {wm withdraw $G(TOPLEVEL)}
            if {[info exists tooltip($w,$tabWin)]} {
                set G(AFTERID) [after $G(DELAY) \
                   [namespace code [list show $w $tooltip($w,$tabWin) cursor]]]
            }
        }
    }
}

# Initialize tooltip events for ttk::notebook widgets
proc ::tooltip::enableNotebook {w args} {
    if {[string match *notebooktabTip* [bind $w <Enter>]]} { return }
    bind $w <Enter> +[namespace code [list notebooktabTip %W %x %y]]
    bind $w <Motion> +[namespace code [list notebooktabMotion %W %x %y]]
    bind $w <Leave> +[namespace code [list hide 1]] ; # fade ok
    bind $w <Any-KeyPress> +[namespace code hide]
    bind $w <Any-Button> +[namespace code hide]
}

proc ::tooltip::tagTip {w tag} {
    variable tooltip
    variable G
    set G(LAST) -1
    if {$G(enabled) && [info exists tooltip($w,t_$tag)]} {
        if {[info exists G(AFTERID)]} { after cancel $G(AFTERID) }
        set G(AFTERID) [after $G(DELAY) \
            [namespace code [list show $w $tooltip($w,t_$tag) cursor]]]
    }
}

proc ::tooltip::enableTag {w tag} {
    if {[string match *tagTip* [$w tag bind $tag]]} { return }
    $w tag bind $tag <Enter> +[namespace code [list tagTip $w $tag]]
    $w tag bind $tag <Leave> +[namespace code [list hide 1]] ; # fade ok
    $w tag bind $tag <Any-KeyPress> +[namespace code hide]
    $w tag bind $tag <Any-Button> +[namespace code hide]
}
proc ::tooltip::set_tags {w {colors yes}} {

    variable G
    set font $G(font)
    $w tag configure bolditalicunder        -font "$font bold italic underline"
    $w tag configure boldunder              -font "$font bold underline"
    $w tag configure italicunder            -font "$font italic underline"
    $w tag configure bolditalic             -font "$font bold italic"
    $w tag configure bold                   -font "$font bold"
    $w tag configure italic                 -font "$font italic"
    $w tag configure under                  -font "$font underline"
    $w tag configure normal                 -font "$font"
    $w tag configure label                  -font "$font"
    
    if { $colors } {
        $w  tag configure red                   -foreground red
        $w  tag configure green                 -foreground green
        $w  tag configure blue                  -foreground lightblue
        $w  tag configure orange                -foreground orange
        $w  tag configure violet                -foreground violet
        $w  tag configure grey                  -foreground grey80
        $w  tag configure black                 -foreground black 
        foreach gr {1 2 3 4 5 6 7 8 9} {
            $w  tag configure grey5$gr           -foreground black -background grey90 -selectbackground lightblue
        }
    }
   
    
    
    $w tag add normal insert
}

proc ::tooltip::restore {w savex} {
    set save [subst -nocommands -novariables $savex]
    # create items, restoring their attributes
    foreach {key value index} $save \
            {
        switch $key \
                {
            exec    { eval [string replace $value 0 [string first " " $value]-1 $w] }
            image   { $w image create $index -name $value }
            text    { $w insert $index $value }
            mark    {
                switch $value {
                    current { set currentIndex $index }
                    insert { set insertIndex $index}
                    default { $w mark set $value $index }
                }
            }
            tagon   { set tag($value) $index }
            tagoff  { $w tag add $value $tag($value) $index }
            window  { $w window create $index -window $value }
        }
    }
    $w mark set current $currentIndex
    $w mark set insert $insertIndex
}

package provide tooltip 1.6 ;# - not needed for cooltip, but keeps this from causing conflicts if user tries a package require tooltip also



======
<<enddiscussion>>

Below in the discussion is the cooltip gui builder program. Copy it to a file in the same directory as cooltip-1.6.tm and run with '''wish'''. If the module is in one of the known directories, the module system will find it and this same directory requirement would not be needed.

<<discussion>>
======
# The cooltip gui editor from Arjen's little wp, by ET 12/25/2023
#
# wordp.tcl --
#     A very basic word processor original by Arjen
#

# mainWindow --
#     Set up the window with some buttons
#
lappend auto_path [pwd]
set wtitle [wm title .]
wm title .  "$wtitle tooltip"

set ::cooltip [file dirname [info script]] 
tcl::tm::path add [file dirname [info script]] 
set ::ver [package require cooltip 1.6]


set ::myfont $::tooltip::G(font)
set ::nowcolor black


# add your own picks here

set picks   {\u261B \u2611 \u2190   \u2191  \u2192  \u2193  \u2194  
            \u2195  \u2196  \u2197  \u2198  
            \u2726  \u2727  \u2729  \u272A  \u2022 \u00A9 \u2023 "\u231A \u231B"
            \u277D \u25B2   "\u007B \uFFFC \u007D  \u3010 \uFFFC \u3011" 
            "\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500"
            "-setup choices-" "-in variable-" "-picks-"
} ;# set some favorites here, the 10 char line makes the tearoff wider as well


#0x2190 LEFTWARDS ARROW 
#0x2191 UPWARDS ARROW   
#0x2192 RIGHTWARDS ARROW    
#0x2193 DOWNWARDS ARROW 
#0x2194 LEFT RIGHT ARROW    
#0x2195 UP DOWN ARROW   
#0x2196 NORTH WEST ARROW    
#0x2197 NORTH EAST ARROW    
#0x2198 SOUTH EAST ARROW    

#0x2726 BLACK FOUR POINTED STAR
#0x2727 WHITE FOUR POINTED STAR
#0x2729 STRESS OUTLINED WHITE STAR  
#0x272A CIRCLED WHITE STAR  

#0x277D DINGBAT NEGATIVE CIRCLED DIGIT EIGHT
#0x25B2 BLACK UP-POINTING TRIANGLE

namespace eval popup {
    set VERSION 0.1
}




proc mainWindow {} {
    catch {console show}
    global bold
    global italic
    global under
    global red
    global tootip_varname tipsonoff
    global colorlab
    global picks
    global texttag
    
    set ::atoz "--"
    set ::clipboard {}
    dosetsave ""
    
    puts "Dir= |$::cooltip| ver=$::ver saveto= |$::savefile| font= |$::myfont| "
   
    set ::themex 0
    set ::darkonoff 0
    set ::curtheme [ttk::style theme use]
    puts "::argv= |$::argv| curtheme= |$::curtheme| "
# on linux, menus will be made darkmode by awthemes using option database, not ttk styles, simply by doing the package require awdark
# so we can only suppress it by not doing the package require, hence the user command line option
# On windows, this is suppressed for some reason, comment said it had bad side effects so not done   
    if { "-nodark" ni $::argv } { ;
        if [catch {
            package require awdark 
            set ::themex 1
            ttk::style theme use awdark
            set ::darkonoff 1
        } err_code] {
            puts stderr $err_code 
        }
    }
    set tootip_varname "tooltip"
    #
    # Create the toolbar
    #
    global t
    set t [frame .toolbar]

    text   .text -font $::myfont -width 100 -height 50 -wrap none -undo true -insertbackground red -background grey85 ;# need to see the cursor, red seems to work

    ttk::button      $t.load   -text "Load"             -style Toolbutton -command [list loadf .text $t.testbut]
    ttk::button      $t.save   -text "Save"             -style Toolbutton -command {storeText 1}
    ttk::combobox    $t.atoz   -text "A-Z"              -style Toolbutton -width 2 -height 27 -textvariable ::atoz -values {"--" A B C D E F G H I J K L M N O P Q R S T U V W X Y Z}   
    bind $t.atoz <<ComboboxSelected>> [list doatoz] 
    $t.atoz set "--"
   
    ttk::button      $t.next   -text "+"                -style Toolbutton -command {loadnextone}
    ttk::button      $t.copy   -text "Copy"             -style Toolbutton -command {storeText 0}
    ttk::button      $t.paste  -text "Paste"            -style Toolbutton -command [list clip .text $t.testbut]
    ttk::button      $t.clear  -text "Clear"            -style Toolbutton 
    ttk::checkbutton $t.bold   -text "Bold"             -style Toolbutton -variable bold   -command {toggleFont}
    ttk::checkbutton $t.italic -text "Italic"           -style Toolbutton -variable italic -command {toggleFont}
    ttk::checkbutton $t.under  -text "Underline"        -style Toolbutton -variable under  -command {toggleFont}
    ttk::label       $t.pick   -text "Pick"             -style Toolbutton 
    ttk::label       $t.color  -text "Color"            -style Toolbutton -background black -foreground white
    ttk::button      $t.test   -text "Notes"            -style Toolbutton -command  [list testit $t.testbut]
    ttk::button      $t.testbut -text "\u2192Test"      -style Toolbutton -command  [list testit $t.testbut]
    ttk::checkbutton $t.tip    -text "Tips On"          -variable tipsonoff -command {onoff}

    set tooltip::G(alwayson) [list $t.testbut]

    ttk::separator .sep
    ttk::separator $t.sep1 -orient vertical
    ttk::separator $t.sep2 -orient vertical
    ttk::separator $t.sep3 -orient vertical
    ttk::separator $t.sep4 -orient vertical
    ttk::separator $t.sep5 -orient vertical
   
    set colorlab $t.color ;# so we can change it to the current color
 
    bind $t.testbut <Enter> [list testit $t.testbut]
    bind $t.clear <1>         {clear text}
    bind $t.clear <Control-1> {clear all}
    bind $t.clear <Shift-1>   {clear config}
    
# our 2 tearoff menus 
    set ::fnt {ariel 10}
    set ::popup::menu(color) {
        {radiobutton  -label "red         "  -value red       -variable nowcolor  -background "PaleVioletRed1"  -foreground black -font $::fnt  -command colorset}
        {radiobutton  -label "green       "  -value green     -variable nowcolor  -background "lightgreen"      -foreground black -font $::fnt  -command colorset}
        {radiobutton  -label "blue        "  -value blue      -variable nowcolor  -background "lightblue"       -foreground black -font $::fnt  -command colorset}
        {radiobutton  -label "orange      "  -value orange    -variable nowcolor  -background "orange"          -foreground black -font $::fnt  -command colorset}
        {radiobutton  -label "violet      "  -value violet    -variable nowcolor  -background "violet"          -foreground black -font $::fnt  -command colorset}
        {radiobutton  -label "grey        "  -value grey      -variable nowcolor  -background "grey80"          -foreground white -font $::fnt  -command colorset}
        {radiobutton  -label "black       "  -value black     -variable nowcolor  -background "black"           -foreground white -font $::fnt  -command colorset -selectcolor white}
        {separator}
        {separator}
        {radiobutton  -label "grey51      "  -value grey51    -variable nowcolor  -background "grey80"          -foreground white -font $::fnt  -command colorset -selectcolor white}
        {radiobutton  -label "grey52      "  -value grey52    -variable nowcolor  -background "grey70"          -foreground white -font $::fnt  -command colorset -selectcolor white}
        {radiobutton  -label "grey53      "  -value grey53    -variable nowcolor  -background "grey80"          -foreground white -font $::fnt  -command colorset -selectcolor white}
        {radiobutton  -label "grey54      "  -value grey54    -variable nowcolor  -background "grey70"          -foreground white -font $::fnt  -command colorset -selectcolor white}
        {radiobutton  -label "grey55      "  -value grey55    -variable nowcolor  -background "grey80"          -foreground white -font $::fnt  -command colorset -selectcolor white}
        {radiobutton  -label "grey56      "  -value grey56    -variable nowcolor  -background "grey70"          -foreground white -font $::fnt  -command colorset -selectcolor white}
        {radiobutton  -label "grey57      "  -value grey57    -variable nowcolor  -background "grey80"          -foreground white -font $::fnt  -command colorset -selectcolor white}
        {radiobutton  -label "grey58      "  -value grey58    -variable nowcolor  -background "grey70"          -foreground white -font $::fnt  -command colorset -selectcolor white}
        {radiobutton  -label "grey59      "  -value grey59    -variable nowcolor  -background "grey80"          -foreground white -font $::fnt  -command colorset -selectcolor white}
        {separator}
        {separator}
        {checkbutton  -label "DarkMode    "  -variable darkonoff -onvalue 1 -offvalue 0 -command {dodark}       -font $::fnt}
        {checkbutton  -label "Wrapping    "  -variable wraponoff -onvalue 1 -offvalue 0 -command {dowrapping}   -font $::fnt}
        {separator}
        {command      -label "Configure   " -command {con_dlog $::nowcolor}  -font $::fnt}
        {command      -label "Change Folder" -command {newpwd}  -font $::fnt}
        {separator}
        {command      -label "Create Catalog" -command {createcatalog}  -font $::fnt}
        {command      -label "Expand Catalog" -command {expandcatalog}  -font $::fnt}
        {separator}
        {command      -label "Console"   -command {console show}          -font $::fnt}
        {separator}
        {separator}
        {command      -label "Exit"      -command exit  -foreground red   -font $::fnt} 
    }
    set ::wraponoff 0
    set ::popup::menu(picks) {}
    foreach pick $picks {
        append ::popup::menu(picks) \n \{ [list command -label $pick -font {arial 12} -command "pick1 $pick"] \} 
    }
    
    ::popup::create color 1 {-tearoffcommand tearoffcmd }
    ::popup::create picks 1 {-tearoffcommand tearoffcmd }
    
    bind $t.color  <Button-1> {::popup::show %W color} 
    bind $t.pick   <Button-1> {::popup::show %W picks} 

# ok, now grid them or pack em, I prefer packing

    set widgets [list  $t.load  $t.save $t.atoz $t.next $t.clear $t.sep1  $t.copy $t.paste $t.sep2 $t.test $t.testbut  $t.sep3 $t.bold $t.italic $t.under $t.sep4  $t.color $t.pick $t.sep5 $t.tip]
    if { 0 } {
        grid {*}$widgets  -padx 2 -sticky ns
    
        grid   $t    -sticky w
        grid   .sep  -sticky we
        grid   .text
    } else {
        pack  {*}$widgets  -side left -fill both -expand true -anchor w
    
        pack   $t  .sep  .text -fill x -side top
    }

#
# Tags for the various fonts
#
    tooltip::set_tags .text
    .text tag add normal insert


    set texttag normal
    set italic  0
    set bold    0
    set under   0
    set red     0
    set tipsonoff 1
    clear text;# if we don't do this, the first load is messed up
    colorset
    focus -force .text



set tooltip_bold {##mark current 1.0 tagon normal 1.0 tagon black 1.0 text Styles 1.0 tagoff black 1.6 text { } 1.6 tagoff normal 1.7 tagon red 1.7 tagon bold 1.7 text \u2196 1.7 tagoff bold 1.8 tagoff red 1.8 tagon normal 1.8 text { } 1.8 tagon black 1.9 text {and colors} 1.9 tagoff black 1.19 text { } 1.19 tagoff normal 1.20 tagon red 1.20 tagon bold 1.20 text \u2197 1.20 tagoff bold 1.21 tagoff red 1.21 tagon normal 1.21 text { } 1.21 tagon black 1.22 text {are sticky. Once they are
} 1.22 text {set, text typed or pasted will use that style. You can
} 2.0 text {use all 3 together with any of the colors. So be
} 3.0 text {         \u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500
} 4.0 tagoff black 5.0 text { } 5.0 tagon black 5.1 text \u2726 5.1 tagoff black 5.2 text {             } 5.2 tagon black 5.15 text {   } 5.15 tagoff black 5.18 text { } 5.18 tagoff normal 5.19 tagon bolditalicunder 5.19 tagon red 5.19 text {B } 5.19 tagoff red 5.21 tagon orange 5.21 text O 5.21 tagoff orange 5.22 tagon red 5.22 text { } 5.22 tagoff red 5.23 tagon green 5.23 text L 5.23 tagoff green 5.24 tagon red 5.24 text { } 5.24 tagoff red 5.25 tagon green 5.25 text D 5.25 tagoff bolditalicunder 5.26 tagoff green 5.26 tagon black 5.26 tagon normal 5.26 text {                  \u2726} 5.26 tagoff normal 5.45 tagon under 5.45 text {
} 5.45 tagoff under 6.0 tagon normal 6.0 text {         \u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500
} 6.0 text {To modify an attribute of existing text, select the 
} 7.0 text {text and then set the attribues/colors} 8.0 mark tk::anchor1 8.38 mark insert 8.38 text { you want.
} 8.38 tagoff normal 9.0 tagoff black 9.0}


set tooltip_copy {##mark current 1.0 tagon normal 1.0 tagon black 1.0 text The 1.0 tagoff black 1.3 text { } 1.3 tagon red 1.4 text Copy 1.4 tagoff red 1.8 text { } 1.8 tagon black 1.9 text {command copies} 1.9 mark tk::anchor1 1.23 mark insert 1.23 text { all the text in the 
} 1.23 text {window below } 2.0 tagoff normal 2.13 tagoff black 2.13 tagon violet 2.13 tagon bold 2.13 text \u2193 2.13 tagoff bold 2.14 tagoff violet 2.14 tagon normal 2.14 tagon black 2.14 text { into the clipboard with all its 
} 2.14 text {attributes formatted as a tcl} 3.0 tagoff black 3.29 text { } 3.29 tagon red 3.30 text set 3.30 tagoff red 3.33 text { } 3.33 tagon black 3.34 text {command.
} 3.34 text {
} 4.0 text {It can then be pasted into the user program where
} 5.0 text {it can be used in a tooltip command. The variable
} 6.0 text {defaults to tooltip. The user should change that,
} 7.0 text {for example, } 8.0 tagoff black 8.13 tagon red 8.13 text tooltip3 8.13 tagoff red 8.21 tagon black 8.21 text {. To use it, one would
} 8.21 text {write the followng tcl code:
} 9.0 text {
} 10.0 text {    tooltip::tooltip } 11.0 tagoff black 11.21 tagon orange 11.21 text <widget3> 11.21 tagoff orange 11.30 tagon black 11.30 text { } 11.30 tagoff black 11.31 tagon red 11.31 text {$tooltip3} 11.31 tagoff red 11.40 tagon black 11.40 text {
} 11.40 text {
} 12.0 tagoff black 13.0 tagon red 13.0 text Copy 13.0 tagoff red 13.4 tagon black 13.4 text { writes a formatted pretty print \u261b stdout 
} 13.4 text {or \u261b console of the text widget dump command.} 14.0 tagoff black 14.45 text {
} 14.45 text {
} 15.0 tagon red 16.0 text Copy 16.0 tagoff red 16.4 text { } 16.4 tagon black 16.5 text {ignores any currently} 16.5 tagoff black 16.26 text { } 16.26 tagoff normal 16.27 tagon violet 16.27 tagon bold 16.27 text selected 16.27 tagoff bold 16.35 tagoff violet 16.35 tagon normal 16.35 text { } 16.35 tagon black 16.36 text {text, as it
} 16.36 text {always uploads the entire window to the clipboard.
} 17.0 tagoff normal 18.0 tagoff black 18.0}

set tooltip_paste {##mark current 1.0 tagon normal 1.0 tagon black 1.0 text {Select and copy your code from} 1.0 tagoff black 1.30 text { } 1.30 tagon red 1.31 text {set tooltipN {...}} 1.31 tagoff red 1.49 text { } 1.49 tagon black 1.50 text {in your
} 1.50 text {text editor and use the} 2.0 tagoff black 2.23 text { } 2.23 tagon red 2.24 text Paste 2.24 tagoff red 2.29 text { } 2.29 tagon black 2.30 text {command to reload it here for
} 2.30 text {editing. After it's edited, use the } 3.0 tagoff black 3.36 tagon red 3.36 text Copy 3.36 tagoff red 3.40 tagon black 3.40 text { command to
} 3.40 text {place the new contents into the clipboard for pasting
} 4.0 text {back into your source program.
} 5.0 text {
} 6.0 text The 7.0 tagoff black 7.3 text { } 7.3 tagon red 7.4 text Copy 7.4 tagoff red 7.8 text { } 7.8 tagon black 7.9 text {command will use the variable name from the
} 7.9 text {last paste operation or use the variable name} 8.0 tagoff black 8.45 text { } 8.45 tagon red 8.46 text tooltip. 8.46 tagoff red 8.54 text {
} 8.54 text {
} 9.0 tagon black 10.0 text {Be sure to select the entire statement. If you don't
} 10.0 text {begin with } 11.0 tagoff black 11.11 tagon violet 11.11 text set 11.11 tagoff violet 11.14 tagon black 11.14 text { an error will be posted
} 11.14 tagoff normal 12.0 tagoff black 12.0 mark tk::anchor1 12.0 mark insert 12.0}

set tooltip_test {##tagon normal 1.0 tagon black 1.0 text \u2500\u2500\u2500\u2500 1.0 tagoff black 1.4 tagon red 1.4 text {  } 1.4 tagoff red 1.6 tagon black 1.6 text { } 1.6 tagoff normal 1.7 tagon bold 1.7 text {Notes on the \u2192Test button} 1.7 tagoff bold 1.32 tagoff black 1.32 tagon normal 1.32 tagon red 1.32 text { } 1.32 tagoff red 1.33 tagon black 1.33 text {\u2500\u2500\u2500\u2500\u2500
} 1.33 text {
} 2.0 text {\u2727 This will render with tooltip config settings} 3.0 tagoff black 3.47 tagon orange 3.47 text { } 3.47 tagoff orange 3.48 tagon black 3.48 text {as noted.
} 3.48 text {
} 4.0 mark current 5.0 text {\u2727 If the last line's not showing, you need
} 5.0 text {   a newline after the last line.
} 6.0 text {
} 7.0 text {\u2727 If it's cutting off on the right side, add some
} 8.0 text {   spaces at the end of the longest line.
} 9.0 text {   This can happen with unicode.
} 10.0 text {
} 11.0 text {\u2727 Click this button to force an update in the test    
} 12.0 text {   button.} 13.0 tagoff black 13.10 tagon orange 13.10 text {
} 13.10 text {
} 14.0 tagoff orange 15.0 tagon black 15.0 text {\u2727 Cannot use braces, use unicode instead\u3010  \u3011
} 15.0 text {
} 16.0 text {tooltip::tooltip configure ?-option value?} 17.0 tagoff black 17.42 tagon red 17.42 text { } 17.42 tagoff red 17.43 tagon orange 17.43 text {\u261b defaults} 17.43 tagoff orange 17.53 tagon red 17.53 text {
} 17.53 tagoff red 18.0 tagon black 18.0 text {
} 18.0 text {-fg -foreground } 19.0 tagoff black 19.16 tagon orange 19.16 text black 19.16 tagoff orange 19.21 tagon red 19.21 text {        } 19.21 tagoff red 19.29 tagon black 19.29 text {
} 19.29 text {-bg -background } 20.0 tagoff black 20.16 tagon orange 20.16 text lightyellow 20.16 tagoff orange 20.27 tagon red 20.27 text {    } 20.27 tagoff red 20.31 tagon black 20.31 text {
} 20.31 text -font\u3010 21.0 tagoff black 21.6 tagon orange 21.6 text {FixedSys 10} 21.6 tagoff orange 21.17 tagon black 21.17 text {\u3011
} 21.17 text {
} 22.0 text {The above affect both regular and styled tips. Can also
} 23.0 text {replace the 7 colors, e.g. } 24.0 tagoff black 24.27 tagon red 24.27 text -red 24.27 tagoff red 24.31 tagon black 24.31 text { } 24.31 tagoff black 24.32 tagon red 24.32 text purple 24.32 tagoff red 24.38 tagon black 24.38 mark tk::anchor1 24.38 mark insert 24.38 text {
} 24.38 text {
} 25.0 text {-black } 26.0 tagoff black 26.7 tagon grey 26.7 text -grey 26.7 tagoff grey 26.12 tagon black 26.12 text { } 26.12 tagoff black 26.13 tagon violet 26.13 text -violet 26.13 tagoff violet 26.20 tagon black 26.20 text { } 26.20 tagoff black 26.21 tagon orange 26.21 text -orange 26.21 tagoff orange 26.28 tagon black 26.28 text { } 26.28 tagoff black 26.29 tagon blue 26.29 text -blue 26.29 tagoff blue 26.34 tagon black 26.34 text { } 26.34 tagoff black 26.35 tagon green 26.35 text -green 26.35 tagoff green 26.41 tagon black 26.41 text { } 26.41 tagoff black 26.42 tagon red 26.42 text -red 26.42 tagoff red 26.46 tagon black 26.46 text {
} 26.46 text {
} 27.0 tagoff normal 28.0 tagoff black 28.0}

# styled tips

    tooltip::tooltip $t.bold   $tooltip_bold 
    tooltip::tooltip $t.copy   $tooltip_copy
    tooltip::tooltip $t.paste  $tooltip_paste
    tooltip::tooltip $t.test   $tooltip_test
# regular tips
    atoztips
    tooltip::tooltip $t.tip   "Turns on/off cooltip tips. The test\nbutton \u2192Test is always on\n"
    tooltip::tooltip $t.next  "Load next one in directory"
    tooltip::tooltip $t.atoz  "Save file name extra A-Z, or -none-"
    tooltip::tooltip $t.pick   "A menu of favorites, including unicode\nedit to add or replace with your own." 
    tooltip::tooltip $t.color  "A menu of colors with a tearoff.\nThe tearoff menu also has tooltips\nexplaining the menu items.\n" 
    tooltip::tooltip $t.clear  "Clear text in edit window\nShift-click Clear Configurations\nControl-click Clear Both\n" 
    foreach tag {51 52 53 54 55 56 57 58 59} {
        tooltip::tooltip .text -tag grey$tag "grey$tag"
    }
#   namespace import tooltip::tooltip
    history add "tooltip::tooltip config -grey51 {-font {courier 12} -relief ridge -borderwidth 4}" 
    history add "tooltip::tooltip config -grey51" 
    history add "tooltip::tooltip config -font {courier 14}" 
    history add "tooltip::tooltip config -background grey80" 
    history add "tooltip::tooltip config"
    history add "tooltip::tooltip delay 50"
    history add "make_border 14 540 ; insert_clip 3"
#    history add "ttk::themes"
#    history add "package require "
#    history add ".con config -bg black"
#    history add "ttk::style theme use default ;#smaller"
    puts [history info]
    puts "\nTo access the above pre-loaded history, use up-arrow\nthis version: 1/22/2024\nWhat's new? control-mousewheel zoom; text configure dialog with more attributes"
    puts "awdark if available and more ttk widgets\; experimental wrap mode; to suppress awdark\nby command line: wish [file tail [info script]] -nodark; new current directory chooser dialog"
    puts "Load/Save can have a-z with a menu and a load next; New cataloging, so one can put a series of\ntips into a single file or on the wiki; configure functionally ordered rather than alphabetical"
    puts "Fancy borders using tabs, such as in the screen shot on the wiki; will soon upload some configurations"
    console eval {wm geom . 109x24+10+10}  
    wm geom . 1004x517+181+209
    trace add variable ::tooltip::G(font)        write {catch {.text configure -font $::tooltip::G(font) ; ::tooltip::set_tags .text} ;#}
    trace add variable ::tooltip::G(config_done) write {catch {config2text; #puts "config change: $::tooltip::G(config_done) "} ;# }
    trace add variable ::nowcolor write {catch {colchange; #puts "color change: $::nowcolor "} ;# }
    bind .text <Control-MouseWheel> {mwheel %D} ;# windows
    bind .text <Control-4> {mwheel 1} ;# linux
    bind .text <Control-5> {mwheel -1}
    set ::lastfound -1
}
proc loadnextone {{getletters 0}} {
    set files [glob -nocomplain save*2.tcl]
    if { [llength $files] <= 0 } {
        puts "no files found"
        return {}
    }
#   set f $::atoz
    
    
    set letters {}
    foreach file $files {
        if {  [regexp -nocase -linestop -lineanchor {save([a-zA-Z])?2.tcl} $file -> firstone]   } {
            lappend letters $firstone
        }
    }
    set letters [lsort $letters]
    if { $getletters } {
        return $letters ;# just want the letters, don't skip
    }
    
    puts "letters= |$letters| "
    incr ::lastfound
    if { $::lastfound >= [llength $files]} {
        set ::lastfound 0
    }
    set f [lindex $letters $::lastfound]
    if { $f eq "" } {
        set f "--"
    }
    $::t.atoz set [string toupper $f ]
    doatoz [string tolower $f ]
    loadf .text $::t.testbut
}
proc getfile {file {nonl 1}} {
    set io  [open $file r]
    if { $nonl } {
        set data [read -nonewline $io]
    } else {
        set data [read  $io]
    }
    close $io
    return $data
}

proc createcatalog {args} {
    set letters [loadnextone 1]
    if { [llength $letters] <= 0 } {
        return 0
    }
    set out  {}
    set out2 {}
    foreach letter $letters {
        set letter [string tolower $letter]
        lappend out [list $letter [getfile save${letter}.tcl]]
        lappend out2 [list $letter [getfile save${letter}2.tcl]]
    }
    
    set io [open catalog.tcl w]
    foreach item $out { ;# write out all the text data with delimiter markers
        lassign $item letter data
        puts $io "# Begin text \{${letter}\}"
        puts $io "set tooltip_${letter} \{##\\"
        puts $io $data
        puts $io "\}\n# End text \{${letter}\}" 
        
    }

    set letter [lindex $letters 0]
    set letter [string tolower $letter]
    set last [lrange $letters 1 end]
    set first [getfile save${letter}2.tcl] ;# compare all to the first one
    set same 1
    foreach letter $last {
        set letter [string tolower $letter]
        if { [getfile save${letter}2.tcl] ne $first } { ;# if all configs the same, output only once
            puts "Not the same at $letter"
            set same 0
            break
        }
    }
#   puts "same= |$same| " 
    if { $same } {
        foreach item $out2 { ;# still need to process as a list, but just done the first one
            lassign $item letter data
            puts $io "# Begin config ${letters}"    
            puts $io $data
            puts $io "# End config ${letters}"
            break   
        }
    } else {
        foreach item $out2 { ;# do all of them since not all the same
            lassign $item letter data
            puts $io "# Begin config \{${letter}\}" 
            puts $io $data
            puts $io "# End config \{${letter}\}"   
        }
    }
    close $io
    set comment ""  
    if { $same && [llength $letters] > 1} {
        set comment "  - All with the same config" 
    }
    puts "created catalog with [llength $letters] item(s) = $letters $comment"
    return [llength $letters]
}
proc expandcatalog {} {
    if [catch {
        set data [getfile catalog.tcl]
        puts "ok"
    } err_code] {
        puts stderr $err_code
        return 
    }
    set lines [split $data \n]
    set n -1
    set toc [list]
    foreach line $lines {
        incr n
        if       { [string range $line 0 11] eq "# Begin text" } {
#                                                                   puts "t n= |[expr {   $n +1  }]| line= |$line| "
            lappend toc [list b t [expr {   $n+1   }] [lrange $line 3 end]]
        } elseif { [string range $line 0 13] eq "# Begin config" } {
#                                                                   puts "c n= |[expr {   $n +1  }]| line= |$line| "
            lappend toc [list b c [expr {   $n+1   }] [lrange $line 3 end]]
        } elseif { [string range $line 0  9] eq "# End text"  } {
#                                                                   puts "c n= |[expr {   $n +1  }]| line= |$line| "
            lappend toc [list e t [expr {   $n-1   }] [lrange $line 3 end]]
        } elseif { [string range $line 0 11] eq "# End config"  } {
#                                                                   puts "c n= |[expr {   $n +1  }]| line= |$line| "
            lappend toc [list e c [expr {   $n-1   }] [lrange $line 3 end]]
        } else {
#           dothis
        }   
    }
    puts ""
    foreach {odd even} $toc { ;# check pass
        lassign $odd  check1 kind1 n1 letters1  
        lassign $even check2 kind2 n2 letters2
        incr n1; incr n2 ;# only for testing not when done
        if { $check1 ne "b" || $check2 ne "e" || $kind1 ne $kind2} {
            puts "Bad catalog for lines $n1 to $n2"
            puts "n1= |$n1| n2= |$n2| |$check1 $check2 $kind1 $kind2| letters1= |$letters1| "
            return  
        }
        
#       puts "n1= |$n1| n2= |$n2| |$check1 $check2 $kind1 $kind2| letters1= |$letters1| "   
    }
    update
    puts stderr "Expand Catalog.tcl in directory [pwd]"
    foreach {odd even} $toc { ;# do it pass
        lassign $odd  check1 kind1 n1 letters1  
        lassign $even check2 kind2 n2 letters2
        if { $kind1 eq "t" } {
            lassign $letters1 letter
            set letter [string tolower $letter]
            set file "save$letter.tcl"
            write2file $lines [expr {   $n1+1   }] [expr {   $n2-1   }] $file
        } else {
            foreach letter $letters1 {
                set letter [string tolower $letter]
                set file "save${letter}2.tcl"
                write2file $lines $n1 $n2  $file
            }   
        }       
    }
}
proc write2file {lines from to file} {
    puts "Lines [format %5s  [expr {   $from+1   }] ]    ..  [format %5s [expr {   $to+1   }] ]  $file"
    set io  [open $file w]
    for {set m $from} {$m <= $to} {incr m} {
        puts $io [lindex $lines $m]     
    }
    close $io
        
}


proc dosetsave {arg} {
    set arg [string tolower $arg]
    set ::savefile [file join [pwd] "save${arg}.tcl"] ;# save writes here
    set ::savefile2 [file join [pwd] "save${arg}2.tcl"] ;# save writes here
}
proc doatoz {args} {
    if { $::atoz eq "--" } {
        dosetsave ""
    } else {
        dosetsave $::atoz   
    }
    atoztips    
    puts "Save file name: $::savefile"
}
proc atoztips {} {
    global t
    tooltip::tooltip $t.save  "Quick save text to $::savefile\nSave the config to $::savefile2\n"
    tooltip::tooltip $t.load   "The load/save commands use 2 fixed file names\n    $::savefile  is the text   dump\n    $::savefile2 is the config dump\nBoth are saved into the current directory\n\nNote copy/paste does not save the config settings\nUse save then include [file tail $::savefile2 ] contents in the user\nprogram if you have configured color options\n"

}
proc mwheel {direction} {
    lassign $::tooltip::G(font) name size
    if { [string is integer -strict $size] } { ;# must be an int, like courier 12
        if { $direction > 0 } {
            incr size
        } else {
            incr size -1    
        }
        if { $size > 30 || $size < 6 } {
            return
        }
        tooltip::tooltip configure -font [list $name $size]
    }
}
proc dowrapping {args} {
    if { $::wraponoff } {
        tooltip::tooltip config -wrap word
    } else {
        tooltip::tooltip config -wrap none  
    }
    
}
proc dodark {args} {
#puts "::themex= |$::themex| ::darkonoff= |$::darkonoff| "
    set con 0
    if { [info command .con] eq ".con" } {
        set con 1 ;# there's a dialog open
    }
    
    if { $::themex } { ;# cannot switch themes if no dark was available
        destroy .con
        if { $::darkonoff } {
#           puts "go to dark"
            ttk::style theme use awdark
        } else {
#           puts "go to light $::curtheme"  
            ttk::style theme use $::curtheme
        }
    } else {
        set ::darkonoff 0
        puts stderr "Cannot go to dark mode"
    }
    if { $con } {
        con_dlog $::nowcolor
    }
    
}
proc newpwd {args} {

    set dir [tk_chooseDirectory -initialdir [pwd] -mustexist yes -title "Choose a directory"]

    if {$dir eq ""} {
       puts stderr "No new directory chosen"
    } else {
       puts stderr "New directory is: $dir" ; update
       cd $dir
       doatoz $::atoz
       atoztips 
       set ::lastfound -1

    }
}

proc tearoffcmd {menu thetear} { ;# so tearoffs don't open at 0,0 - this is really ugly code I found somewhere !
#       puts "menu= |$menu| thetear= |$thetear| "
        if { $menu eq ".color" } {
            tooltip::tooltip $thetear -index  1 "These 7 colors can be configured as desired,\nbut if changed, will also affect this editors tips.\n\nClicking a color sets a selection to that color\neven if this is the current color unlike\nstyles where clicking one that is set will\nunset that style of the selection. Can click a style \ntwice to set a selection to the current setting.\n\nStyles are on/off, Colors are mutually exclusive \nradio buttons.\n"            
            tooltip::tooltip $thetear -index 10 "The 9 greys 51-59 are available for advanced\ntag usage. This editor doesn't use them\n\nNote: Settings such as tabs only apply if the first\ntext on a line is tagged with its color\n"           
            tooltip::tooltip $thetear -index 22 "Experimental, not working, just turns on the option\n"         
            tooltip::tooltip $thetear -index 24 "Opens a configure dialog for all the colors. Can \nchoose a different color while open.\n\nClick Apply before changing or changes will not be\nsaved except for checkboxes, listboxes, fonts, and\ncolors selected by the color picker.\n \nTo enter a named color type in the box and type Enter.\n\nTo revert to defaults clear an item and type Enter.\n"           
            tooltip::tooltip $thetear -index 25 "Select a directory of save files that\nall load, save, and catalog operations\nwill work in.\n"
            tooltip::tooltip $thetear -index 27 "This is Create Catalog that creates a\nsingle file catalog.tcl with all\nthe save files\n"
            tooltip::tooltip $thetear -index 28 "This is Expand Catalog that recreates\nall the save files from a single catalog.tcl\n"
        }
        set geom [wm geom .]
        set re {^([0-9]+)x([0-9]+)([+-])([+-]?[0-9]+)([+-])([+-]?[0-9]+)}
        regexp $re $geom -> dx0 dy0 xs xpos ys ypos
        set geomt [wm geom $thetear]
        regexp $re $geomt -> dx dy xs xpost ys ypost
        set newx [expr {   $xpos + $dx0 +5  }] ;# place to the right of main window
        set newy [expr {   $ypos - 1   }]
        wm geom $thetear ${dx}x$dy+${newx}+${newy}
}
 
 
proc ::popup::create {m {tear 0} {tearoffcmd {}}} {
    #----------------
    # create menu (m) with from list of supplied items (a)
    #---------------
    
    set c $m
    set m ".[string tolower $m]"
    
    # destroy any pre-exising menu with the same name
    destroy $m
    
    # create new menus
    menu $m -tearoff $tear {*}$tearoffcmd
        
    foreach i $::popup::menu($c) {
        #~~~puts "popup create $c $m $i"
        if { [lindex $i 0] != "nop" } {
            eval $m add $i
        }
    }
}

proc ::popup::show {w m} {
    #---------------
    # display the popup menu adjacent to the current pointer location
    #---------------
    
    set m ".[string tolower $m]"
    
    foreach {x y} [winfo pointerxy $w] {}
    
    set ::active(tag) $m
    tk_popup $m $x $y
    return
}
proc timems {args} {
    set result [uplevel 1 time $args]
    set number [format %.3f [expr {( [lindex $result 0] / 1000. )}]]
    set number [regsub -all {\d(?=(\d{3})+($|\.))} $number {\0,}]
    return "[format %12s $number ] milliseconds [lrange $result 2 end]"
}

proc testit {w} {
    set tip [storeText 2]
#   puts "w= |$w| tip= |$tip| "
    tooltip::tooltip $w $tip
}
proc onoff {args} {
    global tipsonoff
    if { $tipsonoff } {
        tooltip::tooltip on
    } else {
        tooltip::tooltip off    
    }
}

proc pick1 {args} {
    .text insert insert "$args"  $::texttag ;# put in here
    focus -force .text
}

proc bt {args} { ;# debugging aid
    if { $args eq "" } {
    puts [join [lsort [bind Text]] \n]
        puts ""
        return
    }
    puts [bind Text $args]
    
}
proc clip {w test} {
#   puts "w= |$w| test= |$test| "
    clear text ;# don't clear the config settings, user can use clear to do that
    set data [clipboard get]
    global s name dump dump2
    lassign $data s name dump
    if { $s ne "set" } {
        error "does not begin with a set command"
    }
    set ::tootip_varname $name
#   puts stderr $data
    puts "Command= |$s| name= |$name| list length= [llength $dump]"
    wm title . "$::wtitle $name"
    set dump2 [string range $dump 2 end ]
    restore $w  $dump2 
    testit $test

}

proc clear {what} {
    puts stderr "Clear $what"
    if       { $what eq "text" } {
        .text delete 1.0 end
        after 0 {focus -force .text}
        return
    } elseif { $what eq "all" } {
        .text delete 1.0 end
    } elseif { $what eq "config" } {
    } else {
        error "bad clear $what"
    }
    if { [info command $::tooltip::G(TOPLEVEL).text] eq ""} {
#       puts "not created yet"
        return
    }
    
# delete all tags and then restore them all, clears any set attributes
#   puts stderr "clear configurations"
    catch {destroy .con}
    
    if [catch {
        .text tag delete {*}[.text tag names]
        $::tooltip::G(TOPLEVEL).text tag delete {*}[$::tooltip::G(TOPLEVEL).text tag names]
        
        tooltip::set_tags $::tooltip::G(TOPLEVEL).text
        tooltip::set_tags .text
        foreach tag {51 52 53 54 55 56 57 58 59} { ;# recreate these, we lost them from above
            tooltip::tooltip .text -tag grey$tag "grey$tag"
        }

    } err_code] {
        puts "clear: $err_code"
    }
    after 0 {focus -force .text}

}

# overide these two actions that the text widget uses for
# its default bindings, so we can add the tags to pastes and insert
proc tk_textPaste {w} {
    if {![catch {::tk::GetSelection $w CLIPBOARD} sel]} {
        set oldSeparator [$w cget -autoseparators]
        if {$oldSeparator} {
            $w configure -autoseparators 0
            $w edit separator
        }
        if {[tk windowingsystem] ne "x11"} {
            catch { $w delete sel.first sel.last }
        }
        $w insert insert $sel $::texttag ;# modify here
        if {$oldSeparator} {
            $w edit separator
            $w configure -autoseparators 1
        }
    }
}
proc ::tk::TextInsert {w s} {
    if {$s eq "" || [$w cget -state] eq "disabled"} {
        return
    }
    set compound 0
    if {[TextCursorInSelection $w]} {
        set oldSeparator [$w cget -autoseparators]
        if {$oldSeparator} {
            $w configure -autoseparators 0
            $w edit separator
            set compound 1
        }
        $w delete sel.first sel.last
    }
    $w insert insert $s $::texttag ;# modify here
    $w see insert
    if {$compound && $oldSeparator} {
        $w edit separator
        $w configure -autoseparators 1
    }
}
proc make_border {lines pixels {grey 59}} {
    clear text
    tooltip::tooltip configure -grey$grey {\
                -background grey90 -bgstipple {} -borderwidth {} -elide {} -fgstipple {} -font {} -foreground black     \
                -justify {} -lmargin1 {} -lmargin2 {} -lmargincolor {} -offset {} -overstrike {} -overstrikefg {}       \
                -relief {} -rmargin {} -rmargincolor {} -selectbackground lightblue -selectforeground {} -spacing1 {}   \
                -spacing2 {} -spacing3 {} -tabs {} -tabstyle {} -underline {} -underlinefg {} -wrap {}                  \
            }
    tooltip::tooltip configure -grey$grey   "-background \#969696 -borderwidth 5 -elide 0           \
                                -foreground black -lmargin1 3 -offset 0 -overstrike 0               \
                                -relief raised -selectbackground lightblue -spacing1 0 -spacing3 0  \
                                -tabs $pixels -tabstyle wordprocessor -underline 0"
    .text insert 1.0 [string repeat "\n" $lines] "normal black"
    .text insert 1.end "\t " "normal grey$grey"
    .text insert $lines.end "\t " "normal grey$grey"
    for {set m 2} {$m <= $lines -1} {incr m} {
        .text insert $m.0 " " "normal grey$grey"
        .text insert $m.1 "\t" "normal black"
        .text insert $m.2 " " "normal grey$grey"
    }
    after 100 {console eval {focus -force .console}}
    return
}
proc insert_clip {{indent 1}} {
    set data [clipboard get]
    set lines [split $data \n]
    set n 1
    foreach line $lines {
        .text insert [incr n].1 "[string repeat " " $indent]$line" "normal black"
        if { $n == [llength $lines] } { ;# skip last null entry that split makes
            break
        }
    }
    after 100 {console eval {focus -force .console}}
    return
}

# toggleFont --
#     Make the text appear in bold, italic, underline font or normal
#     also current color
# Arguments:
#     None
#
# Returns:
#     Nothing
#
# Side effects:
#     Next letters typed or pasted in the text widget have the selected font and color
#
proc toggleFont {} {
    global bold
    global italic
    global under
    global red
    global texttag
    global nowcolor
    set type ""

    if { $bold } {
        append type "bold"
    }
    if { $italic } {
        append type "italic"
    }
    if { $under } {
        append type "under"
    
    }
    if { $type eq "" } {
        set type "normal"
    }
    append type " $nowcolor"
    set texttag [string trim $type ]
#   puts "texttag= |$texttag| "
    Apply2Selection
    focus -force .text
}
proc colorset {} {
    global texttag nowcolor colorlab
    lassign $texttag style
    set texttag "$style $nowcolor"
#   puts $texttag
    set fg black
    if { $nowcolor in {black green red violet grey} } {
        set fg white
    }
    set bg $nowcolor
    if { $nowcolor eq "blue" } {
        set bg lightblue
    }
    
    $colorlab configure -background $bg -foreground $fg
    Apply2Selection
    focus -force .text

}
proc Apply2Selection {} {
    set s [.text tag ranges sel]
#   puts "s= |$s| "
    if { $s eq "" } { ;# isn't one
        return
    }
    lassign $s from to
    set chars [.text get {*}$s]
    .text delete {*}$s

#   puts "newattr=   $from $chars $::texttag "
    .text insert $from $chars $::texttag
    .text tag add sel $from $to
}
proc config2text {args} { ;# copy all the config args for colors into our text edit widget
    set opts2 {-red -green -blue -orange -violet -black -grey -grey51 -grey52 -grey53 -grey54 -grey55 -grey56 -grey57 -grey58 -grey59}
    set gt ${::tooltip::G(TOPLEVEL)}.text
    foreach c $opts2 {
        set tag [string range $c 1 end] 
        set all [$gt tag config $tag] ;# get all attr's even those that are null
        foreach item $all {
            lassign $item key x2 x3 x4 val
            set err_code ""
            if [catch {
                .text tag configure $tag  {*}[list $key $val]   ;# if null there, we will reset it to null in .text also
            } err_code] {
#               puts "tried to copy tag: |$tag| key/val: |$key|  |$val| got error: $err_code" 
                catch {.text tag configure $tag  {*}[list $key {}]} ;# if this gets a bad value, our tag becomes useless
            }
        }
    }
    .text configure -foreground [tooltip::tooltip configure -foreground]
#    .text configure -background [tooltip::tooltip configure -background]
    .text configure -wrap       [tooltip::tooltip configure -wrap]
    if { [tooltip::tooltip config -wrap] eq "word" } {
        set ::wraponoff 1
    } else {
        set ::wraponoff 0
    }

    
}
proc colchange {args} {;# someone changed the current color
    global nowcolor
    if { [info command .con] eq ".con"} { ;# if there's a configure dialog open, 
        con_dlog $nowcolor       ;# start it up again with the new color
    }
}

proc con_dlog {{color grey51}} { ;# configure dialog
    set savegeom ""
    if { [info command .con] eq ".con"} {
        set savegeom [wm geom .con]
    }
    
    destroy .con
    global configs
    if [catch {
        array unset configs
    } err_code] {
        puts $err_code 
    }
    if { [info command .con] eq ".con" } {
        return ;# already or still exists
    }
    toplevel .con
    if { $::themex && $::darkonoff} {
        .con config -bg grey20
    }
    
    ttk::label .con.label1 -text "--Configuration--"
    label .con.label2 -text $color -background white -foreground black -relief ridge
    ttk::button  .con.apply     -text "Apply" -command [list doapply $color]

    grid .con.label1 .con.label2  .con.apply  
    set fields [list \
            {background         color       {value1 value2}}\
            {foreground         color       {value1 value2}}\
            {-bgstipple         entry       {value1 value2}}\
            {-fgstipple         type        {value1 value2}}\
            {font               font        {value1 value2}}\
            {justify            combobox    {left center right}}\
            {offset             spinbox     {-25 25 1 0} "Raises or lowers the text"}\
            {borderwidth        spinbox     {0 30 1 0}}\
            {relief             combobox    {flat groove raised ridge solid sunken} "Works together with borderwidth"}\
            {lmargin1          spinbox      {0 100 1 0} "Only effective if text of this color\nbegins on a line\n"}\
            {lmargin2          spinbox      {0 100 1 0}}\
            {lmargincolor       color       {value1 value2}}\
            {rmargin           spinbox      {0 100 1 0}}\
            {rmargincolor       color       {value1 value2}}\
            {elide             checkbutton  {value1 value2} "Hides all text of this color"}\
            {overstrike         checkbutton {value1 value2}}\
            {underline          checkbutton {value1 value2}}\
            {overstrikefg       color       {value1 value2}}\
            {underlinefg        color       {value1 value2}}\
            {-selectbackground  color       {value1 value2}}\
            {-selectforeground  color       {value1 value2}}\
            {-                separator    {0 50 1 0}}\
            {spacing1          spinbox      {0 50 1 0}}\
            {spacing2          spinbox      {0 50 1 0}}\
            {spacing3          spinbox      {0 50 1 0}}\
            {tabs              entry        {value1 value2} "If tabs is a single integer, it can be\nadjusted by 1 unit with the mousewheel\nshift-wheel adjusts by 10\n"}\
            {tabstyle           combobox    {tabular wordprocessor}}\
            {wrap               combobox    {none char word} "Still experimental"}\
            {{}                 separator    {value1 value2}}\
        ]
    set i 0
    foreach field $fields {
        lassign $field name type values tips
        if { [string index $name 0] eq "-" } {
            continue
        }
        set ddd {} ;# assume no dialog needed
        if { $type ne "separator" } {
            set vnow [lindex [.text tag config $color -$name] end ]
        }
        incr i
        set l [ttk::label .con.l$i -text "$name"  ]
        if { $tips ne "" } {
                tooltip::tooltip .con.l$i $tips
        }
        set ::configs($i,type) $type
        if       { $type eq "combobox" } {
            set w [ttk::combobox .con.w$i -textvariable ::configs($i,value) -values $values  ]
            bind .con.w$i <<ComboboxSelected>> [list setcombo $i $color]
            set ::configs($i,value) $vnow
            set ::configs($i,legal) $values
        } elseif { $type eq "spinbox" } {
            lassign $values from to by initial
            set w [ttk::spinbox .con.w$i -textvariable ::configs($i,value) -from $from -to $to -increment $by -command [list setspin $i $color]]
            set ::configs($i,value) $vnow
            if { $vnow eq "" } {
                .con.w$i set $initial
            } else {
                .con.w$i set $vnow  
            }
        } elseif { $type eq "separator" } {
            set w [ttk::separator .con.w$i] 
        } elseif { $type eq "checkbutton" } {
            set w [ttk::checkbutton .con.w$i -variable ::configs($i,value) -command [list setcheck $i $color]]
            set ::configs($i,value) $vnow
        } elseif { $type eq "font" } {
            set w [ttk::entry .con.w$i -textvariable ::configs($i,value)]
            set ::configs($i,value) $vnow
            set ::configs($i,legal) "-font"
            set ddd [ttk::button .con.cw$i -command [list setfont $i $color] -text Font...]
            bind .con.w$i <Key-Return> [list doapply $color]
        } elseif { $type eq "color" } {
            set w [ttk::entry .con.w$i -textvariable ::configs($i,value)]
            set ::configs($i,value) $vnow
            set ddd [ttk::button .con.cw$i -command [list setcolor $i $color] -text Color...]
            bind .con.w$i <Key-Return> [list doapply $color]
        } elseif { $type eq "entry" } {
            set w [ttk::entry .con.w$i -textvariable ::configs($i,value)]
            set ::configs($i,value) $vnow
            bind .con.w$i <Key-Return> [list doapply $color]
            bind .con.w$i <MouseWheel> [list entrywheel %D 1 $i $color]
            bind .con.w$i <Shift-MouseWheel> [list entrywheel %D 10 $i $color]
        } elseif { $type eq "type" } {
            
        } else { ;# no default
            error "bad configure type $type"
        }
        grid $l $w {*}$ddd -sticky w -padx 10
#       puts "$w / name= |$name| type= |$type| values= |$values| "
        set configs($i,name) $name
        
    }
    tooltip::tooltip .con.apply "Apply static values from text entries\nFor example font, named colors, or tabs\nNote: relief needs a borderwidth\nspinboxes should support mousewheel\nCan also type Return in any entry to apply\nMany attributes only apply if first used on a\nline e.g. spacing123, margins or tabs\n"
#   button  .con.ok        -text "Ok"    -command {} 
#    ttk::button  .con.done    -text "Done"  -command {destroy .con} 
#    grid .con.apply  .con.done 
    if { $savegeom ne "" } {
        wm geom .con $savegeom
    } else {
        wm geom .con +9+3      
    }

}
proc between {a b c} {
    if       { $b < $a } {
        return $a
    } elseif { $b > $c } {
        return $c
    } else {
        return $b
    }
}
proc copyg {from to} {
    if { ![string is integer $from ]  || ![string is integer $to ] } {
        error "$from and $to are not both integers"
    }
    if {!( [between 1 $from 9] == $from) || ! ( [between 1 $to 9] == $to)} {
        error "$from or $to out of range (1..9)"
    }
    tooltip::tooltip configure -grey5$to [tooltip::tooltip configureall -grey5$from]
    if { [info command .con] eq ".con" } {
        set geom [wm geom .con]
        con_dlog grey5$to
        set ::nowcolor grey5$to
        wm geom .con $geom
    }
}
proc entrywheel {dir mult i color} {
    set v $::configs($i,value)
    if {! [string is integer $v] } {
        return ;# if not a simple integer, we just punt
    }
    if { $dir  > 0} {
        incr ::configs($i,value) $mult
    } else {
        incr ::configs($i,value) -$mult
    }
    doapply $color
}
proc doapply {color} {
    global configs
    for {set i 1} {$i < 100} {incr i} {
        if {! [info exist ::configs($i,name)] } {
#           puts "done doapply $i"
            return
        }
        if { $::configs($i,type) in {font color entry}} {
#           puts "apply to $color [format %10s $i ] with [format %15s |$::configs($i,name)| ] type= [format %10s |$::configs($i,type)| ] value = |$::configs($i,value)|"
            tooltip::tooltip config -$color [list -$::configs($i,name) $::configs($i,value)]
        }
        
    }
}
proc foo {args} { ;# for debug only
   puts "foo: args= |$args|"
}

proc setcombo {i color} {
#   puts "combo: i= |$i|  color= |$color| "
    if { $::configs($i,value) in $::configs($i,legal)} {
        tooltip::tooltip config -$color "-$::configs($i,name)  $::configs($i,value)"
    } else {
        puts stderr "invalid $::configs($i,name) not one of $::configs($i,legal)"
    }
    
}
proc setcheck {i color} {
#   puts "check: i= |$i|  color= |$color| "
        tooltip::tooltip config -$color "-$::configs($i,name)  $::configs($i,value)"
}
proc setspin {i color} {
#   puts "spin: i= |$i|  color= |$color| "
        tooltip::tooltip config -$color "-$::configs($i,name)  $::configs($i,value)"
}
proc setcolor {i color} {
    set ncolor [tk_chooseColor -initialcolor $color -title "Choose color"]
#   puts "col: i= |$i| ncolor= |$ncolor| color= |$color| "
    if { $color ne "" } {
        set ::configs($i,value) $ncolor
        tooltip::tooltip config -$color "-$::configs($i,name) $ncolor"
    }
}

proc setfont {i color} {
    tk fontchooser configure -command [list gotfont $i $color]
    tk fontchooser show 
#   puts "col: i= |$i| ncolor= |$ncolor| color= |$color| "
}
proc gotfont {i color args} {
#   puts "gotfont i= |$i| color= |$color| args= |$args| "
    lassign $args nfont
    if { $color ne "" } {
         set ::configs($i,value) $nfont
         tooltip::tooltip config -$color "-$::configs($i,name) [list $nfont]"
    }
}
catch {unset conv}  ;# we generate this once only, takes time to build it
proc tocode {str} { ;# revert back to unicode \uFFFF so can be placed in source code
    global conv
    if { ![info exist conv] } {
        set conv [list "\t" "\\t" " " " "] ;# space to space for speedup, same as letter/symbols below
        set c {e i a n s o r t l c u d p m h g y b f v k w z x j q E I A N S O R T L C U D P M H G Y B F V K W Z X J Q 0 1 2 3 4 5 6 7 8 9 0}
        set d {! @ # $ % ^ & * ( ) _ + - = \{ \} [ ] ; ' : \" < > , . / ?}   
        foreach letter [concat {{ }} $c $d] {
            lappend conv $letter $letter
        }
        # most chars are not unicode, so the above is found quickly worst case is no hit at all
        for {set m 0x100} {$m < 0xffff} {incr m} {
            if { $m == 0x2424 || $m == 0x2409} {
                continue ;# except for our nl char or horizontal tab
            }
            set h [format %04x $m  ]
            set y "set x \\u$h"
            eval $y
            lappend conv $x "\\u$h" 
        }
    }
    return [string map $conv $str]
}
# storeText --
#     Dump the contents
#
# Arguments:
#     action 1=save 2=return text dump, with unicode back to \uxxxx form so we can use in a program
#
# Returns:
#     Nothing
#
# Side effects:
#     Prints the contents of the text widget in a console
#     and saves it based on action
#
proc storeText {action} {
#    console show
    global tags 

    set ender "end"
    set textdump [.text dump 1.0 $ender]
    if { [.text get end-1c end] eq "\n" } {
#       puts "trimming last newline"
        set textdump [lrange $textdump 0 end-3] 
    }

    if { $action == 1} {
        set ::save $textdump
        set io [open $::savefile w]
        fconfigure $io -encoding utf-8
        puts $io [tocode $::save]
        close $io
        
        set io [open $::savefile2 w]
        set out [tooltip::tooltip configureall]
        regsub -nocase -linestop -lineanchor -all {(-grey5[1-9]|-blue|-violet|-red|-green|-orange|-black|-grey )} $out "\\\n\\1" out2
        puts $io "tooltip::tooltip configure $out2"
        close $io
    }
    
    if { $action == 2} {
        set ans "##[tocode $textdump]" ;# so we can time this easier
        return $ans
    }
    set tcode "\nset $::tootip_varname \{##[tocode $textdump]\}\n\n" ;# code we can copy into our program
    clipboard clear ; clipboard append "$tcode" ;# the 2 #'s tell tooltip it's a complex tip
    set ::clipboard $tcode
    catch {unset ::tags}
    set cnt 0
    foreach {key value index}  $textdump { ;# fancy dump
        set color normal
        if { $key eq "text" } {
            set color red
            set value [string map {"\n" "\u2424" "\t" "\u2409" } $value]
        }
        
        if { $key eq "tagon" } {
                set color normal
                set ::tags($value) {}
                foreach item [.text tag configure $value] {
                    set value2 [lindex $item 4]
                    if {[string length $value2] > 0} {
                        set option [lindex $item 0]
                        lappend ::tags($value) $option $value2
                    }
                }
        }
        cputs $color "key= |[format %10s $key]| index= |[format %10s $index ]| value= [format %-30s |[tocode $value]|]  \n" 
        if { [incr cnt] % 100 == 0 } {
            update
        }
         
    }
    puts \n-----------------\n
    if [catch {
        parray ::tags
    } err_code] {
        puts $err_code
    }
    puts \n-----------------\n
}
proc loadf {w test} {
    set con 0
    if { [info command .con] eq ".con" } {
        set con 1 ;# there's a dialog open
        set geom [wm geom .con]
    }
    clear all
    set io [open $::savefile r]
    fconfigure $io -encoding utf-8 ;# for our unicode characters
    set ::save [read -nonewline $io]
     
    close $io
    if { [lindex $::save end-2] eq "text" &&  [lindex $::save end-1] eq "\n"} {
#       puts "trimming last newline on load"
        set ::save [lrange $::save 0 end-3]
    }

    restore $w $::save

    if { [file exist $::savefile2] } {
        source $::savefile2
    }
    
    testit $test
    if { [tooltip::tooltip config -wrap] eq "word" } {
        set ::wraponoff 1
    } else {
        set ::wraponoff 0
    }
    if { $con } {
        con_dlog $::nowcolor
        wm geom .con $geom
    }

}
proc restore {w savex} {
    set save [subst -nocommands -novariables $savex]
    # create items, restoring their attributes
    foreach {key value index} $save \
            {
        switch $key \
                {
            exec    { eval [string replace $value 0 [string first " " $value]-1 $w] }
            image   { $w image create $index -name $value }
            text    { $w insert $index $value }
            mark    {
                switch $value {
                    current { set currentIndex $index }
                    insert { set insertIndex $index}
                    default { $w mark set $value $index }
                }
            }
            tagon   { set tag($value) $index }
            tagoff  { $w tag add $value $tag($value) $index }
            window  { $w window create $index -window $value }
        }
    }
    $w mark set current $currentIndex
    $w mark set insert $insertIndex
}
proc cputs { color args} { ;# this (re-)defines my color puts
    if { $::tcl_platform(platform) eq "windows" || 1} {
        if { $color eq "red" } {
            puts -nonewline stderr {*}$args
        } else {
            puts -nonewline {*}$args
        }
    } else {
        puts -nonewline {*}$args
    }
}

#proc
# main --
#     Run the thing
#



# Include a console for non-windows and modify it

#puts "before console "
package require Tk
if { $::tcl_platform(platform)  ne "windows" } {
if {[catch {console show}]} { ;# if already done, bypass
puts "enable console" 
 
 
 
######################## linux console

 
########################################################################
# Check Tcl/Tk support
########################################################################
if {[catch {package require Tcl 8-}]} {
    package require Tcl 7.5-
}

if {[catch {package require Tk 8-}]} {
    if {[catch {package require Tk 4.1}]} {
        return -code error "Tk required but not loaded."
    }
}


########################################################################
# Provide the support which the Tk library script console.tcl assumes
########################################################################
# 1. Create an interpreter for the console window widget and load Tk
set consoleInterp [interp create]
$consoleInterp eval [list set tk_library $tk_library]
$consoleInterp alias exit exit
load "" Tk $consoleInterp
 
# 2. A command 'console' in the application interpreter
;proc console {sub {optarg {}}} [subst -nocommands {
    switch -exact -- \$sub {
        title {
            $consoleInterp eval wm title . [list \$optarg]
        }
        hide {
            $consoleInterp eval wm withdraw .
        }
        show {
            $consoleInterp eval wm deiconify .
        }
        eval {
            $consoleInterp eval \$optarg
        }
        default {
            error "bad option \\\"\$sub\\\": should be hide, show, or title"
        }
    }
}]

# 3. Alias a command 'consoleinterp' in the console window interpreter
#       to cause evaluation of the command 'consoleinterp' in the
#       application interpreter.
;proc consoleinterp {sub cmd} {
    switch -exact -- $sub {
        eval {
            uplevel #0 $cmd
        }
        record {
            history add $cmd
            catch {uplevel #0 $cmd} retval
            return $retval
        }
        default {
            error "bad option \"$sub\": should be eval or record"
        }
    }
}
if {[package vsatisfies [package provide Tk] 4]} {
    $consoleInterp alias interp consoleinterp
} else {
    $consoleInterp alias consoleinterp consoleinterp
}

# 4. Bind the <Destroy> event of the application interpreter's main
#    window to kill the console (via tkConsoleExit)
bind . <Destroy> [list +if {[string match . %W]} [list catch \
        [list $consoleInterp eval ::tk::ConsoleExit]]]

# 5. Redirect stdout/stderr messages to the console
if { 0 } { ;#no, don't use this, it doesn't work (unicode fail)
    # 5a. we can use TIP#230 channel transforms to achieve this simply:

} else {
    # 5b. Pre-8.6 needs to redefine 'puts' in order to redirect stdout
    #     and stderr messages to the console
    rename puts tcl_puts
    ;proc puts {args} [subst -nocommands {
        switch -exact -- [llength \$args] {
            1 {
                if {[string match -nonewline \$args]} {
                    if {[catch {uplevel 1 [linsert \$args 0 tcl_puts]} msg]} {
                        regsub -all tcl_puts \$msg puts msg
                        return -code error \$msg
                    }
                } else {
                    $consoleInterp eval [list ::tk::ConsoleOutput stdout \
                            "[lindex \$args 0]\n"]
                }
            }
            2 {
                if {[string match -nonewline [lindex \$args 0]]} {
                    $consoleInterp eval [list ::tk::ConsoleOutput stdout \
                            [lindex \$args 1]]
                } elseif {[string match stdout [lindex \$args 0]]} {
                    $consoleInterp eval [list ::tk::ConsoleOutput stdout \
                            "[lindex \$args 1]\n"]
                } elseif {[string match stderr [lindex \$args 0]]} {
                    $consoleInterp eval [list ::tk::ConsoleOutput stderr \
                            "[lindex \$args 1]\n"]
                } else {
                    if {[catch {uplevel 1 [linsert \$args 0 tcl_puts]} msg]} {
                        regsub -all tcl_puts \$msg puts msg
                        return -code error \$msg
                    }
                }
            }
            3 {
                if {![string match -nonewline [lindex \$args 0]]} {
                    if {[catch {uplevel 1 [linsert \$args 0 tcl_puts]} msg]} {
                        regsub -all tcl_puts \$msg puts msg
                        return -code error \$msg
                    }
                } elseif {[string match stdout [lindex \$args 1]]} {
                    $consoleInterp eval [list ::tk::ConsoleOutput stdout \
                            [lindex \$args 2]]
                } elseif {[string match stderr [lindex \$args 1]]} {
                    $consoleInterp eval [list ::tk::ConsoleOutput stderr \
                            [lindex \$args 2]]
                } else {
                    if {[catch {uplevel 1 [linsert \$args 0 tcl_puts]} msg]} {
                        regsub -all tcl_puts \$msg puts msg
                        return -code error \$msg
                    }
                }
            }
            default {
                if {[catch {uplevel 1 [linsert \$args 0 tcl_puts]} msg]} {
                    regsub -all tcl_puts \$msg puts msg
                    return -code error \$msg
                }
            }
        }
    }]
    $consoleInterp alias puts puts
    # Restore normal [puts] if console widget goes away...
    proc Oc_RestorePuts {slave} {
        rename puts {}
        rename tcl_puts puts
        interp delete $slave
    }
}

# 6. No matter what Tk_Main says, insist that this is an interactive  shell
set tcl_interactive 1

########################################################################
# Evaluate the Tk library script console.tcl in the console interpreter
########################################################################
$consoleInterp eval source [list [file join $tk_library console.tcl]]
if {[string match 8.3.4 $tk_patchLevel]} {
    # Workaround bug in first draft of the tkcon enhancments
    $consoleInterp eval {
        bind Console <Control-Key-v> {}
    }
}

$consoleInterp alias Oc_RestorePuts Oc_RestorePuts $consoleInterp
$consoleInterp eval {
    bind Console <Destroy> +Oc_RestorePuts
}


unset consoleInterp

console title "[wm title .] Console"


######################## end linux console
 
 
 
 
    
 } else { ;# already done
     puts "console already done"
 }
 } ;# if not windows

if [catch { ;# add our enhancements if not allready there (in the tclkit)
    console eval {
        
        if { ![info exist ::tk::do_scroll] } {
            
#           proc console stuff
            set vers [split [info patch] .]
            # was: $::tcl_platform(platform) eq "windows" && [package vcompare [info patch] 8.6.9]
            if { [.menubar.edit entrycget 5 -label] eq "Font..."} { ;# test for font... menu item, if there, +1 to find incr/decr font size
                set menuincr 1
                puts "incr menu, there's a Font... item"
            } else {
                set menuincr 0
                puts "no incr menu, there's no Font... item"
            }
            if [catch {
                .console config -inactiveselectbackground SystemInactiveBorder 
            } err_code] {
                puts stderr "inactive border setup: $err_code "
            }
            .console config -tabs {32 left} -tabstyle wordprocessor -width 30
#           wm geom . 110x30+446+9
            bind all <Button-3> {.menubar.edit invoke 2}
            bind all <Control-Button-3> {.menubar.edit invoke 1;.menubar.edit invoke 2}
            pack forget .console .sb .consoleframe
            
            pack [frame  .frame -bg black] -side left -fill y -ipady 10 -pady 10
            #pack [button .frame.eval -text Cev  -command {clipboard clear; clipboard append "console eval \{\}"; .menubar.edit invoke 2}] -side top -fill x
            pack [button .frame.clear -bg white -fg black -text Clear -command {.menubar.file invoke 2}] -side top -fill x
            pack [button .frame.smaller -bg white -text {font -} -command {.menubar.edit invoke [expr ( $menuincr+6 )];after 100 {.frame.repos invoke}}] -side top -fill x
            pack [button .frame.bigger  -bg white -text {font +} -command {.menubar.edit invoke [expr ( $menuincr+5 )];after 100 {.frame.repos invoke}}] -side top -fill x
            pack [button .frame.exit     -bg pink -text Exit -command {exit}] -side top -fill x
            pack [button .frame.repos -bg white -text BottOM -command {.console see end; .console mark set insert end}] -side top -fill x
            pack [frame  .frame.frame -bg black] -side top -fill x
            pack [button .frame.frame.pm20 -bg gray -text -x -command {wm geom . [expr [lindex [split [wm geom .] x] 0]-10]x[lindex [split [wm geom .] x] 1]}] -side left -fill x -expand 1
            pack [button .frame.frame.pp20 -bg gray -text +x -command {wm geom . [expr [lindex [split [wm geom .] x] 0]+10]x[lindex [split [wm geom .] x] 1]}] -side left -fill x -expand 1
            
            .frame.bigger invoke;.frame.bigger invoke;.frame.bigger invoke;.frame.bigger invoke
            
            pack [checkbutton .frame.scroll -bg white -fg black  -text scroll -variable ::tk::do_scroll] -side top -fill x
            pack .consoleframe -in . -anchor center -expand 1 -fill both -ipadx 0 -ipady 0 -padx 0 -pady 0 -side left
            pack .console -in .consoleframe -anchor center -expand 1 -fill both -ipadx 0 -ipady 0 -padx 1 -pady 1 -side left
            pack .sb -in .consoleframe -anchor center -expand 0 -fill both -ipadx 0 -ipady 0 -padx 1 -pady 1 -side right
            set ::tk::console::maxLines 10000
            .menubar add casc -label Extra2 -menu [menu .menubar.extra -tearoff 0]
            proc menu+ {head label cmd} {
                set cmd2 [list consoleinterp eval $cmd]
                .menubar.$head add command -label $label -command $cmd2
            }
#           menu+ extra {Widget Tree} {wtree}
            proc ::tk::ConsoleOutput {dest string} {
                set w .console
                $w insert output $string $dest
                ::tk::console::ConstrainBuffer $w $::tk::console::maxLines
                if {$::tk::do_scroll} {$w see insert}
            }
            set ::tk::do_scroll 1
        }
    }
} errstr ] {
    puts stderr "console error = $errstr"
}


mainWindow








======
<<enddiscussion>>
The easiest way to include borders around tooltips is to configure the text widget that cooltip creates:
<<discussion>>
======
# First, the toplevel must be createad, if not already done.
# Paste this into the gui editor's console (cntrl-v not the paste button) 
# to apply it there and see results in the editor's own tips as well as any 
# being created
# 

if {![winfo exists $::tooltip::G(TOPLEVEL)]} {
        ::tooltip::createToplevel
}
$::tooltip::G(TOPLEVEL).text config -bd 8 -relief ridge -pady 4 -padx 4

======


<<enddiscussion>>

<<categories>> Concept | Text Widget | tklib | GUI | Dev. Tools