#!/bin/sh
#  -*- mode: tcl; fill-column: 75; tab-width: 8 -*- \
exec wish "$0" -- "$@"

package require Tk 8.6-
catch {package require Img}

#
# Xmaxima is created from the files in the directory interfaces/xmaxima/Tkmaxima/
# in maxima's source tree. For creating this program maxima
# version 5.50.0 was used.
#
# The main purpose of this header is to tell un*x-based systems how to execute
# the program. 
#
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifht Floor, Boston,
# MA 02110-1301, USA
# Voodo for CYGWIN
# Is there a canonical way of telling we are under CYGWIN?
if {$::tcl_platform(platform) == "windows" && \
	[info exists ::env(PATH)] && $::env(PATH) != "" && \
	[string match {*/usr/bin*} $::env(PATH)] && \
	[string match {*:*} $::env(PATH)] && \
	![string match {*;*} $::env(PATH)]} {
    # CYGWIN uses Unix PATH but Tcl considers it Windows
    # What's even worse auto_execok uses ; but exec uses :
    if {0} {
	set ::env(PATH) [join [split $::env(PATH) ":"] ";"]
    } else {
	set ::xmaxima_priv(platform) cygwin
        # Windows version.
        #
        # Note that info executable doesn't work under Windows, so we have to
        # look for files with .exe, .com, or .bat extensions.  Also, the path
        # may be in the Path or PATH environment variables, and path
        # components are separated with semicolons, not colons as under Unix.
        #
        proc auto_execok name {
            global auto_execs
            if {[info exists auto_execs($name)]} {
                return $auto_execs($name)
            }
            set auto_execs($name) ""
            set shellBuiltins [list cls copy date del erase dir echo mkdir \
                                   md rename ren rmdir rd time type ver vol]
            if {[string equal $::tcl_platform(os) "Windows NT"]} {
                # NT includes the 'start' built-in
                lappend shellBuiltins "start"
            }
            if {[info exists ::env(PATHEXT)]} {
                # Add an initial : to have the {} extension check first.
                set execExtensions [split ":$::env(PATHEXT)" ":"]
            } else {
                set execExtensions [list {} .bat .com .exe]
            }
            if {[lsearch -exact $shellBuiltins $name] != -1} {
                return [set auto_execs($name) [list $::env(COMSPEC) /c $name]]
            }
            if {[llength [file split $name]] != 1} {
                foreach ext $execExtensions {
                    set file ${name}${ext}
                    if {[file exists $file] && ![file isdirectory $file]} {
                        return [set auto_execs($name) [list $file]]
                    }
                }
                return ""
            }
            set path "[file dirname [info nameof]]:.:"
            if {[info exists ::env(WINDIR)]} {
                set windir $::env(WINDIR) 
            }
            if {[info exists windir]} {
                if {[string equal $::tcl_platform(os) "Windows NT"]} {
                    append path "$windir/system32:"
                }
                append path "$windir/system:$windir:"
            }
            foreach var {PATH Path path} {
                if {[info exists ::env($var)]} {
                    append path ":$::env($var)"
                    break
                }
            }
            foreach dir [split $path {:}] {
                # Skip already checked directories
                if {[info exists checked($dir)] || [string equal {} $dir]} {
                    continue
                }
                set checked($dir) {}
                foreach ext $execExtensions {
                    set file [file join $dir ${name}${ext}]
                    if {[file exists $file] && ![file isdirectory $file]} {
                        return [set auto_execs($name) [list $file]]
                    }
                }
            }
            return ""
        }
    }
} else {
      set ::xmaxima_priv(platform) $::tcl_platform(platform)
}
############################################################
# Constants.tcl                                            #
# Copyright (C) 1998 William F. Schelter                   #
# For distribution under GNU public License.  See COPYING. #
#                                                          #
#     Modified by Jaime E. Villate                         #
############################################################

proc cMAXINITBeforeIni {} {
    global embed_args tk_version

    # default settings. Might be changed by local configuration file
    set ::xmaxima_default(plotwindow) multiple
    set ::xmaxima_default(iShowBalloons) 0
    set ::xmaxima_default(fontAdjust) 0
    set ::xmaxima_default(iConsoleWidth) 80
    set ::xmaxima_default(iConsoleHeight) 32
    set ::xmaxima_default(browser) 1
    
    # Set up Maxima console font
    set cfont [font actual TkFixedFont -family]
    set cfontsize [font actual TkFixedFont -size]
    catch {font delete ConsoleFont}
    font create ConsoleFont -family $cfont -size $cfontsize 
    set ::xmaxima_default(ConsoleFont) [list $cfont $cfontsize]
    set ::xmaxima_default(iLocalPort) 4008
    set ::xmaxima_default(bDebugParse) 0

    # Set the path to the home directory
    if {[string index $tk_version 0] == 9} {
        set ::xmaxima_priv(home) [file home]
    } elseif {[info exists ::env(HOME)]} {
        set ::xmaxima_priv(home) $::env(HOME)
    } else {
        set ::xmaxima_priv(home) "~"
    }

    # Set the paths to the configuration directory.
    # 1- Windows: the configuration directory should be ~\AppData\Local\Maxima
    #    but if ~\AppData\Local does not exist, use the home directory.
    # 2- Other systems: the configuration directory should be ~/.config/maxima
    #    but if ~/.config does not exist, use the home directory.
    # The user can set the environment variable $XDG_CONFIG_HOME
    # (%LOCALAPPDATA% in Windows) to use a different configuration directory.
    #
    if {$::tcl_platform(platform) == "windows"} {
        if {[info exists ::env(LOCALAPPDATA)]} {
            set ::xmaxima_priv(confdir) $::env(LOCALAPPDATA)/Maxima
        } elseif {[file isdirectory $::xmaxima_priv(home)/AppData/Local]} {
            set ::xmaxima_priv(confdir) \
                $::xmaxima_priv(home)/AppData/Local/Maxima
        } else {
            set ::xmaxima_priv(confdir) $::xmaxima_priv(home)
        }
    } else {
        if {[info exists ::env(XDG_CONFIG_HOME)]} {
            set ::xmaxima_priv(confdir) $::env(XDG_CONFIG_HOME)/maxima
        } elseif {[file isdirectory $::xmaxima_priv(home)/.config]} {
            set ::xmaxima_priv(confdir) $::xmaxima_priv(home)/.config/maxima
        } else {
            set ::xmaxima_priv(confdir) $::xmaxima_priv(home)
        }
    }

    # Set the path for the configuration and history files.
    # If the configuration directory is the same as home, those files will
    # be named .xmaximarc and .xmaxima_history, as in old versions of Xmaxima.
    # Otherwise, they will be named xmaxima_default and xmaxima_history.
    #
    if {$::xmaxima_priv(confdir) == $::xmaxima_priv(home)} {
        set ::xmaxima_priv(conffile) $::xmaxima_priv(home)/.xmaximarc
        set ::xmaxima_priv(history) $::xmaxima_priv(home)/.xmaxima_history
    } else {
        set ::xmaxima_priv(conffile) $::xmaxima_priv(confdir)/xmaxima_default
        set ::xmaxima_priv(history) $::xmaxima_priv(confdir)/xmaxima_history
        if {![file isdirectory $::xmaxima_priv(confdir)]} {
            file mkdir $::xmaxima_priv(confdir)
        }
    }
        
    # from FileDlg.tcl
    set ::xmaxima_default(OpenDir) "$::xmaxima_priv(home)/"
    # The last files opened and saved. Any default value serves
    # but a good starting value is Xmaxima's initialization file.
    set ::xmaxima_default(OpenFile) $::xmaxima_priv(conffile)
    set ::xmaxima_default(SaveFile) $::xmaxima_priv(conffile)

    if { "[info var embed_args]" != "" } {
	# the following will be defined only in the plugin
	set ::xmaxima_default(defaultservers) nmtp://some.server.example.org/
    }
    set ::xmaxima_priv(imgregexp) {[.](gif|png|jpe?g)[^/]*$}

    # from Getdata1.tcl
    set ::xmaxima_priv(cachedir) "$::xmaxima_priv(home)/.xmaxima/cache"
}

# Reads the xmaxima configuration file and if a line contains
# a key valid key and a value, separated by space, the value
# associated to that key in ::xmaxima_default will be set to
# that value.
proc cMAXINITReadIni {} {
    if {[file isfile $::xmaxima_priv(conffile)]} {
        set fileId [open $::xmaxima_priv(conffile) r]
        foreach line [split [read $fileId] \n] {
            if {![catch {llength $line}]} {
                if {[llength $line] == 2} {
                    set key [lindex $line 0]
                    if {[info exists ::xmaxima_default($key)]} {
                        set val [string map "\~ $::xmaxima_priv(home)" \
                                     [lindex $line 1]]
                        set ::xmaxima_default($key) $val
                    }
                }
            }
        }
        close $fileId
    }
}

proc cMAXINITAfterIni {} {
    lMaxInitSetOpts

    # from plot3d.tcl
    set ::xmaxima_priv(speed) [expr {(9700.0 / (1 + [lindex [time {set i 0 ; while { [incr i] < 1000} {}} 1] 0]))}]

    # from Wmenu.tcl
    global show_balloons
    set show_balloons $::xmaxima_default(iShowBalloons)

    # From Browser.tcl
    global debugParse
    set debugParse $::xmaxima_default(bDebugParse)

    if {[info exists ::xmaxima_default(lProxyHttp)] && \
	    [llength $::xmaxima_default(lProxyHttp)] == "2"} {
	#mike FIXME: make this a _default
	set ::xmaxima_priv(proxy,http) $::xmaxima_default(lProxyHttp)
    }

}

# Constants
set ::xmaxima_priv(date) 21/03/2024

if { ![info exists ::xmaxima_priv(date)] } {
    set ::xmaxima_priv(date) [clock  format [clock seconds] -format {%m/%d/%Y} ]
}

# from Preamble.tcl
set ::xmaxima_priv(clicks_per_second) 1000000

# from Plot2d.tcl
array set ::xmaxima_priv { bitmap,disc4 {#define disc4_width 4
#define disc4_height 4
static unsigned char disc4_bits[] = {
    0x06, 0x0f, 0x0f, 0x06};}
    bitmap,disc6 {#define disc_width 6
#define disc_height 6
static unsigned char disc_bits[] = {
    0xde, 0xff, 0xff, 0xff, 0xff, 0xde};}
}

# from xmaxima.tcl
set ::xmaxima_priv(options,maxima) {{doinsert 0 "Do an insertion" boolean}}

# from EHref.tcl
set ::xmaxima_priv(options,href) {
    {src "" [mc "A URL (universal resource locator) such as http://maxima.sourceforge.net/index.html"]}
    {search "" [mc "A string to search for, to get an initial position"]}
    {searchregexp "" [mc "A regexp to search for, to get an initial position"]}
}

# from Preamble.tcl
set ::xmaxima_priv(counter) 0
	
# the linelength initially will have Maxima's default value.
set ::xmaxima_priv(linelength) 79

# From Browser.tcl
set ::xmaxima_priv(sticky) "^Teval$|^program:"
set ::xmaxima_priv(richTextCommands) {Tins TinsSlashEnd}
set ::xmaxima_priv(urlHandlers) {
    text/html  netmath
    text/plain netmath
    image/gif  netmath
    image/png  netmath
    image/jpg netmath
    image/jpeg netmath
    application/postscript "ghostview -safer %s"
    application/pdf "acroread %s"
    application/x-dvi "xdvi %s"
}
set ::xmaxima_priv(imagecounter) 0

global evalPrograms
set evalPrograms {  gp gap gb }
#set ::xmaxima_priv(options,maxima) {{doinsert 1 "Do an insertion" boolean}}
#set ::xmaxima_priv(options,gp) {{doinsert 1 "Do an insertion" boolean}}
#set ::xmaxima_priv(options,openplot) {{doinsert 0 "Do an insertion" boolean}}

# Icons from the Tango Desktop Project (http://tango.freedesktop.org)
# "The Tango base icon theme is released to the Public Domain.
# "The palette is in public domain. Developers, feel free to ship it
# "along with your application."

# Images added by J. Villate

image create photo ::img::brokenimage -format GIF -data {
    R0lGODlhHQAgAOMEAAAAAP9jMcbGxoSEhP///zExY/9jzgCEAP/////////////////////
    //////////yH5BAEAAAIALAAAAAAdACAAAATTcMhJqxU440G6/+AnaRkXnuAgqKRJvi+3th
    1sbzWLE/bh+xoTT+d6/Y6lz2xVIx2fO8+sqHkiBYCsNsvkOa1ATGFMBkiaVfAhSDFTM+r1q
    +NGp6Ew+plnMF7zBHV8fTc3ei4GiYU2hzWJioskjYOPLwGXmJdiBYICj5UamZqbI4ifkBii
    mwVEjqckowJkI0mUqDBjtEGut6ucrC+doBq5EzADwoQkwDccwsRkzMeTL6y6MSrU0DotkoF
    7HsU22SGCHbmFKN9bWdwk7PBmK9fYFhQZEQA7
}

image create photo ::img::play -format GIF -data {
    R0lGODlhFgAWAPZZAEpMSVJUUVRWU1dZVVdaVVhaVVhaVlhbVllbVllaV1lbV1lbWFpbWFl
    cWFteWVxeW11eW11fW19hXF5gXV9iXWBiXmFiXmNkYGRlYmRmYmdoZW9wbnN2cnV3c3x9e5
    KTkJGUkJKUkaChn7K0sLO2srq7ur/AvcDCv8/Rz9jZ2OPk4+Tl4+Xm4+fp5Ofp5ejq5unq5
    +nr5+ns5+rs6Ovs6evt6uzt6uzu6uzu6+zt7O7v7O7w7e/w7e/w7u/x7vDx7vDx7/Hy7/Hy
    8PLz8vP08fP08vT08/T18/X19fX29PX29fb39ff39/f49vf49/j5+Pr6+vr7+vv8+/z8+/z
    8/Pz9/P39/P39/f7+/v///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAFoALAAAAAAWABYAAAejgFqCg4SFhoeI
    iYqLhAQRAoyHBE4jCwCRjVlSQiALmIIEWS9CWSscBJihL6tEWSgWAYyqqzMzTlIjDosIWTM
    2v78/UUggD4mhPsnKNi8+USocxoa8tbWrLy0tSFknCIfUODvKPq0qGxSIvD4/REZI20YfEo
    q87EhPWVkl0vRZOz9OsqTAoCFSvSk5PFz4tCALEhHoPmlBcCKiRC0WMFzcyNFQIAA7
}

image create photo ::img::pause -format GIF -data {
    R0lGODlhFgAWAPUxAFJUUFRWUlVXU1ZYVFdZVVhaVltdWV5hXGVmYmVmY2VnZGZoZW1va9j
    b1Nve2d7g29/h3OHj3+Lk3+Lk4OPl4OPl4eTl4uTm4uXm4uXm4+Xn4+bn4+fp5ujp5ujq5+
    rr6Ovs6e7u7e/w7vj5+Pn5+Pr6+fr7+vv7+/v8+/z8+/z8/Pz9/P39/P39/f3+/f7+/v///
    v///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAADIA
    LAAAAAAWABYAAAaNQJlwSCwaj8ikcslsOpGAQWAwKAyn0sHhGFB5VYyh4atacFWRSyksLKg
    ol1PiHJGQ2DL3hVJSnCV2eG4UFClzRgMqFxd3YooXhkeJHh5rQ24ODSqHRV0XEZZtaBCbki
    oecYKPKn5GXSAeKXhjlGWmIiBglyohuWaIZKpfv0VUVQUGQ1VUBcRPz9DR0kRBADs=
}

image create photo ::img::start -format GIF -data {
    R0lGODlhFgAWAPZZAElLR0tNSk1OS01QTE5QTVFTT1JTT1NVUVVXU1ZYVFdZVVhZVVhaVVh
    bV1lcV1lbWFpdWFtdWVtdWlxdWV1eW19hXGJkYGRlYmtsaW1wbHBxbYKGgISHhIiKho6Pi5
    SWk6Cin6Kjn6utqrGyr7/AvsLEwMjJx8rMydLT0NfY1dnd1trc2d7h2+Lj4ePm4ebo5Ofp5
    efo5ujq5ejq5unq5ujq5+nr5+rs6Ovt6ezt6uzu6uzu6+3u6+3v7O7v7O/w7e/w7/Dy7/Lz
    8fP08vT19PX29Pb39fb29vb39vf39vf49vf49/j59/n5+Pn6+fr7+vv7+/v8+/z8+/z8/Pz
    9/P39/P39/f7+/f7+/v///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAFoALAAAAAAWABYAAAe7gFqCg4SFhoeI
    iYqLjI2OhgqRiAGHAoIINgiGBBuahAcengoqCoUUKVaeWgIaMKmXLKoFIUpDVqUAFChSQFY
    JggoupQIYNk83N6kHI09CNja+wDaRJc0511YdRUrXyK9aCj0KECtWQj3oVi1WQTAwz98KQq
    UOHEpWRUWpH/pFQkLRwBUpBcyElYOaGIg4+CQggycEBVXA0EsVAxIIBTEYCCmEKkEQTniCk
    ADCoQsmC1l48Kily5cwYxoKBAA7
}

image create photo ::img::end -format GIF -data {
    R0lGODlhFgAWAPZyAEZIRUtNSUxOSkxOS01OS01PTFBRT1BSTlJUUFRWUlVXU1ZXU1ZYVFd
    ZVFdZVVdaVVdbVlhZVlhaVllbVllaV1lbV1pbWFlcWF5gXF9gXV5hXWBiXmFiX2JjYGJkYG
    NkYGNkYWRmYmZnY2ZoZGdoZmxtaW5xbG9wbW9wbnBxbnBybnByb3FzcHJzcHN0cXN1cnR1c
    XR1cnZ5dXl6d4GDf4iJhpGSj5CSkJOUkJ6enKOkoa+xrrW3s7q8ur6/vMbIxczNytHS0N/h
    3uDh3+Lj4OTm4+fp5Ofp5ejp5ejq5unr5ujp6Onq6Onr6Ovt6ezt6uzt6+zu6u3u6+3t7e3
    v7O7v7e/v7u/w7vDx7vDy7/Dx8PHy8PHz8PLz8PLz8fPz8/P08fT18/X19PX19fT29PX29f
    b29ff39vj4+Pn6+fr6+vv7+vv7+/v8+/z8+/z8/P39/f7+/v///wAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAHMALAAAAAAWABYAAAfLgHOCg4SFhoeI
    iYqLjI2OhgWHAogQFxCCGDQHhRgyk4UvYQ6CJ3FDJJ9zKXFAEYUnUK6qbllrPwoAc6VkZDi
    bgilXsiVrR0lhaDoIJ2tJUGtEIgFzJUuyLG1V2rVaN21QTklbazwKG0LXbWBb62SmbUlHR1
    tvQQsbRReCMHFaWe5farCIs8UdmRn6OizRN4efuzU5LMx5EWdNnB6y5nSowpDfmh0Z+S358
    IHQRoYjfIwi9MGGxEIbZVkQYShjoQgMMDzaybOnz5+GAgEAOw==
}

image create photo ::img::config -format GIF -data {
    R0lGODlhFgAWAPZaAF9fXnl4dHx8fH19fX9/fyBKhzRlpFhthFtxiWB2j2B3kWN7lU50pEV
    xqVR8rll9q2yFoWWErHWQroaGhoeHh4GKlZGRkZmZmZ6enp+fno2YpYGTqYKXsoSctpeltp
    CmvpGmvqenpq2tra+vr6SttqKuvKexvbW1tbu7u5mtw52wyp22zp240qG0yKS60LvByLDG2
    8HBwc/NyszMzNjY19zc3N/f38DR4tPf6tfi7d/n8OPi4ePj4uTj4efm5Ojn5Ojn5uvp5+rp
    6Orq6uzq6O3r6e3r6vLx7+3y9u7z9vDw8PPy8fPz8vD09/T09Pb29fj39vj49/n49/n59/j
    4+Pn5+Pr6+fr6+vv7+/7+/v///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAFsALAAAAAAWABYAAAfxgFuCggQEg4eI
    iVsERVY0hoqRhFJLj5EcBpEERFaQiAZZDJlbAgIQgiicnoOgMyMRggJBQgQjPZwBiQY2I6N
    bF0JLRURBxVKrBlYGvoIUMlLQU8aQoMyHGAITAidWxU4ZydaSBFY/Lw1O4pKLKrsPIeuHBf
    MGTg4kWQLxWwUSLiAFDJiI0SPLqkT9cJRYsaCAgCxCiBiMVKBDDg0LWCgosCgLEU4TEKbQs
    eEACwkIOHb8aIWCvBZINiQ4mfIQgSw9AGQ5xQ9EEw8zUaq0mWXJklz8YCCpQHMoIgsE9Akq
    AIHFDRA19w2iCqGhVkTznO4LBAA7
}

image create photo ::img::close -format GIF -data {
    R0lGODlhFgAWAPYAAEhKR09STVBSTVBTT1NUUFRVUVRWUlVWUlZXU1VXVFVYVFZYVFZZVFZ
    ZVVdZVVdaVVdZVlhZVFhaVFhaVVhZVlhaVllaVlhaV36BfYCCfYGDfoKDgIKEgIOEgIWGg4
    aHhIaIhYeJhYeJhoiJhYiKhomKhomLhomKh4mLh4mLiIqLiIuNiIuMiY6Qi46QjY+RjZCRj
    ZCSjZCSjpGSjpGSj5GTj5GTkJKUkJSWkZWWkpWXkpaYk5eZlJialZqbl5qcl52fmqWnoqan
    pKaopKeppaeppqippqiqpqmqp6mrp6qrp6qsqKusqKutqaytqqyuqq2uq62vq66vq66wrK+
    wra+xrbCxrrCyrrGyrrGzr7K0sLO0sbS1sQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAF0ALAAAAAAWABYAAAfNgF2Cg4SFhoeI
    iYqLhBYODoiPFocWHEQckIUOGkQbk4UWQTlLJJ+CDiBLPESZjRpLMUspnxYgVDdLmIcOJE4
    5VCwOFixZO1QrrYaoWTxaMTZcPlkgyZQkWT9TVEBcs4xdFi9LPT9SMaaLDi9KPDxO59/DVD
    tKSj1U3oq8SzdSLy9ZcjjJtwuEkhakLFjohQsEukGbhqxQUkpQBBBOWijZUK2LAyExiFAjZ
    OCDkhtKFhgioEEIBwOGDGAI4gGmIQEOACASkIDAt59AgzIKBAA7
}

image create photo ::img::replot -format GIF -data {
    R0lGODlhFgAWAPcAAC9ZjzFbkTRflzZlojZnozNlpDRlpDVlpDRlpTVlpTRmpDVmpDVmpTZ
    mpDZnpDdnpDZmpTdmpTZnpTdnpTZnpjdnpjdopTdopjdopzxpozhopjlopjhppjlppjhopz
    lppztppjpppzpqpztqpztrpzpqqDtqqDprqDtrqDpqqT1rqDxsqD1sqD1sqT5tqT9vqT5tq
    z5uqz9uq0FuqEBuqUBuqkBvq0RxqkFwrENxrEVyrEZ0rkd0rkx4r0d2sEx4sE16sE56sU56
    tFB7slB8slN+s1V+s1eBtVqDt2qOvGqQv2KNw2WOxG+VwWyWynKXw3OYxXeaxXKfz3Sfz3+
    gx36hyn+iy3+kzIKjy4elyoSkzIWmzZSx05Oy1pG02ZS22pa325q42p252Z+52Zu63KC726
    C82qG+3aK+3aO/3aC+3qbA3afA3ajC3qbC4KrE4arG4q3G4a/H4azG4q7I4q7I46/J47DI4
    rHJ47LJ4rTJ4rDJ5LHK5LPK5LTM5bXM5bbN5bfN5bbN5rfN5rjN5brP5rvQ57vR57vR6L3S
    6MDS5sDU6cHV6sPW6sXV6MjY6cja7Mna7Mrb7M3d7c3d7tHf7tTi8NXi8Njj8dnk8Nrl8dv
    m8tzm8tzn8+Dp8+Dp9OHq9OLr9ePs9eTs9eXt9gAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAKUALAAAAAAWABYAA
    Aj+AEsJHEiwoMGDCBMWRIFiwYIRKEYYXGCQYZQyc+ywGVPlB0WBFwoUHIEE0B0zcwAVOoQI
    0ZwmIxZA4VFQxxiPIyZc+LEFECA3d85UYaSD4IgiI2DY+FhqxIkqfMB4ARQJhtEFQpZIHNm
    jjZ0plKwORGHDSSkUB2Ho+SLFEtqBTA+OYBOJkqVOFRQSLPAQosO4Ff4K1gt306fDmYwojL
    vg05kzmrBcqCgQx1uBFT6RSaQJqcELTHgUECtwASlJcxh1kjy5NAwYOYoSNJ0IU6U3iwphS
    TJEhQ0kWLhshetoxIgsj3z+4cN8zpswpOHKLpUhCZc7iUymeTICwESDAQgMELAxYYIAwujT
    6w0IADs=
}

image create photo ::img::zoom-in -format GIF -data {
    R0lGODlhFgAWAPcAAAAAAFhaV15gXV9gXmRmYmZoZGdpZWhpZmhqZmlrZmhqZ2lqaGpraGt
    ra2psaGtsaWttaWxuaWxtamxuam1vamxua21ua21vbG5wa29wbG9xbHBxbXZ4dXp8eH+AfV
    mArVyFs2GKuWaQv2iTwmmUxW2XxW6ayW6aym+czXKdz3GeznKfznOfznKez3Kfz3Ofz3Sfz
    nagzXWhz3ihzXihzoOFgIKEgYSGgoiKhYmKiY+Qj5GSkZaWlpmZmZubm6GhoaOkoaeopqio
    qKipqK2trb6+voqmxY6oxYKkyoWmyompy5apwZutwp6vxIWr1o+x2Zaz0pe005e42626yrn
    K3L7O3qnE4q7I47bN5sLCwsTExMnJyMrKycvMyszMzNHR0dLS0tXV1dHV2dTW2dbY2tfY2t
    jY2NnZ2Nra2dja29ra2trb29vb29rb3Nzc3Nzd3t7e3t/f38fY68fZ7NHZ4dLZ4NXc5NLg7
    9vi6dHg8Nbi8dbj8drl8tvm8tvm8+Hh4eLi4ufn5+zs7OHq9efu9wAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAIUALAAAAAAWABYAA
    Aj3AAsJHEiwoEGDHDRs0KCBQoeDBzV0aTNGTJkyXShAJKgBzZISMlq4GMHkDYaNhSigMdJC
    DgAAeq64OIJGI8QgTVzoIfSSzx0pLqYAgZgAjQgrfAb1vOPEBRI0CQ5SeHPipVWrLk4AkiA
    VjYurV0UCOmlwKownWOa8HPjiRM2DNbQkIeGi0FqBIZR0qQHRRh0XKOwCGOiijoGNEoRQkQ
    Fi4AcYVbwQiQqRwg48UWi4oBHFTgJAQngchiihg44sb4rkIJByDI8elCHioEAbh8AGFMD06
    DEaZVkwP4Qw8H2QARgtYQKgFBTIoIA3gIYTNxjA5vTr2AUGBAA7
}

image create photo ::img::zoom-out -format GIF -data {
    R0lGODlhFgAWAPcAAAAAAFhaV15gXV9gXmRmYmZoZGdpZWhpZmhqZmlrZmhqZ2lqaGpraGt
    ra2psaGtsaWttaWxuaWxtamxuam1vamxua21ua21vbG5wa29wbG9xbHBxbXZ4dXp8eH+AfV
    mArVyFs2GKuWaQv2iTwmmUxW2XxW6ayW6aym+czXKdz3GeznKfznOfznKez3Kfz3Ofz3Sfz
    nagzXWhz3ihzXihzoOFgIKEgYSGgoiKhYmKiY+Qj5GSkZaWlpmZmZubm6GhoaOkoaeopqio
    qKipqK2trb6+voqmxY6oxYKkyoWmyompy5apwZutwp6vxIWr1o+x2Zaz0pe005e42626yrn
    K3L7O3qnE4q7I47bN5sLCwsTExMnJyMrKycvMyszMzNHR0dLS0tXV1dHV2dTW2dbY2tfY2t
    jY2NnZ2Nra2dja29ra2trb29vb29rb3Nzc3Nzd3t7e3t/f38DT6cfY68fZ7NHZ4dLZ4NXc5
    NLg79vi6dHg8Nbi8dbj8drl8tvm8tvm8+Hh4eLi4ufn5+zs7ODq9OHq9eLr9eTs9eTs9ufu
    9+zy+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAIsALAAAAAAWABYAA
    Aj4ABcJHEiwoEGDHDRswKCBQoeDBy90aTNGDBkyXChAJKihzZISMlzAGMHkDYaNiyigMdKC
    zqFCfK64WNKmwcYgTVzsOaQIUR88UlRMAQIxARoRVvoUOuQTjxMZSNAkOEjhzQkAWLNidXE
    ikE2DGNC40KrVhQtAGg1WhfEECx05BLmySVvwRpYkJFwYDKFkyw2INuq4UGHQhZipEBsMoe
    ICxMAPMLB4IYL4YIQdeaDMgEEjyp0IgITwMLCRgoccWeIUyUEg5RkePSofzEGhNg6BDSh86
    dGDNEqqYH4IYfD7IAMwWsIEQDlIkEEBbwIRL24wAF3q2LMvCggAOw==
}

image create photo ::img::save -format GIF -data {
    R0lGODlhFgAWAPYAAFt6clRye1d4fV58eWZoZGdpZG5wa2B9bnJ1a3V5bHd5dXyBbWyFd3+
    Bfj9shjhniz9qiTtskTxtkT9ylklugkJuiEFsik1yglR3gFF5ilN5ilt+iEJwkk15kUR4nE
    d9okd9o22NjnCKgmiJk0qApkqAqE6HsFCIsVCJslGLtVOMtViSvWKWu1uWwVyXw16Zxl6ax
    2CcymCdy2KfzmOgzmeizmOh0Gej0mul03So03So1HWp1YOFgI6PjZGRkZSWkZSUlJeXl5iY
    mJudmaOkoqWlpampqaysrLCwsLGxsLKysri4uLq6uru7u7y8vIGt0Y+228DAwMHBwcTExMX
    FxMXFxcfHx8bMwMnOw8jIyMnJycvLy8zMy8zMzM3Nzc/Pzc7OzsrQxMzRxdLWzNPYzNDQ0N
    HR0dbW1tfX19ja2Nvb2+Dg4OHh4eHi4eLi4eLj4ePj4+Xl5ebm5ufn5+np6Orr6uvr6+zs7
    O3t7fHx8fPz8/b29gAAAAAAAAAAAAAAACH5BAEAAHwALAAAAAAWABYAAAf+gHyCDB0Phg8V
    GIKLjI0cLE85UDszGhSNmHwZNR4TESAzOzggFpmLAyEbixUgMDAtIBWmfBcijREqKy0zAge
    mAAsGwgYJDyvHKyMBwwaNCHvQ0MbIMQ/Re82LPHd7dt7GKMc2D95pdjyMQ3d2e4cr4SszDx
    EPbHU/iwZccN8xMTcoUuhyAYPcHS4IBBmIw8/OmAgxTKCQaMJFBDF27tzJpoCbNztiHkSU6
    OJBGG977jQQ1ONOHGgasYhEUfIktDh3evAxsCSOnTkvoZERGYHMzThs2CgxQGCMnjhQo8a5
    8gCL1KR5wBAwcK2r167C2IAZS5bsFjBn0W45yyZsFjVBPoQUQaLESRMrZqKc0cu3rQE2WdA
    AkWvkyBIpU/LuXRzFL2AwU6JEjhLFShbFfPf63ZK0s+fPnrM0Y0a6NGk+gQAAOw==
}

image create photo ::img::redo -format GIF -data {
    R0lGODlhFgAWAPUAAEmRBUqTBUuUBUyXBU2ZBU6aBlKSDWesD2i/E2nBE2rCFGvEFG7KFG/
    LFXLKHHTUFnXVFnbYFnjbF3XQHHbTHHfTHXfUHXnWHnnXHnrZHnzdHnrUInzWI33aIn3aJJ
    SjA5egIKe0MozPLYDVK4LYKpHTK4XdMJTWPJrcP4fgLInpK4rjMYvjMoriNIvkNIzkNYzkN
    4zqMI7kOo/lO4/lPJDlPZDlPpHlPpHlP5LlQJPlQpnrRqHsVwAAAAAAAAAAACH5BAEAAD0A
    LAAAAAAWABYAAAaMwJ5wSBQWisjksHBUOo2t5jNZaEWnRCazpblOC6CTtWXCOLzKAoo22mw
    8FQwigS4WcK+KXh9pzOlSSyI4FhUOExMQEgsJgFQuGRsvLzg4NDQJDXVZOB0qJVoFMpqBdj
    gqEFJ3m3Y6PIFVpUgFLjuwsrMhdbizHyu8XykGWGkkwF8Hx08AAsRPzc7RQkEAOw==
}

image create photo ::img::home -format GIF -data {
    R0lGODlhFgAWAPYAAFVXU3tMSmVnY3V1dXV2dnJ1enV4e3d4enV4fHZ5fHZ5fZwICKQAAIQ
    iIdwlJdwmJt4mJuAmJuInJ+U5OYhaWJldW511c+xGRvFMTPBRUfJVVfNbW/JeXvNjY/NkZP
    RmZvRsbPR1dX6Ae3+BfIqIZYmIcICCfYiJfjRlpG52gXF4gUp2rl+Gt3eYwnmZw4SGgYSFg
    oWHgoaIg4eJhIiKhY+QjZeZlJiZlpmalpmal5ubmqONi6efnZ+gnqGgnqKjoaKioqOjoqOj
    o6SkpLGztri5uLq6ubq7vL+/vsCKisShocm1tbi8wbm9wcLCwdfX19zQ0NjY2Nra2tvc293
    d3d7e3d7e3uLe3uDg4OLi4uPj4+Tk5OXl5ebm5ufn5+np6erq6uvr6+zs7O3t7e7u7u/v7/
    Dw8PHx8fLy8vPz8/j4+Pn5+QAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAGwALAAAAAAWABYAAAfygGyCg4QMDISI
    iYUhIYeKj2wMjIyOkIsTjBKNloOSFxiZmpWPkhkajZISopCSGxyNARSSD6uJkh4ejRUwOkm
    ztZ0hIB+NFjVFTkVKv5vBuQw7PUhV1E9LCyEPzYKSjT5BUmHiXmFeUNjbkSENPj9RXfDwWl
    1aWNijkVMA+/thXQcJBiQ4YAYfGwBlAIgQMWIEvAQuBrRIYAZAIgBiAMDYCEOLFgQsBqwoU
    PFiRhkySJSopwLFABQpSiLCCIAGjRMmsKwhwuQIkyEJL4apaZPGlTVBgghRWsXizDICbNyY
    mqYMmatX1TglxK+r166cworlFAgAOw==
}

image create photo ::img::next -format GIF -data {
    R0lGODlhFgAWAPYAAC9dAzNmAjduAzt0Azt1Azt3Azx2AzhwBDlzBDpzBDt0BDp1BDt1BDt
    2BDx3BT13BT12CT53CUR9D0V8EE6aBk+aB0+cBkqDFkuBGE6DHlKhCFSjCFWlCVeoClipCl
    iqDFyvDFywDF6zDV+0DV2qE16uEl+lHGC2DmG3DmCvFWGtFmW9EFWLIlaKIliJKVqNKWaVO
    WufOmGlIWanJ2SpImirJ2aoKGqtK2qqLWurLWutLm2sMm+tNHCtNnCuNnOvOne2OnWwPXax
    PnaxP2fBEWnDEWnCE3HGH3PMGnShSniyQXiyQnqzRHu0RXy0R321R361SX+0Sn+2SoOtW4e
    7V4m8WI23Z5e/cYTER47DWpXTWZjJZ5jFb53HdZzKcJ3FeJ/GeKPfaaTPeqPLfqTLfqbPf6
    bWdqfecqbMgqjNhanUgazYgq7bg6/cg7DSkLXVl7fVm7nXnLzZoLzZob7ao77ZpL/apL/ap
    cDbpsHcqQAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAHoALAAAAAAWABYAAAfGgHqCg4SFhoeI
    iYgLio0JLo2JCHcwBpGGCHlwSQqNCwmgoAp3VG5TlokJeKurc3NNTmhWEKlxUbdOTkpBQTx
    cXBOICXFKxbxBPjs4NlRgwYYLbz42MjIzOTk3MzQmSmMtjIQLaRYUFBYbHB8lKiokQF0s4Y
    MJY+boHiAjKCgjWF4XHBiqZ05DhxAoVhAxomXLs4FkIpZRw6aNESRhskRINQCBRwQK2Bw5E
    2XepQRszPQQcIlQAjEuArR0mQHATEIsb+rcSSgQADs=
}

image create photo ::img::previous -format GIF -data {
    R0lGODlhFgAWAPcAAC1ZAzNlAjduAzpyAzp0Azt1Azt3AzpzBDtzBDp0BDt1BDx0BDx0Bjx
    1Bzx2Bzx1CD11CDx2CD13CD52CT92Cj93C0F7C0F9CUJ5DUR7D06aBlOdDVSeD0mCFUmAFk
    yBG1WeEFKgB1enCVenC1elDFekD1mrClqqC1qsC1uuC1ywDF+zDV+0DVqhF16jHGC2DmK4D
    mO6D2O7D2S7D2GxFGm5HFSIIFSKIFSIJVeLJWKSNGaYNmGlIWOmI2SnJWevI2aoKGmrK2uv
    KWqqLWuvLGqwKG2sMW2sMm+tNHCtNnKvOXOvOnKyNnWwPXWxPnaxPnaxP2fBEWjBEWrFEmv
    GEnGeRXWmRXiyQXiyQnqzRH21R361SX+2Sn6qVYGwU4S5Uoa7U4e6VYu2Y4y5YZS8bJTGY5
    bDa5XAbJ3Ob5rEcZrDdJvEdKPOeaTLf6HQdajUfqrXf6rThKzYga3bgK3Zgq7dgK/dg6/Rj
    rTVlbXUmLjWmrnXnbrWn7vYn7LhhLTlhbXmhrzZoLzZob7ao7/apL/apcDbpgAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAIcALAAAAAAWABYAA
    AjfAA8JHEiwoMGDCBMqPJRgYUIcCxwaPKBjTwWJBBNUyVPoIsZDC7rc+SLIwoEEB1I2RChB
    TBssV/YIKlTIkKFCGBBmIGPGSJIlUK5k0bJlSyAJBz2sCcMDyBAjSIAGxaKHQsEEN9ZAaeG
    iaRAhRX78EMIED1KCBm6kQbKBA4cSIkygUKECxYk4ZzN2OKNFQwgRKVjAmCEDxoo3eQtiGA
    OmROAZUahQiRJDzoOECbyUocGijh9Af/zYoZPY4AAraGrMuXASZcqFAna4mVNaYoAcbGpLB
    PDhwEeDAn4LHy4wIAA7}

image create photo ::img::help -format GIF -data {
    R0lGODlhFgAWAPfmAA8jQRMsURUyWhk4Zh5BcyBFeiFJgiJJgiBJhSFKhiBKhyFLhyFLiCJ
    LiCJMiCNNiSlRiylRjClSjCxTjSxVji5Wjy1WkC9XkTNblDVclDRclTRdlTdelTZeljhglz
    hgmDlhmTpimTtjmjxkmkBnnUFpnkJpn0Rrn0Zrn0psnkxunkxun0RroEVsoUhvo0lvo01uo
    E5xoU5xoktxpUtypUxxpExypU10p050p1BxoFByo1JzolB0pFV1pFV2pVl4pVh4plh5plB2
    qFF3qVJ4qlR6rFV7rFd8rVd9rlh8q1x8qFh9rlp/r1p/sFqAsF2Csl6Dsl6Ds1+Ds2KBrWK
    Fs2GFtGGGtGKGtWKHtWOHtmaIs2OItmSItmSJt2yIsGeLuWiMuWuNuGqOu2uOu2uPu2uPvH
    aRtniTt3CTv3eWvnyWu32Wu3uXvXKVwHOWwXOXwXeZw3yawnibxXmcxXydxX6dxHyfyH2fy
    H2gyH6hyX+hyYKcv4edvoeevoCbwIOix4yiwYGiyYCiyoCjyoOkyoOky4Wnzoanzoaozoao
    z4mqz5CnxZKpx5SoxZesyZaty5mxz5ywzJ2xzIip0Iiq0Imq0I2v1I6v1JGy1pKz15+205i
    11p652J+72pu73Z+83KCyzKGzzaO0zaS1zqa40Ka40aO616a61KS716i50Km50ai60qm60q
    m81K+/1a/A1rPB1rTC17LC2LLF27XE2LTE2bXE2bXF2rXF27bG27fH3LjH27rH2rrI273L3
    b7L3cHO38HQ4sLR48HR5MjT48nU5MjW58nX58vX587Z6NPe69ri7N/l7uDm7uDm7+Ho8eHp
    8ePo8ODo8uXq8ebr8ebr8ufs8ufs8+ft9ejt8+nt8+nu9Onu9env9erv9env9uzw9e3x9u7
    y9/Dz9/P1+Pj5+////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAOcALAAAAAAWABYAA
    Aj+AM8JHEiwoMGD5xQoVMCAgUKEBBXC4AOrmTNafVQogJgQAqhpo87EyLEm1TZQEjYaVJCC
    WSoOFjBw6CBCBAtazWCoHKhAQjMvFqbYmlaO3LJFJ0zsaSahoAJRqWKmMke1aqsZM3qdesA
    zxzQOHESc2sVGyymq3orwSOItB09AoDCIMDFDSJEmYaiOg9KkiC1GKhX0MuNhRN0jULgkoy
    rsSxYnj35xTWgtxogWN4pA6YKMqjM4aMJ8YTMt8DYehok4yTKLqrRCduS4GSNn2mQFv9SYs
    KH5izSqnCYZKiQHjSlgtxudOnHjSJYwcApNuoTpkiE7b4A5Cvxj2ozmWcpyKMO27ZMnTJT0
    zAnnI+KrV+DLbANeHZEdZLImD6ywLY4RKmFgQ9UmkyCiByrbVLDSD9bYQsUWZbgxhx56EII
    MOO0dxEAFtmyjCyR1/GFKMOHYQgFHCSkRCTHhhINMJD8YgKJAAQxQgAIGECAAADP2SFBAAD
    s=
    }

image create photo ::img::stop -format GIF -data {
    R0lGODlhFgAWAPf6AFYAAF4AAG4AAHQAAIIAAIMAAIQAAIYAAIgAAIkAAIkEBIgFBYkHB4w
    HB4kICIoJCZkNDZsPD5wQEJ0SEp8UFKIPD6gPD7UAALMGBrUGBrkAALoAALsAAL0AAL4AAL
    8AALsEBL0EBL8EBKwREb8WFrocHLodHakqKqkrK6srK6wqKqwuLrcoKLspKb4uLq8yMq81N
    bY1Nb8wMLA5ObA7O7E+PsAAAMEAAMIAAMMAAMUAAMYAAMAFBcIFBcMFBcgAAMsAAMsLC88Q
    EMsWFsIdHcMfH9EdHdMeHtUfH8UgIMYgIMgkJMgnJ8cpKcosLNggINkqKsszM80xMcw0NM4
    1Nc02Ns83N8s7O884OMg8PNA4ONE5OdE6OtE7O9I7O9I8PNI9PdE/P9Q8PNc/P9g9Pdg+Pt
    g/P7tERL1ERL1HR8FDQ8VCQsVDQ8BFRcFHR8JGRsRERMxFRc1GRsVJScRLS8xISM1JSc5MT
    M1OTsxPT9lBQdlCQtlDQ9lERNlFRdpGRtpHR9RPT9pISNpJSdpKSttLS9pMTNtMTNtNTdtP
    T91PT8BRUcFTU8BUVMFVVcJVVcBXV8JXV8VWVsxRUc5SUsNcXMVdXcRfX8VfX8lZWctbW85
    fX9BVVdpQUNtTU9xQUNxRUdxSUt9SUuRFRelLS+pNTeRTU+FVVeFXV+RUVOpSUulWVutWVu
    ZYWOdbW+laWuhdXehfX+1dXcViYsVjY8ZiYsZjY8dkZMZnZ8hmZsx2dsx7e8t8fONhYeViY
    uNkZOpiYu1mZu9mZuRoaOVqau9paexqau1sbO9sbOxvb+pycu92dvF7e8+IiNWVlfKBgfKI
    iPSJifWMjPWNjfWOjvSPj/WPj/aQkPSTk/aSkvSUlPSVlfaWlveYmPeZmfeamvebm9miouS
    8vN3T097U1N/V1eXV1eXW1ubW1uLY2ObY2ObZ2ejf3+bi4uri4uvj4+7j4+nk5Ovr6+3s7O
    7u7vHj4/Dk5PXm5vbq6vDu7gAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAPoALAAAAAAWABYAA
    Aj+APUJHEiwoMGDCBIqTJAAQYKDBBHU2AbOm7dt3LJFU4EAor4DNLYRU6SIEKE/fVA944hw
    hkhPnhCZRKnnFDMUHSPC2DbMUyZOMQkJkjPHjKllOAcieIGtV6dMzWZRkmmn0a43YhQpS6p
    PQbVeiDqlKTfuEp5AjdS5S5PFC6FiDwQ2yCYIEaJJs8aZqwRJ3btLa75gsQJXbrU/JgnhmV
    WuXbx4s9aIGRylsL4G1fT06WOSTjN69Jyp+eLFipUpwRQY3rzZTpp1oN/N2iTFSZMmxxYYN
    qNHT5xF6NzpulWvHhoXHzhwKHVAbjQyer40QscO15oMufDdi3GBA4lXzbt+CoMiJAidcI1M
    6LBRIpc4NMqJKAuvr4IsJD+GvJGhY70NDJJkwQERprSQk0AUsHJEf/7Z8EFyHChxCgsHDkS
    BKkj0Z8OGECqRyggVEgQBKUfwwIMIKHKwxCkWhEiQABCMwgowwMDiiiu9VDCARwIBcMABBQ
    QZ5AEB8GjkQQEBADs=}

image create photo ::img::track -format GIF -data {
    R0lGODlhFgAWAPYAACBKhyBLiCFLiCFLiSNNiSJMiiRNiSVPiydRjShSjilUkSxXkS9XkTJ
    clzFdmThfmDZhmzhjnDRlpDVlpDVmpDZmpTZnpT1noT5noDdopjhopjpppzpqpztqpzxqpj
    xrpztrqD5sqD5tqT9uqUNso0BqpEFspUdvpEhuo0FuqEBuqUJvqUFvqklxp0NwqENxq0Nyq
    0Rxq0Vxq0ZxqkVyq0RyrUdzrElzqUtzqEp1rUl2rk53rE15r1J6rkh3sEt4sU15sU96sFF7
    sVZ9sFJ+tFN/tVuCtFuCtVuDtVmDtmOLvGGMvWmQwGuSwWiRwmuTwm+XxXGWw3OaxnKfz3O
    fz3ieynOgz3Sgz3igzYCo04So0IWs1Yas1Yet1Yet1oiu1o+y2JCz2ZW325e425y42Z+72p
    q63Jy73aG/36LA36PA36XB4LDI4rHJ47HK5LjO5gAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAHAALAAAAAAWABYAAAfcgHCCg4SFExKF
    iYpwEzxNGYuREzBsb0oTkYoZZGNfZB2ZiTpuVlRsIpEBAYQTUWNTU2hJiwELKKuCE01isGp
    AiwZGRie4cERnsGugiQAQQhNGDIMgaFRfWpDMOCoSNje4NmZUZj+YzD0dEho9BIxFYVtV2c
    w7IRMdO6swUltgqLQXbExQUYLAhCVivEAxtygBjwk2IgTQhcXLk2W0SqgQcSGAhB9bsMyLh
    EBHBxMBCmQAkYFhKggqbjQoFkoQAAQ2VKigWRMOARUeVADoSQiAAg8OePYMAEAp0Z6BAAA7
}

image create photo ::img::plot -format GIF -data {
R0lGODlhFgAWAMIHAAAAAAAAMgAAfwAPAAAZAAAnAAE8AP///yH5BAEKAAcALAAAAAAWABYAAANb
eLrcriDKSSl8eAEVct4H6DkCVI6McQLCORpGeLVvLN80k8OaMiy5ltDWOxB0woWqYRMpXIdYTlG4
PHhPF8ipgBGzVpAXSwqPRysr6pC+rYXbtS4uL1bu9zomAQA7
}

###### preamble.tcl ######

# get the number of clicks per second on this machine..
after idle {after 1000 "set ::xmaxima_priv(clicks_per_second) \[expr 1.0 *( \[clock clicks\] - [clock clicks])\]" }

catch {
    # the following will be defined only in the plugin
    global embed_args
    array set embed_args [getattr browserArgs]
    proc wm { args } {}
}

# from Send-some.tcl
#mike - I hope these can be eliminated or encapsulated
global port magic interrupt_signal _waiting _debugSend
if { $argc == 0 } {
    set port 4444
    set magic "billyboy"
}
set interrupt_signal "<<interrupt fayve>>"

set _waiting 0

set _debugSend 0

package require msgcat
namespace import msgcat::*

###### Readdata.tcl ######
############################################################
# Netmath       Copyright (C) 1998 William F. Schelter     #
# For distribution under GNU public License.  See COPYING. #
############################################################



#
#-----------------------------------------------------------------
#
# readDataTilEof --  read data from CHANNEL appending to VAR
# allowing no more than TIMEOUT milliseconds between reads.
#
#  Results:  1 on success, and -1 if it fails or times out.
#
#  Side Effects: CHANNEL will be closed and the global variable VAR will
#  be set..
#
#----------------------------------------------------------------
#
proc readDataTilEof { channel var timeout } {
    global readDataDone_ _readDataData
    global readDataDone_
    upvar 1 $var variable
    set _readDataData ""
    set readDataDone_ 0
    set $var ""

    set after_id [after $timeout "set readDataDone_ -1"]
    fconfigure $channel -blocking 0
    fileevent $channel readable \
	    [list readDataTilEof1 $channel _readDataData $timeout $after_id]

    myVwait readDataDone_
    after cancel $after_id
    catch { close $channel}
    set res $readDataDone_
    if {$res > 0 } { append variable $_readDataData }
    return $res
}

proc readDataTilEof1 { channel var timeout after_id} {
    global readDataDone_  $var

    set new  [read $channel]
    append $var $new

    if { [eof $channel] } {
	set readDataDone_ 1
	close $channel
    } else {
	after cancel $after_id
        after $timeout "set readDataDone_ -1"
    }
}


## endsource Readdata.tcl
############################################################
# Getdata1.tcl                                             #
# Copyright (C) 1998 William F. Schelter                   #
# For distribution under GNU public License.  See COPYING. #
#                                                          #
############################################################
#-----------------------------------------------------------------
#
# readAllData --  read data from CHANNEL.
#  Options: -tovar variable    (store in this global variable)
#           -mimeheader store in alist the mime values
#                   and oset $sock contentlength if
#           -tochannel  (store in channel)
#           -timeout   (for non action)
#           -translation  (for the sock)
#           -chunksize   size to do for each read between updating %
#           -command    a call back run on each chunk
# If -command is not specified, wait and return the result code.
# Value of -1 means a timeout, and value of >1 means success.
# If  command is specified, call command each time data is read,
# with 1 argument appended, the result code.
# allowing no more than TIMEOUT millisconds between reads.
#  We set up local variables for the $CHANNEL
#        result
#        bytesread  (after the header if one specified)
#        mimeheader (extracted)
#        length     (0 if not provied by mime header)
# COMMAND can access
# to examine the data read so far.
#
#  Results:  1 on success, and -1 if it fails or times out.
#
#  Side Effects: CHANNEL will be closed and the global variable VAR will
#  be set..
#
#----------------------------------------------------------------
#
proc readAllData { sock args } {
    global readAllData [oarray $sock]

    array set [oarray $sock] {
	timeout 5000
	command ""
	tochannel ""
	translation binary
	chunksize 2024
	mimeheader ""
	tovar ""
	result ""
	done 0
	usecache 0
	percent 0
	bytesread 0
	headervalue ""
	contentlength -1
    }
    oset $sock begin [clock clicks]
    foreach { key val } $args {
	#puts "	oset $sock [string range $key 1 end] $val"
	oset $sock [string range $key 1 end] $val
	
    }
    #puts "locals:[array get [oarray $sock]]"
    # puts "args=$args"
    if { "[oget $sock translation]" != "" } {
	fconfigure $sock -translation [oget $sock translation]
    }
    fconfigure $sock -blocking 0

    catch { 
	$::xmaxima_priv(cStatusWindow).scale \
	    config -variable [oloc $sock percent] 
    }
    lappend [oloc $sock after] [after [oget $sock timeout] "oset $sock done -1"]
    if { "[oget $sock mimeheader]" != "" } {
	fileevent  $sock readable "readMimeHeader $sock"
    } else {
	fileevent  $sock readable "readAllData1 $sock"
    }

    if { "[oget $sock command]" == "" } {
	oset $sock docommand 0
	return [wrWaitRead $sock]
    } else {
	oset $sock docommand 1
	# the command will do things and maybe caller will vwait..
	return ""
    }
}
#
#-----------------------------------------------------------------
#
# readMimeHeader --  read from SOCK until end of mime header.
#  this is done as a fileevent.  Store result in $sock local HEADERVALUE.
#
#  Results: none
#
#  Side Effects:  data read, and the mime header decoded and stored.
#
#----------------------------------------------------------------
#
proc readMimeHeader { sock } {
    global [oarray $sock]
    set result ""
    set ans ""
    while { 1 } {
	set n [gets $sock line]
	if { $n < 0 } {
	    if { [eof $sock] } {
		oset $sock done -1
		close $sock
		return
	    }
	    append [oloc $sock result] $result\n
	    break
	}
	if { $n <=1 && ($n==0 || "$line" == "\r") }  {
	    # we are done the header
	
	    append [oloc $sock result] $result\n
	    regsub -all "\r"  [oget $sock result] "" result
	    set lis [split $result \n]
	    foreach v $lis {
		if { [regexp "^(\[^:]*):\[ \t]*(.*)\$" $v junk key val] } {
		    lappend ans  [string tolower $key] $val
		}
	    }
	    oset $sock headervalue $ans
	    oset $sock contentlength [assoc content-length $ans -1]
	    if { [oget $sock usecache] } {
		set result [tryCache [oget $sock cachename] $ans]
		if { "$result" != "" } {
		    oset $sock bytesread [string length $result]
		    wrFinishRead $sock
		    return
		}
	    }
	    oset $sock percent 0
	    oset $sock bytesread 0
	    oset $sock result ""
	    #puts "mimeheader = <$ans>"
	    #puts "switching to readAllData1 $sock, [eof $sock]"
	    fileevent $sock readable "readAllData1 $sock"
	    #puts "doing     readAllData1 $sock"
	    return
	}
	append result "$line\n"
    }
}

proc readAllData1 { sock } {
    #puts "readAllData1 $sock" ; flush stdout
    global [oarray $sock]

    makeLocal $sock timeout tovar tochannel docommand chunksize after contentlength begin

    upvar #0 [oloc $sock bytesread] bytesread
    #puts "readAllData1 $sock, bytes=$bytesread" ; flush stdout
    if { [catch {
	foreach v $after {after cancel $v}
	while { 1 } {
	    if { "$tochannel" != "" } {
		if { [eof $sock] } {
		    wrFinishRead $sock
		    return finished
		} else {
		    set amt [expr { $contentlength >= 0 ? ($chunksize < $contentlength - $bytesread ? $chunksize : ($contentlength -$bytesread)) : $chunksize } ]
		    set chunksize $amt
		    set n [fcopy $sock $tochannel -size $chunksize]
		}
	    } else {
		set res [read $sock $chunksize]
		set n [string length $res]
		append [oloc $sock result] $res
	    }
	    incr bytesread $n
	    if { $n == 0 } {
		if { [eof $sock] } {
		    wrFinishRead $sock
		    return finished
		}
	    }
	    set ::xmaxima_priv(load_rate) "[expr {round ($bytesread * ($::xmaxima_priv(clicks_per_second)*1.0 / ([clock clicks] - $begin)))}] bytes/sec"

	    if { $contentlength > 0 } {
		oset $sock percent \
		    [expr {$bytesread * 100.0 / $contentlength }]
		
	    }

	    if { $docommand } {
		catch { uplevel "#0"  [oget $sock command] }
	    }
	    # puts "percent=[oget $sock percent],bytes=[oget $sock bytesread]"

	    if { $contentlength >= 0 &&  $bytesread >= $contentlength } {
		wrFinishRead $sock
		return finished
	    }
	    if { $n <= $chunksize } { break    }
	
	}
    } errmsg   ] } {
	if { "$errmsg" == "finished" } {
	    return
	} else {
	    global errorInfo
            error [concat [mc "error:"] "$errmsg , $errorInfo"]
	}
    }
    lappend [oloc $sock after] \
	[after $timeout "oset $sock done -1"]
}
#
#-----------------------------------------------------------------
#
# wrFinishRead --  run at the EOF.  It will run the COMMAND one last
# time and look after setting the global variables with the result,
# closing the channel(s).
#
#  Results:  the $sock variable 'done', 1 for success, -1 for failure.
#
#  Side Effects: many!
#
#----------------------------------------------------------------
#
proc wrFinishRead { sock } {
    makeLocal $sock mimeheader contentlength tovar tochannel headervalue \
	bytesread docommand
    #puts "entering wrFinishRead" ; flush stdout

    if { "$mimeheader" != "" } {
	uplevel "#0" set $mimeheader \[oget $sock headervalue\]
    }
    if { "$tovar" != "" } {
	uplevel "#0" set $tovar \[oget $sock result\]
    } else {
	catch { close $tochannel }
    }
    if { $contentlength < 0 || $bytesread >= $contentlength } {
	oset $sock done 1
    } else {
	oset $sock done -1
    }
    catch { close $sock }	
    if { $docommand } {
	catch { uplevel "#0"  [oget $sock command]  }
    }
    set res [oget $sock done]
    #puts "wrFinishRead, tovar=$tovar,tochannel=$tochannel,res=$res,bytesread=$bytesread"	
    clearLocal $sock
    oset $sock done $res
    return $res
}

proc wrWaitRead { sock } {
    #puts "entering wrWaitRead"
    global [oarray $sock]
    if { [oget $sock done] == 0 } {
	myVwait [oloc $sock done]
    }
    #vwait [oloc $sock done]
    set res [oget $sock done]
    return $res
}

proc testit { addr usecommand args } {
    if { [regexp {//([^/]+)(/.*)$} $addr junk server path] } {
	set sock [socket $server 80]
	#puts "server=$server"
	# fconfigure $sock -translation binary
	#puts "GET $path HTTP/1.0\n"
	puts $sock "GET $path HTTP/1.0\nMIME-Version: 1.0\nAccept: text/html\n\nhi there" ;
	flush $sock
	proc _joe { sock } {
	    makeLocal $sock percent contentlength bytesread
	    puts "percent=$percent,contentlength=$contentlength,bytesread=$bytesread"
	}
	if { $usecommand } {	
	    eval readAllData $sock -command  [list "_joe $sock"] $args
	    wrWaitRead $sock
	} else {
	    eval readAllData $sock $args
	}
	catch { close $sock }
    }
}
#
#-----------------------------------------------------------------
#
# tryGetCache --  look up PATH (eg http://maxima.sourceforge.net:80/...)
# in the cache, and if you find success and a matching ETAG,
# then return the data in the file
#
#  Results:  The cached data in FILE or ""
#
#  Side Effects: Will remove the file if the current etag differs.
#
#----------------------------------------------------------------
#
proc tryGetCache { path alist } {
    global ws_Cache
    set tem [ws_Cache($path)]
    if { "$tem" != "" } {
	set filename [file join $::xmaxima_priv(cachedir) [lindex $tem 1]]
	set etag [assoc etag $alist]
	if { "$etag" != "" } {
	    if {  "[lindex $tem 0]" == "$etag" }  {
		if { ! [catch {
		    set fi [open $filename  r]
		}] } {
		    fconfigure $fi -translation binary
		    set result [read $fi]
		    close $fi
		    return $result
		}
	    } else {
		# cache out of date.
		if { [file exists $filename] } {
		    file delete $filename
		    return ""
		}
	    }

	}
    }
}

proc saveInCache { path etag  result} {
    global ws_Cache
    set cachedir $::xmaxima_priv(cachedir)
    # todo add a catch
    set type [lindex [split [file tail $path] .] 1]
    set count 0
    while [ file exists [set tem [file join $cachedir $count$etag.$type]]] {
	incr count
    }
    set fi [open $tem w]
    #puts "writing $tem"
    fconfigure $fi -translation binary
    puts -nonewline $fi $result
    close $fi
    set ws_Cache($path) [list $etag [file tail $tem]]
    set fi [open [cacheName index.dat] a]
    puts $fi "[list [list $path]] {$ws_Cache($path)}"
    close $fi
}

proc cleanCache { } {
    global ws_Cache
    catch {
	foreach v [glob [cacheName *]] {
	    catch { file delete $v }
	}
    }
    catch { unset ws_Cache }
}

proc cacheName { name } {
    return [ file join $::xmaxima_priv(cachedir) $name]
}
#
#-----------------------------------------------------------------
#
# readAndSyncCache --  read the cache index.dat
# and remove duplicates removing files, and if necessary save
# the file out.   Normally this would be done at start up.
#
#  Results:
#
#  Side Effects:
#
#----------------------------------------------------------------
#
proc readAndSyncCache { } {
    global ws_Cache
    if { [catch {  set fi [open [cacheName index.dat] r] } ] } {
	return
    }
    set all [read $fi]
    #puts "all=$all"
    set lis [split $all \n]
    #puts "lis=$lis"
    set doWrite 0
    foreach v $lis {
	set key [lindex $v 0]
	set val [lindex $v 1]
	if { "$v" == ""} { continue}
	if { [info exists  ws_Cache($key)] } {
	    set doWrite 1
	    catch {file delete [cacheName [lindex $ws_Cache($key) 1] ] }
	}
	if { "$val" != "badvalue" } {
	    set ws_Cache($key) $val
	}
    }
    close $fi
    if {  $doWrite}  {
	set fi [open [cacheName index.dat] w]
	puts [concat [mc "writing"] "[cacheName index.dat]"]
	foreach { key val } [array get ws_Cache *]  {
	    puts  $fi "[list [list $key]] {$val}"
	}
	close $fi
    }
}
###### Macros.tcl ######################################################
#
# Copyright (C) 1998 William F. Schelter
# For distribution under GNU public License.  See COPYING.tcl
#
# Procedures defined in this file:
#
#  desetq   - set the values for several variables
#  assoc    - returns the value of an option in an options list
#  delassoc - removes an option from an options list
#  putassoc - sets the value of an option in an options list
#  ldelete  - removes all ocurrences of an item in a list
#
########################################################################
#
#-----------------------------------------------------------------------
# desetq lis1 lis2 -- for each vaiable name in lis1, set its value equal
# to the corresponding value in list lis2 (in the scope where desetq was
# issued). lis1 and lis2 must be two list with the same length.
#-----------------------------------------------------------------------
proc desetq {lis1 lis2} {
    foreach var $lis1 value $lis2 { uplevel 1 set $var [list $value]}}

######  Options parsing functions ######################################
# Options are assumed to be a list of keywords followed by a single vlaue
#
#-----------------------------------------------------------------------
# assoc key lis args -- returns the value of option with keywork key in
# options list lis, or the optional value args if lis doesn't have that
# keyword.
#-----------------------------------------------------------------------
proc assoc {key lis args} {
    foreach {k val} $lis {if {$k eq $key} {return $val}}
    return [lindex $args 0]}

#-----------------------------------------------------------------------
# delassoc key lis -- returns the options list lis excluding the option
# with keyword key
#-----------------------------------------------------------------------
proc delassoc {key lis} {
    set new {}
    foreach {k val} $lis {
	if {$k ne $key} {lappend new $k $val}}
    return $new}

#-----------------------------------------------------------------------
# putassoc key lis value -- returns the options list lis with the keyword
# key associated to value. If the keyword key was already present its
# associated value is replaced by value
#-----------------------------------------------------------------------
proc putassoc {key lis value} {
    set done 0
    set new {}
    foreach {k val} $lis {
	if {$k eq $key} {
	    set done 1
	    set val $value}
	lappend new $k $val}
    if {!$done} {lappend new $key $value }
    return $new}
######  End options parsing functions #################################

#-----------------------------------------------------------------------
# intersect lis1 lis2 -- returns the list of common elements of the two
# lists lis1 and lis2
#-----------------------------------------------------------------------
proc intersect {lis1 lis2} {
    set new {}
    foreach v $lis1 {
        foreach u $lis2 {
            if {$v eq $u} {lappend new $v}}}
    return $new}

#-----------------------------------------------------------------------
# ldelete item lis -- returns list lis with all ocurrences of item
# removed
#-----------------------------------------------------------------------
proc ldelete {item lis} {
    while {[set ind [lsearch $lis $item]] >= 0} {
	set lis [concat [lrange $lis 0 [expr {$ind-1}]] \
                     [lrange $lis [expr {$ind+1}] end]]}
    return $lis}

## endsource macros.tcl
#
#-----------------------------------------------------------------
#
# openSocketAndSend --  open a Socket to HOST on PORT and then
# send the message MSG to it.   If verify is non 0, then read
# up through the end of the http header and verify this is not
# an error.
#
#  Results:  returns a socket which you can read from using ordinary
#  read and write, but to which you should write only using s
#
#  Side Effects:
#
#----------------------------------------------------------------
#
proc openSocketAndSend { host port msg { verify 0}} {
    global pdata
    dtrace
    if { [info exists ::xmaxima_priv(proxy,http)] } {
	set magic "billy-[clock clicks]"
	debugsend "sendViaProxy $msg $host $port $magic"
	
	set sock [sendViaProxy $msg $host $port $magic]

	if { $verify } {
	    fconfigure $sock -blocking  1 -translation {crlf binary}
	    gets $sock tem
	    if { [regexp "503" $tem] } {
		error [concat [mc "Could not connect"] "$host $port"]
	    }
	    while { 1 } {
		gets $sock tem
		if  { [string length $tem] == 0 } { break }
	    }
	}
	set pdata($sock,proxyto) [list $host $port $magic]
	fconfigure $sock -blocking  0
	return $sock
	
	
    } else {
	set sock [socket $host $port]
	if {[info exists pdata($sock,proxyto)]} {
	    unset pdata($sock,proxyto)
	}
	fconfigure $sock -blocking  0
	puts -nonewline $sock $msg
	flush $sock
	return $sock
    }
}





#
#-----------------------------------------------------------------
#
# proxyPuts --  send the MESSAGE to SOCK, not appending a newline.
#
#  Results: none
#
#  Side Effects: message sent
#
#----------------------------------------------------------------
#
proc proxyPuts { sock  message } {
    global pdata
    debugsend "proxyPuts $sock  $message useproxy=[info exists pdata($sock,proxyto)]"
    if { [info exists pdata($sock,proxyto)] } {
	desetq "host port magic" $pdata($sock,proxyto)
	close [sendViaProxy $message $host $port $magic]
    } else {
	puts -nonewline $sock $message
	flush $sock
    }
}


#
#-----------------------------------------------------------------
#
# sendViaProxy --  send a message.
#  this is a private function.
#
#  Results: a socket one can read the answer from.
#   Caller is responsible for closing the socket.
#
#  Side Effects: socket opened and message sent as the body
#  of a post.  The magic is put in the http header request as the
#  filename	
#
#----------------------------------------------------------------
#
proc sendViaProxy { message host port magic  } {
    dtrace
    set ss [eval socket $::xmaxima_priv(proxy,http)]
    fconfigure $ss -blocking 0
    fconfigure $ss -translation {crlf binary}
    set request [getURLrequest http://$host:$port/$magic $host $port "" $message]
    debugsend "<$ss  request=$request>"
    puts $ss $request
    flush $ss
    return $ss
}

## endsource proxy.tcl

############################################################
# Send-some.tcl                                            #
# Copyright (C) 1998 William F. Schelter                   #
# For distribution under GNU public License.  See COPYING. #
#                                                          #
############################################################
# Usage:
# catch {close $socket}
# source send-some.tcl ; openConnection $tohost $port $magic $program
# one linux14 do
# run-one.tcl octave  4448 billy1
# then from any machine do:
# can also open maxima at same time
# source send-some.tcl ; openConnection linux14 4448 billy1 octave
# then
# sendOneWait octave 2+3
# 5
# If you specified -debug when starting the server then you can
#    evaluate tcl commands in the process controlling 'program'
#   eg:  sendCommand octave "list 1 1"
#
#-----------------------------------------------------------------
#
# myVwait --  this is a replacement for vwait which is missing from
# the plugin tcl.   It is 'supposed' to be the same but in fact if it
# is a fileevent handler that is supposed to do the setting, then the
# fileevent handler might indeed get called continuously because the
# file becomes readable, and myVwait which was checking a variable that
# the handler set,  never gets a chance to return, since the handler
# is called again and again.   So Remove the handler when it is invoked.
# Note this uses tracing of the variable or array, and may interfere
# with other tracing.
#  Results:
#
#  Side Effects: waits till the variable is set if it was unset, or
# until its value is different.
#
#----------------------------------------------------------------
#
proc myVwait { var  } {
    global _waiting
    set tem [split $var "(" ]
    set variable [lindex $tem 0]
    global $variable
    lappend ::xmaxima_priv(myVwait) $variable
    set index ""
    if { [llength $tem ] > 1 } {
	set index [lindex [split [lindex $tem 1] ")" ] 0]
    }

    set action  "_myaction [list $index]"
    trace variable $variable w $action
    set _waiting 1

    while { [set _waiting] } {
        #puts "still waiting _waiting=$_waiting"
	update
    }
    set ::xmaxima_priv(myVwait) [ ldelete $variable $::xmaxima_priv(myVwait)]
    trace vdelete $variable w $action
}

proc _myaction { ind name1 name2 op } {
    global _waiting
    # puts "action $ind $name1 $name2 $op"
    if { "$ind" == "$name2" } {
	
	global $name1
	set _waiting 0
    }
}

# proc myVwait { x args } {uplevel "#0"  vwait $x }
if { "[info commands vwait]" == "vwait"  } {
    proc myVwait { x  } {
# Fix for Tcl 8.5: linking unreachable global variables used to be ignored
# in Tcl 8.4 but in 8.5 it raises an error. The catch command should
# restore the Tcl 8.4 behavior. (villate, 20080513)
	catch {global $x}
	lappend ::xmaxima_priv(myVwait) $x
	vwait $x
	set ::xmaxima_priv(myVwait) [ ldelete $x $::xmaxima_priv(myVwait)]
    }
}

proc omDoInterrupt { win } {
    foreach v [ $win tag names] {
	if { [regexp "com:pdata\\((\[a-z_A-Z]*)," $v junk program] } {
	    set var [string range $v 4 end]
	    # puts "interrupt program=$program,$var"
	    after 10 uplevel "#0" set $var <interrupted>
	    catch { sendInterrupt $program }
	}
    }
}


proc omDoAbort { win } {
    foreach v [ $win tag names] {
	set var [string range $v 4 end]
	if { [regexp "com:pdata\\((\[a-z_A-Z]*)," $v junk program] } {
	    set prog [programName $program]
	    if { "[info command abort_$prog]" != "" } {
		abort_$prog $program
		after 200 uplevel "#0" set $var <aborted>
	    }
	    cleanPdata $program
	    set var [string range $v 4 end]
	    # rputs "interrupt program=$program,$var"
	    after 200 uplevel "#0" set $var <aborted>
	}
    }
}

proc  msleep { n } {
    global Msleeping
    set Msleeping 1
    after $n "set Msleeping 0"
    debugsend "waiting Msleeping.."
    myVwait Msleeping
    debugsend "..donewaiting Msleeping"
}

proc message { msg } {
    global _debugSend
    if { $_debugSend } { puts "setting message=<$msg>" }
    catch { set ::xmaxima_priv(load_rate) $msg }
}

proc sendOne { program  com }  {
    global  pdata
    incr pdata($program,currentExpr)
    set socket $pdata($program,socket)

    if { [eof $socket] } {
        error [mc "connection closed"]
    }
    # puts "sending $program ([lindex [fconfigure $socket -peername] 1])"
    message [concat [mc "sending"] "$program" [mc "on"] "[lindex [fconfigure $socket -peername] 1]"]
    debugsend "sending.. {$com<$pdata($program,currentExpr)\|fayve>}"
    set msg "$com<$pdata($program,currentExpr)\|fayve>\n"
    proxyPuts $socket $msg
}
#
#-----------------------------------------------------------------
#
# sendOneDoCommand --  sends to PROGRAM the COMMAND and then
# when the result comes back it invokes the script CALLBACK with
# one argument appended: the global LOCATION where the result
# will be.   [uplevel "#0" set $LOCATION] would retrieve it.
#
#  Results: returns immediately the location that will be
#  watched.
#
#  Side Effects: CALLBACK is invoked later by tracing the
#  result field
#
#----------------------------------------------------------------
#
proc sendOneDoCommand {program command callback } {
    global pdata

    if { ![assureProgram $program 5000 2] } { return "cant connect"}
    set ii [expr {$pdata($program,currentExpr) + 1}]
    catch { unset pdata($program,results,$ii)}
    trace variable pdata($program,results,$ii) w \
	    [list invokeAndUntrace $callback]
    sendOne $program $command
    return pdata($program,results,$ii)
}

proc testit { program com } {
    sendOneDoCommand $program $com "jimmy"
    proc jimmy {s} { puts "<result is:[uplevel #0 set $s]>" ; flush stdout}
}

proc invokeAndUntrace { callback name1 name2 op args} {
    #puts "callback:$callback $name1 $name2 $op, args=$args"
    #puts "trace vdelete [set name1]($name2) w [list invokeAndUntrace $callback]"
    trace vdelete [set name1]($name2) w [list invokeAndUntrace $callback]
    lappend callback  [set name1]($name2)
    # puts "callback=$callback" ; flush stdout
    if { [catch { eval $callback } errmsg ] } {
	global errorInfo
	# report the error in the background
	set com [list  error [concat [mc "had error in"] "$callback:[string range $errmsg 0 300].."]	$errorInfo]
	after 1 $com
    }
}

proc sendOneWait { program com } {
    global pdata
    if { ![assureProgram $program 5000 2] } { return "cant connect"}
    set ii [expr {$pdata($program,currentExpr) + 1}]
    catch { unset pdata($program,results,$ii)}
    sendOne $program $com
    set i $pdata($program,currentExpr)
    set socket $pdata($program,socket)
    if { $ii != $i } { error "expected $ii got $i as expression number " }
    debugsend "waiting for pdata($program,results,$i)"
    myVwait pdata($program,results,$i)
    debugsend "..done waiting for pdata($program,results,$i)"
    return $pdata($program,results,$i)
}

proc closeConnection { program } {
    global pdata
    catch {
	set sock $pdata($program,socket)
	set pdata(input,$sock) ""
	cleanPdata $program
	close $sock
    }
}

proc dtrace { } {
    global _debugSend
    if { $_debugSend } {
	puts "at: [info level -1]"
	if { [info level]>2 } {puts "   from:[info level -2 ]"}
    }
}

proc openConnection { tohost port magic program } {
    global  pdata
    dtrace
    set msg "magic: $magic\n"
    set retries 2
    message [concat [mc "connecting to"] "nmtp($port)://$tohost/$program"]
    debugsend "openConnection { $tohost $port $magic $program }"

    while { [incr retries -1] > 0 \
                && [catch {set socket [openSocketAndSend $tohost $port $msg 1]}] } {
	debugsend retries=$retries
	msleep 400
    }
    if { $retries == 0 } { return 0}	
    message [concat [mc "connected to"] "nmtp//$tohost:$port/$program"]
    set pdata($program,socket) $socket
    set pdata($program,currentExpr) 0
    set pdata(input,$socket) ""
    catch { fconfigure $socket -blocking 0 }
    fileevent $socket readable "getResults $program $socket"
    return 1
}

proc sendInterrupt { program } {
    global pdata interrupt_signal
    set socket $pdata($program,socket)
    maxStatus [mc "Sending socket interrupt"]
    puts $socket $interrupt_signal
    flush $socket
}

proc sendCommand { program c }   {
    global  pdata
    set socket $pdata($program,socket)
    puts $socket "<command:$c>"
    flush $socket
}

proc dumpInfo {program } {
    sendCommand $program dumpInfo
}

proc getResults {  program socket } {
    # debugsend "enter:getResults"
    global pdata  next_command_available next_command results ii
    if { [eof $socket] } {
	close $socket ;
	debugsend "closed $socket"
	cleanPdata $program
	return "<$program exitted>"
    }
    set s [read $socket]
    if { "[string index $s 0]" != "" } {
	set s [append pdata(input,$socket) $s]
	while { [set inds [testForFayve $s]] != "" } {
	    set input $pdata(input,$socket)
	    # set next_command_available 1
	    debugsend "input=$input"
	    set gotback [string range $input 0 [expr {[lindex $inds 0] -1}]]
	    set index [lindex $inds 2]
	    set pdata($program,results,$index) $gotback
    	    if { [string first "exitted>" $gotback] > 0 } {
		close $socket
		cleanPdata $program
	    }

	    debugsend "gotback{$index:$gotback}"
	    set s \
		    [string range $input [expr {1 + [lindex $inds 1]}] end ]
	    set pdata(input,$socket) $s
	}
    }
    return ""
}

proc cleanPdata { program } {
    global pdata
    catch { close $pdata($program,socket) }
    catch { unset pdata($program,socket) }
    catch { unset pdata($program,preeval) }
    catch {
	foreach v [array names $program,results,*] {
	    unset pdata($v)
	}
    }
}

proc currentTextWinWidth { } {
    set width 79
    catch {
	set t [oget [omPanel .] textwin]
	set width [expr {round([winfo width $t]*1.0 / [font measure [$t cget -font] 0]) - 12 }]
    }
    return $width
}
#
#-----------------------------------------------------------------
#
# assureProgram --
#
#  Results: return 2 if the program was already open, and 1 if it is just
# now opened.   0 if cant open it.
#
#  Side Effects: program is started.
#
#----------------------------------------------------------------
#
proc assureProgram { program timeout tries } {
    # puts "assure: program=$program"
    global pdata
    set MathServer { some.server.example.org 4443 }

    if { $tries <=  0   } { return 0}

    if  { [catch { set socket $pdata($program,socket) } ] \
	    || [catch { eof $socket}] \
	    || [eof $socket] \
	    || [catch { set s [read $socket]; append pdata(input,$socket) $s }] } {
	cleanPdata $program
	message [concat [mc "connecting"] "[lindex $MathServer 0]"]
	set msg "OPEN [programName $program] MMTP/1.0\nLineLength: [currentTextWinWidth]\n\n\n"
	if {[catch {openSocketAndSend [lindex $MathServer 0] \
		[lindex $MathServer 1] "$msg\n"} sock] } {
	    error [concat [mc "Can't connect to"] "$MathServer." [mc "You can try another host by altering Base Program under the \"File\" menu."]]
	}
	
	set pdata($program,currentExpr) 0
	fconfigure $sock -blocking 0
	if { [eof $sock] } {return 0}
	message [concat [mc"connected to"] "[lindex $MathServer 0]"]
	debugsend $msg
	set result ""
	set pdata(waiting,$sock) 1
	set script "close $sock ; debugsend {after closing} ; set pdata(waiting,$sock) -1"
	debugsend "script=$script,timeout=$timeout"
	set af [after $timeout $script ]
	debugsend "after=$af"
	while {1 } {
	    debugsend "waiting pdata(waiting,$sock)=$pdata(waiting,$sock)"
	    #	    puts "pdata=[array get pdata *$sock* ]"
	    fileevent $sock readable "if { [eof $sock] }  {set pdata(waiting,$sock) -2} else { set pdata(waiting,$sock) 0 ;} ;fileevent $sock readable {} "
	    set pdata(waiting,$sock) 1
	    debugsend "waiting on  pdata(waiting,$sock)"
	    myVwait pdata(waiting,$sock)
	
	    debugsend "..done now pdata(waiting,$sock)=$pdata(waiting,$sock)"
	    if { $pdata(waiting,$sock) < 0 } {
		debugsend "timed out,$pdata(waiting,$sock)"
		return 0
	    }
	    set me [read $sock]
	    if { "[string index $me 0]" == ""  && [eof $sock] } {
		debugsend "nothing there"
		return 0
	    }
	    append result $me
	    debugsend "result=<$result>"
	    if { [regexp "RUNNING (\[^ \]+) MMTP\[^\n\]*\nHost: (\[^\n ]+)\nPort: (\[0-9\]+)\nMagic: (\[^\n \]+)\n" \
		    $result junk prog tohost port magic] } {
		after cancel $af
		debugsend "doing openConnection  $tohost $port $magic $program"
		close $sock
		return [openConnection  $tohost $port $magic $program]
	    }
	}
    } elseif { [eof $socket] } {
	close $socket
	unset pdata($program,socket)
	return [assureProgram $program $timeout [expr {$tries -1}]]
    } else {
	# already open
	return 2
    }
}

# name may look like "maxima#1.2"
proc programName { name } {
    set name [file tail $name]
    return [lindex [split $name #] 0]
}

proc getMatch { s inds } {
    return [string range $s [lindex $inds 0] [lindex $inds 1]]
}

proc testForFayve { input } {
    set EOFexpr "|fayve>"
    set ind [string first $EOFexpr $input]
    if { $ind < 0 } { return "" } else {
	regexp -indices {<([0-9]+)\|fayve>} $input all first
	set n [getMatch $input $first]
	return "$all $n"
    }
}

#### the following is correct but just a fair bit slower.. ####
##### because of all the arguments to be parsed for the other..
proc statServer1  {server {timeout 1000}} {
    global statServer
    set ans ""
    if { ![catch { set s [eval socket $server]} ] } {
	puts $s "STAT MMTP/1.0\n" ; flush $s
	if { [readAllData $s -tovar statServer(data) \
		-mimeheader statServer(header) -timeout $timeout ] > 0 } {
	    set head $statServer(header)
	    #	   puts "data=<$statServer(data)>"
	    set res $statServer(header)\n\n$statServer(data)
	    unset statServer
	    return $res
	}
    }
    return ""
}
#
#-----------------------------------------------------------------
#
# needToDo --  Check if we have already done OPERATION for  NAME into data
#
#  Results: returns 0 if the data for name is not preloaded, and 1 otherwise
#
#  Side Effects: adds NAME to those preloaded for PROGRAM if not there
#
#----------------------------------------------------------------
#
proc preeval { program name } {
    global pdata
    assureProgram $program 5000 2
    if { ![info exists pdata($program,preeval)] || \
    [lsearch  $pdata($program,preeval) $name] < 0 } {
	lappend pdata($program,preeval) $name
	return 0
    } else {
	return 1
    }
}

proc statServer  {server {timeout 1000}} {
    global statServer1_
    set ans ""
    if { ![catch { set s [eval socket $server]} ] } {
	puts $s "STAT MMTP/1.0\n" ; flush $s
	if { [readDataTilEof $s data $timeout ] } {
	    foreach v { jobs currentjobs } {
		if { [regexp "\n$v: (\[^\n]*)\n" $data junk val] } {
		    lappend ans $v $val
		}
	    }
	}
    }
    return $ans
}

proc isAlive1 { s } {
    if { [catch { read $s } ] } {
	set ::xmaxima_priv(isalive) -1
    } else {
	set ::xmaxima_priv(isalive) 1
    }
    close $s
}

proc isAlive { server {timeout 1000} } {
    if { [ catch { set s [eval socket -async $server] } ] } { return -1 }
    set ::xmaxima_priv(isalive) 0
    fconfigure $s -blocking 0
    fileevent    $s writable     "isAlive1 $s"
    set c1 "set ::xmaxima_priv(isalive) -2"
    set after_id [after $timeout $c1]
    myVwait ::xmaxima_priv(isalive)
    catch { close $s}
    after cancel $after_id
    return $::xmaxima_priv(isalive)
}

proc debugsend { s } {
    global _debugSend
    if { $_debugSend } {
	
	puts $s
	flush stdout
    }
}
###### plotting.tcl ######
############################################################
# Netmath       Copyright (C) 1998 William F. Schelter     #
# For distribution under GNU public License.  See COPYING. #
############################################################

global axisGray
if { "[winfo screenvisual .]" == "staticgray" } {
    set axisGray black
} else  {
    set axisGray gray60
}
if {[catch { set doExit }] } { set doExit ""}

## endsource plotting.tcl
# set font {Courier 8}
global fontCourier8 fixedFont fontSize
set ::xmaxima_priv(fixedFont) Courier

# Pick a default font size in pixels
set _screenheight [winfo screenheight .]
# if {$_screenheight < 500} {
#     # for 640x480
#     set _pixel 10
#     set _point 8
#     # Pick a default borderwidth which smaller
#     set _bd 1
# } elseif {$_screenheight < 700} {
#     # for 800x600
#     set _pixel 12
#     set _point 8
# } elseif {$_screenheight < 800} {
#     # for 1024x768
#     set _pixel 12
#     set _point 8
# } elseif {$_screenheight < 1100} {
#     # for 1200x1000
#     set _pixel 14
#     set _point 10
# } else {
#     set _pixel 18
#     set _point 12
# }

# ZW: this actually produces better result
set _pixel 10
set _point 8
set fontSize $_pixel

# setup defaults depending on the OS and Window Manager
# Really should do another version for mono
switch -exact -- $::tcl_platform(platform) {
    windows {
	set _prop_default Tahoma
	set _fixed_default {Courier New}
    }
    default {
	set _prop_default {Bitstream Vera Sans}
	set _fixed_default {Bitstream Vera Sans Mono}
    }
}
# make sure these fonts are installed
set _allowed [string tolow [font families]]
foreach font [list $_prop_default "MS Sans Serif" Tahoma Arial Helvetica \
		 fixed system] {
    if {[lsearch -exact $_allowed [string tolow $font]] > -1} {
	set _prop_default $font
	break
    }
}
foreach font [list $_fixed_default Courier fixed system] {
    if {[lsearch -exact $_allowed [string tolow $font]] > -1} {
	set _fixed_default $font
	break
    }
}
set fontCourier8 [list $_fixed_default $_pixel]
set fixedFont [font create -family $_fixed_default -size $_pixel]
set buttonfont [font create -family $_prop_default -size $_pixel]

set ::xmaxima_default(adjust) 0
# I think this is too crude and wont work with WM schemes
if {0} {
    catch {
	set width_ [expr {.9 * [winfo screenwidth .]}]
	if { [winfo width .] >= 500 } {
	    set width_ [winfo width .]
	}
	set ::xmaxima_default(adjust) [expr {
					  $width_<= 640 ? -1 :
					  $width_<= 800 ? 0 :
					  1 } ]
	unset width_
    }
}



######### font choosing utilities #########
global isFixedp

if { "$::tcl_platform(platform)" == "unix" } {
    array set isFixedp {
	fixed 1 {fangsong ti} 1 {clearlyu alternate glyphs} 0 lucidatypewriter 1 charter 0 lucidabright 0 times 0 ming 1 {lucidux sans} 0 {open look glyph} 0 {song ti} 1 newspaper 0 helvetica 0 {open look cursor} 1 li 1 mincho 1 {clearlyu ligature} 0 {clearlyu pua} 0 {lucidux mono} 1 courier 1 clearlyu 0 utopia 0 lucida 0 nil 1 clean 1 terminal 1 kai 1 gothic 1 cursor 0 symbol 0 {clearlyu arabic extra} 0 {lucidux serif} 0 {new century schoolbook} 0 song 1
    }
}

proc getFontFamilies { fixed } {
    global isFixedp
    foreach font  [font families] {
	if { ![info exists isFixedp($font)] } {
	    set isFixedp($font) [font metrics [list $font] -fixed]
	}
	if { $isFixedp($font) == $fixed } {
	    lappend answer $font
	}
    }
    return [lsort $answer]
}


# Copyright (c) 2009-2026, Jaime E. Villate <villate@fe.up.pt>
#
# Procedures to work with colors
# (the license information can be found in COPYING.tcl)
#
##############################################################################
# Three notations are used for colors:                                       #
#                                                                            #
# 1. A list of red, green and blue, being all integers between 0 and 255.    #
#                                                                            #
# 2. A list of hue, saturation and value, where hue is an integer between 0  #
# and 360, while saturation and value are numbers between 0 and 1.           #
#                                                                            #
# 3. A string "#rrggbb", where rr, gg and bb are 2-digit hexadecimal numbers #
# (the red, green and blue components).                                      #
##############################################################################

# Transforms a (hue, saturation, value) set into a (red, green, blue) set
proc hsv2rgb {hue sat val} {
    if { $sat < 0 } { set sat [expr 1 -  $sat] }
    if { $val < 0 } { set val [expr 1 -  $val] }
    if { $val > 1 } { set val [expr $val - int($val)] }
    if { $sat > 1 } { set sat [expr $sat - int($sat)] }
    set v  [expr round($val*255)]
    if {$sat == 0} {
        return [format "\#%02x%02x%02x" $v $v $v]
    } else {
        set h [expr {round($hue)%360/60.0}]
        set i [expr {round($hue)%360/60}]
        set f [expr {$h-$i}]
        set u [expr {round($v)}]
        set p [expr {round($v*(1-$sat))}]
        set q [expr {round($v*(1-$sat*$f))}]
        set t [expr {round($v*(1-$sat*(1-$f)))}]
        switch $i {
            0 {set r $u; set g $t; set b $p}
            1 {set r $q; set g $u; set b $p}
            2 {set r $p; set g $u; set b $t}
            3 {set r $p; set g $q; set b $u}
            4 {set r $t; set g $p; set b $u}
            5 {set r $u; set g $p; set b $q}}
        return [format "\#%02x%02x%02x" $r $g $b]
    }
}

# Transforms a color code #rrggbb into a list of three components (red,
# green and blue) between 0 and 255
proc rgb2list {rgb} {
    set num "0x"
    set r [append num [string range $rgb 1 2]]
    set num "0x"
    set g [append num [string range $rgb 3 4]]
    set num "0x"
    set b [append num [string range $rgb 5 6]]
    return [format "%d %d %d" $r $g $b]
}

# Transforms a list c with three components between 0 and 255 (red,
# green and blue components) into a color code #rrggbb
proc list2rgb {c} {
    return [format "\#%02x%02x%02x" [lindex $c 0] [lindex $c 1] [lindex $c 2]]}

# Given a fraction f between 0 and 1 and at least two color codes in the form
# #rrggbb returns another color code in the form #rrggbb obtained by linear
# interpolation of the given colors
proc interpolatecolor {f rgb1 rgb2 args} {
    set colors [list [rgb2list $rgb1]]
    lappend colors [rgb2list $rgb2]
    foreach color $args {lappend colors [rgb2list $color]}
    set l [llength $colors]
    set x [expr {$f*($l-1.0)}]
    set n [expr {int($x)}]
    set r [expr {$x-int($x)}]
    if {$n == [expr {$l-1}]} {
        return [lindex $colors end]
    } else {
        set c1 [lindex $colors $n]
        set c2 [lindex $colors $n+1]
        set r1 [lindex $c1 0]
        set g1 [lindex $c1 1]
        set b1 [lindex $c1 2]
        set r2 [lindex $c2 0]
        set g2 [lindex $c2 1]
        set b2 [lindex $c2 2]
        return [list2rgb [list [expr {round($r1+$r*($r2-$r1))}] [expr {round($g1+$r*($g2-$g1))}] [expr {round($b1+$r*($b2-$b1))}]]]
    }
}

###### private.tcl ######
############################################################
# Netmath       Copyright (C) 1998 William F. Schelter     #
# For distribution under GNU public License.  See COPYING. #
############################################################

# a private way of storing variables on a window by window
# basis
#mike FIXME: these stay in memory when the window is destroyed

proc makeLocal { win args } {
    foreach v $args {
	uplevel 1 set  $v \[oget $win $v\]
    }
}

proc linkLocal { win args } {
    foreach v $args {
	uplevel 1 upvar #0 _WinInfo${win}\($v) $v
    }
}

proc clearLocal { win } {
    global _WinInfo$win
    # puts "clearing info for $win in [info level 1]"
    catch { unset _WinInfo$win }
}


proc oset { win var val } {
    global _WinInfo$win
    set _WinInfo[set win]($var) $val
}

proc oarraySet { win vals } {
    global _WinInfo$win
    array set  _WinInfo$win $vals
}

proc oloc { win var } {
    return _WinInfo[set win]($var)
}

proc oarray { win  } {
    return _WinInfo[set win]
}

proc oget { win var } {
    global _WinInfo$win
    return [set _WinInfo[set win]($var)]
}

## endsource private.tcl
###### Getopt.tcl ######
############################################################
# Netmath       Copyright (C) 1998 William F. Schelter     #
# For distribution under GNU public License.  See COPYING. #
############################################################

#####sample option list.   Error will be signalled if "Required" option
##### not given.
#set dfplotOptions {
#    {xdot Required {specifies dx/dt = xdot.  eg -xdot "x+y+sin(x)^2"} }
#    {ydot Required {specifies dy/dt = ydot.  eg -ydot "x-y^2+exp(x)"} }
#    {xradius 10 "Width in x direction of the x values" }
#    {yradius 10 "Height in y direction of the y values"}
#}


#
#-----------------------------------------------------------------
#
# optLoc --  if $usearray is not 0, then the OPTION is stored
# in a hashtable, otherwise in the variable whose name is the
# same as OPTION.
#  Results: a form which when 'set' will allow storing value.
#
#  Side Effects: none
#
#----------------------------------------------------------------
#
proc optLoc { op ar }  {
    #  puts "$ar,[lindex $op 0]"
    # puts "return=$ar\([lindex $op 0]\)"
    if { "$ar" == 0 } {
	return [lindex $op 0]
    } else {
	#puts "$ar\([lindex $op 0]\)"
	return "$ar\([lindex $op 0]\)"
    }

}


#
#-----------------------------------------------------------------
#
# getOptions --  given OPTLIST a specification for the options taken,
# parse the alternating keyword1 value1 keyword2 value2 options_supplied
# to make sure they are allowed, and not just typos, and to supply defaults
# for ones not given.   Give an error message listing options.
# a specification is  { varname default_value "doc string" }
# and optlist, is a list of these.   the key should be -varname
#
#  -debug 1 "means print the values on standard out"
#  -allowOtherKeys 1 "dont signal an error if -option is supplied but not in
#                     the list"
#  -usearray "should give a NAME, so that options are stored in NAME(OPTION)
#  -setdefaults "if not 0 (default is 1) do `set OPTION dflt' for all options"
# If a key is specified twice eg.  -key1 val1 -key1 val2, then the first
# value val1 will be used
#  Results:
#
#  Side Effects: set the values in the callers environment
#
#----------------------------------------------------------------
#

proc getOptions { optlist options_supplied args } {
    # global  getOptionSpecs

    set ar [assoc -usearray $args 0]
    set help [assoc -help $args ""]
    if { "$ar" != "0" } { global $ar }
    set debug [assoc -debug $args 0]
    set allowOtherKeys [assoc -allowOtherKeys $args 0]
    set setdefaults [assoc -setdefaults $args 1]
    set supplied ""

    foreach {key val } $options_supplied {
	if { [info exists already($key)] } { continue }
	set already($key) 1
	set found 0
	foreach op $optlist {
	    if { "$key" == "-[lindex $op 0]" } {
		uplevel 1 set [optLoc $op $ar] [list $val]
		
		append supplied " [lindex $op 0]"
		set found 1
		break
	    }
	}
	set caller global

	if { $found == 0  && !$allowOtherKeys } {
	    catch {set caller [lindex [info level -1] 0]}
	    error [concat "`$caller'" [mc "does not take the key"] "`$key':\n[optionHelpMessage $optlist]\n$help"]

	}
    }
    foreach op $optlist {
	if { [lsearch $supplied [lindex $op 0]] < 0 } {
	    if { "[lindex $op 1]" == "Required" } {
		catch {set caller [lindex [info level -1] 0]}	
		error [concat "`-[lindex $op 0]'" [mc "is required option for"] "`$caller':\n[optionHelpMessage $optlist]"]
	    }
	    if { $setdefaults }  {

		uplevel 1 set [optLoc $op $ar] [list [lindex $op 1]]
	    }
	}
	# for debugging see them.
	# if { $debug } {   uplevel 1 puts "[optLoc $op $ar]=\$[optLoc $op $ar]"}
	if { $debug } {   puts "[optLoc $op $ar]=[safeValue [optLoc $op $ar] 2]"}
	
    }
}

proc getOptionDefault { key optionList } {
    foreach v $optionList {
	if { "[lindex $v 0]" == "$key" } { return [lindex $v 1]}
    }
    return ""
}

proc assq {key list {dflt ""}} {
    foreach v $list { if { "[lindex $v 0]" == "$key" } { return $v }}
    return $dflt
}

proc safeValue { loc level} {
    if { ![catch { set me [uplevel $level set $loc] } ] } {
	return $me
    }  else {
	return "`unset'"
    }
}



proc optionFirstItems { lis } {
    set ans ""
    foreach v $lis { append ans " [list [lindex $v 0]]" }
    return $ans
}

proc optionHelpMessage { optlist } {
    set msg ""
    foreach op $optlist  {	
	append msg \
		" -[lindex $op 0] \[ [lindex $op 1] \] --[lindex $op 2]\n"
    }
    return $msg
}


#
#-----------------------------------------------------------------
#
# setSplittingOptionsRest --  takes ARGLIST and splits it into
# two lists, the first part it stores in KEYPAIRS and the second in REST
#
#
#  Results: none
#
#
#  Side Effects: sets the variables in the local frame passed to KEYPAIRS
#
#----------------------------------------------------------------
#	
proc setSplittingOptionsRest {  keypairs rest arglist } {
    upvar 1 $keypairs keys
    upvar 1 $rest res
    set i 0
    while { 1 } {
	if { $i >= [llength $arglist] } { break }
	if { "[string range [lindex $arglist $i] 0 0]" == "-" } {
	    incr i 2
	} else {
	    break
	}
    }
    set keys [lrange $arglist 0 [expr $i -1]]
    set res [lrange $arglist  $i end]
}



## endsource getopt.tcl
###### Parse.tcl ######
############################################################
# Netmath       Copyright (C) 1998 William F. Schelter     #
# For distribution under GNU public License.  See COPYING. #
############################################################

global Parser parse_table
if {[info exists Parser]} {catch { unset Parser }}

foreach v  { { ( 120 } { \[ 120 } { ) 120 } { \] 120 }  { ^ 110}
{ ^- 110} {* 100} { / 100} {% 100}  {- 90 } { + 90 }
{ << 80} { >> 80 } { < 70 } { > 70 } { <= 70 } {>= 70}
{ == 60 } { & 50} { | 40 } { , 40 } {= 40}
{ && 30 } { || 20 } { ? 10 } { : 10 }  { ; 5 }}  {
    set parse_table([lindex $v 0]) [lindex $v 1]
    set getOp([lindex $v 0]) doBinary

}

proc binding_power {s} {
    global parse_table billy
    set billy $s
    if { [catch { set tem $parse_table($s) }] } {
	return 0
    } else {
	return $tem
    }
}

proc getOneMatch { s inds } {
    return [string range $s [lindex $inds 0] [lindex $inds 1]]
}

proc parseTokenize { str } {
    regsub  -all {[*][*]} $str "^" str
    set ans ""
    while { [string length $str ] > 0 } {
	#    puts "ans=$ans,str=$str"	
	set str [string trimleft $str " \t\n" ]
	set s [string range $str 0 1]
	set bp [binding_power $s]
	if { $bp > 0 } {
	    append ans " $s"
	    set str [string range $str 2 end]
	    continue
	} else {
	    set s [string range $s 0 0]
	    set bp [binding_power $s]
	    if { $bp > 0 } {
		append ans " $s"
		set str [string range $str 1 end]
		continue
	    }
	}
	if { "$s" == "" } {
	    return $ans
	}
	if { [regexp -indices {^[0-9.]+([eE][+---]?[0-9]+)?} $str all] } {
	    append ans " { number [getOneMatch $str $all] }"
	    # append ans " [getOneMatch $str $all]"
	    set str [string range $str [expr {1+ [lindex $all 1]}] end]
	}  elseif { [regexp -indices {^[$a-zA-Z][a-zA-Z0-9]*} $str all] } {
	    append ans " { id [getOneMatch $str $all] } "
	    # append ans " [getOneMatch $str $all]"
	    set str [string range $str [expr {1+ [lindex $all 1]}] end]
	}  else {
	    error [concat [mc "parser unrecognized:"] "$str"]
	}
    }
    return $ans
}

set Parser(reserved) " acos cos hypo sinh asin cosh log sqrt atan exp log10 tan atan2 floor pow tanh ceil fmod sin abs double int round"

set Parser(help) [join [list [mc \
{
The syntax for the definition of functions is like C, except that it is \
permitted to write x^n instead of pow(x,n).
} ] [mc {
Functions:}] $Parser(reserved) [mc {

Operators:}] " == % & || ( << <= ) : * >=  + && , | < >> - > ^ ? /" ] ""]



proc nexttok { } {
    global Parser
    set x [lindex $Parser(tokenlist) [incr Parser(tokenind) ]]
    # puts "nexttok=$x"
    if {[llength $x ] > 1 } {
	set Parser(tokenval) [lindex $x 1]
	return [lindex $x 0]
    } else {
	return $x
    }
}


#
#-----------------------------------------------------------------
#
# parseToSuffixLists -- Convert EXPR1; EXPR2; ..
# to a list of suffix lists.  Each suffix list is suitable for
# evaluating on a stack machine (like postscript) or for converting
# further into another form.  see parseFromSuffixList.
#  "1+2-3^4;" ==>
#   {number 1} {number 2} + {number 3} {number 4} ^ -
#  Results: suffix list form of the original EXPR
#
#  Side Effects: none
#
#----------------------------------------------------------------
#
proc parseToSuffixLists { a }  {
    global Parser
    set Parser(result) ""
    set Parser(tokenlist) [parseTokenize $a]
    set Parser(tokenind) -1
    set Parser(lookahead)  [nexttok]
    #puts tokenlist=$Parser(tokenlist)
    set ans ""
    while { "$Parser(lookahead)" != ""  } {
	getExpr  ; parseMatch ";"
	#puts "here: $Parser(result) "	
	append ans "[list	$Parser(result)] "
	set Parser(result) "" 	
    }
    regsub \\^- $ans {PRE_MINUS ^} ans2
    return $ans2
}

proc parseMatch { t } {
    global Parser
    if { "$t" == "$Parser(lookahead)" } {
	set Parser(lookahead)  [nexttok]
    } else {
	error "syntax error: wanted $t"
    }
}

proc emit { s args } {
    global Parser
    if { "$args" == "" }   {
	append Parser(result) " $s"
	# puts " $s "
    } else {
	append Parser(result) " {[lindex $args 0 ] $s}"
	#puts " {[lindex $args 0 ] $s} "
    }
}

proc getExpr { } {
    getExprn 0
}

proc getExprn { n } {
    global Parser
    #puts "getExpr $n, $Parser(tokenind),$Parser(tokenlist)"
    if { $n == 110 } {
	getExpr120
	return
    }

    incr n 10
    if  { $n == 110 } {
	if { "$Parser(lookahead)" == "-" || "$Parser(lookahead)" == "+"  } {
            if { "$Parser(lookahead)" == "-" } {
		set this PRE_MINUS
	    } else {
		set this PRE_PLUS
	    }
	    parseMatch $Parser(lookahead)
	    getExprn $n
	    #puts "l=$Parser(lookahead),pl=$Parser(result)"
	    emit $this
	    return
	}
	
    }

    getExprn $n
    while { 1 } {
	if { [binding_power $Parser(lookahead)] == $n } {
	    set this $Parser(lookahead)
	    parseMatch $Parser(lookahead)
	    getExprn $n
	    if { $n == 110 } {
		set toemit ""
		while { "$this" == "^" &&  "$Parser(lookahead)" == "^" } {
		    # puts "p=$Parser(result),$
		    set this $Parser(lookahead)
		    append toemit " $this"
		    parseMatch $Parser(lookahead)
		    getExprn $n
		}
		foreach v $toemit { emit $v }
	    }
	    emit $this

	} else {
	    return
	}
    }
}

proc getExpr120 { } {
    global Parser
    #puts "getExpr120, $Parser(tokenind),[lrange $Parser(tokenlist) $Parser(tokenind) end]"
    while { 1 } {
	if { "$Parser(lookahead)" == "(" } {
	    parseMatch $Parser(lookahead)
	    getExpr
	    parseMatch ")"
	    break;
	} elseif { $Parser(lookahead) == "id" } {
	    emit $Parser(tokenval) id

	    parseMatch $Parser(lookahead)
	    if { "$Parser(lookahead)" == "(" } {
		getExpr120
		emit funcall
	    }
	    break;
	} elseif { $Parser(lookahead) == "number" } {
	    emit $Parser(tokenval) number
	    parseMatch $Parser(lookahead)
	    break;
	} else {
	    bgerror [mc "syntax error"]
	    break;
	}
    }
}

global getOp
set getOp(PRE_PLUS) doPrefix
set getOp(PRE_MINUS) doPrefix
set getOp(funcall) doFuncall
set getOp(^) doPower
set getOp(:) doConditional
set getOp(?) doConditional

proc doBinary { } {
    uplevel 1 {set s $nargs; incr nargs -1 ;
    if { "$x" == "," } {
	set a($nargs) "$a($nargs) $x $a($s)"
    } else {
	set a($nargs) "($a($nargs) $x $a($s))"}
    }
}

proc doPower { } {
    uplevel 1 {set s $nargs; incr nargs -1 ; set a($nargs) "pow($a($nargs),$a($s))" }
}

proc doFuncall {} {
    uplevel 1 {
	#puts nargs=$nargs
	set s $nargs; incr nargs -1 ; set a($nargs) "$a($nargs)($a($s))"
    }
}

proc doPrefix {} {
    uplevel 1  { if { "$x" == "PRE_MINUS" } { set a($nargs) "-$a($nargs)" } }
}

proc doConditional { } {
    set x [uplevel 1 set x]
    if { "$x" == "?" } { return }
    # must be :
    uplevel 1 {
	set s $nargs ; incr nargs -2 ;
	set a($nargs) "($a($nargs) ? $a([expr {$nargs + 1}]) : $a($s))"
    }
}


#
#-----------------------------------------------------------------
#
# parseFromSuffixList --  takes a token list, and turns
# it into a suffix form.  eg: 1 + 2 - 3 ^ 4 --> 1 2 + 3 4 ^ -
#  Results:
#
#  Side Effects:
#
#----------------------------------------------------------------
#
proc parseFromSuffixList { list } {
    global getOp
    set stack ""
    set lim [llength $list]
    set i 0
    set nargs 0
    while { $i < $lim } {
	set x [lindex $list $i ]
	set bp [binding_power $x]
	incr i
	# all binary
	if { [llength $x] > 1 } {
	
	    set a([incr nargs]) [lindex $x 1]

	} else {
	    $getOp($x)
	}
    }

    return $a(1)
}


#
#-----------------------------------------------------------------
#
# parseConvert --  given an EXPRESSION, parse it and find out
# what are the variables, and convert a^b to pow(a,b).  If
# -variables "x y" is given, then x and y will be replaced by $x $y
#  doall 1 is giv
#  Results:
#
#  Side Effects:
#
#----------------------------------------------------------------
#
global Parser
set Parser(convertOptions) {
    { doall 0 "convert all variables x to \$x" }
    { variables "" "list of variables to change from x to \$x" }
}
proc parseConvert { expr args } {
    global Parser
    getOptions $Parser(convertOptions) $args
    if { "$expr" == "" } { return [list {} {}] }
    set parselist [parseToSuffixLists "$expr;"]
    #puts "parselist=$parselist"
    catch { unset allvars }
    set new ""
    set answers ""
    foreach lis $parselist {

	foreach v $lis {

	    if { ("[lindex $v 0]" == "id")
	    && ([llength $v] == 2)
	    && ([lsearch  $Parser(reserved) [set w [lindex $v 1]]] < 0)
	} {
	    if { ($doall != 0)  || ([lsearch  $variables $w] >= 0) } {
		append new " {id \$$w}"
		set allvars(\$$w) 1
	    } else {
		set allvars($w) 1
		append new " {$v}"
	    }
	}  else {
	    if { [llength $v] > 1 } {
		append new " {$v}"
	    } else {
		append new " $v" }
	    }
	}
	#puts "new=$new"
	append answers "[list [parseFromSuffixList $new]] "
	set new ""
    }
    return [list $answers [array names allvars]]
}

proc test { s } {
    set me [parseFromSuffixList [lindex [parseToSuffixLists "$s;"] 0]]
    puts $me
    return "[eval expr $s] [eval expr $me]"
}




## endsource parse.tcl
###### Textinsert.tcl ######
############################################################
# Netmath       Copyright (C) 1998 William F. Schelter     #
# For distribution under GNU public License.  See COPYING. #
############################################################

proc mkTextItem { c x y args  } {

    global _fixed_default _prop_default fontSize
    set helvetica $_prop_default
    set courier $_fixed_default

    set font [assoc -font $args [list $helvetica $fontSize]]
    set tags [assoc -tags $args {}]
    set item [$c create text $x $y -text " " -width 440 -anchor n -font $font -justify left]
    append tags text
    foreach v $tags { $c addtag $v withtag $item}
    $c bind text <1> "textB1Press $c %x %y"
    $c bind text <B1-Motion> "textB1Move $c %x %y"
    $c bind text <Shift-1> "$c select adjust current @%x,%y"
    $c bind text <Shift-B1-Motion> "textB1Move $c %x %y"
    $c bind text <KeyPress> "textInsert $c %A"
    $c bind text <Return> "textInsert $c \\n"
    $c bind text <Control-h> "textBs $c"
    $c bind text <BackSpace> "textBs $c"
    $c bind text <Delete> "textDel $c"
    $c bind text <2> "textPaste $c @%x,%y"
}


## endsource textinsert.tcl
###### Printops.tcl ######
############################################################
# Netmath       Copyright (C) 1998 William F. Schelter     #
# For distribution under GNU public License.  See COPYING. #
############################################################

### FIXME: fix a4 size !
global paperSizes printOptions
set paperSizes {{letter 8.5 11} { A4 8.5 11} {legal 8.5 13}}

set printOptions {
    { landscape 0 "Non zero means use landscape mode in printing"}
    { papersize letter "letter, legal or A4"}
    { hoffset 0.5 "Left margin for printing"}
    { voffset 0.5 "Top margin for printing"}
    { xticks 20 "Rough number of ticks on x axis"}
    { yticks 20 "Rough number of ticks on y axis"}
#   { title "" "Title"}
    { psfilename "~/sdfplot.ps" "Postscript filename"}
    { centeronpage 1 ""}
}

# proc getPageOffsets { widthbyheight} {
#     global printOption paperSizes
#     puts "wbh=$widthbyheight"
#     set pwid 8.5
#     set phei 11.0

#     foreach v $paperSizes {
# 	if { "[lindex $v 0]" == "$printOption(papersize)" } {
# 	    set pwid [lindex $v 1]
# 	    set phei [lindex $v 2]
# 	}
#     }
#     set wid [expr {$pwid - 2* $printOption(hoffset)}]
#     set hei [expr {$phei - 2* $printOption(voffset)}]
# #    if { $printOption(landscape) } {set widthbyheight [expr  {1.0 /$widthbyheight}]}
# #    set w $wid ; set hei $wid ; set wid $w

#     puts "pw=$wid,ph=$hei,w/h=$widthbyheight,hh=[expr {$hei * $widthbyheight}], ww=[expr {$wid / $widthbyheight}]"

#     set fac   $widthbyheight
#     puts "fac=$fac"
#     if { $fac * $hei < $wid } {
    # 	set iwid [expr {$fac *$hei}]
# 	set ihei $hei

#     } else {
    # 	set ihei [expr {$wid / $fac}]

# 	set iwid $wid

#     }

#     if { $printOption(landscape) } { set fac1 [expr {1/$fac}] }
#     if { $wid/$hei > $fac } {
# 	set ihei $hei
    # 	set iwid   [expr {$hei / $fac }]

#     } else {
# 	 set iwid $wid
    # 	 set ihei [expr {$wid * $fac }]
#     }

#     #-pagex = left margin (whether landscape or not)
#     #-pagey = right margin (whether landscape or not)
#     #-pagewidth becomes vertical height if landscape
#     #-pageheight becomes horiz width if landscape

#     set xoff [expr {($pwid-$iwid)/2.0}]
#     set yoff [expr  {($phei-$ihei)/2.0}]

#     if { $printOption(landscape) } {
# 	set h $ihei
# 	set ihei $iwid
# 	set iwid $h
#     }

#     puts "phei=$phei,ihei=$ihei,yoff=$yoff,voff=$printOption(voffset)"
#     set ans "-pagex [set xoff]i -pagey [set yoff]i \
# 	    -pagewidth [set iwid]i -pageheight [set ihei]i"
#     set ans "-pagex [set xoff]i -pagey [set yoff]i \
# 	    -pagewidth [set iwid]i -pageheight [set ihei]i"
#     return $ans
# }

proc swap { a b } {
    set me [uplevel 1 set $b]
    uplevel 1 set $b \[set $a\]
    uplevel 1 set $a [list $me]
}

proc getPageOffsets { widthbyheight} {
    global printOption paperSizes
    #puts "wbh=$widthbyheight"
    set pwid 8.5
    set phei 11.0

    foreach v $paperSizes {
	if { "[lindex $v 0]" == "$printOption(papersize)" } {
	    set pwid [lindex $v 1]
	    set phei [lindex $v 2]
	}
    }
    set wid [expr {$pwid - 2* $printOption(hoffset)}]
    set hei [expr {$phei - 2* $printOption(voffset)}]
    if { $printOption(landscape) } {
	swap wid hei
	#	swap pwid phei
    }
    if { $wid / $hei  < $widthbyheight  } {
	# width dominates
	set iwid $wid
	set ihei [expr {$wid / $widthbyheight }]
	append opts " -pagewidth [set wid]i"
    } else {
	set ihei $hei
	set iwid [expr {$hei * $widthbyheight }]
	append opts " -pageheight [set hei]i"
    }

    #-pagex = left margin (whether landscape or not)
    #-pagey = right margin (whether landscape or not)
    #-pagewidth becomes vertical height if landscape
    #-pageheight becomes horiz width if landscape

    append opts " -pagex [expr {$pwid / 2.0}]i -pagey [expr {$phei / 2.0}]i "

    if { $printOption(landscape) } {
	append opts " -rotate $printOption(landscape)"
    }
    return $opts
}

global printOption
set printOption(setupDone) 0

proc getEnv { name } {
    if { [catch { set tem $::env($name) } ] } { return "" }
    return $tem
}
proc setPrintOptions { lis } {
    global browser_version
    global printOptions printOption printSetUpDone
    if { !$printOption(setupDone) } {
	set printOption(setupDone) 1
	getOptions $printOptions $lis -allowOtherKeys 1 \
		-setdefaults [catch { source [getEnv HOME]/.printOptions }] -usearray printOption
    }
}

proc mkentryPr { w var text buttonFont }  {
    set fr $w ; frame $fr
    uplevel 1 append topack [list " $fr"]
    label $fr.lab1
    label $fr.lab -text "$text:" -font $buttonFont -width 0
    entry $fr.e -width 20 -textvariable $var -font $buttonFont
    pack $fr.lab1 -side left -expand 1 -fill x
    pack $fr.lab -side left
    pack $fr.e -side right -padx 3 -fill x
}


proc mkPrintDialog { name args } {
    global printSet argv printOptions printOption printSetUpDone paperSizes buttonfont

    set canv [assoc -canvas $args ]
    set buttonFont [assoc -buttonfont $args $buttonfont]
    catch { destroy $name }
    set dismiss "destroy $name"
    if { "$canv" == "" } {
	catch {destroy $name}
	toplevel $name
	wm geometry $name -0+20

    } else {
        $canv delete printoptions
        set name [winfo parent $canv].printoptions
	# set name $canv.fr1
        catch {destroy $name}
	frame $name -borderwidth 2 -relief raised
	
	set item [$canv create window [$canv canvasx 10] [$canv canvasy  10] -window $name -anchor nw -tags printoptions]
        $canv raise printoptions
	set dismiss "$canv delete $item; destroy $name "
    }

    frame $name.fr

    set w $name.fr
    label $w.msg  -wraplength 600 -justify left -text [mc "Encapsulated PostScript File Options"] -font $buttonFont
    pack $w
    pack $w.msg
    set wb $w.buttons
    frame $wb
    pack $wb -side left -fill x -pady 2m
    set topack ""
    catch { set printOption(psfilename) \
	    [file nativename $printOption(psfilename)]}
    set win [winfo parent $canv]
    button $wb.save -text [mc "Save"] -font $buttonFont -command "destroy $name; writePostscript $win; $canv delete printoptions"
    button $wb.cancel -text [mc "Cancel"] -font $buttonFont -command "destroy $name ; $canv delete printoptions"
    mkentryPr  $wb.psfilename printOption(psfilename) [mc "Postscript filename"] $buttonFont
    mkentryPr  $wb.hoffset printOption(hoffset) [mc "Left margin (inches)"] $buttonFont
    mkentryPr  $wb.voffset printOption(voffset) [mc "Top margin (inches)"] $buttonFont
    eval pack $topack -expand 1

    foreach v  $paperSizes {
	set papersize [lindex $v 0]
        set lower [string tolower $papersize]
        radiobutton $wb.$lower -text [lindex $v 0] -variable printOption(papersize) \
		-value [lindex $v 0] -font $buttonFont -highlightthickness 0
	pack $wb.$lower -pady 2 -anchor w -fill x
    }

    checkbutton $wb.b1 -text [mc "Center on Page"] -variable printOption(centeronpage) -relief flat -font $buttonFont
    checkbutton $wb.b2 -text [mc "Landscape Mode"] -variable printOption(landscape) -relief flat -font $buttonFont
    pack $wb.b1 $wb.b2

    frame $w.grid
    pack $w.grid -expand yes -fill both -padx 1 -pady 1
    pack $wb.save $wb.cancel
    grid rowconfig    $w.grid 0 -weight 1 -minsize 0
    grid columnconfig $w.grid 0 -weight 1 -minsize 0
}

proc markToPrint { win tag title } {
    # puts "$win $tag"
    # bind $win <1> "bindBeginDrag $win %x %y $tag [list $title]"
    pushBind $win <1> "$win delete printrectangle ; popBind $win <1>"
    pushBind $win <1> "bindBeginDrag $win %x %y $tag [list $title]; popBind $win <1>"
}

proc bindBeginDrag { win x y tag title } {
    $win delete $tag printrectangle
    set beginRect "[$win canvasx $x] [$win canvasy $y]"
    set it1 [eval $win create rectangle $beginRect $beginRect -tags $tag -width 3]
    set old [bind $win <B1-Motion>]
    set new "eval $win coords $it1 \
	    $beginRect \[$win canvasx %x\] \[$win canvasy %y\]; \
	    "
    if { "$old" == "$new" } {set old ""}
    #mike FIXME: rip this out
    bind $win <B1-Motion> $new
    bind $win <ButtonRelease-1> "bind $win <B1-Motion> [list $old];\
	    bind $win <ButtonRelease-1> {} ; unbindAdjustWidth $win $tag [list $title];"
}

proc unbindAdjustWidth { canv tag title } {
    set win [winfo parent $canv]
    global printOption

    set it [$canv find withtag $tag]
    set co1 [$canv coords $tag]
    set co [$canv coords $it]
    # if { "$co" != "$co1" } {puts differ,$co1,$co}
    desetq "x1 y1 x2 y2" $co
    set center [expr { ($x1+$x2 )/2}]
    set h [expr {$y2 - $y1}]
    set it [$canv find withtag $tag]
    set new [$canv create rectangle $x1 $y1 $x2 $y2 -outline white -width [expr {$h* .04}] -tags [concat $tag bigger] ]

    # puts "<marginTicks $canv $x1 $y1 $x2 $y2 printrectangle>"
    marginTicks $canv [storx$win $x1] [story$win $y2] [storx$win $x2] [story$win $y1] "printrectangle marginticks"
    desetq "a1 b1 a2 b2" [$canv bbox $new]
    set textit [$canv create text $center [expr {$y1 - $h *.03}] \
	    -font [font create -family Courier -size 14 -weight bold] -text "$title" \
	    -anchor s -tags [concat $tag bigger title]]

    set bb [$canv bbox $textit]
    $canv create rectangle $a1 [lindex $bb 1]  $a2 [expr {$y1 - 0.02 * $h}]  -tags $tag -fill white -outline {}
    $canv itemconfig $it -width [expr {$h *.002}]
    $canv raise $it
    $canv raise $textit
    $canv raise marginticks
    if { $printOption(domargin) == 0 } {
	$canv delete marginticks
    }

    $canv create text [expr {($a1 + $a2)/2.0}] [expr {$y2 + .01*$h  }] -anchor nw -tag $tag
    # puts h=$h

}


proc getPSBbox  { } {
    set fi [open /home/wfs/sdfplot.ps r]
    set me [read $fi 500]
    regexp {BoundingBox: (-*[0-9]+) (-*[0-9]+) (-*[0-9]+) (-*[0-9]+)} $me junk x1 y1 x2 y2
    set w [expr {72 * 8.5}]
    set h [expr {72 * 11}]
    # puts "hei=[expr {$y2-$y1}],tm=[expr {$h - $y2}],bm=$y1"
    # puts "wid=[expr {$x2-$x1}],lm=$x1,rm=[expr {$w - $x2}]"
    # puts "hei=[expr {($y2-$y1)/72.0}],tm=[expr {($h - $y2)/72.0}],bm=([expr {$y1/72.0}])"
    #puts "wid=[expr {($x2-$x1)/72.0}],lm=([expr {$x1/72.0}]),rm=[expr {($w - $x2)/72.0}]"
    close $fi
}


## endsource printops.tcl
###### push.tcl ######
############################################################
# Netmath       Copyright (C) 1998 William F. Schelter     #
# For distribution under GNU public License.  See COPYING. #
############################################################



#
#-----------------------------------------------------------------
#
# pushl --  push VALUE onto a stack stored under KEY
#
#  Results:
#
#  Side Effects:
#
#----------------------------------------------------------------
#

global __pushl_ar
proc pushl { val key  } {
    global __pushl_ar
    append __pushl_ar($key) " [list $val]"
}


#
#-----------------------------------------------------------------
#
# peekl --  if a value has been pushl'd under KEY return the
# last value otherwise return DEFAULT.   If M is supplied, get the
# M'th one pushed... M == 1 is the last one pushed.
#  Results:  a previously pushed value or DEFAULT
#
#  Side Effects: none
#
#----------------------------------------------------------------
#
proc peekl {key default {m 1}} {
    global __pushl_ar
    if {![info exists __pushl_ar($key)]} {
	return $default
    } elseif { [catch { set val [set __pushl_ar($key) ] } ] } {
	return $default
    } else {
	set n [llength $val]
	if { $m > 0 && $m <= $n } {
	    return [lindex $val [incr n -$m]]
	} else {
	    return $default
	}
    }
}



#
#-----------------------------------------------------------------
#
# popl --  pop off  last value stored under KEY, or else return DFLT
#
#  Results: last VALUE stored or DEFAULT
#
#  Side Effects: List stored under KEY becomes one shorter
#
#----------------------------------------------------------------
#
proc popl { key  dflt} {
    global __pushl_ar

    if { [catch { set val [set __pushl_ar($key) ] } ] } {
	return $dflt
    } else {
	set n [llength $val]
	set result [lindex $val [incr n -1]]
	
	if { $n > 0 } {
	    set __pushl_ar($key) [lrange $val 0 [expr {$n -1}]]
	} else {
	    unset __pushl_ar($key)
	}
	return $result
    }
}


#
#-----------------------------------------------------------------
#
# clearl --  clear the list stored under KEY
#
#  Result: none
#
#  Side Effects:  clear the list stored under KEY
#
#----------------------------------------------------------------
#
proc clearl { key } {
    global __pushl_ar
    catch { unset __pushl_ar($key) }
}



## endsource push.tcl
############################################################
# Plotconf.tcl                                             #
# Copyright (C) 1998 William F. Schelter                   #
# For distribution under GNU public License.  See COPYING. #
#                                                          #
#     Modified by Jaime E. Villate                         #
############################################################

proc makeFrame { w type background} {
    # If the plot was produced by Xmaxima's console, it will be in a frame
    # inserted in the console. Otherwise it will be a toplevel window
    global doExit fontSize buttonfont
    set win $w
    if { "$w" == "." } {
        set w ""
    } else {
	catch { destroy $w}
	if { [regexp {^\.(plot|versust)} $w] } {
            tk::toplevel $w
        } else {
            ttk::frame $w
        }
    }
    # hide the parent window and destroy it when the canvas is destroyed
    set dismiss "destroy $win"
    catch { set parent [winfo parent $w]
	if { "$parent" == "." } {
	    set dismiss "destroy ."
	}
	if { [regexp {^\.(plot|versust)} [winfo toplevel $win]] } {
            set top [winfo parent $win]
            set dismiss "destroy $top"
            wm withdraw $top
	}
    }
    if { "$doExit" != "" } {set dismiss $doExit } 	
    set dismiss [concat $dismiss "; clearLocal $win "]

    # Win is the name of the window and w its name without a final period
    oset $win type $type
    set c $w.c
    oset $win c $c
    bboxToRadius $win
    set buttonFont $buttonfont
    oset $win buttonFont $buttonfont

    # widgets for the menu buttons and (x, y) coordinates label
    if { $type == {df} } {
        set ltext [mc "Click on the graph\nto trace a curve"]
    } else {
        set ltext [mc "Pointer Coordinates"]
    }
    ttk::label $w.position -text $ltext -background white -font $buttonFont
    set mb [frame $w.menubar]
    pack $mb -fill x
    ttk::button $mb.close -text [mc "Close"] -command $dismiss
    ttk::button $mb.config -text [mc "Config"] -command "doConfig$type $win"
    ttk::button $mb.save -text [mc "Save"] \
        -command "mkPrintDialog .dial -canvas $c -buttonfont $buttonFont "
    pack $mb.close $mb.config $mb.save -side left
    set buttonsLeft 1

    # c is the canvas where the plot will be drawn
    tk::canvas $c -cursor arrow -background $background \
        -width [oget $win width] -height [oget $win height]
    pack $c -side top -expand 1 -fill both
    bind $c <Motion> "showPosition $w %x %y"
    bind $c <Configure> "reConfigure %W %w %h"
    
    $w.position config -background [$c cget -background]
    place $w.position -in $w.c -relx 0.03 -rely 0.99 -anchor sw
    raise $w.position
    focus $w
    addSliders $win
    if { [regexp {^\.(plot|versust)} [winfo toplevel $win]] } {
        pack [ttk::sizegrip $w.szgr] -side bottom -anchor se
        bind $win <Control-w> $dismiss
        wm protocol $w WM_DELETE_WINDOW $dismiss
    }
    return $win
}

proc mkentry { newframe textvar text buttonFont } {
    frame $newframe
    set parent $newframe
    set found 0
    while { !$found } {
	set parent [winfo parent $parent]
	if { "$parent" == "" } { break }
	if { ![catch {  set type [oget $parent type] } ] } {
	    global plot[set type]Options
	    foreach v [set plot[set type]Options] {
		if { "[oloc $parent [lindex $v 0]]" == "$textvar" } {
		    setBalloonhelp $parent $newframe [lindex $v 2]
		    set found 1
		    break}}}}
    label $newframe.lab1
    label $newframe.lab -text "$text:" -font $buttonFont -width 0
    entry $newframe.e -width 20 -textvariable $textvar -font $buttonFont
    pack $newframe.lab1 -side left -expand 1 -fill x
    pack $newframe.lab -side left
    pack $newframe.e -side right -padx 3 -fill x
    # pack $newframe.lab $newframe.e -side left -padx 3 -expand 1 -fill x}

proc pushBind { win key action } {
    pushl [bind $win $key] [list $win $key ]
    bind $win $key $action}

proc popBind { win key  } {
    set binding [popl [list $win $key] {}]
    bind $win $key $binding}

proc showPosition { win x y } {
    # global position c
    makeLocal $win c
    # we catch so that in case have no functions or data..
    catch {
	$win.position config -text \
	    "[format {(%.6g,%.6g)}  [storx$win [$c canvasx $x]] [story$win [$c canvasy $y]]]"}}

proc reConfigure { c width height  } {
    set win [winfo parent $c]
    set w [oget $win width]
    set h [oget $win height]
    set wscale [expr double($width)/$w]
    set hscale [expr double($height)/$h]
    $c scale all 0 0 $wscale $hscale
    oset $win width $width
    oset $win height $height
    set_xy_transforms $win}

proc writePostscript { win } {
    global  printOption argv
    makeLocal $win c transform transform0 xmin ymin xmax ymax
    set rtosx rtosx$win ; set rtosy rtosy$win
    drawPointsForPrint $c
    if { "[$c find withtag printrectangle]" == "" } {
	$c create rectangle [$c canvasx 0] [$c canvasy 0] \
          [$c canvasx [$c cget -width ]] [$c canvasy [$c cget -height ]] \
          -tags printrectangle -outline white}
    set bbox [eval $c bbox [$c find withtag printrectangle]]
    desetq "x1 y1 x2 y2" $bbox
    # set title "unknown plot"
    # catch { set title [eval $printOption(maintitle)] }
    # $c create text [expr {($x1 + $x2)/2}]  [expr {$y1 + .04 * ($y2 - $y1)}] \
    # 	    -anchor center -text $title -tag title
    update
    #set diag [vectorlength [expr {$y1-$x1}] [expr {$y2-$x2}]]
    #  get rid of little arrows that creep onto the outside, ie let
    #  the blank rectangle cover them.
    #set x1 [expr {$x1+.01 * $diag}]
    #set x2 [expr {$x2-.01 * $diag}]
    #set y1 [expr {$y1+.01 * $diag}]
    #set y2 [expr {$y2-.01 * $diag}]
    # Set up font replacement list
    catch {set fontMap([font create -family {BitstreamVeraSansMono} -size 10]) [list Courier 14]}
    catch {set fontMap([font create {helvetica 16 normal}]) [list Helvetica 16]}
    set com "$c postscript  \
      	    -x [expr {($x1 - 35)}] -y [expr {($y1 -25)}] \
	    -width [expr {($x2 - $x1 + 60)}] \
            -height [expr {($y2 - $y1 + 45)}] \
            -fontmap fontMap \
	    [getPageOffsets [expr {($x2 - $x1 + 55)/(1.0*($y2 - $y1 + 45))}] ]"

    #puts com=$com
    set output [eval $com]
    set fi [open $printOption(psfilename) w]
    puts $fi $output
    close $fi}

proc vectorlength {a b} {
    return [expr {sqrt($a*$a+$b*$b)}]}

proc setupCanvas { win } {
    makeLocal $win xcenter xradius ycenter yradius
    oset $win xmin [expr {$xcenter - $xradius}]
    oset $win xmax [expr { $xcenter + $xradius}]
    oset $win ymin [expr { $ycenter - $yradius}]
    oset $win ymax [expr { $ycenter + $yradius} ]}

#
#-----------------------------------------------------------------
#
# compose --  A and B are transformations of the form "origin scalefac"
# and composing them means applying first b then a, as in a.b.x
#  "o s" . x ==> (x-o)*s + o
#  Results: the "origin scalefac" which corresponds to the composition.
#
#----------------------------------------------------------------
#
proc compose { a b } {
    return  "[expr {-[lindex $a 1]*[lindex $b 0]*[lindex $b 1] \
      +[lindex $a 1]*[lindex $b 0]-[lindex $a 0]*[lindex $a 1] \
      +[lindex $a 0]}] [expr {[lindex $a 1]*[lindex $b 1]}]"
}

proc sparseListWithParams { form variables paramlist } {
    set tem [parseConvert $form -doall 1]
    # puts tem=$tem
    set params [splitParams $paramlist]
    if { [catch {set res [substParams [lindex $tem 0] $variables $params] }\
	      err ] } {
	set vars [lindex $tem 1]
	set all $variables
	foreach { v val }  $params { lappend all $v}
	foreach v $vars { if { [lsearch $all [string range $v 1 end]] < 0 } {
	    error [mc "The variable %s appeared in %s but was not in allowed variables: %s or in parameters: %s" "`[string range $v 1 end]'" $form $variables $paramlist] }}
	error [mc "The form %s may involve variables other than %s or the parameters %s, or the latter may have invalid expressions: %s" $form $variables $paramlist $err] }
    return $res
}

proc sparseWithParams { form variables params } {
    set tem [sparseListWithParams $form $variables $params]
    if { [llength $tem ] > 1 } { error [concat [mc "only wanted one function:"] "$form"]}
    lindex $tem 0}

#-----------------------------------------------------------------
#
# myVarSubst --  into FORM substitute where
# listVarsVals where each element of this list may mention
# the previous values eg "k 7 ll sin(k+8)"
# eg:
#myVarSubst [lindex [parseConvert "k*x+l" -doall 1] 0] {x $x k 27+4 l 93+k^3}
# ==> {((31 * $x) + 29884.0)}
#
#  Results: FORM with the substitutions done
#
#----------------------------------------------------------------
proc myVarSubst { form listVarsVals } {
    foreach {_u _v} $listVarsVals {
	if { "\$$_u" == "$_v" } {
	    set $_u $_v
	} else {
	    set _f1 [lindex [parseConvert  $_v -doall 1] 0]
	    set $_u [expr [lindex $_f1 0]]
	    # puts "$_u = [set $_u]"
	}}
    subst -nobackslashes -nocommands $form}

proc splitParams { paramlist } {
    set params ""
    foreach v [split $paramlist ,] {
	set tem [split $v =]
	if { [llength $tem] == 2 } {
	    lappend params [lindex $tem 0] [lindex $tem 1]}}
    return $params}

#-----------------------------------------------------------------
#
# substParams --  substitute into FORM keeping VARIABLES as they are
# and the PARAMLIST (of the form k=23, l=k+7,...) into FORM
#
#  Results: substituted FORM
#
#----------------------------------------------------------------
proc substParams { form variables params } {
    foreach v $variables { lappend params $v \$$v}
    set res [myVarSubst $form $params]
    return $res}

#-----------------------------------------------------------------
#
# set_xy_region --  set up the bounds of the x and y coordinates
# that will appear on the plot and the part of the window that will
# be filled by the plot (fac, a number between 0 and 1).
#
#----------------------------------------------------------------
proc set_xy_region { win fac } {
    makeLocal $win xcenter ycenter xradius yradius c
    set xmin [expr {$xcenter - $xradius}]
    set xmax [expr {$xcenter + $xradius}]
    set ymin [expr {$ycenter - $yradius}]
    set ymax [expr {$ycenter + $yradius}]
    oset $win fac $fac
    oset $win xmin $xmin
    oset $win xmax $xmax
    oset $win ymin $ymin
    oset $win ymax $ymax}

#-----------------------------------------------------------------
#
# set_xy_transforms --  set up transformations for the canvas of WINDOW
# so that the plot is a fraction of the window (fac).
# these transformations are used to convert from real values of x and y
# to screen coordinates in pixels and vice versa.
#
#  Side Effects: transform functions rtosx$win rtosy$win storx$win story$win
#  are defined.
#
# $rtosx,$rtosy --  convert Real coordinate to screen coordinate
# $storx,$story --  Convert a screen coordinate to a Real coordinate.
#
#----------------------------------------------------------------
proc set_xy_transforms { win } {
    makeLocal $win xmin ymin xmax ymax width height fac
    if { [oget $win type] == {3d} } {
        set f1 [expr {(1 - $fac)/2.0}]
        set x1 [expr {$f1 *$width}]
    } else {
        set f1 [expr {(1 - $fac)/3.0}]
        set x1 [expr {2* $f1 *$width}]}
    set y1 [expr {$f1 *$height}]
    set x2 [expr {$x1 + $fac*$width}]
    set y2 [expr {$y1 + $fac*$height}]
    # Do not use the extra vertical space for sliders
    linkLocal $win sliders
    if {[string length $sliders] > 0} {
        set y2 [expr {$y2 - 40*[llength [split $sliders ,]]}]}

    set transform [makeTransform "$xmin $ymin $x1 $y2" "$xmin $ymax $x1 $y1 " \
                       "$xmax $ymin $x2 $y2"]
    oset $win transform $transform
    oset $win transform0 $transform
    getXtransYtrans $transform rtosx$win rtosy$win
    getXtransYtrans [inverseTransform $transform] storx$win story$win}
                        
proc inputParse { in } {
    if { [regexp -indices \
	      {D\[([a-zA-Z][0-9a-zA-Z]*[ ]*),([a-zA-Z][0-9a-zA-Z]*[ ]*)\] *=} \
	      $in all1 i1 i2] } {
	set v1 [getOneMatch $in $i1]
	set v2 [getOneMatch $in $i2]
	set s1 [string range $in [lindex $all1 1] end]

	if { [regexp -indices {,[ \n]*D\[([a-zA-Z][0-9a-zA-Z]*[ ]*),([a-zA-Z][0-9a-zA-Z]*[ ]*)\] *=} \
		  $s1 all2 i1 i2] } {
	    set v3  [getOneMatch $s1 $i1]
	    set v4 [getOneMatch $s1 $i2]
	    set end [string first \} $s1 ]
	    set form2 [string range $s1 [expr {1 + [lindex $all2 1]}] [expr {$end -1}]]
	    if { "$v4" != "$v2" } {error [concat [mc "different variables"] "$v2" [mc "and"] "$v4"]}

	    set form1 [string range $in [expr {1 + [lindex $all1 1]}] [expr {[lindex $all2 0] + -1 + [lindex $all1 1]}]]
	    # puts "v1=$v1,form1=$form1,form2=$form2"
	    return [list  $v2 $v1 $v3 $form1 $form2]}}}

proc composeTransform { t1 t2  } {
    desetq "a11 a12 a21 a22 e1 e2" $t1
    desetq "b11 b12 b21 b22 f1 f2" $t2
    return  [list \
		 [expr {$a11*$b11+$a12*$b21}] \
		 [expr {$a11*$b12+$a12*$b22}] \
		 [expr {$a21*$b11+$a22*$b21}] \
		 [expr {$a22*$b22+$a21*$b12}] \
		 [expr {$a11*$f1+$a12*$f2+$e1}] \
		 [expr {$a21*$f1+$a22*$f2+$e2}]]}

#-----------------------------------------------------------------
#
# makeTransform --  Given three points mapped to three other points
# write down the affine transformation (A.X+B) which performs this.
# the arguments are of the form "x1 y1 u1 v1" "x2 y2 u2 v2" "x3 y3 u3 v3"
# where (x1,y1) --> (u1,v1)  etc.
#  Results: an affine transformation "a b c d e f" which is
#     [ a  b ]  [ x1 ] + [ e ]
#     [ c  d ]  [ y1 ]   [ f ]
#  Side Effects: none
#
#----------------------------------------------------------------
proc makeTransform { P1 P2 P3 } {
    desetq  {X1 Y1 U1 V1} $P1
    desetq  {X2 Y2 U2 V2} $P2
    desetq  {X3 Y3 U3 V3} $P3
    set tem [expr {double((($X2-$X1)*$Y3+($X1-$X3)*$Y2+($X3-$X2)*$Y1))}]
    set A [expr {(($U2-$U1)*$Y3+($U1-$U3)*$Y2+($U3-$U2)*$Y1) \
		     /$tem}]
    set B [expr {-(($U2-$U1)*$X3+($U1-$U3)*$X2+($U3-$U2)*$X1) \
		     /$tem}]
    set E [expr {(($U1*$X2-$U2*$X1)*$Y3+($U3*$X1-$U1*$X3)*$Y2+($U2*$X3-$U3*$X2)*$Y1) \
		     /$tem}]
    set C [expr {(($V2-$V1)*$Y3+($V1-$V3)*$Y2+($V3-$V2)*$Y1) \
		     /$tem}]
    set D [expr {-(($V2-$V1)*$X3+($V1-$V3)*$X2+($V3-$V2)*$X1) \
		     /$tem}]
    set F [expr {(($V1*$X2-$V2*$X1)*$Y3+($V3*$X1-$V1*$X3)*$Y2+($V2*$X3-$V3*$X2)*$Y1) \
		     /$tem}]
    return [list $A $B $C $D $E $F]}

#-----------------------------------------------------------------
#
# getXtransYtrans --   If the x coordinate transforms independently
#  of the y and vice versa, give expressions suitable for building a
# proc.
#
#----------------------------------------------------------------
#
proc getXtransYtrans { transform p1 p2 } {
    desetq "a b c d e f"  $transform
    if { $b == 0  && $c == 0 } {
	proc $p1 { x } "return \[expr {$a*\$x+$e}\]"
	proc $p2 { y } "return \[expr {$d*\$y+$f} \]"
	return 1}
    return 0}

#-----------------------------------------------------------------
#
# inverseTransform --   Find the inverse of an affine transformation.
#
#----------------------------------------------------------------
proc inverseTransform { transform } {
    desetq "a b c d e f" $transform
    set det [expr {double($a*$d - $b*$c)}]
    return [list [expr {$d/$det}] [expr {- $b / $det }] [expr {- $c / $det}] \
                [expr {$a / $det}]  [expr {($b*$f-$d*$e)/ $det }] \
                [expr {-($a*$f-$c*$e)/ $det}]]}

#-----------------------------------------------------------------
#
# getTicks --  given an interval (a,b) subdivide it and
# calculate where to put the ticks and what to print there.
# we want DESIRED number of ticks, but we also want the ticks
# to be at points in the real coords of the form .2*10^i or .5*10^j
#  Results: the ticks
#
#----------------------------------------------------------------
proc getTicks { a b n } {
    set len [expr {(($b - $a))}]
    if { $len < [expr {pow(10,-40)}] } { return ""}
    set best 0
    foreach v { .1 .2 .5 } {
	# want $len/(.1*10^i) == $n
	set val($v)  [expr {ceil(log10($len/(double($n)*$v)))}]
	set use [expr {$v*pow(10,$val($v))}]
	set fac [expr {1/$use}]
	set aa [expr {$a * $fac}]
	set bb [expr {$b * $fac}]
	set j [expr {round(ceil($aa)) }]
	set upto [expr {floor($bb) }]
	if { $upto-$j > 14} {
	    set step 5
	} else {
	    set step 2
	}
	set ticks ""
	while { $j <= $upto } {
	    set tt [expr {$j / $fac}]
	    if { $j%$step == 0 } {
		append ticks " { $tt $tt }"
	    } else  {append ticks " $tt"}
	    incr j}
	set answer($v) $ticks
	set this [llength $ticks]
	if { $this  > $best } {
	    set best $this
	    set at $v}
	#puts "for $v [llength $ticks] ticks"
    }
    #puts "using $at [llength $answer($at)]"
    return $answer($at)}

proc axisTicks { win c }  {
    $c delete axisTicks
    if { ![catch {oget $win noaxisticks}] } { return }
    set swid [$c cget -width]
    set shei [$c cget -height]
    set x1 [storx$win [$c canvasx 0]]
    set y1 [story$win [$c canvasy 0]]
    set x2 [storx$win [$c canvasx $swid]]
    set y2 [story$win [$c canvasy $shei]]
    #puts "x1=$x1,y1=$y1,y2=$y2,x2=$x2"
    if { $y1 > 0  &&  $y2 < 0 } {
	set ticks [getTicks $x1 $x2 [expr {$swid/50}] ]
	#puts "ticks=$ticks"
	set eps [expr {.005 * abs($y1 - $y2)}]
	set neps [expr {-.005 * abs($y1 - $y2)}]
	set donext 0
	foreach v $ticks {
	    set x [lindex $v 0]
	    set text [lindex $v 1]
	    if { $donext } {set text [lindex $v 0] ; set donext 0 }
	    if { [lindex $v 0] == 0 } { set text "" ; set donext 1 }
	    #puts " drawTick $c $x 0 0 $neps 0 $eps  $text axisTicks"
	    drawTick $c $x 0 0 $neps 0 $eps  $text axisTicks}}
    if { 0 < $x2 && 0 > $x1 } {
	set ticks [getTicks $y2 $y1 [expr {$shei/50}]]
	set eps [expr {.005 * ($x2 - $x1)}]
	set neps [expr {-.005 * ($x2 - $x1)}]
	set donext 0
	foreach v $ticks {
	    set y [lindex $v 0]
	    set text [lindex $v 1]
	    if { $donext } {set text [lindex $v 0] ; set donext 0}
	    if { [lindex $v 0] == 0 } { set text "" ; set donext 1}
	    drawTick $c 0 $y $neps 0 $eps 0  $text axisTicks}}}

#-----------------------------------------------------------------
#
# marginTicks --  draw ticks around the border of window
#  x1,y1  top left x2,y2 bottom right.
#
#----------------------------------------------------------------
proc marginTicks { c x1 y1 x2 y2 tag }  {
    global printOption
    set win [winfo parent $c]

    if { ![catch {oget $win noaxisticks}] } { return }
    $c delete marginTicks
    set ticks [getTicks $x1 $x2 $printOption(xticks)]
    # puts "x=$x1 $x2"
    set eps [expr {.008 * ($y1 - $y2)}]
    set neps [expr {-.008 * ($y1 - $y2)}]
    foreach v $ticks {
	set x [lindex $v 0]
	set text [lindex $v 1]
	drawTick $c $x $y1 0 0 0 $eps $text $tag
	drawTick $c $x $y2 0 0 0 $neps {} $tag}
    #puts "y=$y2,$y1"
    set ticks [getTicks $y1 $y2 $printOption(yticks)]
    set eps [expr {.005 * ($x2 - $x1)}]
    set neps [expr {-.005 * ($x2 - $x1)}]
    set donext 0
    foreach v $ticks {
	set y [lindex $v 0]
	set text [lindex $v 1]
	drawTick $c $x1 $y 0 0 $neps 0 $text $tag
	drawTick $c $x2 $y 0 0 $eps 0 {} $tag}}

proc drawTick {c x y dx dy ex ey n tags} {
    global axisGray     fontCourier8
    set win [winfo parent $c]
    set rtosx rtosx$win ; set rtosy rtosy$win
    set it [$c create line [$rtosx [expr {$x +$dx}]] [$rtosy [expr {$y +$dy}]] [$rtosx [expr {$x +$ex}]] [$rtosy [expr {$y +$ey}]] -fill $axisGray -tags $tags]
    $c lower $it
    if { "$n" != "" } {
	if { $ey > 0 } { set anch s
	} elseif { $ex > 0 } {set anch w
	} elseif { $ex < 0 } {set anch e
	} elseif { $ey < 0 } {set anch n}
	$c create text  [$rtosx [expr {$x +1.5*$ex}]] [$rtosy [expr {$y +1.5*$ey}]] \
	    -text [format "%.8g" $n] -font $fontCourier8 -tags $tags \
	    -anchor $anch}}

proc doConfig { win }  {
    makeLocal $win c buttonFont
    $c delete configoptions
    set canv $c
    # set w $c.config
    set w $win.config
    catch {destroy $w}
    frame $w -borderwidth 2 -relief raised

    label $w.msg  -wraplength 600 -justify left -text [mc "Plot Setup"] -font $buttonFont
    pack $w
    pack $w.msg -side top
    set wb1 $w.choose1
    frame $wb1
    set wb2 $w.choose2
    frame $wb2
    pack $wb1 $wb2 -side left -fill x -pady 2m
    set item [$canv create window [$canv canvasx 10] [$canv canvasy  10] -window $w -anchor nw -tags configoptions]
    button $wb1.dismiss -command  "$canv delete $item; destroy $w " -text "ok" -font $buttonFont
#    button $wb1.printoptions -text [mc "Print Options"] -command "mkPrintDialog .dial -canvas $c -buttonfont $buttonFont " -font $buttonFont

    pack $wb1.dismiss -side top
    return "$wb1 $wb2"}
# mkentry { newframe textvar text }

# turn off the horrible show_balloons by default.
global show_balloons
set show_balloons 0

proc balloonhelp { win subwin msg } {
    global show_balloons

    if { $show_balloons == 0 } {return}
    linkLocal  [oget $win c] helpPending
    if { [info exists helpPending] } {after cancel $helpPending}
    set helpPending [after 1000 [list balloonhelp1 $win $subwin $msg]]
}

proc balloonhelp1 { win subwin msg } {
    if { ![winfo exists $win] } { return }
    makeLocal $win c buttonFont
    set x0 [winfo rootx $win]
    set y0 [winfo rooty $win]
    set atx [expr {[winfo rootx $subwin] + [winfo width $subwin] - $x0} ]
    set aty [expr {[winfo rooty $subwin] + [winfo height $subwin] - $y0} ]
    set wid [$c cget -width]
    set wid2 [expr {round ($wid /2.0)}]
    set wid10 [expr {round ($wid /10.0)}]
    if { $aty <=1 } { set aty 30 }
    incr aty 10
    incr atx 10
    set atx [$c canvasx $atx]
    set aty [$c canvasy $aty]
    #puts "$atx $aty"
    $c delete balloon
    $c create text $atx $aty -anchor nw -text $msg -font $buttonFont -width $wid2 -fill white -fill black -tags "balloon btext"
    desetq "x1 y1 x2 y2" [$c bbox btext]
    set x1 [expr {$x1 - .3*($x2-$x1)}]
    set x2 [expr {$x2 + .3*($x2-$x1)}]
    set y1 [expr {$y1 - .3*($y2-$y1)}]
    set y2 [expr {$y2 + .3*($y2-$y1)}]

    eval $c create polygon $x1 $y1  $x2 $y1 $x2 $y2 $x1 $y2  -fill beige -tags balloon -smooth 1
    $c raise btext}

proc setBalloonhelp { win subwin msg } {
    makeLocal $win c
    bind $subwin <Enter> "balloonhelp $win $subwin [list $msg]"
    bind $subwin <Leave> "deleteBalloon $c"
}

proc deleteBalloon { c } {
    linkLocal $c helpPending
    if { [info exists helpPending] } {
	after cancel $helpPending
	unset helpPending}
    $c delete balloon}

#-----------------------------------------------------------------
#
# minMax --  Compute the max and min of the arguments, which may
# be vectors or numbers
#
#----------------------------------------------------------------
# This function only works if the args are all numbers and sorted from
# smaller to larger. Use matrixMinMax instead (villate, 2026-03-30)
proc minMax { args } {
    set max [lindex [lindex $args 0] 0] ; set min $max ;
    foreach vec $args {
	foreach v $vec {
	    if { $v > $max } {set max $v }}}
    return [list $min $max]}

proc matrixMinMax { list } {
    # compute the min max of the list
    set min +10e300
    set max -10e300
    foreach mat $list {
	foreach row $mat {
	    foreach v $row {
		if { $v > $max } {catch  { set max [expr {$v + 0}] }}
		if { $v < $min} {catch  { set min [expr {$v + 0}] }}}}}
    return [list $min $max]}

proc omPlotAny { data args } {
    # puts "data=<[lindex $data 0]>"
    set command [list [lindex [lindex $data 0] 0]  -data [lindex $data 0] ]
    if { "[lindex $command 0]" == "plot2d" } {
	lappend command -xfun {}}
    foreach v $args { lappend command $v }
    eval $command
    #eval [lindex [lindex $data 0] 0] -xfun [list {}] -data [list [lindex $data 0]] $args
}

proc resizeSubPlotWindows { win wid height } {
    set at [$win yview "@0,0"]
    foreach w [winfo children $win] {
	if { [string match plot* [lindex [split $w .] end]] } {
	    resizePlotWindow $w [winfo width $w] $height}}
    if { "$at" != "" } { $win yview $at}}

proc resizePlotWindow  { w width height } {
    if { [winfo width $w.c] <= 1 } {
	after 100 update ;
	return }
    if { ![catch { set tem [oget $w lastResize] } ] && [expr {[clock seconds] - $tem }] < 2 } { return
    } else {
	oset $w lastResize [clock seconds ]
    }
    #puts "resizePlotWindow $w $width $height"
    # return
    set par [winfo parent $w]
    set facx 1.0
    set facy 1.0
    set wid [winfo width $par]
    set hei [winfo height $par]
    if { "[winfo class $par]" == "Text" } {
	set dif 10
	set wid1 $wid ; set hei1 $hei
	#puts "now w=$w"
	#set wid1 [getPercentDim [oget $w widthDesired] width $par]
	catch {set wid1 [getPercentDim [oget $w widthDesired] width $par] }
	catch {set hei1 [getPercentDim [oget $w heightDesired] height $par] }
	set wid [expr {($wid1 > $wid - 30 ? $wid - 30 : $wid1 )}]
	set hei [expr {($hei1 > $hei - 30 ? $hei - 30 : $hei1 )}]
    } else {set dif 10}
    #     if { $width > $wid -20 || $wid > $width -20 }
    if { (abs($width-$wid) > $dif ||  abs($height-$hei) > $dif)
	 &&  [winfo width $w.c] > 1 } {
	set eps [expr {2 * [$w.c cget -insertborderwidth] + [$w.c cget -borderwidth] }]
	set epsx $eps
	set epsy $eps
	set extrawidth [expr {([winfo width $w] - [winfo width  $w.c]) +$epsx}]
	set extraheight [expr {([winfo height $w] - [winfo height  $w.c]) +$epsy}]
	set nwidth [expr {$wid - ($extrawidth > 0  ? $extrawidth : 0)}]
	set nheight [expr {$hei - ($extraheight > 0  ? $extraheight : 0)}]

	#puts "$w.c config -width $nwidth  -height $nheight, extraheight=$extraheight,epsy=$epsy"
	$w.c config -width $nwidth  -height $nheight}}

proc bboxToRadius { win  } {
    makeLocal $win bbox
    if { "$bbox" != "" } {
	linkLocal $win xradius yradius xcenter ycenter
	set i 0
	foreach v { x y z } {
	    set min [lindex $bbox $i]
	    set max [lindex $bbox [expr {$i+2}]]
	    if { "$min" != "" } {
		if { $min >= $max } {error "bad bbox $bbox since $min >= $max"}
		set ${v}radius [expr { ($max - $min) /2.0}]
		set ${v}center [expr { ($max + $min) /2.0}]}}}}

proc updateParameters { win var value} {
    linkLocal $win parameters
    # puts "$win $var $value"
    set ans ""
    set comma ""
    foreach {v val} [splitParams $parameters] {
        if { "$v" == "$var" } {set val $value}
	append ans $comma $v=$val
	set comma ","}
    #    puts "parameters=$ans"
    set parameters $ans}

proc addSliders { win } {
    linkLocal $win sliders c width parameters
    set i 0
    if { "$sliders" == "" } { return }
    catch { destroy $c.sliders }
    set bg "#9ce"
    set trough "#9df"
    frame $c.sliders -relief raised -highlightthickness 2 -highlightbackground $trough
    foreach v [split $sliders ,] {
	if { [regexp {([a-zA-Z0-9]+)[ ]*=?(([---0-9.]+):([---0-9.]+))?} $v  junk var junk x0 x1] } {
	    incr i
	    if { "$x0" == "" } { set x0 -5  ; set x1 5}
	    set fr $c.sliders.fr$i
	    frame $fr -background $bg
	    label $fr.lab -text $var: -background $bg
	    label $fr.labvalue -textvariable [oloc $win slidevalue$i]  -background $bg -relief sunken -justify left
	    scale $fr.scale -command "sliderUpdate $win $var" \
		-from "$x0" -to $x1 -orient horizontal \
		-resolution [expr ($x1 - $x0) < 1 ? ($x1-$x0)/100.0 : .01] \
		-length [expr {$width/2}] -showvalue 0 -variable \
                [oloc $win slidevalue$i] -background $bg -troughcolor "#9ad" \
                -highlightthickness 0
	    pack $fr.lab -side left -expand 1 -fill x
	    pack $fr.labvalue $fr.scale -side left
	    pack  $fr -side top -expand 1 -fill x
	    set found 0
	    set val  [assoc $var [splitParams $parameters] no]
	    if { "$val" == "no" } {
		set val  [expr ($x1 + $x0)/2.0]
		if { "$parameters" != "" }  { append parameters , }
		append parameters $var=$val}
	    $fr.scale set $val}}
    place $c.sliders -in $c -relx 1.0 -x -4 -rely 1.0 -y -4 -anchor se}

proc sliderUpdate { win var val } {
    linkLocal $win sliderCommand parameters
    set params $parameters
    updateParameters $win $var $val
    if {"$params" ne "$parameters" && [info exists sliderCommand] } {
        $sliderCommand $win $var $val}}

## endsource plotconf.tcl
############################################################
# Adams.tcl                                                #
#  Copyright William F. Schelter.  All rights reserved.    #
#                                                          #
#     Modified by Jaime E. Villate                         #
############################################################

proc adamsMoulton {f g t0 x0 y0 h nsteps} {
    set ans [rungeKutta $f $g $t0 $x0 $y0 $h 3]
    catch {
	set i 0
	set h24 [expr {$h/24.0}]
	foreach {t x y } $ans {
	    lappend listXff [xff [expr {$t0+$i*$h}] $x $y]
	    lappend listYff [yff [expr {$t0+$i*$h}] $x $y]
	    incr i
	    set xn $x
	    set yn $y}
	set n [expr $nsteps -3]
	while { [incr n -1] >= 0 } {
	    #puts "listXff = $listXff"
	    #puts "listYff = $listYff"		
	    # adams - bashford formula:
	    set xp [expr {$xn + ($h24)*(55 *[lindex $listXff 3]-59*[lindex $listXff 2]+37*[lindex $listXff 1]-9*[lindex $listXff 0]) }]
	    set yp [expr {$yn + ($h24)*(55 *[lindex $listYff 3]-59*[lindex $listYff 2]+37*[lindex $listYff 1]-9*[lindex $listYff 0]) }]
	    #puts "i=$i,xp=$xp,yp=$yp"
	    # adams-moulton corrector-predictor:
	    # compute the yp = yn+1 value..
	    set t [expr {$t0+$i*$h}]
	    incr i
	    if { 1 } {
		set xap [expr { $xn+($h24)*(9*[xff $t $xp $yp]+19*[lindex $listXff 3]-5*[lindex $listXff 2]+[lindex $listXff 1]) }]
		set yap [expr { $yn+($h24)*(9*[yff $t $xp $yp]+19*[lindex $listYff 3]-5*[lindex $listYff 2]+[lindex $listYff 1]) }]

		set xn $xap
		set yn $yap
		# puts "after correct:i=[expr $i -1],xn=$xn,yn=$yn"	
		# could repeat it, or check against previous to see if changes too much.
	    }
	    set listXff [lrange $listXff 1 end]
	    set listYff [lrange $listYff 1 end]

	    lappend listXff [xff $t $xn $yn]
	    lappend listYff [yff $t $xn $yn]

	    lappend ans $t $xn $yn
	    # puts "ans=$ans"}
	#puts "adams:t=$t"
    }
    return $ans}

## endsource adams.tcl
############################################################
# Rk.tcl                                                #
#  Copyright William F. Schelter.  All rights reserved.    #
#                                                          #
#     Modified by Jaime E. Villate                         #
############################################################

proc rungeKutta { f g t0 x0 y0 h nsteps} {
    set n $nsteps
    set ans "$t0 $x0 $y0"
    set xn $x0
    set yn $y0
    set tn $t0
    set h2 [expr {$h / 2.0 }]
    set h6 [expr {$h / 6.0 }]
    catch {
	while { [incr nsteps -1] >= 0 } {
	    set kn1 [$f $tn $xn $yn]
	    set ln1 [$g $tn $xn $yn]
	    set arg [list [expr {$tn+$h2}] [expr {$xn+$h2*$kn1}] \
                         [expr {$yn+$h2*$ln1}]]
	    set kn2 [eval $f $arg]
	    set ln2 [eval $g $arg]
	    set arg [list [expr {$tn+$h2}] [expr {$xn+$h2*$kn2}] \
                         [expr {$yn+$h2*$ln2}]]
	    set kn3 [eval $f $arg]
	    set ln3 [eval $g $arg]
	    set arg [list [expr {$tn+$h}] [expr {$xn+$h*$kn3}] \
                         [expr {$yn+$h*$ln3}]]
	    set kn4 [eval $f $arg]
	    set ln4 [eval $g $arg]
	    set xn [expr {$xn+$h6*($kn1+2*$kn2+2*$kn3+$kn4)}]
	    set yn [expr {$yn+$h6 * ($ln1+2*$ln2+2*$ln3+$ln4)}]
	    set tn [expr {$tn+ $h}]
	    lappend ans $tn $xn $yn}}
    return $ans}

proc pathLength {list} {
    set sum 0
    foreach {t x y} $list {
	set sum [expr {$sum + sqrt($x*$x+$y*$y)}]
    }
    return $sum}

proc rungeKuttaA {f g t0 x0 y0 h nsteps} {
    set ans [rungeKutta $f $g $t0 $x0 $y0 $h $nsteps]
    set count 0
    # puts "retrying([llength $ans]) .."
    while { [llength $ans] < $nsteps*.5  && $count < 7 } {
	incr count
	#set leng [pathLength $ans]
	#if { $leng == 0 } {set leng .001}
	set th [expr {$h/3.0}]
	if { $th  < $h }  { set h $th }
	set ans  [rungeKutta $f $g $t0 $x0 $y0 $h $nsteps]
	# puts -nonewline "..(h=[format "%.5f" $h],pts=[llength $ans])"
	# flush stdout
    }
    return $ans}

## endsource rk.tcl
############################################################
# Plotdf.tcl                                               #
# Copyright (C) 1998 William F. Schelter                   #
# For distribution under GNU public License.  See COPYING. #
#                                                          #
#     Modified by Jaime E. Villate                         #
############################################################

set ::plotdfOptions {
    {dxdt "x-y^2+sin(x)*.3" {specifies dx/dt = dxdt.  eg -dxdt "x+y+sin(x)^2"} }
    {dydt "x+y" {specifies dy/dt = dydt.  eg -dydt "x-y^2+exp(x)"} }
    {dydx "" { may specify dy/dx = x^2+y,instead of dy/dt = x^2+y and dx/dt=1 }}
    {vectors blue "Color for the vectors"}
    {fieldlines red "Color for the fieldlines"}
    {curves "" "Color for the orthogonal curves"}
    {xradius 10 "Width in x direction of the x values" }
    {yradius 10 "Height in y direction of the y values"}
    {width 700 "Width of canvas in pixels"}
    {height 600 "Height of canvas in pixels" }
    {background white "background color"}
    {scrollregion {} "Area to show if canvas is larger" }
    {xcenter 0.0 {(xcenter,ycenter) is the origin of the window}}
    {ycenter 0.0 "see xcenter"}
    {bbox "" "xmin ymin xmax ymax .. overrides the -xcenter etc"}
    {algorithm "adamsMoulton" "can be rungeKutta, rungeKuttaA or adamsMoulton"}
    {tinitial 0.0 "The initial value of variable t"}
    {nsteps 300 "Number of steps to do in one pass"}
    {xfun "" "A semi colon separated list of functions to plot as well"}
    {tstep "" "t step size"}
    {direction "both" "May be both, forward or backward" }
    {versus_t 0 "Plot in a separate window x and y versus t, after each trajectory" }
    {windowname ".plotdf" "window name"}
    {windowtitle "Plotdf" "window title"}
    {parameters "" "List of parameters and values eg k=3,l=7+k"}
    {linecolors { green black  brown gray black} "colors for functions plots"}
    {sliders "" "List of parameters ranges k=3:5,u"}
    {trajectory_at "" "Place to calculate trajectory"}
    {linewidth "1.5" "Width of integral lines" }
    {nolines 0 "If not 0, plot points and nolines"}
    {plotpoints 0 "if not 0 plot the points at pointsize" }
    {pointsize 2 "radius in pixels of points" }
    {autoscale "x y" "Set {x,y}center and {x,y}range depending on data and function. "}
    {errorbar 0 "If not 0 width in pixels of errorbar.  Two y values supplied for each x: {y1low y1high y2low y2high  .. }"}
    {data "" "List of data sets to be plotted.  Has form { {xversusy {x1 x2 ... xn} {y1 .. yn ... ym}} .. {againstIndex {y1 y2 .. yn}}  .. }"}
    {labelposition "10 15" "Position for the curve labels nw corner"}
    {xaxislabel "" "Label for the x axis"}
    {yaxislabel "" "Label for the y axis"}
    {psfile "" "A filename where the graph will be saved in PostScript."}
    {nobox 0 "if not zero, do not draw the box around the plot."}
    {axes "xy" "if zero, no axes are drawn. x, y or xy to draw the axes."}
    {narrows "15" "Minimum number of arrows to draw in x and y directions"}
    {nolegend 0 "if not zero, do not write down the legend."}
    {bargraph 0 "If not 0 this is the width of the bars on a bar graph" }
}

proc makeFrameDf { win } {
    set w [makeFrame $win df [oget $win background]]
    if { $w eq "." } { set w "" }
    makeLocal $win c dydx buttonFont type

    set top $win
    catch { set top [winfo parent $win]}
    catch {
	wm title $top {Xmaxima: plotdf}
	wm iconname $top "plotdf"
    }
    set mb $w.menubar
    ttk::button $mb.versust -text [mc "Time Plot"] -command "plotVersusT $win"
    ttk::button $mb.replot -text [mc "Replot"] -command "replot$type $win"
    pack $mb.replot $mb.versust -side left
    setForIntegrate $w
    return $win
}

proc swapChoose {win msg winchoose } {
    # global dydx dxdt dydt
    if { "$msg" == "dydt" } {
	pack $winchoose.dxdt -before $winchoose.dydt -side bottom
	oset $win dydx ""
	$winchoose.dydt.lab config -text "dy/dt:"
    } else {
	pack forget $winchoose.dxdt
	oset $win dxdt 1
	oset $win dydx " "
	$winchoose.dydt.lab config -text "dy/dx:"}}

proc setForIntegrate { win} {
    makeLocal $win c
#    $c delete printrectangle
    bind $c  <1> "doIntegrateScreen $win %x %y "
}

# sample procedures
# proc xff { t x y } { return [expr {$x + $y }] }
# proc yff { t x y } { return [expr {$x - $y }] }

proc doIntegrateScreen { win sx sy  } {
    makeLocal $win c
    doIntegrate $win [storx$win [$c canvasx $sx]] [story$win [$c canvasy $sy]]
}

proc doIntegrate { win x0 y0 } {
    makeLocal $win xradius yradius c dxdt dydt algorithm tinitial tstep nsteps \
        direction linewidth tinitial versus_t xmin xmax ymin ymax parameters \
        width height
    linkLocal $win didLast trajectoryStarts
    set linewidth [expr {$linewidth*[vectorlength $width $height]/1000.}]
    set arrowshape [scalarTimesVector $linewidth {3 5 2}]

    oset $win trajectory_at [format "%.10g  %.10g" $x0 $y0]
    lappend trajectoryStarts [list $x0 $y0]
    set didLast {}
    # puts "doing at $trajectory_at"
    set steps $nsteps
    set integrator $algorithm

    set todo {1}
    switch -- $direction {
	forward { set todo {1}}
	backward { set todo {-1}}
	both { set todo {-1 1}}}
    set tasks {}
    foreach task {fieldlines curves} {
        set color [oget $win $task]
        if {($color ne {}) && ($color ne {blank})} {
            lappend tasks $task
            lappend useColors $task $color}}
    set taskNo -1
    foreach task $tasks {
        incr taskNo
        set linecolor [assoc $task $useColors]
        set signs $todo
        set coords {}
        if {$task eq {curves}} {
            setCurvesFunctions $dxdt $dydt $parameters
            set signs {-1 1}
        } else {
             setFieldFunctions $dxdt $dydt $parameters}                 
        foreach sgn $signs {
            set arrow {none}
            if {$task eq {fieldlines}} {
                if { $sgn < 0 } {
                    set arrow {first}
                    set coords {}
                } else {
                    if {$direction eq {forward}} {
                        set arrow {last}
                        set coords {}}}}
            set h [expr {$sgn*$tstep}]
            set form [list $integrator xff yff $tinitial $x0 $y0 $h $nsteps]

            # puts "doing: $form"
            # pts will be a list with values of t, x and y, at the initial
            # point and at each of the steps
            set pts [eval $form]
            lappend didLast $form
            set first 1
            # puts "clipping box: ($x1,$y1), ($x2,$y2)"
            foreach {t xr yr} $pts {
                if {$first} {
                        set p1 [list $xr $yr]
                        set c1 [PointCode $p1 $xmin $ymin $xmax $ymax]
                        # puts "point $p1 with code $c1"
                        if {!$c1} {
                            set coords [list [rtosx$win $xr] [rtosy$win $yr]]
                        } else {set coords {}}
                        set first 0
                    } else {
                        set p2 [list $xr $yr]
                        set c2 [PointCode $p2 $xmin $ymin $xmax $ymax]
                        # puts "point $p2 with code $c2"
                        if {$c1|$c2} {
                            set clip \
                                [ClipLine $p1 $p2 $c1 $c2 $xmin $ymin $xmax $ymax]
                            if {[llength $clip]} {
                                foreach p $clip {
                                    lappend coords [rtosx$win [lindex $p 0]]
                                    lappend coords [rtosy$win [lindex $p 1]]}}
                            if {$c2 && ([llength $coords] >= 4)} {
                                $c create line $coords -tags path -width \
                                    $linewidth -fill $linecolor -arrow $arrow \
                                    -arrowshape $arrowshape
                                set coords {}}
                        } else {
                            lappend coords [rtosx$win [lindex $p2 0]]
                            lappend coords [rtosy$win [lindex $p2 1]]}
                        set p1 $p2
                        set c1 $c2}}
            if {[llength $coords] >= 4} {
                $c create line $coords -tags path -width $linewidth \
                    -fill $linecolor -arrow $arrow -arrowshape $arrowshape}}}
    if { $versus_t } { plotVersusT $win}
}

proc plotVersusT { win } {
    linkLocal $win didLast dydt dxdt parameters xcenter xradius ycenter yradius
    if { $didLast == {} } { return }
    set w [winfo parent $win]
    if {$w eq {.}} { set w {}}
    set xwin .versust.plotx
    set ywin .versust.ploty
    set xdata {}
    set ydata {}

    foreach v $didLast {
	set ans [eval $v]
	desetq "tinitial x0 y0 h steps" [lrange $v 3 end]
	set this [lrange $v 0 4]
	if { [info exists doing($this) ] } { set tem $doing($this) } else {
	    set tem ""
	}
	set doing($this) ""
	set allx ""; set ally ""; set allt ""
	foreach {t x y } $ans {
            if {($x>=$xcenter-1.1*$xradius) && ($x<=$xcenter+1.1*$xradius)
                && ($y>=$ycenter-1.1*$yradius) && ($y<=$ycenter+1.1*$yradius)} {
                lappend allx $x
                lappend ally $y
                lappend allt $t}}
	foreach u $tem v [list $allx $ally $allt] {
	    if { $h > 0 } { lappend doing($this) [concat $u $v]} else {
		lappend doing($this) [concat [lreverse $v] $u]}}}

    foreach {na val } [array get doing] {
	lappend xdata [list xaxislabel "t"]
	lappend xdata [list yaxislabel [oget $win xaxislabel]]
        lappend xdata [list plotpoints 0] [list nolegend 1]
	lappend xdata [list xversusy [lindex $val 2] [lindex $val 0] ]
	lappend ydata [list xaxislabel "t"]
	lappend ydata [list yaxislabel [oget $win yaxislabel]]
        lappend ydata [list plotpoints 0] [list nolegend 1]
	lappend ydata [list xversusy [lindex $val 2] [lindex $val 1] ]}
    if { ![winfo exists .versust] } {toplevel .versust}
    # puts "plotdata: $plotdata"
    plot2d -data $xdata -windowname $xwin -ycenter $xcenter -yradius $xradius
    wm title $xwin [concat [oget $win xaxislabel] [mc " versus t"]]
    plot2d -data $ydata -windowname $ywin -ycenter $ycenter -yradius $yradius
    wm title $ywin [concat [oget $win yaxislabel] [mc " versus t"]]
}

proc lreverse { lis } {
    set ans ""
    set i [llength $lis]
    while { [incr i -1]>=0 } {
	lappend ans [lindex $lis $i]
    }
    return $ans
}

proc drawArrowScreen { c atx aty dfx dfy color } {
    set win [winfo parent $c]
    makeLocal $win width height
    set linewidth [expr {[vectorlength $width $height]/1000.}]
    set arrowshape [scalarTimesVector $linewidth {3 5 2}]
    set x1 [expr {$atx + $dfx}]
    set y1 [expr {$aty + $dfy}]
    $c create line $atx $aty $x1 $y1 -tags arrow -fill $color -arrow last \
        -arrowshape $arrowshape -width $linewidth }

proc drawDF { win tinitial } {
    global axisGray
    makeLocal  $win xmin xmax xcenter ycenter c ymin ymax transform vectors \
        xaxislabel yaxislabel nobox axes width height narrows
    set rtosx rtosx$win
    set rtosy rtosy$win
    set storx storx$win
    set story story$win
    set stepsize [expr {$width/($narrows+2.0)}]
    set stepy [expr {$height/($narrows+2.0)}]
    if { $stepy < $stepsize } {set stepsize $stepy}
    set margin [expr {0.7*$stepsize}]
    set min 1.0E42
    set max 0.0
    set t0 $tinitial
    set xfactor [lindex $transform 0]
    set yfactor [lindex $transform 3]
    set uptox [expr {[$rtosx $xmax] - $margin}]
    set uptoy [expr {[$rtosy $ymin] - $margin}]
    # draw the axes:
    #puts "draw [$rtosx $xmin] to $uptox"
    if {($vectors ne "") && ($vectors ne "blank") } {
	for {set x [expr {[$rtosx $xmin] + $margin}]} {$x < $uptox} \
            {set x [expr {$x + $stepsize}]} {
                for {set y [expr {[$rtosy $ymax] + $margin}]} {$y < $uptoy} \
                    {set y [expr {$y + $stepsize}]} {
		set args "$t0 [$storx $x] [$story $y]"
		set dfx [expr {$xfactor * [eval xff $args]}]
		# screen y is negative of other y
		set dfy [expr  {$yfactor * [eval yff $args]}]
		# puts "$dfx $dfy"
		set len [vectorlength $dfx $dfy]
		append all " $len $dfx $dfy "
		if { $min > $len } {set min $len}
                        if { $max < $len } {set max $len}}}
	set arrowmin [expr {0.25*$stepsize}]
	set arrowrange [expr {0.85*$stepsize - $arrowmin}]
	set s1 [expr {($arrowrange*$min+$arrowmin*$min-$arrowmin*$max)/($min-$max)}]
	set s2 [expr {$arrowrange/($max-$min)}]
	# we calculate fac for each length, so that
	# when we multiply the vector times fac, its length
	# will fall somewhere in [arrowmin,arrowmin+arrowrange].
	# Vectors of length min and max resp. should get mapped
	# to the two end points.
	# To do this we set fac [expr {$s1/$len + $s2}]
        set i -1
	for {set x [expr {[$rtosx $xmin] + $margin}]} {$x < $uptox} \
            {set x [expr {$x + $stepsize}]} {
                for {set y [expr {[$rtosy $ymax] + $margin}]} {$y < $uptoy} \
                    {set y [expr {$y + $stepsize}]} {
                set len [lindex $all [incr i]]
		set dfx [lindex $all [incr i]]
		set dfy [lindex $all [incr i]]
		#puts "[$storx $x] [$story $y] x=$x y=$y dfx=$dfx dfy=$dfy
		# puts "$len $dfx $dfy"
                if {$len != 0.0} {
                    set fac [expr {$s1/$len + $s2}]
                    drawArrowScreen $c $x $y [expr {$fac * $dfx}] \
                        [expr {$fac * $dfy} ] $vectors}}}}
    set x1 [rtosx$win $xmin]
    set y1 [rtosy$win $ymax]
    set x2 [rtosx$win $xmax]
    set y2 [rtosy$win $ymin]
    
    # Draw the two axes
    $c del axes
    if { $xmin*$xmax < 0 && ($axes == {y} || $axes == {xy}) } {
	if { $nobox == 0 } {
	    $c create line [$rtosx 0] $y1 [$rtosx 0] $y2 -fill $axisGray \
		-tags axes
	} else {
	    $c create line [$rtosx 0] $y1 [$rtosx 0] $y2 -width 2 \
		-arrow "first" -tags axes}}
    if { $ymin*$ymax < 0  && ($axes == {x} || $axes == {xy}) } {
	if { $nobox == 0 } {
	    $c create line $x1 [$rtosy 0] $x2 [$rtosy 0] -fill $axisGray \
		-tags axes
	} else {
	    $c create line $x1 [$rtosy 0] $x2 [$rtosy 0] -width 2 \
		-arrow "last" -tags axes}}
    # Draw the plot box
    if { "[$c find withtag printrectangle]" == "" && $nobox == 0 } {
	$c create rectangle $x1 $y1 $x2 $y2 -tags printrectangle -width 2
	marginTicks $c [storx$win $x1] [story$win $y2] [storx$win $x2] \
	    [story$win $y1] "printrectangle marginticks"}
    # Write down the axes labels
    $c del axislabel
    set width [oget $win width]
    set height [oget $win height]
    if {$nobox != 0  && $xmin*$xmax < 0  && ($axes == {y} || $axes == {xy})} {
	set xbound [expr { [$rtosx 0] - 0.08*$width}]
    } else {
	set xbound [expr {$x1-0.08*$width}]
    }
    $c create text $xbound [expr {($y1+$y2)/2.0}] -anchor center -angle 90 \
       -text [oget $win yaxislabel] -font {TkDefaultFont 16 normal} -tags axislabel
    if {$nobox != 0  && $ymin*$ymax < 0  && ($axes == {x} || $axes == {xy})} {
	$c create text [expr {$x2-0.01*$width}] \
            [expr { [$rtosy 0]+0.02*$height}] -anchor ne -tags axislabel \
            -text [oget $win xaxislabel] -font {TkDefaultFont 16 normal}
    } else {
	$c create text [expr {($x1 + $x2)/2}] [expr {$y2 + 0.08*$height}] \
	    -anchor center -text [oget $win xaxislabel] \
	    -font {TkDefaultFont 16 normal} -tags axislabel
    }
}

proc parseOdeArg {  s } {
    set orig $s
    set w "\[ ]*"
    set exp "\[dD]$w\\($w\(\[xyz])$w,$w\(\[xyt])$w\\)$w=(\[^;]+)"
    while { [regexp -- $exp $s junk x t expr ] } {
	lappend ans  -d${x}d$t
	lappend ans $expr
	regexp -indices $exp $s junk x t expr
	set s [string range $s [lindex $junk 1] end]
    }
    if { ![info exists ans] || ([llength $ans] == 2 && "[lindex $ans 0]" != "-dydx") } {
	error [mc "bad -ode argument:\n$orig\nShould be d(y,x)=f(x,y)
       OR d(x,t)=f(x,y) d(y,t)=g(x,y)"]
    }
    return $ans
}

proc plotdf { args } {
    global printOption printOptions
    # puts "args=$args"
    # to see options add: -debug 1
    set win [assoc -windowname $args]
    if { "$win" == "" } {set win [getOptionDefault windowname $::plotdfOptions] }
    if { "[set ode [assoc "-ode" $args]]" != "" }  {
	set args [delassoc -ode $args]
	set args [concat [parseOdeArg $ode] $args]
    }
    global [oarray $win]
    getOptions $::plotdfOptions $args -usearray [oarray $win]
    oset $win didLast {}
    # Makes extra vertical space for sliders
    linkLocal $win sliders height tstep xradius yradius
    # Default value for tstep equal to the plot box's diagonal divided by 400
    if { "$tstep" == "" } {
	set tstep [expr {[vectorlength $xradius $yradius] / 200.0}]
    }
    if {[string length $sliders] > 0} {
        oset $win height [expr {$height + 40*[llength [split $sliders ,]]}]}

    makeLocal $win dydx

    if { "$dydx" !="" } { oset $win dxdt 1 ; oset $win dydt $dydx }
    setPrintOptions $args
    foreach v {trajectoryStarts recompute} {
	catch { unset [oloc $win $v]  }
    }

    makeFrameDf $win
    oset $win sliderCommand sliderCommandDf
    oset $win trajectoryStarts ""

    oset $win maintitle [concat "makeLocal $win  dxdt dydt dydx ;"  \
			     {if { "$dydx" == "" } { concat "dx/dt = $dxdt , dy/dt = $dydt"}  else {
				 concat "dy/dx = $dydt" } } ]
    replotdf $win
}

proc replotdf { win } {
    global printOption 
    linkLocal $win xfundata data psfile
    if { ![info exists data] } {set data ""}
    makeLocal $win c dxdt dydt tinitial nsteps xfun trajectory_at parameters
    set_xy_region $win 0.8
    set_xy_transforms $win
    setFieldFunctions $dxdt $dydt $parameters
    $c delete all
    setForIntegrate $win
    oset $win curveNumber -1
    drawDF $win $tinitial
    if { $trajectory_at ne "" } {eval doIntegrate $win  $trajectory_at}
    set xfundata ""
    foreach v [sparseListWithParams $xfun {x y t} $parameters ] {
	proc _xf {  x  } "return \[expr { $v } \]"
	lappend xfundata [list nolegend 1] \
	    [linsert [calculatePlot $win _xf $nsteps] 0 xversusy] }
    redraw2dData $win -tags path

    # Create a PostScript file, if requested
    if { $psfile ne "" } {
	set printOption(psfilename) $psfile
	writePostscript $win
	$c delete printoptions
	eval [$win.menubar.close cget -command] }}

proc setFieldFunctions { dxdt dydt parameters } {
    proc xff {t x y} "expr {[sparseWithParams $dxdt {x y} $parameters]}"
    proc yff {t x y} "expr {[sparseWithParams $dydt {x y} $parameters] } "
}
proc setCurvesFunctions { dxdt dydt parameters } {
    proc xff {t x y} "expr {[sparseWithParams $dydt {x y} $parameters]}"
    proc yff {t x y} "expr {[sparseWithParams -($dxdt) {x y} $parameters]}"
}

proc doConfigdf { win } {
    desetq "wb1 wb2" [doConfig $win]
    makeLocal $win buttonFont
    frame $wb1.choose1
    set frdydx $wb1.choose1
    button $frdydx.dydxbut -command "swapChoose $win dydx $frdydx " \
	-text "dy/dx" -font $buttonFont
    button $frdydx.dydtbut -command "swapChoose $win dydt $frdydx" \
	-text "dy/dt,dx/dt" -font $buttonFont
    mkentry $frdydx.dxdt [oloc $win dxdt] "dx/dt" $buttonFont
    mkentry $frdydx.dydt [oloc $win dydt] "dy/dt" $buttonFont
    pack $frdydx.dxdt  $frdydx.dydt -side bottom  -fill x -expand 1
    pack $frdydx.dydxbut $frdydx.dydtbut -side left -fill x -expand 1

    foreach w {narrows parameters xfun linewidth xradius yradius xcenter \
        ycenter tinitial versus_t tstep nsteps direction curves vectors \
        fieldlines} {
	mkentry $wb1.$w [oloc $win $w] $w $buttonFont
	pack $wb1.$w -side bottom -expand 1 -fill x
    }
    radiobutton $wb1.rk -text "4th order Runge Kutta" \
        -variable [oloc $win algorithm] -value rungeKutta -anchor w
    radiobutton $wb1.rka -text "Adaptive-step Runge Kutta" \
        -variable [oloc $win algorithm] -value rungeKuttaA -anchor w
    radiobutton $wb1.am -text "Adams-Moulton" \
        -variable [oloc $win algorithm] -value adamsMoulton -anchor w
    pack $wb1.rk -side bottom -expand 1 -fill x
    pack $wb1.rka -side bottom -expand 1 -fill x
    pack $wb1.am -side bottom -expand 1 -fill x
    mkentry $wb1.trajectory_at [oloc $win trajectory_at] \
	"Trajectory at" $buttonFont
    bind $wb1.trajectory_at.e <KeyPress-Return> \
	"eval doIntegrate $win \[oget $win trajectory_at\] "
    pack  $wb1.trajectory_at   $frdydx    -side bottom -expand 1 -fill x
    if { "[oget $win dydx]" != "" } { swapChoose $win dydx $frdydx }
    setForIntegrate $win
}

proc sliderCommandDf { win var val } {
    linkLocal $win recompute
    updateParameters $win $var $val
    set com "recomputeDF $win"
    # allow for fast move of slider...
    #mike FIXME: this is a wrong use of after cancel
    after cancel $com
    after 50 $com
}

proc recomputeDF { win } {
    linkLocal $win  recompute
    if { [info exists recompute]  } {
	incr recompute
	return
    } else {
	#	puts "set recompute 1"
	set recompute 1
    }
    linkLocal $win trajectoryStarts c tinitial dxdt dydt parameters
    set redo 0
    set trajs ""

    catch {set trajs $trajectoryStarts}

    while { $redo != $recompute } {
	#	puts "	setFieldFunctions $dxdt $dydt $parameters"
	setFieldFunctions $dxdt $dydt $parameters
	#	$c delete path point arrow
	$c delete all
	catch { unset  trajectoryStarts }
	set redo $recompute
	foreach pt $trajs {
	    desetq "x0 y0" $pt
	    catch { doIntegrate $win $x0 $y0 }
	    update
	    if { $redo != $recompute } { break }
	}
	if  { $redo == $recompute } {
	    catch { drawDF $win $tinitial }
	}
    }
    #    puts "    unset recompute"
    unset recompute
}


## endsource plotdf.tcl
###### Plot2d.tcl ####################################################
#
# Copyright (C) 1998 William F. Schelter 
# For distribution under GNU public License.  See COPYING.tcl
#
#     Modified by Jaime E. Villate
######################################################################

set ::plot2dOptions {
    {xradius 10 "Width in x direction of the x values" }
    {yradius 10 "Height in y direction of the y values"}
    {width 700 "Width of canvas in pixels"}
    {height 600 "Height of canvas in pixels" }
    {xcenter 0.0 {(xcenter,ycenter) is the origin of the window}}
    {xfun "" {function of x to plot eg: sin(x) or "sin(x);x^2+3" }}
    {parameters "" "List of parameters and values eg k=3,l=7+k"}
    {sliders "" "List of parameters ranges k=3:5,u"}
    {nsteps "100" "minimum number of steps in x direction"}
    {ycenter 0.0 "see xcenter"}
    {bbox "" "xmin ymin xmax ymax .. overrides the -xcenter etc"}
    {windowname ".plot2d" "window name"}
    {nolines 0 "If not 0, plot points and nolines"}
    {bargraph 0 "If not 0 this is the width of the bars on a bar graph" }
    {linewidth "1.5" "Width of plot lines" }
    {background white "background color"}
    {plotpoints 0 "if not 0 plot the points at pointsize" }
    {pointsize 2 "radius in pixels of points" }
    {linecolors {blue green red brown gray black} "colors to use for lines in data plots"}
    {labelposition "10 15" "Position for the curve labels nw corner"}
    {xaxislabel "" "Label for the x axis"}
    {yaxislabel "" "Label for the y axis"}
    {autoscale "y" "Set {x,y}center and {x,y}range depending on data and function. Value of y means autoscale in y direction, value of {x y} means scale in both.  Supplying data will automatically turn this on."}
    {errorbar 0 "If not 0 width in pixels of errorbar.  Two y values supplied for each x: {y1low y1high y2low y2high  .. }"}
    {data "" "List of data sets to be plotted.  Has form { {xversusy {x1 x2 ... xn} {y1 .. yn ... ym}} .. {againstIndex {y1 y2 .. yn}}  .. }"}
    {psfile "" "A filename where the graph will be saved in PostScript."}
    {nobox 0 "if not zero, do not draw the box around the plot."}
    {axes "xy" "if zero, no axes are drawn. x, y or xy to draw the axes."}
    {nolegend 0 "if not zero, do not write down the legend."}
}

proc argSuppliedp { x } {
    upvar 1 args a
    return [expr [set i [lsearch $a $x]] >= 0 && $i%2 == 0]
}

proc mkPlot2d { args } {
    global printOption axisGray
    set win [assoc -windowname $args]
    if { "$win" == "" } {
	set win [getOptionDefault windowname $::plot2dOptions]
    }
    global  [oarray $win]
    set data [assoc -data $args ]
    
    getOptions $::plot2dOptions $args -usearray [oarray $win]
    # Makes extra vertical space for sliders
    linkLocal $win sliders height
    if {[string length $sliders] > 0} {
        oset $win height [expr {$height + 40*[llength [split $sliders ,]]}]}

    linkLocal $win autoscale
    if { [argSuppliedp -data] && ![argSuppliedp -autoscale] && \
	     ![argSuppliedp -xradius] } {
	lappend autoscale x
    }
    if { ![argSuppliedp -autoscale] & [argSuppliedp -yradius] } {
	set autoscale [ldelete y $autoscale]
    }	

    oset $win curveNumber -1
    setPrintOptions $args
    oset $win maintitle ""	
    setupCanvas $win
    catch { destroy $windowname }

    makeFrame2d $win
    oset $win sliderCommand sliderCommandPlot2d
    makeLocal $win c
    return $win

}

proc makeFrame2d  { win } {
    set w [makeFrame $win 2d [oget $win background]]
    set top $w
    catch { set top [winfo parent $w]}
    catch {
	wm title $top {Xmaxima: plot2d}
	wm iconname $top "plot2d"
    }
    return $w
}

proc doConfig2d { win } {
    desetq "wb1 wb2" [doConfig $win]
    makeLocal $win buttonFont
    mkentry $wb1.nsteps [oloc $win nsteps]  [mc "Number of mesh grids"]  $buttonFont
    mkentry $wb1.xfun [oloc $win xfun]  "y=f(x)"  $buttonFont
    bind $wb1.xfun.e <Return> "replot2d $win"

    pack $wb1.xfun  $wb1.nsteps -expand 1 -fill x
    foreach w {xradius yradius xcenter ycenter linecolors autoscale linewidth parameters} {
	mkentry $wb1.$w [oloc $win $w] $w $buttonFont
	pack $wb1.$w -side bottom -expand 1 -fill x
    }
}

global plot
set   plot(numberPlots) 4

proc mkExtraInfo { name args } {
    # global plot 	
    catch { destroy $name }

    toplevel $name
    wm geometry $name -10+10
    # pack $name
    set canv [assoc -canvas $args ]
    set i 0
    set w $name
    frame $w.grid
    pack $w.grid -expand yes -fill both -padx 1 -pady 1
    grid $w.grid
    grid rowconfig    $w.grid 0 -weight 1 -minsize 0
    grid columnconfig $w.grid 0 -weight 2 -minsize 0

    set i 0
    label $w.title -text [mc "Extra Plotting Information"] -width 50
    grid $w.title -in $w.grid -columnspan 2 -row 0 -column 0
    incr i
    label $w.labppl -text [mc "Plot Function f(x)"]
    label $w.labcol -text [mc "plot color"]
    grid $w.labppl -padx 1 -in $w.grid  -pady 1 -row $i -column 0 -sticky news
    grid $w.labcol -padx 1 -in $w.grid  -pady 1 -row $i -column 1 -sticky news
    incr i
    set k 1
    proc mkPlotEntry { w k i } {
	entry $w.plot$k -textvariable plot(fun$k)
	entry $w.color$k -textvariable plot(col$k)
	grid $w.plot$k -padx 10 -in $w.grid  -pady 1 -row $i -column 0 -sticky news
	grid $w.color$k -padx 4 -in $w.grid  -pady 1 -row $i -column 1 -sticky news
    }
    while { $k <= $plot(numberPlots) } { mkPlotEntry $w $i $k ; incr i ; incr k}
}

proc calculatePlot { win fun  nsteps } {
    #  global xmin xmax  ymax ymin
    makeLocal $win xmin xmax  ymax ymin
    set h0 [expr {($xmax - $xmin)/double($nsteps )}]
    set x0 $xmin
    set res ""
    set limit [expr {100 * (abs($ymax)> abs($ymin) ? abs($ymax) : abs($ymin))}]
    while { $x0 < $xmax } {
	set lastx0 $x0
	#puts xmax=$xmax
	append res " " [calculatePlot1 $win $x0 $h0 $fun $limit]
	#puts res:[lrange $res [expr [llength $res] -10] end]
	if { $x0 <= $lastx0 }	{
	    # puts "x0=$x0,($lastx0)"
	    set x0 [expr {$x0 + $h0/4}]
	    #error "how is this?"
	}
    }
    # puts "plength=[llength $res]"
    return $res
}


#
#-----------------------------------------------------------------
#
# calculatePlot1 --   must advance x0 in its caller
#
#  Results: one connected line segment as "x0 y0 x1 y1 x2 y2 .."
#
#  Side Effects: must advance x0 in its caller
#
#----------------------------------------------------------------
#
proc  calculatePlot1 { win x0 h0 fun  limit } {
    #puts "calc:$win $x0 $h0 $limit $fun"
    makeLocal $win xmax
    set ansx ""
    set ansy ""
    while { [catch { set y0 [$fun $x0] } ] && $x0 <= $xmax }  {
	set x0 [expr {$x0 + $h0}]
    }
    if { $x0 > $xmax } {
	# puts "catching {$fun $x0}"
	uplevel 1 set x0 $x0
	return ""
    }
    set ans "$x0 $y0"
    set delta 0
    set littleLimit [expr {$limit/50.0 }]
    set veryLittleLimit [expr {$littleLimit * 10}]
    # now have one point..
    # this is really set below for subsequent iterations.
    set count 10
    set heps [expr {$h0/pow(2,6)}]
    set h2 [expr {$h0 *2 }]
    set ii 0
    set x1 [expr {$x0 + $h0}]
    while { $x1 <= $xmax  && $ii < 5000 } {
	# puts $x1
	incr ii
	if { [catch { set y1 [$fun $x1] } ] } {
	    #puts "catching1 {$fun $x1}"
	    if { $count > 0 } {
		# try a shorter step.
		set x1 [expr {($x1 -$x0)/2 + $x0}]
		incr count -1
		continue
	    } else {
		uplevel 1 set x0 [expr {$x0 + $heps}]
		return [list $ansx $ansy]
	    }
	}
	# ok have x1,y1
	# do this on change in slope!! not change in limit..

	set nslope [expr {($y1-$y0)/($x1-$x0)}]
	catch { set delta [expr {($slope * $nslope < 0 ? abs($slope-$nslope) : .1*abs($slope-$nslope))}]}
	# catch { set delta [expr {abs($slope - ($y1-$y0)/($x1-$x0))}] }
	
	if { $count > 0 && (abs($y1 - $y0) > $h2 || $delta > $h2)  && (0 || abs($y1) < $littleLimit)
	 } {
	    #puts "too  big $y1 [expr {abs($y1-$y0)}] at $x1"
	    set x1 [expr {($x1 -$x0)/2 + $x0}]
	    incr count -1
	    continue
	} elseif { abs($y1) > $limit || abs($y1-$y0) > $limit
		   || $delta > $littleLimit } {
	    incr ii
	    if { $count == 0 } {
		uplevel 1 set x0 [expr {$x0 + $heps}]
		return [list $ansx $ansy]
	    } else {
		
		set x1 [expr {($x1 -$x0)/2 + $x0}]
		incr count -1
		continue
	    }
	} else {
	    if {   abs($y1-$y0) > $limit/4} {
		
		# puts "x0=$x0,x1=$x1,y0=$y0,y1=$y1"
		uplevel 1 set x0 $x1
		return [list $ansx $ansy]
	    }

	
	    # hopefully common case!!
	    # puts "got it: $x1,$y1,"
	    lappend ansx $x1
	    lappend ansy $y1
	    #append ans " $x1 $y1"
	    set slope [expr {($y1-$y0)/($x1-$x0)} ]
	    set x0 $x1
	    set y0 $y1
	    set x1 [expr {$x0 + $h0}]
	    set count 4
	}
    }
    uplevel 1 set x0 $x1
    return [list $ansx $ansy]
}





#
#-----------------------------------------------------------------
#
# nextColor --  get next COLOR and advance the curveNumber
#
#  Results: a color
#
#  Side Effects: the local variable for WIN called curveNumber is incremented
#
#----------------------------------------------------------------
#
proc nextColor { win } {
    makeLocal $win linecolors
    if { [catch { set i [oget $win curveNumber] } ] } { set i -1 }
    set color [lindex $linecolors [expr {[incr i]%[llength $linecolors]}]]
    oset $win curveNumber $i
    return $color
}


proc plot2d { args } {
    set win [mkPlot2d {*}$args]
    replot2d $win
    return $win
}

proc replot2d { win } {
    global printOption axisGray
    linkLocal $win xfundata data psfile nobox axes
    foreach v $data {
	if { "[assq [lindex $v 0] $::plot2dOptions notthere]" != "notthere" } {
	    oset $win [lindex $v 0] [lindex $v 1]
	}
    }
    linkLocal $win parameters
    makeLocal $win xfun nsteps c linecolors xaxislabel yaxislabel autoscale sliders
    if { "$sliders" != "" && ![winfo exists $c.sliders] } {
	addSliders $win
    }
    set xfundata ""
    foreach v [sparseListWithParams $xfun x $parameters] {
	proc _xf {  x  } "expr { $v }"	
	regsub "\\$" $v "" label
	lappend xfundata [list label $label] \
	    [linsert [calculatePlot $win _xf $nsteps]  \
		 0 xversusy]
    }

    # in case only functions and no y autoscale dont bother.
    if { "$data" != "" || [lsearch $autoscale y]>=0  } {
	set ranges [plot2dGetDataRange [concat $data $xfundata]]
	#      puts ranges=$ranges
	foreach {v k} [eval plot2dRangesToRadius $ranges] {
	    if { [lsearch $autoscale [string index $v 1] ] >= 0 } {
		oset $win [string range $v 1 end] $k
	    }
	}
    }

    set_xy_region $win 0.8
    set_xy_transforms $win
    set rtosx rtosx$win ; set rtosy rtosy$win
    makeLocal $win xmin ymin xmax ymax
    set x1 [rtosx$win $xmin]
    set x2 [rtosx$win $xmax]
    set y2 [rtosy$win $ymin]
    set y1 [rtosy$win $ymax]

    # Draw the two axes
    $c del axes
    if { $xmin*$xmax < 0 && ($axes == {y} || $axes == {xy}) } {
	if { $nobox == 0 } {
	    $c create line [$rtosx 0] $y1 [$rtosx 0] $y2 -fill $axisGray \
		-tags axes
	} else {
	    $c create line [$rtosx 0] $y1 [$rtosx 0] $y2 -width 2 \
		-arrow "first" -tags axes
	}
    }
    if { $ymin*$ymax < 0  && ($axes == {x} || $axes == {xy}) } {
	if { $nobox == 0 } {
	    $c create line $x1 [$rtosy 0] $x2 [$rtosy 0] -fill $axisGray \
		-tags axes
	} else {
	    $c create line $x1 [$rtosy 0] $x2 [$rtosy 0] -width 2 \
		-arrow "last" -tags axes
	}
    }

    if { "$xfun" != "" } {
	oset $win maintitle [concat list "Plot of y = \[oget $win xfun\]" ]
    }
    $c del path
    $c del label
    oset  $win curveNumber -1
    redraw2dData $win -tags path

    # Draw the plot box
    if { "[$c find withtag printrectangle]" == "" && $nobox == 0 } {
	$c create rectangle $x1 $y1 $x2 $y2 -tags printrectangle -width 2
	marginTicks $c [storx$win $x1] [story$win $y2] [storx$win $x2] \
	    [story$win $y1] "printrectangle marginticks"

    }
    # Write down the axes labels
    $c del axislabel
    set width [oget $win width]
    set height [oget $win height]
    if {$nobox != 0  && $xmin*$xmax < 0  && ($axes == {y} || $axes == {xy})} {
	set xbound [expr { [$rtosx 0] - 0.08*$width}]
    } else {
	set xbound [expr {$x1-0.08*$width}]
    }
    $c create text $xbound [expr {($y1+$y2)/2.0}] -anchor center -angle 90 \
       -text [oget $win yaxislabel] -font {TkDefaultFont 16 normal} -tags axislabel
    if {$nobox != 0  && $ymin*$ymax < 0  && ($axes == {x} || $axes == {xy})} {
	$c create text [expr {$x2-0.01*$width}] \
            [expr { [$rtosy 0]+0.02*$height}] -anchor ne -tags axislabel \
            -text [oget $win xaxislabel] -font {TkDefaultFont 16 normal}
    } else {
	$c create text [expr {($x1 + $x2)/2}] [expr {$y2 + 0.08*$height}] \
	    -anchor center -text [oget $win xaxislabel] \
	    -font {TkDefaultFont 16 normal} -tags axislabel
    }
    $c configure -background [oget $win background]

    # Create a PostScript file, if requested
    if { $psfile != "" } {
	set printOption(psfilename) $psfile
	writePostscript $win
	$c delete printoptions
	eval [$win.menubar.close cget -command]
    }
}



#
#-----------------------------------------------------------------
#  Should change name to plotData since works for 3d to now..
# plot2dData --  create WIN and plot 2d OR 3d DATA which is a list of
#  data sets.  Each data set must begin with xversusy or againstIndex
#  In the first case the data set looks like:
#       { xversusy {x1 x2 ...xn} {y1 ... yn yn+1 ... ym} }
#  and will be plotted as m/n curves : (x1,y1) (x2,y2) .. (xn,yn)
#  and (x1,yn+1) (x2,yn+2) ..
#  In the againstIndex case the x values are replace by the indices
#  0,1,2,... [length $yvalues]-1
#  Results: none
#
#  Side Effects: curves draw
#
#----------------------------------------------------------------
#
proc plot2dData { win data args } {
    clearLocal $win
    #puts "data=$data, [regexp plot2d $data junk ]"
    if { [regexp plot2d $data junk] } {
	# eval plot2d $args -windowname $win  [plot2dGetRanges $data] -xfun [list {}] -data [list $data]
	eval plot2d $args -windowname $win   -xfun [list {}] -data [list $data]	
    } else {
	# puts data=$data
	set com [concat \
		     plot3d $args -windowname $win -zfun {{}} -data [lrange $data 1 end]]
	# puts com=$com
	eval $com
    }
}



proc plot2dGetDataRange { data } {
    set rangex ""
    set rangey ""
    #puts "data=$data"
    set extra ""
    foreach d $data {
	#puts first=[lindex $d 0]
	if { [catch { 	
	    switch -exact -- [lindex $d 0] {
		xversusy {
		    foreach { xx yy } [lrange $d 1 end] {
			# puts "hi xx=[llength $xx],yy=[llength $yy]"
			if { [llength $xx] > 0 } {
			    set rangex [minMax $xx $rangex]
			    set rangey [minMax $yy $rangey]
			}
		    }
		    #puts "rangex=$rangex,rangey=$rangey"
		}
		againstIndex {
		    set rangex [minMax [list 0 [llength [lindex $d 1]]] $rangex]
		    set rangey [minMax [lindex $d 1] $rangey]
		}
		default {
		    set vv [lindex $d 0]
		    if { [lsearch {xrange yrange   } $vv] >= 0 } {
			set radius [expr {([lindex $d 2] -[lindex $d 1])/2.0 }]
			set center [expr {([lindex $d 2] +[lindex $d 1])/2.0 }]
			set var [string range $vv 0 0]
			lappend extra -${var}radius $radius -${var}center $center
		    }
		    if { [lsearch bargraph $vv] >= 0 } {
			set rangey [minMax 0 $rangey]
		    }


		    if { [lsearch {xradius yradius xcenter ycenter } $vv] >= 0 } {
			# these arguments must have numerical values
			lappend extra -$vv [expr {1*[lindex $d 1]}]
		    }

		}
	    }
	} errmsg ] } {
	    bgerror "bad data: [string range $d 0 2].."
# 	    set com [list error "bad data: [string range $d 0 200].." $errmsg]
# 	    after 1 $com
	}
    }

    list $rangex $rangey $extra
}



proc plot2dRangesToRadius  { rangex rangey extra } {
    set ranges ""
    # puts "extra=$extra"
    foreach u { x y } {
	if { "[assoc -[set u]radius $extra]" == "" } {
	    desetq "min max" [set range$u]
	    if { "$min" == "$max" } {
		set min [expr {$min - .5}]
		set max [expr {$max + .5}]
	    }
	    #puts "$u has $min,$max"
	    if { "$max" != "" } {
		
		lappend extra -[set u]radius [expr {($max-$min)/2.0}] \
		    -[set u]center [expr {($max+$min)/2.0}]
	    }
	}
    }
    # puts "extra=$extra"
    return $extra
}


proc redraw2dData { win  args } {
    makeLocal $win c linecolors data xfundata errorbar linewidth
    set tags [assoc -tags $args {} ]
    set rtosx rtosx$win ; set rtosy rtosy$win
    set i -1
    set label _default
    append data " " $xfundata
    #    set linewidth 2.4

    #puts "data=$data"
    foreach d $data {
	set type [lindex $d 0]
	switch  $type {
	    xversusy {
		#puts "starting .. [oget $win curveNumber]"
		set curvenumber [oget $win curveNumber]
		# the data can be multiple lists and each list
		# will not be line connected to previous
		foreach {xvalues yvalues} [lrange $d 1 end] {
		    # puts "xvalues=$xvalues"
		    #puts "here:$curvenumber,[oget $win curveNumber]"
		    oset $win curveNumber $curvenumber
		    set n [expr {[llength $xvalues] -1}]
		    while { [llength $yvalues] > 0 } {
			set ans ""
			set color [nextColor $win]
			catch { set color [oget $win color] }
			
			if { [info exists didLabel([oget $win curveNumber])] } {
			    set label ""
			} else {
			    set didLabel([oget $win curveNumber]) 1
			}
			set errorbar [oget $win errorbar]
			# puts "errorbar=$errorbar"
			if { $errorbar != 0 } {
			    set j 0
			    # puts "xvalues=$xvalues,yvalues=$yvalues"
			    for { set i 0 } { $i <= $n } {incr i} {
				set x [lindex $xvalues $i]
				set y1 [lindex $yvalues [expr {$i * 2}]]
				set y2 [lindex $yvalues [expr { $i * 2 +1}]]
				if { 1 } {
				    # puts "x=$x,y1=$y1,y2=$y2"
				    set xx [$rtosx $x]
				    set y1 [$rtosy $y1]
				    set y2 [$rtosy $y2]
				    $c create line [expr {$xx - $errorbar}] $y1 [expr {$xx +$errorbar}] $y1 $xx $y1 $xx $y2 [expr {$xx -$errorbar}] $y2 [expr {$xx + $errorbar}] $y2  -tags [list [concat $tags line[oget $win curveNumber]]]  -fill $color
				}
			    }
			    set yvalues [lrange $yvalues [llength $xvalues] end]
			} else {

			    foreach x $xvalues y [lrange $yvalues 0 $n] {
				append ans "[$rtosx $x] [$rtosy $y] "
				
			    }

			    drawPlot $win [list $ans] -tags [list [concat $tags line[oget $win curveNumber]]]  -fill $color -label $label
			}
			set label _default
			set yvalues [lrange $yvalues [llength $xvalues] end]
		    }
		}
	    }
	    againstIndex {
		set color [nextColor $win]
		set ind 0
		set ans ""
		foreach y [lindex $d 1] {
		    append ans "[$rtosx $ind] [$rtosy $y] "
		    incr ind
		}
		
		drawPlot $win [list $ans] -tags \
		    [list [concat $tags line[oget $win curveNumber]]] \
		    -fill $color -width $linewidth -label $label
		set label _default

		# eval $c create line $ans -tags \
		#  [list [concat $tags line[oget $win curveNumber]]] \
		#  -fill $color -width .2
	    }
	    label {
		set label [lindex $d 1]
	    }
	    default {

		# puts "$type,[lindex $d 1]"
		if { [lsearch { xfun color plotpoints linecolors pointsize \
				    nolines bargraph errorbar maintitle \
				    linewidth labelposition xaxislabel \
				    yaxislabel dydx nolegend} $type] >= 0 } {
		    # puts "setting oset $win $type [lindex $d 1]"
		    oset $win $type [lindex $d 1]
		} elseif { "$type" == "text" } {
		    desetq "x y text" [lrange $d 1 end]
		    $c create text [$rtosx $x] [$rtosy $y] -anchor nw \
			-text $text -tags "text all" -font {times 16 normal}
		}
	    }
	}
    }
}

proc plot2dDrawLabel { win label color } {
    makeLocal $win c labelposition xmin ymax
    #puts "$win $label $color"
    if { "$label" == ""} {return }
    set bb [$c bbox label]
    desetq "a0 b0" $labelposition
    set a0 [expr $a0 + [rtosx$win $xmin]]
    set b0 [expr $b0 + [rtosy$win $ymax]]
    if { "$bb" == "" } { set bb "$a0 $b0 $a0 $b0" }
    desetq "x0 y0 x1 y1" $bb
    set leng  15
    set last [$c create text [expr {$a0 +$leng +4}] \
		  [expr {2 + $y1}] \
		  -anchor nw       -text "$label" -tags label]
    desetq "ux0 uy0 ux1 uy1" [$c bbox $last]
    $c create line $a0 [expr {($uy0+$uy1) /2}] [expr {$a0 +$leng}] [expr {($uy0+$uy1) /2}]   -tags "label" -fill $color
}


proc RealtoScreen { win listPts } {
    set rtosx rtosx$win ; set rtosy rtosy$win
    set ans ""
    if { [llength [lindex $listPts  0]] != 1 } {
	foreach v $listPts {
	    append ans " {"
	    append ans [RealtoScreen $win $v]
	    append ans "}"
	}
    }    else {
	foreach {x y } $listPts {
	    append ans " [$rtosx $x] [$rtosy $y]"
	}
    }
    return $ans
}

proc drawPlot {win listpts args } {
    makeLocal $win c nolines nolegend plotpoints  pointsize bargraph \
        linewidth xmin xmax ymin ymax
    # set linewidth 2.4
    # puts ll:[llength $listpts]
    set x1 [rtosx$win $xmin]
    set x2 [rtosx$win $xmax]
    set y1 [rtosy$win $ymax]
    set y2 [rtosy$win $ymin]
    set tags [assoc -tags $args ""]
    if { [lsearch $tags path] < 0 } {lappend tags path}
    set fill [assoc -fill $args black]
    set label [assoc -label $args ""]
    if { "$label" == "_default" } {
	set label line[oget $win curveNumber]
    }

    catch { set fill [oget $win color] }

    if { $nolines == 1 && $plotpoints == 0 && $bargraph == 0} {
	set plotpoints 1}

    foreach pts $listpts {
        if { $bargraph } {
            set rtosy rtosy$win
            set rtosx rtosx$win
            set width [expr {abs([$rtosx $bargraph] - [$rtosx 0])}]
            set w2 [expr {$width/2.0}]
            # puts "width=$width,w2=$w2"
            set ry0 [$rtosy 0]
            foreach { x y } $pts {
                $c create rectangle [expr {$x-$w2}] $y  [expr {$x+$w2}] \
                    $ry0 -tags $tags -fill $fill }
        } else {
            if { $plotpoints } {
                set im [getPoint $pointsize $fill]
                # there is no eval, so we need this.
                if {$im ne {}} {
                    foreach { x y } $pts {
                        $c create image $x $y -image $im -anchor center \
                            -tags "$tags point"}
                } else {
                    foreach { x y } $pts {
                        $c create oval [expr {$x-$pointsize}] \
                            [expr {$y-$pointsize}] [expr {$x +$pointsize}] \
                            [expr {$y+$pointsize}] -tags $tags \
                            -fill $fill -outline {}}}}
            if { $nolines == 0 } {
                set first 1
                # puts "box: ($x1,$y1), ($x2,$y2)"
                foreach {x y} $pts {
                    if {$first} {
                        set p1 [list $x $y]
                        set c1 [PointCode $p1 $x1 $y1 $x2 $y2]
                        # puts "point $p1 with code $c1"
                        if {!$c1} {
                            set inpts [list $p1]
                        } else {set inpts {}}
                        set first 0
                    } else {
                        set p2 [list $x $y]
                        set c2 [PointCode $p2 $x1 $y1 $x2 $y2]
                        # puts "point $p2 with code $c2"
                        if {$c1|$c2} {
                            set clip [ClipLine $p1 $p2 $c1 $c2 $x1 $y1 $x2 $y2]
                            if {[llength $clip]} {
                                lappend inpts {*}$clip}
                            if {$c2 && ([llength $inpts] >= 2)} {
                                eval $c create line {*}$inpts -tags \
                                    [list $tags] -width $linewidth -fill $fill
                                set inpts {}}
                        } else {lappend inpts $p2}
                        set p1 $p2
                        set c1 $c2}}
                if {[llength $inpts] >= 2} {
                    eval $c create line {*}$inpts -tags [list $tags] \
                        -width $linewidth -fill $fill}
                set res "$win create line "}}}
    if { $nolegend == 0 } {plot2dDrawLabel $win $label $fill}}

proc drawPointsForPrint { c } {
    foreach v [$c find withtag point] {
	set tags [ldelete point [$c gettags $v]]
	desetq "x y" [$c coords $v]
	desetq "pointsize fill" $::xmaxima_priv(pointimage,[$c itemcget $v -image])
	catch {
	    $c create oval [expr {$x -$pointsize}] \
		[expr {$y -$pointsize}] [expr {$x +$pointsize}] \
		[expr {$y +$pointsize}] -tags $tags \
		-fill $fill -outline {}
	    $c delete $v}}}

proc getPoint { size color } {
    set im {}
    if { ![catch { set im $::xmaxima_priv(pointimage,$size,$color) }] } {
	return $im
    }
    catch { set data $::xmaxima_priv(bitmap,disc[expr {$size * 2}])
	set im [image create bitmap -data $data -foreground $color]
	set ::xmaxima_priv(pointimage,$size,$color) $im
	set ::xmaxima_priv(pointimage,$im) "$size $color"}
    return $im}

proc sliderCommandPlot2d { win var val } {
    linkLocal $win recompute
    updateParameters $win $var $val
    set com "recomputePlot2d $win"
    # allow for fast move of slider...
    #mike FIXME: this is a wrong use of after cancel
    after cancel $com
    after 10 $com}

proc recomputePlot2d { win } {replot2d $win}

# Assign an integer code between 0 and 10 to a given point, according
# to its position relative to the box with vertices (xmin,ymin) and (xmax,ymax)
proc PointCode {point xmin ymin xmax ymax} {
    set code 0
    set x [lindex $point 0]
    set y [lindex $point 1]
    if {$x < $xmin} {incr code 1} elseif {$x > $xmax} {incr code 2}
    if {$y < $ymin} {incr code 4} elseif {$y > $ymax} {incr code 8}
    return $code}

# Finds the intersection of the segment from point p1 to point p2 with
# the left edge of the box with vertices (xmin,ymin) and (xmax,ymax)
proc ClipLeft {p1 p2 xmin ymin xmax ymax} {
    set x1 [lindex $p1 0]
    set y1 [lindex $p1 1]
    set x2 [lindex $p2 0]
    set y2 [lindex $p2 1]
    set y [expr {$y1 + ($y2-1.0*$y1)*($xmin-$x1)/($x2-$x1)}]
    if {($y >= $ymin) && ($y <= $ymax)} {
        return "$xmin $y"
    } else {return}}

# Finds the intersection of the segment from point p1 to point p2 with
# the right edge of the box with vertices (xmin,ymin) and (xmax,ymax)
proc ClipRight {p1 p2 xmin ymin xmax ymax} {
    set x1 [lindex $p1 0]
    set y1 [lindex $p1 1]
    set x2 [lindex $p2 0]
    set y2 [lindex $p2 1]
    set y [expr {$y1 + ($y2-1.0*$y1)*($xmax-$x1)/($x2-$x1)}]
    if {($y >= $ymin) && ($y <= $ymax)} {
        return "$xmax $y"
    } else {return}}

# Finds the intersection of the segment from point p1 to point p2 with
# the bottom edge of the box with vertices (xmin,ymin) and (xmax,ymax)
proc ClipBottom {p1 p2 xmin ymin xmax ymax} {
    set x1 [lindex $p1 0]
    set y1 [lindex $p1 1]
    set x2 [lindex $p2 0]
    set y2 [lindex $p2 1]
    set x [expr {$x1 + ($x2-1.0*$x1)*($ymin-$y1)/($y2-$y1)}]
    if {($x >= $xmin) && ($x <= $xmax)} {
        return "$x $ymin"
    } else {return}}

# Finds the intersection of the segment from point p1 to point p2 with
# the top edge of the box with vertices (xmin,ymin) and (xmax,ymax)
proc ClipTop {p1 p2 xmin ymin xmax ymax} {
    set x1 [lindex $p1 0]
    set y1 [lindex $p1 1]
    set x2 [lindex $p2 0]
    set y2 [lindex $p2 1]
    set x [expr {$x1 + ($x2-1.0*$x1)*($ymax-$y1)/($y2-$y1)}]
    if {($x >= $xmin) && ($x <= $xmax)} {
        return "$x $ymax"
    } else {return}}

# Returns the intersection points of the segment from point1 to ppoint2
# and the box with vertices in (xmin,ymin) and (xmax,ymax). 
proc ClipLine {p1 p2 code1 code2 xmin ymin xmax ymax} {
    set clipped {}
    # puts "ClipLine: codes = $code1 $code2"
    if {$code1 & $code2} {
        return
    } else {
        foreach code [list $code1 $code2] i [list 0 1] {
            switch $code {
                0 {if {$i} {lappend clipped $p2}}
                1 {set p [ClipLeft $p1 $p2 $xmin $ymin $xmax $ymax]
                    if {[llength $p]} {lappend clipped $p} else {return}}
                2 {set p [ClipRight $p1 $p2 $xmin $ymin $xmax $ymax]
                    if {[llength $p]} {lappend clipped $p} else {return}}
                4 {set p [ClipBottom $p1 $p2 $xmin $ymin $xmax $ymax]
                    if {[llength $p]} {lappend clipped $p} else {return}}
                8 {set p [ClipTop $p1 $p2 $xmin $ymin $xmax $ymax]
                    if {[llength $p]} {lappend clipped $p} else {return}}
                5 {set p [ClipLeft $p1 $p2 $xmin $ymin $xmax $ymax]
                    if {[llength $p]} {
                        lappend clipped $p
                    } else {
                        set p [ClipBottom $p1 $p2 $xmin $ymin $xmax $ymax]
                        if {[llength $p]} {lappend clipped $p} else {return}}}
                6 {set p [ClipRight $p1 $p2 $xmin $ymin $xmax $ymax]
                    if {[llength $p]} {
                        lappend clipped $p
                    } else {
                        set p [ClipBottom $p1 $p2 $xmin $ymin $xmax $ymax]
                        if {[llength $p]} {lappend clipped $p} else {return}}}
                9 {set p [ClipLeft $p1 $p2 $xmin $ymin $xmax $ymax]
                    if {[llength $p]} {
                        lappend clipped $p
                    } else {
                        set p [ClipTop $p1 $p2 $xmin $ymin $xmax $ymax]
                        if {[llength $p]} {lappend clipped $p} else {return}}}
                10 {set p [ClipRight $p1 $p2 $xmin $ymin $xmax $ymax]
                    if {[llength $p]} {
                        lappend clipped $p
                    } else {
                        set p [ClipTop $p1 $p2 $xmin $ymin $xmax $ymax]
                        if {[llength $p]} {lappend clipped $p} else {return}}}
                default {return}}}
        # puts "$clipped"
        return $clipped}}

## endsource plot2d.tcl
###### Matrix.tcl #################################################
#
#   Copyright (C) 2024 Jaime E. Villate
#
#  For distribution under GNU public License. See COPYING.tcl
#  (Based on William F. Schelter's work, Copyright (C) 1998)
#
###################################################################

# In this file a matrix is represented as in Maxima.
# Namely, as a list of rows, where each row is itself a list.
# {{1 0} {0 1}} would then be the two by two identity.
# vectors are represented by lists.

# mkMultLeftExpr
# Given a matrix {{a00 a01} {a10 a11}} and a constant vector {k0 k1},
# it returns the symbolic expression:
# {prefix0 prefix1} {[expr {a00*$prefix0+a01*$prefix1+k0}]
#    [expr {a10*$prefix0+a11*$prefix1+k1}]}
# which will be used by mkMultLeft to define a procedure with input
# parameters {prefix0 prefix1}

proc mkMultLeftExpr {mat prefix {constant ""}} {
    set vars ""
    set ans ""
    set n [llength [lindex $mat 0]]
    for { set i 0} { $i < $n} {incr i} { append vars " $prefix$i" }
    foreach row $mat c $constant {
        set prod ""
        set op ""
        foreach a $row v $vars {
            append prod "$op$a*\$$v"
            set op "+"}
        if {$c ne ""} {append prod "+$c"}
        append ans [concat \[expr [list $prod]\]]
        append ans " "}
    return [list $vars $ans]}

# mkMultLeftFun
# Creates a procedure named "name" with as many input parameters as
# the number of columns o matrix mat.
# That procedure will return a vector with as many components as
# the number of rows of mat.
# If given, constant is a vector with as many components as the number
# of rows of mat. Each component on the returned vector is the linear
# combination of the input parameters with the corresponding row of mat,
# plus the corresponding component of "constant" if it is given.

proc mkMultLeftFun {mat name {constant ""} } {
    set expr [mkMultLeftExpr $mat _a $constant]
    set bod1 [string trim [lindex $expr 1] " "]
    set bod [concat list [lindex $expr 1]]
    proc $name [lindex $expr 0] $bod}

# rotationMatrix
# Computes the matrix of the rotation by azimuth th, and elevation ph
# matrix([cos(th),sin(th),0], [-cos(ph)*sin(th),cos(ph)*cos(th),sin(ph)],
#	  [sin(ph)*sin(th),-sin(ph)*cos(th),cos(ph)]);
proc rotationMatrix {th ph {ignore {} } } {
    set cph [expr {cos($ph)}]
    set sph [expr {sin($ph)}]
    set cth [expr {cos($th)}]
    set sth [expr {sin($th)}]
    return [list [list $cth $sth 0] \
                [list [expr {-$cph*$sth}] [expr {$cph*$cth}] $sph] \
                [list [expr {$sph*$sth}] [expr {-$sph*$cth}] $cph]]}

# matMul
# Returns the product of matrices mat1 and mat2
proc matMul {mat1 mat2} {
    set rows [llength $mat1]
    set cols [llength [lindex $mat2 0]]
    foreach r $mat2 {
        for {set j 0} {$j < $cols} {incr j} {
            lappend col$j [lindex $r $j]}}
    for {set i 0} {$i < $rows} {incr i} {
        for {set j 0} {$j < $cols} {incr j} {
            lappend row$i [vectDot [lindex $mat1 $i] [set col$j]]}
        lappend mat3 [set row$i]}
    return $mat3}

# vectDot
# Returns the dot product of vectors vec1 and vec2
proc vectDot {vec1 vec2} {
    set prod 0
    foreach c1 $vec1 c2 $vec2 {
        set prod [expr {$prod + $c1*$c2}]}
    return $prod}

# vectorOp
# Returns the vector obtained by applying the infix operator "op"
# between vectors vec1 and vec2
proc vectorOp {vec1 op vec2} {
    set ans ""
    foreach ai $vec1 bi $vec2 {lappend ans [expr [list $ai $op $bi]]}
    return $ans}

# scalarTimesVector
# Returns the vector obtained by multiplying vector by scalar
proc scalarTimesVector {scalar vector} {
    foreach coord $vector {lappend ans [expr {$scalar*$coord}]}
    return $ans}

## endsource matrix.tcl
###### Plot3d.tcl #################################################
#
# Copyright (C) 1998 William F. Schelter
# For distribution under GNU public License. See COPYING.tcl
#
#     Modified by Jaime E. Villate 
###################################################################

set ::plot3dOptions {
    {xradius 1 "Width in x direction of the x values" }
    {yradius 1 "Height in y direction of the y values"}

    {width 700 "Width of canvas in pixels"}
    {height 500 "Height of canvas in pixels" }
    {xcenter 0.0 {(xcenter,ycenter) is the origin of the window}}
    {ycenter 0.0 "see xcenter"}
    {zcenter 0.0 "see xcenter"}
    {bbox "" "xmin ymin xmax ymax zmin zmax overrides the -xcenter etc"}
    {zradius auto " Height in z direction of the z values"}
    {az 30 "azimuth angle" }
    {el 60 "elevation angle" }

    {thetax 10.0 "ignored is obsolete: use az and el"}
    {thetay 20.0 "ignored is obsolete: use az and el"}
    {thetaz 30.0 "ignored is obsolete: use az and el"}

    {flatten 1 "Flatten surface when zradius exceeded" }
    {zfun "" "a function of z to plot eg: x^2-y^2"}
    {parameters "" "List of parameters and values eg k=3,l=7"}
    {sliders "" "List of parameters ranges k=3:5,u"}
    {data  "" "a data set of type { variable_grid xvec yvec zmatrix}
    or {matrix_mesh xmat ymat zmat} or {grid {xmin xmax} {ymin ymax} zmatrix}"}
    {nsteps "10 10" "steps in x and y direction"}
    {rotationcenter "" "Origin about which rotation will be done"}
    {windowname ".plot3d" "window name"}
    {background white "background color"}
    {psfile "" "A filename where the graph will be saved in PostScript."}
    {nobox 0 "if not zero, do not draw the box around the plot."}
    {hue 0.25 "Default hue value."}
    {saturation 0.7 "Default saturation value."}
    {value 0.8 "Default brightness value."}
    {colorrange 0.5 "Range of colors used."}
    {gradlist {"#00ff00" "#ff00ff"} "Color gradient: List of values and colors."}
    {ncolors 180 "Number of colors used."}
    {colorscheme "gradient" "Coloring Scheme (hue, saturation, value, gray, gradient or 0)."}
    {mesh_lines "black" "Color for the meshes outline, or 0 for no outline."}
}


## source Matrix.tcl

proc transformPoints { pts fun } {
    set ans ""
    foreach { x y z } $pts {
	append ans " "
	append ans [$fun $x $y $z]
    }
    return $ans
}

proc calculatePlot3d {win fun  nx ny } {
    global plot3dMeshes$win
    set meshes  plot3dMeshes$win
    makeLocal $win xradius xmin yradius ymin zradius zcenter flatten

    set stepx [expr { 2*$xradius / double($nx)}]
    set stepy [expr { 2*$yradius / double($ny)} ]
    set i 0
    set j 0
    set zmax -1000000000
    set zmin 1000000000
    # check if zradius is a number
    set dotruncate [expr ![catch {expr {$zradius + 1} }]]
    if { $dotruncate } {
	if { $flatten } { set dotruncate 0 }
	set zzmax [expr {$zcenter + $zradius}]
	set zzmin [expr {$zcenter - $zradius}]
	#puts "zzmax=$zzmax,$zzmin"
    } else {
	set flatten 0
    }

    catch { unset  $meshes }
    set k 0
    for {set i 0} { $i <= $nx } { incr i} {
	set x [expr { $xmin + $i * $stepx }]
	for {set j 0} { $j <= $ny } { incr j} {
	    set y [expr { $ymin + $j *$stepy }]
	    if { [catch {  set z [$fun $x $y] }] } {
		set z nam
	    } elseif { $dotruncate  &&  ($z > $zzmax || $z < $zzmin) } {
		set z nam

	    } else {
		if { $flatten } {
		    if { $z > $zzmax } { set z $zzmax } elseif {
								$z < $zzmin } { set z $zzmin }}
		
		if { $z < $zmin }  { set zmin $z } elseif {
							   $z > $zmax } { set zmax $z }
		if { $j != $ny && $i != $nx } {
		    set [set meshes]($k) \
			"$k [expr { $k+3 }] [expr { $k+3+($ny+1)*3 }] \
		      [expr { $k+($ny+1)*3 }]"} else {
			  # set plot3dMeshes($k) ""
		      }
	    }
	    incr k 3
	    append ans " $x $y $z"
	}
    }
    oset $win zmin $zmin
    oset $win zmax $zmax
    oset $win points $ans
    oset $win nx $nx
    oset $win ny $ny
    oset $win colorfun plot3dcolorFun
    addAxes $win
    setupPlot3dColors $win
}

proc calculatePlot3data {win fun  nx ny } {
    # calculate the 3d data from function:
    makeLocal $win xradius xmin xmax ymax yradius ymin zradius zcenter flatten

    set rowx [linspace $xmin $xmax $nx]
    set rowy [linspace $ymin $ymax $ny]
    foreach  y $rowy {
	set row ""
	foreach x $rowx {
	    if { [catch {  set z [$fun $x $y] }] } {
		set z nam
	    }
	    lappend row $z
	}
	lappend matrix $row
    }
    global silly
    set silly [list variable_grid $rowx $rowy $matrix ]
    return [list variable_grid $rowx $rowy $matrix ]

}

proc addAxes { win } {
    #global plot3dPoints plot3dMeshes xradius yradius xcenter ycenter
    global [oarray $win] plot3dMeshes$win
    linkLocal $win lmesh
    makeLocal $win   xradius yradius xcenter ycenter  points zmax zcenter zmin
    set meshes plot3dMeshes$win
    set ll [llength $points]

    # puts "oset $win  axisstart  $ll"
    oset $win  axisstart  $ll
    set nx2 5
    set ny2 5
    set xstep [expr { 1.2 * $xradius/double($nx2) }]
    set ystep [expr { 1.2 * $yradius/double($ny2) }]
    set nz2 $ny2

    set ans " "
    set x0 $xcenter
    set y0 $ycenter
    set z0 $zcenter

    set k $ll
    for { set i 0 } { $i < $nx2 } { incr i } {
	append ans "[expr {$x0 +$i * $xstep}] $y0 $z0 "
	lappend lmesh [list $k [incr k 3]]
	#set [set meshes]($k) "$k [incr k 3]"
    }
    append ans "[expr {$x0 +$nx2 * $xstep}] $y0 $z0 "
    incr k 3
    # set plot3dMeshes($k) ""

    for { set i 0 } { $i < $ny2 } { incr i } {
	append ans "$x0 [expr {$y0 +$i * $ystep}] $z0 "
	lappend lmesh [list $k [incr k 3]]
	#set [set meshes]($k) "$k [incr k 3]"
    }
    append ans "$x0 [expr {$y0 +$ny2 * $ystep}] $z0 "
    incr k 3
    # set $meshes($k) ""

    set zstep [expr {1.2 * $zmax/double($nz2)}]
    if { $zstep < $ystep } { set zstep $ystep }

    for { set i 0 } { $i < $ny2 } { incr i } {
	append ans "$x0 $y0 [expr {$z0 +$i * $zstep}] "
	# puts "set [set meshes]($k) \"$k [incr k 3]\""
	lappend lmesh [list $k [incr k 3]]
	# set [set meshes]($k) "$k [incr k 3]"
    }
    append ans "$x0 $y0 [expr {$z0 +$nz2 * $zstep}] "
    incr k 3
    # puts "ans=$ans"
    append [oloc $win points] $ans

    # set $meshes($k) ""

}

proc addBbox { win } {
    global plot3dMeshes$win
    makeLocal $win xmin xmax ymin ymax zmin zmax cmap
    linkLocal $win points lmesh
    set ll [llength $points]
    lappend points $xmin $ymin $zmin $xmax $ymin $zmin $xmin $ymax $zmin
    lappend points $xmax $ymax $zmin $xmin $ymin $zmax $xmax $ymin $zmax
    lappend points $xmin $ymax $zmax $xmax $ymax $zmax
    foreach  { a b } { 0 1 0 2 2 3 3 1 4 5 4 6 6 7 7 5 0 4 1 5 2 6 3 7 } {
	set k [expr {$a*3 + $ll}]
	set l [expr {$b*3 + $ll}]
	# set plot3dMeshes${win}($k) [list $k $l]
	lappend lmesh [list $k $l]
    }
    # Adds the three letters of the 3 axes
    set xm [expr {0.5*($xmin+$xmax)}]
    set ym [expr {0.5*($ymin+$ymax)}]
    set zm [expr {0.5*($zmin+$zmax)}]
    set dx [expr {0.03*($xmax-$xmin)}]
    set dy [expr {0.03*($ymax-$ymin)}]
    set dz [expr {0.04*($zmax-$zmin)}]
    # the letter x
    lappend points [expr {$xm-$dx}] $ymin [expr {$zmin-$dz}]
    lappend points [expr {$xm+$dx}] $ymin [expr {$zmin-3*$dz}]
    lappend points [expr {$xm+$dx}] $ymin [expr {$zmin-$dz}]
    lappend points [expr {$xm-$dx}] $ymin [expr {$zmin-3*$dz}]
    lappend lmesh [list [expr {$ll+24}] [expr {$ll+27}]] 
    lappend lmesh [list [expr {$ll+30}] [expr {$ll+33}]]
    # the letter y
    lappend points $xmin [expr {$ym-$dy}] [expr {$zmin-$dz}]
    lappend points $xmin $ym [expr {$zmin-2*$dz}]
    lappend points $xmin [expr {$ym+$dy}] [expr {$zmin-$dz}]
    lappend points $xmin $ym [expr {$zmin-3*$dz}]
    lappend lmesh [list [expr {$ll+36}] [expr {$ll+39}]]
    lappend lmesh [list [expr {$ll+39}] [expr {$ll+42}]]
    lappend lmesh [list [expr {$ll+39}] [expr {$ll+45}]]
    # the letter z
    lappend points [expr {$xmin-3*$dx}] $ymin [expr {$zm+$dz}]
    lappend points [expr {$xmin-$dx}] $ymin [expr {$zm+$dz}]
    lappend points [expr {$xmin-3*$dx}] $ymin [expr {$zm-$dz}]
    lappend points [expr {$xmin-$dx}] $ymin [expr {$zm-$dz}]
    lappend lmesh [list [expr {$ll+48}] [expr {$ll+51}]] 
    lappend lmesh [list [expr {$ll+51}] [expr {$ll+54}]]
    lappend lmesh [list [expr {$ll+54}] [expr {$ll+57}]]

    # adds to lmesh the boundary where the mesh points end in list points
    lappend lmesh [list $ll]
    # uses red color for the three axes
    oset $win $cmap,$ll[expr {$ll+3}] red
    oset $win $cmap,$ll[expr {$ll+6}] red
    oset $win $cmap,$ll[expr {$ll+12}] red
    oset $win special($ll) "drawOval [oget $win c] 3 -fill red -tags axis"
}

proc drawOval { c radius args } {
    set ll [llength $args]
    set x [lindex $args [expr {$ll -2}]]
    set y [lindex $args [expr {$ll -1}]]
    set rest [lrange $args 0 [expr {$ll -3}]]
    set com [concat $c create oval [expr {$x - $radius}]  [expr {$y - $radius}] [expr {$x + $radius}]  [expr {$y + $radius}] $rest]
    eval $com}

proc plot3dcolorFun {win z } {
    makeLocal $win zmin zmax ncolors hue saturation value colorrange colorscheme gradlist
    if { $z < $zmin || $z > $zmax } {return "none"}
    set h [expr { 360*$hue }]
    if { ($value > 1) || ($value < 0) } {
        set value [expr { $value - floor($value) }]}
    set tem [expr {(double($colorrange)/$ncolors)*round(($z - $zmin)*$ncolors/($zmax - $zmin+.001))}]
    set frac [expr {($z-$zmin)/($zmax-$zmin)}]
    switch -exact $colorscheme {
	"hue" { return [hsv2rgb [expr { 360*$tem+$h }] $saturation $value] }
	"saturation" { return [hsv2rgb $h [expr { $tem+$saturation }] $value] }
	"value" { return [hsv2rgb $h $saturation [expr {$tem+$value}]] }
	"gray"  { set g [expr { round( ($frac)*255 ) } ]
	    return  [format "\#%02x%02x%02x" $g $g $g] }
        "gradient" {
            set colors {}
            # in older versions, elements of gradlists were 2-element lists
            for {set i 0} {$i < [llength $gradlist]} {incr i} {
                if {[llength [lindex $gradlist $i]]==2} {
                    lappend colors [lindex $gradlist $i 1]
                } else {
                    lappend colors [lindex $gradlist $i]}
            }
            set args [linsert $colors 0 $frac]
            return [interpolatecolor {*}$args] }
	"0" { return "#ffffff" }
        default {return $colorscheme}}}

proc setupPlot3dColors { win first_mesh} {
    upvar #0 [oarray $win] wvar
    # the default prefix for cmap
    set wvar(cmap) c1
    makeLocal $win colorfun points lmesh
    foreach tem [lrange $lmesh $first_mesh end] {
        set k [llength $tem]
	if { $k > 2 } {
            set z 0.0
            for { set i 0 } { $i < $k } { incr i } {
                set z [expr {$z+[lindex $points [expr {[lindex $tem $i]+2}]]}]
            }
            set z [expr {$z/$k}]
            catch {set wvar(c1,[lindex $tem 0][lindex $tem 1]) [$colorfun $win $z]}
        }
    }
}

proc calculateRotated { win } {
    set pideg [expr {3.14159/180.0}]
    linkLocal $win scalemat
    makeLocal $win az el rotationcenter xradius zradius yradius
    set rotmatrix [rotationMatrix [expr {$az*$pideg }] [expr {$el*$pideg}] ]

    # shrink by .2 on z axis
    # set fac [expr  {[vectorlength $xradius $yradius] / (sqrt(2) * $zradius)}]

    set rotmatrix [ matMul  $rotmatrix $scalemat]
    set tem [matMul $scalemat $rotationcenter]

    mkMultLeftFun  $rotmatrix _rot$win
    set rot _rot$win
    set ans ""
    # puts "points=[oget $win points]"
    if { $rotationcenter ne "" } {
	#puts "rotationcenter = $rotationcenter"
	set constant [vectorOp $tem - [eval $rot $rotationcenter]]
	mkMultLeftFun  $rotmatrix _rot$win $constant
    }
    #puts "win $win"
    foreach { x y z } [oget $win points] {
	if { [catch { append ans " " [$rot $x $y $z] } ] } {
	    append ans "  nam nam nam " }
    }
    oset $win rotatefun $rot
    oset $win rotated $ans
}

proc getOrderedMeshIndices { win } {
    #   global  plot3dMeshes$win
    #    set meshes plot3dMeshes$win
    linkLocal $win lmesh
    # puts "array names $meshes =[array names $meshes ]"
    # get the list offset by 2, so the lindex indices grab the Z coordinate.
    # without having to add 2.
    set pts2 [lrange [oget $win rotated] 2 end]
    set i 0
    foreach tem $lmesh {
        set k [llength $tem]
	if { [catch {
	    if {  $k == 4 } {
		set z [expr { ([lindex $pts2 [lindex $tem 0]] \
				   +[lindex $pts2 [lindex $tem 1]] \
				   + [lindex $pts2 [lindex $tem 2]] \
				   + [lindex $pts2 [lindex $tem 3]])/4.0 }]
	    } elseif { $k == 2 } {
		set z [expr { ([lindex $pts2 [lindex $tem 0]] \
				   +[lindex $pts2 [lindex $tem 1]])/2.0 }]
	    } else {
		set z 0
		foreach w $tem {
		    set z [expr {$z + [lindex $pts2 $w] }  ]
		
		}	
		set z [expr { $z/double($k)}]
	    }
	    lappend ans [list $z $i]
	    # append pp($z) "$i "
	    incr i
	
	} ]} {
	    set lmesh [lreplace $lmesh $i $i]
	}
    }
    set ttem [lsort -real -index 0 $ans]
    set ans {}
    foreach v $ttem {
	lappend ans [lindex $v 1]
    }
    oset $win meshes $ans
    return
}

#
#-----------------------------------------------------------------
#
# set_xy_region_3d --  set up the bounds of the x and y coordinates
# of the projection of the surface on the xy plane and the part of the
# window that will be filled by that projection (fac, a number between
# 0 and 1).
#
#----------------------------------------------------------------
#
proc set_xy_region_3d { win fac } {
    linkLocal $win scalemat
    makeLocal $win xcenter ycenter xradius yradius xmin xmax ymin ymax zradius
    set scalemat [list [list [expr {1.5/($xradius)}] 0 0] \
                      [list 0 [expr {1.5/($yradius)}] 0] \
                      [list 0 0 [expr {1.5/($zradius)}]]]
    oset $win fac $fac
    oset $win xmin [expr {1.5*$xmin/($xradius)}]
    oset $win xmax [expr {1.5*$xmax/($xradius)}]
    oset $win ymin [expr {1.5*$ymin/($yradius)}]
    oset $win ymax [expr {1.5*$ymax/($yradius)}]}

proc plot3d { args } {
    set win [assoc -windowname $args]
    if { "$win" == "" } {
	set win [getOptionDefault windowname $::plot3dOptions] }
    clearLocal $win
    mkPlot3d  $win {*}$args
    #    bind $win <Configure> {}	
    replot3d $win
}

proc replot3d { win } {
    global printOption
    makeLocal $win nsteps zfun data c
    linkLocal $win parameters sliders psfile nobox

    oset $win maintitle    "concat \"Plot of z = [oget $win zfun]\""
    if { [llength $nsteps] == 1 }    {
	oset $win nsteps \
	    [set nsteps  [list [lindex $nsteps 0] [lindex $nsteps 0]]]
    }

    set sliders [string trim $sliders]
    if { "$sliders" != "" && ![winfo exists $c.sliders] } {
	addSliders $win
    }

    set zfun [string trim $zfun]
    if { "$zfun" != "" } {
	proc _xf {  x  y } "return \[expr { [sparseWithParams $zfun {x y} $parameters ] } \]"
	addOnePlot3d $win [calculatePlot3data $win _xf  [lindex $nsteps 0] [lindex $nsteps 1]]
	# calculatePlot3d $win _xf [lindex $nsteps 0] [lindex $nsteps 1]
    }

    set data [string trim $data]
    if { "$data" != "" } {
	if { 0 } {
	    puts "here"
	    set ranges [ plot3dGetDataRange [list $data]]
	    linkLocal $win zmin zmax
	    desetq "zmin zmax" [lindex $ranges 2]
	    puts "ranges=$ranges"
	    set some [plot2dRangesToRadius [lindex $ranges 0] [lindex $ranges 1] ""]
	    puts "and now"
	    foreach {v k} $some {
		puts "oset $win [string range $v 1 end] $k"
		oset $win [string range $v 1 end] $k
	    }
        }
	addOnePlot3d $win $data
    }

    if { $nobox == 0 } {
	addBbox $win
    }

    set_xy_region_3d $win 0.5
    set_xy_transforms $win
    # grab the bbox just as itself
    linkLocal $win lmesh
    if { [llength $lmesh] > 100 * $::xmaxima_priv(speed)  } {
	# if we judge that rotation would be too slow, we make a secondary list
	# of meshes (random) including the bbox, and display those.
	linkLocal $win  points lmeshBbox pointsBbox
	set n [llength $lmesh]
	set lmeshBbox [lrange $lmesh [expr {$n -13}] end]
	set i 0 ;
	while { [incr i ] < ( 35*$::xmaxima_priv(speed)) } {
	    set j [expr {round(floor(rand()*($n-13))) }]
	    if { ![info exists temm($j)] } {
		lappend lmeshBbox [lindex $lmesh $j ]
		set temm(j) 1
	    }
	}
	resetPtsForLmesh $win
    }
    oset $win lastAnglesPlotted ""
    setView $win ignore
    $c configure -background [oget $win background]

    # Create a PostScript file, if requested
    if { $psfile != "" } {
	set printOption(psfilename) $psfile
	writePostscript $win
	$c delete printoptions
	eval [$win.menubar.close cget -command]
    }

}

proc setView { win ignore } {
    global timer
    foreach v [after info] {
	#puts "$v=<[after info $v]>"
	if {[lindex [after info $v] 0] == "setView1" } {
	    after cancel $v
	}
    }
    after 2 setView1 $win
}

proc setView1 { win  } {
    linkLocal $win lastAnglesPlotted points
    set new [list [oget  $win az] [oget  $win el] ]
    if { "$new" != "$lastAnglesPlotted" } {
   	makeLocal $win c
	calculateRotated $win
	getOrderedMeshIndices $win
	drawMeshes $win $c
	oset $win lastAnglesPlotted $new
    }
}

proc setQuick { win on } {
    linkLocal $win  lmesh  points savedData cmap 	lmeshBbox pointsBbox
    if { $on } {
	if { ![info exists savedData] && [info exists lmeshBbox] } {
	    set savedData [list $lmesh $points $cmap]
	    set lmesh $lmeshBbox
	    set points $pointsBbox
	    set cmap c2
	}
    } else {
	if { [info exists savedData] } {
	    desetq "lmesh points cmap" $savedData
	    unset savedData
	    oset $win lastAnglesPlotted ""
	}
    }
}


# reduce the set of pointsBbox to include only those needed by lmeshBbox
proc resetPtsForLmesh { win } {
    upvar 1 lmeshBbox lmeshBbox
    upvar 1 pointsBbox pointsBbox
    upvar 1 points points
    upvar #0 [oarray $win] wvar
    set k 0
    foreach v $lmeshBbox {
	if { [llength $v] == 1 } {
	    lappend nmesh $v
	} else {
	    set s ""
	    foreach w $v {
		if { [info exists tem($w)] } {
		    lappend s $tem($w)
		} else {
		    set tem($w) $k
		    lappend s $k
		    lappend pointsBbox \
			[lindex $points $w] \
			[lindex $points [expr {$w +1}]] \
			[lindex $points [expr {$w +2}]]
		    catch {set wvar(c2,$k) $wvar(c1,$w)}
		    incr k 3
		
		}
		
	    }
	    lappend nmesh $s
	    if { [info exists wvar(c1,$v)] } {
		set wvar(c2,$s) $wvar(c1,$v)
	    }
	}
    }
    set lmeshBbox  $nmesh
}

proc drawMeshes {win canv} {
    # $canv delete poly
    # only delete afterwards, to avoid relinquishing the colors
    $canv addtag oldpoly withtag poly
    $canv delete axis
    makeLocal $win lmesh rotated cmap
    upvar #0 [oarray $win] ar
    proc _xf { x} [info body rtosx$win]
    proc _yf { y} [info body rtosy$win]
    foreach { x y z} $rotated { lappend rotatedxy [_xf $x] [_yf $y] 0 }
    foreach k [oget $win meshes] {
	#puts "drawOneMesh $win $canv $k"
	set mesh [lindex $lmesh $k]
	set col black
	catch { set col $ar($cmap,[lindex $mesh 0][lindex $mesh 1]) }
	drawOneMesh $win $canv $k $mesh $col
    }
    $canv delete oldpoly
}


#
#-----------------------------------------------------------------
# plot3dMeshes  --  given K an index in plot3dPoints(points)
# if this is the index of a lower grid corner, return the other points.
# k takes values 0,3,6,9,... the values returned all have a 3 factor,
# and so are true lindex indices into the list of points.
# returns {} if this is not a mesh point.
#  Results:
#
#  Side Effects: none... NOTE we should maybe cash this in an array.
#
#----------------------------------------------------------------
#

proc drawOneMesh { win canv k mesh color } {
    #k=i*(ny+1)+j
    # k,k+1,k+1+nyp,k+nyp
    makeLocal $win mesh_lines colorscheme
    upvar 1 rotatedxy ptsxy
    set n [llength $mesh]

    foreach kk $mesh {
	lappend coords [lindex $ptsxy $kk] [lindex $ptsxy [expr {$kk + 1}]]
    }
    if { $n <= 2 } {
	#puts "drawing $k,n=$n $coords, points $mesh "
	#desetq "a b" $mesh
	#puts "<[lrange $points $a [expr {$a +2}]]> <[lrange $points $b [expr {$b +2}]]"
	if { $n == 2 } {
	    #	    set color black
	    #	    catch { set color [oget $win $cmap,$mesh]}

	    eval $canv create line $coords -tags [list [list axis mesh.$k]] \
		-fill $color -width 2
	} else {
	    # puts "doing special $mesh, $coords"
	    catch { set tem [oget $win special([lindex $mesh 0])]
		eval [concat $tem $coords]
	    }
	}
    } elseif { [string length $color] < 8 && $color != "none"} {
	# puts "drawing $k,n=$n $coords, points $mesh "
	if { $mesh_lines != 0 } {
	    set outline "-outline $mesh_lines"
	} else {
	    set outline ""
	}
	# eval $canv create polygon $coords -tags [list [list poly mesh.$k]] \
        #     -fill $color $outline
	if { $colorscheme == 0 } {
            if { $mesh_lines != 0 } {
                set fill "-fill $mesh_lines"
            } else {
                set fill "-fill #000000"
            }
            lappend coords [lindex $coords 0] [lindex $coords 1]
            eval $canv create line $coords -tags [list [list poly mesh.$k]] \
                -width 2 $fill
        } else {
            eval $canv create polygon $coords -tags [list [list poly mesh.$k]] \
                -fill $color $outline
        }            
    }
}


proc makeFrame3d { win } {
    set w [makeFrame $win 3d [oget $win background]]
    set top $w
    catch { set top [winfo parent $w]}
    catch {
	wm title $top {Xmaxima: plot3d}
	wm iconname $top "plot3d"
    }
    #pack $w
}

proc mkPlot3d { win  args } {
    global printOption [oarray $win] axisGray
    getOptions $::plot3dOptions $args -usearray [oarray $win]
    setPrintOptions $args
    set printOption(maintitle) ""
    set wb $win.menubar
    setupCanvas $win
    # catch { destroy $win }
    makeFrame3d $win
    oset $win sliderCommand sliderCommandPlot3d
    oset $win noaxisticks 0

    makeLocal $win buttonFont c
    [winfo parent $c].position config -text {}
    bind $c <Motion> ""

    setForRotate $win
}

proc doConfig3d { win } {
    desetq "wb1 wb2" [doConfig $win]
    makeLocal $win buttonFont

    mkentry $wb1.zfun [oloc $win zfun]  "z=f(x,y)" $buttonFont
    mkentry $wb1.nsteps [oloc $win nsteps]  [mc "Number of mesh grids"]  $buttonFont

    pack $wb1.zfun  $wb1.nsteps
    pack	    $wb1.zfun  $wb1.nsteps
    foreach w {xradius yradius xcenter ycenter zcenter zradius parameters } {
	mkentry $wb1.$w [oloc $win $w] $w $buttonFont
	pack $wb1.$w
    }

    scale $wb1.rotxscale -label [mc "azimuth"]  \
	-orient horizontal -length 150 -from -180 -to 180 -resolution 1 \
	-command "setView $win" -variable [oloc $win az] -tickinterval 120 -font $buttonFont

    scale $wb1.rotyscale -label [mc "elevation"]  \
	-orient horizontal -length 150 -from -180 -to 180 -resolution 1 \
	-command "setView $win" -variable [oloc $win el] -tickinterval 120 -font $buttonFont


    #    scale $wb1.rotzscale -label "thetaz"  \
	#	    -orient horizontal -length 150 -from -180 -to 180 \
	#	    -command "setView $win" -variable [oloc $win thetaz] -tickinterval 120 -font $buttonFont

    pack   $wb1.rotxscale   $wb1.rotyscale

}


proc showPosition3d { win x y } {
    # global position c
    makeLocal $win c
    set x [$c canvasx $x]
    set y [$c canvasy $y]
    set it [ $c find closest $x $y]
    set tags [$c gettags $it]
    if { [regexp {mesh[.]([0-9]+)} $tags junk k] } {
	set i 0
	set min 1000000
	set at 0
	# find closest.
	foreach {x1 y1} [$c coords $it] {
	    set d [expr {($x1 - $x)*($x1 - $x)+($y1 - $y)*($y1 - $y)}]
	    if { $d < $min} { set at $i ; set min $d }
	    incr i
	}
	set mesh [lindex [oget $win lmesh] $k]
	set ll [lindex $mesh $at]
	set pt [lrange [oget $win points] $ll [expr {$ll + 2}]]
	# puts pt=$pt
	catch { $win.position config -text [eval [concat "format {(%.2f %.2f %.2f)}" $pt]] }	
    }
    #    oset $win position [format {(%.1f %.1f)} $x $y]
    #    oset $win position \
	#      "[format {(%.2f,%.2f)}  [storx$win [$c canvasx $x]] [story$win [$c canvasy $y]]]"
}



#
#-----------------------------------------------------------------
#
# rotateRelative --  do a rotation indicated by a movement
# of dx,dy on the screen.
#
#  Results:
#
#  Side Effects:
#
#----------------------------------------------------------------
#

proc rotateRelative { win x1 x2 y1 y2 } {
    makeLocal $win c az el rotatefun
    set x1 [$c canvasx $x1]
    set x2 [$c canvasx $x2]
    set y1 [$c canvasy $y1]
    set y2 [$c canvasy $y2]
    set xx [expr {$x2-$x1}]
    set yy [expr {($y2-$y1)}]
    set res [$rotatefun 0 0 1]
    set res1 [$rotatefun 0 0 0]
    set fac [expr {([lindex $res 1] > [lindex $res1 1] ? -1 : 1) }] ;
    # puts "fac=$fac,[lindex $res 1],[lindex $res1 1]"
    oset $win az [reduceMode360 [expr   {round($az + $fac *  $xx /2.0) }]]
    oset $win el [reduceMode360 [expr   {round($el -  $yy /2.0) }]]
    setView $win ignore
}

proc reduceMode360 { n } {
    return [  expr fmod(($n+180+5*360),360)-180]

}

proc setForRotate { win} {
    makeLocal $win c
    $c delete printrectangle
    bind $c  <Button-1> "setQuick $win 1 ; doRotateScreen $win %x %y "
    bind $c  <ButtonRelease-1> "setQuick $win 0 ; setView $win ignore"
}
proc doRotateScreen { win x y } {
    makeLocal $win c
    oset $win lastx $x
    oset $win lasty $y
    bind $c <B1-Motion> "doRotateScreenMotion $win %x %y"
}

proc doRotateScreenMotion {win x y } {
    makeLocal $win lastx lasty
    set dx [expr {$x - $lastx}]
    set dy [expr {$y - $lasty}]
    if { [vectorlength $dx $dy] < 4 } { return }
    rotateRelative $win $lastx $x $lasty $y
    oset $win lastx $x
    oset $win lasty $y
    # show values of azimuth and elevation angles
    set az [oget $win az]
    set el [oget $win el]
    catch { $win.position config -text [eval [concat "format {Azimuth: %.2f, Elevation: %.2f}" $az $el]] }
}


proc sliderCommandPlot3d { win var val } {
    linkLocal $win recompute

    updateParameters $win $var $val
    set com "recomputePlot3d $win"
    # allow for fast move of slider...
    #mike FIXME: this is a wrong use of after cancel
    after cancel $com
    after 10 $com
}

proc recomputePlot3d { win } {
    linkLocal $win  recompute
    if { [info exists recompute]  } {
	incr recompute
	return
    } else {
	set recompute 1
    }
    set redo 0
    while { $redo != $recompute } {
	set redo $recompute
	#	puts "replot3d $win,[oget $win parameters]"
	catch {replot3d $win }
	update
    }
    unset recompute
}


## endsource plot3d.tcl
###### scene.tcl ######
# Copyright (c) 2011, Jaime E. Villate <villate@fe.up.pt>
#
# Interface to the Visualization Toolkit (VTK) for Xmaxima
# (the license information can be found in COPYING.tcl)

global sceneOptions
set sceneOptions {
    {background {0 0 0} {red green and blue values for the background}}
    {width 500 {Rendering screen width in pixels}}
    {height 500 {Rendering screen height in pixels}}
    {windowname {.scene} {Window name}}
    {windowtitle {Xmaxima: scene} {Window title}}
    {azimuth 135 {Azimuth angle}}
    {elevation 30 {Elevation angle}}
    {tstep 10 {Time interval between iterations, in milliseconds}}
    {restart 0 {If different from zero, the animation will loop forever.}}
    {objects  {} {A list of Objects of the form {{Class {options}} ...}}} 
}


proc PlayStep {frame} {
    linkLocal $frame playing iteration prev_iteration maxiter trackers \
        restart animate tstep renwin
    if { $iteration<0 } {
        foreach obj $trackers {
            set name [lindex $obj 0]
            "$name:points" Initialize
            "$name:points" Modified
            "$name:lines" Initialize
            "$name:lines" Modified
        }
      }
    if {$iteration < $maxiter } {
        incr iteration
        uplevel $frame.menubar.play configure -image ::img::pause
        foreach anim_obj $animate {
            set name [lindex $anim_obj 0]
            set prop [lindex $anim_obj 1]
            set values [lindex $anim_obj 3]
            if { $iteration < [llength $values] } {
                eval "$name:actor" "Set$prop" [lindex $values $iteration]
            } elseif { $prev_iteration < [llength $values] } {
                eval "$name:actor" "Set$prop" [lindex $values end]
            }
        }
        foreach obj $trackers {
            set name [lindex $obj 0]
            if { $iteration <= [lindex $obj 1] } {
                eval "$name:points" InsertPoint $iteration ["$name:actor" GetPosition]
                "$name:points" Modified
                if { $iteration<1 } {
                    "$name:lines" InsertNextCell 1
                    "$name:lines" InsertCellPoint $iteration
                } else {
                    "$name:lines" InsertNextCell 2
                    "$name:lines" InsertCellPoint $prev_iteration
                    "$name:lines" InsertCellPoint $iteration
                    "$name:lines" Modified
                }
            } elseif { $prev_iteration < [lindex $obj 1] } {
                eval "$name:points" InsertPoint [lindex $obj 1] ["$name:actor" GetPosition]
                "$name:points" Modified
                "$name:lines" InsertNextCell 2
                "$name:lines" InsertCellPoint $prev_iteration
                "$name:lines" InsertCellPoint [lindex $obj 1]
                "$name:lines" Modified
            }
        }
        if { $iteration<1 } {
            set prev_iteration 0
        } else {
            set prev_iteration [expr $iteration-1]
        }
        $renwin Render
    }
    if {$iteration < $maxiter } {
        if {$playing == 1} {
            after $tstep PlayStep $frame
        }
    } else {
        if {$restart} {
            set iteration -1
            set trackers {}
            after $tstep PlayStep $frame
        } else {
            uplevel stopAnimation $frame
        }
    }
}

proc playAnimation {frame} {
    linkLocal $frame playing
    if {$playing == 0} {
        set playing 1
        uplevel PlayStep $frame
    } else {
        uplevel stopAnimation $frame
    }
}
proc stopAnimation {frame} {
    linkLocal $frame iteration playing
    after cancel PlayStep $frame
    set playing 0
    uplevel $frame.menubar.play configure -image ::img::play
}
proc startAnimation {frame} {
    linkLocal $frame iteration prev_iteration playing
    after cancel PlayStep $frame
    set playing 0
    set iteration -1
    set prev_iteration 0
    uplevel PlayStep $frame
    uplevel $frame.menubar.play configure -image ::img::play
}
proc endAnimation {frame} {
    linkLocal $frame maxiter iteration prev_iteration
    after cancel PlayStep $frame
    set prev_iteration $iteration
    set iteration [expr $maxiter-1]
    uplevel PlayStep $frame
}

proc makeVTKFrame { w type } {
    global doExit fontSize buttonfont
    linkLocal $w width height restart renwin windowtitle
    set win $w
    if { "$w" == "." } {
        set w ""
    } else {
	catch { destroy $w}
	frame $w
    }
    set dismiss "destroy [winfo toplevel $win]"
    if { "$doExit" != "" } {set dismiss $doExit } 	
    oset $w type $type

    set top $w
    catch { set top [winfo parent $w]}
    catch {
	wm title $top $windowtitle
	wm iconname $top "scene"
    }

    set buttonFont $buttonfont
    oset $win buttonFont $buttonfont
    set mb [frame $w.menubar]
    pack $mb -fill x

    set dismiss [concat "vtkCommand DeleteAllObjects;" \
                     "after cancel PlayStep $mb.play;" $dismiss \
                     "; clearLocal $win"]
    # define exit command fot the scene window
    wm protocol $top WM_DELETE_WINDOW \
        "after cancel PlayStep $mb.play; vtkCommand DeleteAllObjects; destroy $top; clearLocal $win"
 
    button $mb.play -image ::img::play -text [mc "Play"] \
        -command "playAnimation $w"
    button $mb.start -image ::img::start -text [mc "Start"] \
        -command "startAnimation $w"
    button $mb.end -image ::img::end -text [mc "End"] \
        -command "endAnimation $w"
    button $mb.config -image ::img::config -text [mc "Config"]
    button $mb.close -image ::img::close -text [mc "Close"] -command $dismiss
    if {$restart} {
        $mb.end configure -state disabled
    }
    set c $w.c
    oset $win c $c
    canvas $c  -borderwidth 2 -scrollregion {-1200 -1200 1200 1200}

    # Create a Tk widget that we can render into.
    set vtkw [vtkTkRenderWidget $c.ren -width $width -height $height -rw $renwin]
    # Setup Tk bindings and VTK observers for that widget.
    ::vtk::bind_tk_render_widget $vtkw

    pack $vtkw -side left -fill both -expand 1
    pack $mb.play $mb.start $mb.end -side left
    pack $mb.close $mb.config -side right
# FIX ME: these bindings do not work inside the VTK frame, because it
# has its own bindings.
    bind $c <Control-w> $dismiss
    bind $c <p> "playAnimation $w"
    pack $c -side right -expand 1 -fill both
    pack $w
    focus $w
    return $w
}

proc scene { args } {
    if {[catch {package require vtk; package require vtkinteraction}]} {
	 bgerror [mc "VTK is not installed, which is required for Scene"]
	 return
    }
    global sceneOptions
    set win [assoc -windowname $args]
    if { "$win" == "" } {set win [getOptionDefault windowname $sceneOptions] }
    global [oarray $win]
    getOptions $sceneOptions $args -usearray [oarray $win]
    set renderer [set win]:renderer
    set renwin [set win]:renwin
    set iren [set win]:iren
    oset $win maxiter 0
    oset $win trackers "" 
    oset $win playing 0
    oset $win iteration 0
    oset $win prev_iteration 0
    oset $win animate ""
    oset $win renderer $renderer
    oset $win renwin $renwin

    vtkRenderer $renderer

    # Create the render window and put the renderer in it
    vtkRenderWindow $renwin
    $renwin AddRenderer $renderer
    # Change from the default interaction style to Trackball
    vtkRenderWindowInteractor $iren
    $iren SetRenderWindow $renwin
    vtkInteractorStyleTrackballCamera style
    $iren SetInteractorStyle style
    # create the frame with the buttons and the rendering widget
    makeVTKFrame $win scene
    # put the objects into the widget
    updateScene $win
}

proc updateScene { win } {
    linkLocal $win background azimuth elevation objects maxiter trackers \
        animate renwin renderer
    set objcount 0
    foreach obj $objects {
        incr objcount
        set name "object$objcount"
        set class [lindex $obj 0]
        set anim_obj [lindex $obj 4]
        "vtk$class\Source" $name
        foreach prop [lindex $obj 1] {
            eval $name "Set$prop"
        }
        vtkPolyDataMapper "$name:mapper"
        "$name:mapper" SetInputConnection [$name GetOutputPort]
        vtkLODActor "$name:actor"
        "$name:actor" SetMapper "$name:mapper"
        foreach prop [lindex $obj 2] {
            eval ["$name:actor" GetProperty] "Set$prop"
        }
        foreach prop [lindex $obj 3] {
            eval "$name:actor" "Set$prop"
        }
        $renderer AddActor "$name:actor"
        if { [llength $anim_obj] > 2 } {
            lappend animate [linsert $anim_obj 0 $name]
            set n [expr [llength [lindex $anim_obj 2]] - 1]
            if { $n > $maxiter } {
                set maxiter $n
            }
            if { [lindex $anim_obj 1] } {
                lappend trackers "$name [llength [lindex $anim_obj 2]]"
                vtkPoints "$name:points"
                eval "$name:points" InsertPoint 0 [lindex [lindex $anim_obj 2] 0]
                vtkCellArray "$name:lines"
                "$name:lines" InsertNextCell 1
                "$name:lines" InsertCellPoint 0
                vtkPolyData "$name:track"
                "$name:track" SetPoints "$name:points"
                "$name:track" SetLines "$name:lines"
                vtkPolyDataMapper "$name:track:mapper"
                "$name:track:mapper" SetInput "$name:track"
                vtkActor "$name:track:actor"
                "$name:track:actor" SetMapper "$name:track:mapper"
                eval ["$name:track:actor" GetProperty] SetColor [["$name:actor" GetProperty] GetColor]
                $renderer AddActor "$name:track:actor"
            }
        }
    }
    eval "$renderer SetBackground $background"

    # Rotate the camera so the axis are in the position familiar to Physicists
    [$renderer GetActiveCamera] Elevation -90
    [$renderer GetActiveCamera] SetViewUp 0.0 0.0 1.0

    # Set azimuth and elevation
    [$renderer GetActiveCamera] Azimuth $azimuth
    [$renderer GetActiveCamera] Elevation $elevation
    $renderer ResetCamera
    $renwin Render

}

## endsource scene.tcl
############################################################
# NPlot3d.tc                                              #
# Copyright (C) 1998 William F. Schelter                   #
# For distribution under GNU public License.  See COPYING. #
#                                                          #
############################################################

# source plotting.tcl ; source nplot3d.tcl ; catch { destroy .plot3d} ;  plot3d -zfun "" -data $sample -xradius 10 -yradius 10
# newidea:
# { plot3d
#  { gridequal {minx maxx} {miny maxy}
#   {{z00 z01 z02 .. z0n } { z10 z11 z12 .. z1n} {..  } ...}
#  { grid {x0 x1  xm} {y0 y1 yn } miny maxy}
#   {{z00 z01 z02 .. z0n } { z10 z11 z12 .. z1n} {..  } ...}
#  { xyzgrid {{x00 y00 z00 x01 y01 z01 .. x0  }{x0 x1  xm} {y0 y1 yn } miny maxy}
#   {{z00 z01 z02 .. z0n } { z10 z11 z12 .. z1n} {..  } ...}
# tclMesh(2*[0,0,0,0,0;1,1,1,1,1]-1,2*[0,1,1,0,0;0,1,1,0,0]-1,2*[0,0,1,1,0;0,0,1,1,0]-1)

#     { gridequal {

# z00 z01 .. all belong to x=minx and y = miny,.... up y=maxy in n+1 steps
#{ grid {minx maxx} {miny maxy}
#  {{z00 z01 z02 .. z0n } { z10 z11 z12 .. z1n} {..  } ...}
# }
# where a mesh(1) {z00 z01 z11 z10} above



# { mesh {{{x00 y00 z00 } { x01 y01 z01} { x02 y02 z02}  ..}{{x10 y10 z10} {x11 y11 z11} ......} ..}}
# mesh(1) = P00 P01 P11 P10

set sample { variable_grid { 0 1 2 } { 3 4 5} { {21 111 2} {3 4 5 } {6 7 8 }}}
set sample { variable_grid { 0 1 2 } { 3 4 5} { {0 1 2} {3 4 5 } {6 7 8 }}}
set sample { matrix_mesh {{0 1} { 2 3 } {4 5 }}  {{0 1} { 2 3 } {4 5 }}  {{0 1} { 2 3 } {4 5 }} }
set sample { matrix_mesh {{0 1 2} {0 1 2 } {0 1 2 }} {{3 4 5} {3 4 5} {3 4 5}} { {0 1 2} {3 4 5 } {6 7 8 }}}
set sample1 { variable_grid  { 1 2 3 4 5 6 7 8 9 10 }
    { 1 2 3 }
    {  { 0 0 0 0 0 0 0 0 0 0 }
	{ 0 0.68404 1.28558 1.73205 1.96962 1.96962 1.73205 1.28558 0.68404 2.44921e-16 }
	{ 0 1.36808 2.57115 3.4641 3.93923 3.93923 3.4641 2.57115 1.36808 4.89843e-16 }
    }
}

set sample { matrix_mesh  {  { 0 0 0 0 0 }
    { 1 1 1 1 1 }
}  {  { 0 1 1 0 0 }
    { 0 1 1 0 0 }
}  {  { 0 0 1 1 0 }
    { 0 0 1 1 0 }
}
}

proc  fixupZ { } {
    uplevel 1 {
	if { [catch { expr $z + 0 } ] } {
	    set z nam
	}
    }
}

proc vectorLength { v } {
    expr { sqrt(1.0 * [lindex $v 0]*[lindex $v 0] + [lindex $v 1]*[lindex $v 1] + [lindex $v 2]*[lindex $v 2]) }
}

proc normalizeToLengthOne { v } {
    set norm [expr { sqrt(1.0 * [lindex $v 0]*[lindex $v 0] + [lindex $v 1]*[lindex $v 1] + [lindex $v 2]*[lindex $v 2]) }]
    if { $norm != 0.0 } {
	return [list [expr { [lindex $v 0] / $norm  } ] \
		    [expr { [lindex $v 1] / $norm  } ] \
		    [expr { [lindex $v 2] / $norm  } ] ]
	
    } else {
	return "1.0 0.0 0.0 "
    }
}

proc vectorCross { x1 x2 }  {
    list \
	[expr { [lindex $x1 1]*[lindex $x2 2]- [lindex $x2 1]*[lindex $x1 2]}] \
	[expr { [lindex $x1 2]*[lindex $x2 0]- [lindex $x2 2]*[lindex $x1 0] } ] \
	[expr { [lindex $x1 0]*[lindex $x2 1]- [lindex $x2 0]*[lindex $x1 1] }]
}

proc linspace { a b n } {
    if { $n < 2 } { error [mc "from %s to %s requires at least 2 points" $a $b ] }
    set del [expr {($b - $a)*1.0/($n -1)  }]
    for { set i 0 } { $i < $n } { incr i } {
	lappend ans [expr {$a + $del * $i}]
    }
    return $ans
}


proc addOnePlot3d { win data } {
    upvar #0 plot3dMeshes$win meshes
    #puts " adding meshes = plot3dMeshes$win"
    #puts "data=$data"
    linkLocal $win points zmax zmin zcenter zradius rotationcenter xradius yradius xmin xmax ymin ymax lmesh
    makeLocal $win flatten
    oset $win colorfun plot3dcolorFun
    oset $win cmap c1
    catch { unset  meshes }
    set points ""

    # check whether zradius is a number or "auto"
    set dotruncate [expr ![catch {expr {$zradius + 1} }]]
    if { $dotruncate } {
		set zzmax [expr {$zcenter + $zradius}]
		set zzmin [expr {$zcenter - $zradius}]
    }

    set k [llength $points]
    set type [lindex $data 0]
    # in general the data should be a list of plots..
    if { [lsearch {grid mesh variable_grid matrix_mesh }  $type ]>=0 } {
	set alldata [list $data]
    } else {set alldata $data}
    set lmesh {}
    set first_mesh 0
    foreach data $alldata {	
	set type [lindex $data 0]
	if { "$type" == "grid" } {
	    desetq "xmin xmax" [lindex $data 1]
	    desetq "ymin ymax" [lindex $data 2]
	    set pts [lindex $data 3]
	
	    set ncols [llength $pts]
	    set nrows  [llength [lindex $pts 0]]
	    set data [list variable_grid [linspace $xmin $xmax $ncols] \
			  [linspace $ymin $ymax $nrows] \
			  $pts ]
	    set type "variable_grid"
	}
	if { "$type" == "variable_grid" } {
	    set first_mesh [llength $lmesh]
	    desetq "xrow yrow zmat" [lrange $data 1 end]
	    # puts "xrow=$xrow,yrow=$yrow,zmat=$zmat"
	    set nx [expr {[llength $xrow] -1}]
	    set ny [expr {[llength $yrow] -1}]
	    #puts "nx=$nx,ny=$ny"
	    #	set xmin [lindex $xrow 0]
	    #	set xmax [lindex $xrow $nx]
	    #	set ymin [lindex $yrow 0]
	    #	set ymax [lindex $yrow $ny]
	    desetq "xmin xmax" [minMax $xrow ""]
	    desetq "ymin ymax" [minMax $yrow ""]
	    desetq "zmin zmax" [matrixMinMax [list $zmat]]
	    if { $dotruncate } {
		set zmax  $zzmax
		set zmin  $zzmin
	    }
	    #	puts "and now"
	    #	dshow nx xmin xmax ymin ymax zmin zmax

	    for {set j 0} { $j <= $ny } { incr j} {
		set y [lindex $yrow $j]
		set row [lindex $zmat $j]
		for {set i 0} { $i <= $nx } { incr i} {
		    set x [lindex $xrow $i]
		    set z [lindex $row $i]
		    #puts "x=$x,y=$y,z=$z, at ($i,$j)"
		    fixupZ
		    if { $j != $ny && $i != $nx } {
			lappend lmesh [list $k [expr { $k+3 }] \
					   [expr { $k+3+($nx+1)*3 }] \
					   [expr { $k+($nx+1)*3 }]]
		    }
		    incr k 3
		    lappend points $x $y $z
		}
	    }
	    setupPlot3dColors $win $first_mesh
	} elseif { "$type" == "matrix_mesh" } {
	    set first_mesh [llength $lmesh]
	    desetq "xmat ymat zmat" [lrange $data 1 end]
	    foreach v {x y z} {
		desetq "${v}min ${v}max" [matrixMinMax [list [set ${v}mat]]]
	    }
	    if { $dotruncate } {
		set zmax  $zzmax
		set zmin  $zzmin
	    }
	    set nj [expr {[llength [lindex $xmat 0]] -1 }]
	    set ni [expr {[llength $xmat ] -1 }]
	    set k [llength $points]
            set crn {}
            foreach rowx $xmat rowy $ymat rowz $zmat {
                set rowc {}
                foreach x $rowx y $rowy z $rowz {
                    if { [catch {expr {$x+$y+$z}}] } {
                        lappend rowc {NaN}
                    } else {
                        lappend rowc $k
                        lappend points $x $y $z
                        incr k 3
                    }
                }
                lappend crn $rowc
            }
            for { set i 0 } { $i < $ni } { incr i } {
                set ip1 [expr {$i+1}]
                for { set j 0 } { $j < $nj } { incr j } {
                    set jp1 [expr {$j+1}]
                    set quad [list [lindex $crn $i $j] [lindex $crn $i $jp1] \
                                  [lindex $crn $ip1 $jp1] [lindex $crn $ip1 $j]]
                    set k [lsearch $quad {NaN}]
                    if { $k < 0 } {
                        lappend lmesh $quad
                    } else {
                        set quad [lreplace $quad $k $k]
                        if { [lsearch $quad {NaN} ] < 0 } {
                            lappend lmesh $quad
                        }
                    }
                }
            }
            if { [llength $lmesh] == 0 } {
                tk_messageBox -title Error -icon error -message \
                    [mc "plot3d was not given enough data to be plotted."]
                return
            }
	    setupPlot3dColors $win $first_mesh
	} elseif { 0 && "$type" == "mesh" } {
	    set first_mesh [llength $lmesh]
	    # walk thru compute the xmin, xmax, ymin , ymax...
	    # and then go thru setting up the mesh array..
	    # and maybe setting up the color map for these meshes..
	    #
	    # { mesh {{{x00 y00 z00 } { x01 y01 z01} { x02 y02 z02}  ..}{{x10 y10 z10} {x11 y11 z11} ......} ..}}
	    # mesh(1) = P00 P01 P11 P10
	    set mdata [lindex $data 1]
	    set nx [llength $mdata]
	    set ny [llength [lindex $mdata 0]]

	    for {set i 0} { $i <= $nx } { incr i} {
		set pts [lindex $mdata $i]
		set j 0
		foreach { x y z} $pts {
		    fixupZ $z
		    if { $j != $ny && $i != $nx } {
			lappend lmesh [list
				       $k [expr { $k+3 }] [expr { $k+3+($ny+1)*3 }] \
					   [expr { $k+($ny+1)*3 }] ]
		    }
		}
		incr k 3
		lappend points $x $y $z
		incr j
	    }
	    setupPlot3dColors $win $first_mesh
	} elseif { "[assq $type $::plot3dOptions notthere]" != "notthere" } {
	    oset $win $type [lindex $data 1]
	    if { $type == "zradius" } {
		# check whether zradius is a number or "auto"
		set dotruncate [expr ![catch {expr {$zradius + 1} }]]
		if { $dotruncate } {
		    set zzmax [expr {$zcenter + $zradius}]
		    set zzmin [expr {$zcenter - $zradius}]
		}
	    }
	}
	if { $first_mesh != [llength $lmesh] } {
	    # set up the min/max values for the complete plot
	    foreach v { x y z } {
		if { [info exists ${v}gmin] } {
		    if { [set ${v}min] < [set ${v}gmin] } {
			set ${v}gmin [set ${v}min]
		    }
		} else {
		    set ${v}gmin [set ${v}min]
		}
		if { [info exists ${v}gmax] } {
		    if { [set ${v}max] > [set ${v}gmax] } {
			set ${v}gmax [set ${v}max]
		    }
		} else {
		    set ${v}gmax [set ${v}max]
		}
	    }
	}
    }
    foreach v { x y z } {
	set ${v}min [set ${v}gmin]
	set ${v}max [set ${v}gmax]
	set a [set ${v}min]
	set b  [set ${v}max]
	if { $a == $b } {
	    set ${v}min [expr {$a -1}]
	    set ${v}max [expr {$a +1}]
	}
	set ${v}radius [expr {($b - $a)/2.0}]
	set ${v}center [expr {($b + $a)/2.0}]
    }
    set rotationcenter [list [list [expr {.5*($xmax+$xmin)}]] \
                            [list [expr {.5*($ymax+$ymin)}]] \
                            [list [expr {.5*($zmax+$zmin)}]]]

    #puts "meshes data=[array get meshes]"
    #global plot3dMeshes.plot3d
    #puts "array names plot3dMeshes.plot3d = [array names plot3dMeshes.plot3d]"
}

proc vectorDiff { x1 x2 } {
    list [expr { [lindex $x1 0] - [lindex $x2 0] }] \
	[expr { [lindex $x1 1] - [lindex $x2 1] }] \
	[expr { [lindex $x1 2] - [lindex $x2 2] }]
}


proc oneCircle { old2 old1 pt radius nsides { angle 0 } } {
    set dt  [expr {  3.14159265358979323*2.0/($nsides-1.0) + $angle }]
    for  { set i 0 } { $i < $nsides } { incr i } {
	set t [expr {$dt*$i }]
	lappend ans [expr { $radius*([lindex $old2 0]*cos($t) + [lindex $old1 0] * sin($t)) + [lindex $pt 0] } ] \
	    [expr { $radius*([lindex $old2 1]*cos($t) + [lindex $old1 1] * sin($t)) + [lindex $pt 1] } ] \
	    [expr { $radius*([lindex $old2 2]*cos($t) + [lindex $old1 2] * sin($t)) + [lindex $pt 2] } ]
    }
    return $ans
}

proc curve3d { xfun yfun zfun trange } {
    foreach u { x y z} {
	set res [parseConvert [set ${u}fun] -variables t]
	proc _${u}fun { t } [list expr [lindex [lindex $res 0] 0]]
    }
}

proc tubeFromCurveData { pts nsides radius } {
    set n [llength $pts] ;
    set closed [ expr { [vectorLength [vectorDiff [lindex $pts 0] [lindex $pts end]]] < .02} ]
    if { $closed } {
	set f1 [expr {$n -2}]
	set f2 1
    } else {
	set f1 0
	set f2 1
    }
    set delta [vectorDiff [lindex $pts $f2] [lindex $pts $f1]]
    if { [lindex $delta 0] == 0 && [lindex $delta 1] == 0 && [lindex $delta 2] == 0 } { set delta "0 0 1.0" }
    set old ".6543654 0.0765456443 0.2965433"
    set old1 [normalizeToLengthOne [vectorCross $delta $old]]
    set n1 $old1
    set n2 [normalizeToLengthOne [vectorCross $delta $old1]]
    set first1 $n1 ; set first2 $n2

    lappend ans [oneCircle $n2   old1 [lindex $pts 0]]
    for { set j 1 } { $j < $n -1 } { incr j } {
	set delta [vectorDiff [lindex $pts $j] [lindex $pts [expr {$j+1}]]]
	if { [lindex $delta 0] == 0 && [lindex $delta 1] == 0 && [lindex $delta 2] == 0 } { set delta $old
	}
	set old $delta
	set old1 [normalizeToLengthOne [vectorCross $delta $n1]]
	set old2 [normalizeToLengthOne [vectorCross $delta $n2]]
	set n2 $old1
	set n1 $old2
	lappend ans [oneCircle $n2 $n1 [lindex $pts $j] $radius $nsides]
    }
    if { $closed } {
	set f2 1 ; set f1 [expr {$n -2}] ; set f3 0
    } else {
	set f1 [expr {$n -2}] ; set f2 [expr {$n-1}] ; set f3 $f2
    }

    set delta [vectorDiff [lindex $pts $f2] [lindex $pts $f1]]
    if { [lindex $delta 0] == 0 && [lindex $delta 1] == 0 && \
	     [lindex $delta 2] == 0 } { set delta $old }
    set old1 [normalizeToLengthOne [vectorCross delta $n1]]
    set old2 [normalizeToLengthOne [vectorCross $n2 $delta]]
    set n2 $old1 ; set n1 $old2
    if { $closed } {
	set angle [vangle $first1 $n1]
	set n1 $first1 ; st n2 $first2;
    }
    lappend ans [oneCircle $n2 $n1 [lindex $pts $f3] $radius $nsides $angle]
    return $ans
}


#
#-----------------------------------------------------------------
#
# vangle --  angle between two unit vectors
#
#  Results: an angle
#
#  Side Effects: none.
#
#----------------------------------------------------------------
#
proc vangle { x1 x2 } {
    set dot [expr { [lindex $x1 0]*[lindex $x2 0] +\
			[lindex $x1 1]*[lindex $x2 1] +\
			[lindex $x1 2]*[lindex $x2 2]} ]
    if { $dot >= 1 } { return 0.0 }
    if { $dot <= -1.0 } { return 3.141592653589 }
    return [expr { acos($dot) } ]
}

## endsource nplot3d.tcl
###### EOpenplot.tcl ############################################
#
# Copyright (C) 1998 William F. Schelter
# For distribution under GNU public License.  See COPYING.tcl
#
#################################################################

#-----------------------------------------------------------------
#
# eval_openplot --  invoke OPENPLOT on the substring of Window given
# by thisRange, and substitute the result into resultRange, if the
# latter is not the empty list.   If it is, then the window is placed
# on the next line from this command.
#  Results:
#
#  Side Effects:
#
#----------------------------------------------------------------
#

proc eval_openplot { program w thisRange resultRange } {
    set tem [eval $w get $thisRange]
    lappend tem -windowname $name
    foreach v [getDimensions $w $name] { lappend tem $v }
    set allowed "plot2d plotdf plot3d scene"
    set f [lindex $tem 0]
    if { [lsearch $allowed $f] >= 0 } {
	$f {*}[lrange $tem 1 end]
	ShowPlotWindow $w $name $thisRange $resultRange $desired
    } else {
	error [concat "$f" [mc "not allowed, only"] "{$allowed}"]}
    set name  [plotWindowName $w $f]
    set desired [setDesiredDims $w $name $thisRange ]
    return 0}

#-----------------------------------------------------------------
#
# plotWindowName --  checks preferences to see if separate or multiple
#  or nontoplevel windows are desired, and chooses a name accordingly.
#  in the first two cases it also assures that the toplevel window exists.
#
#  Results: window name
#
#  Side Effects:  possibly make a new toplevel window.
#
#----------------------------------------------------------------
#
proc plotWindowName { w command } {
    if {[info exists ::xmaxima_default(plotwindow)]} {
        set plot $::xmaxima_default(plotwindow)
    }
    if {[info exists ::xmaxima_priv(plot,count)]} {
        set count $::xmaxima_priv(plot,count)
    }
    set name ""

    if { "$command" == "scene" } {
        set name ".plotfr"	
        if { [winfo exists $name ] } {
            after cancel PlayStep $name.plot.menubar.play
            vtkCommand DeleteAllObjects
            destroy $name
            clearLocal $name.plot
        }
        toplevel $name
        if { "[info proc setIcon]" != "" } {
            after 1000 setIcon $name
        }
    } else {
        if { ![info exists plot] || "$plot" == "embedded" } {
            linkLocal $w counter
            if { ![info exists counter] } {set counter 0}
            return $w.plot[incr counter]
        }
        set name ".plotfr"	
        if { "$plot" == "multiple" } {
            if { ![info exists count] } {
                set count 1
            } else {
                incr count
            }
            append name $count
        }
        if { ![winfo exists $name ] } {
            toplevel $name
            set h [expr {round ([winfo screenheight $name]*.6) }]
            set wid [expr round ($h * 1.2) ]
            set r1 [expr {round(10+rand()*30)} ]
            set r2 [expr {round(10+rand()*30)} ]
            wm geometry $name ${wid}x${h}+${r1}+${r2}
            if { "[info proc setIcon]" != "" } {
                after 1000 setIcon $name
            }   
        }
    }
    append name .plot
    return $name
}


proc whereToPutPlot { w thisRange resultRange } {
    if { "$resultRange" != "" } {
	eval $w  delete $resultRange
	set at [lindex $resultRange 0]
	$w insert $at " " { Tresult}
	set at [$w index "$at + 1char"]
    } else {
	set at "[lindex $thisRange 1] lineend + 1 chars"
    }
    return $at
}


proc setDesiredDims { w name range } {
    #puts "setDesiredDims  $w $name $range"
    foreach v [getTagsMatching $w "^(width|height):" $range] {
	set tem [split $v :]
	lappend ans [lindex $tem 0]Desired [lindex $tem 1]
    }
    if { [info exists ans] } {
	oarraySet $name $ans
	return $ans
    }
    return ""
}

proc getDimensions { w name } {
    # puts "getDimensions  $w $name"
    set parent [winfo parent $w]
    set scrollwidth 15
    catch { set scrollwidth [ [winfo parent $parent].scroll cget -scrollwidth] }
    set width [winfo width $w]
    set height [winfo height $w]
    #set width [getPercentDim [oget $name widthDesired] width $w]
    catch {set width [getPercentDim [oget $name widthDesired] width $w] }
    catch {set height [getPercentDim [oget $name heightDesired] height $w] }

    set width [expr {round ($width-4) }]
    set height [expr {round ($height-4)}]
    #puts "using width,height=$width,$height"

    if { $width <0 } {
	set width [expr {[oget $parent width] - 2*$scrollwidth}]
	set height [expr {round(.85*[oget $parent height])}]
    }
    return " -width $width -height $height"
}


proc insertResult_openplot {w args } {
    puts "insert=[$w index insert]" 
}

proc ShowPlotWindow { w name thisRange resultRange desired } {
    if { "[winfo toplevel $w]" != "[winfo toplevel $name]" } {
	$name config -relief sunken -borderwidth 2
	pack $name -expand 1 -fill both
	raise [winfo toplevel $name ]
	return
    }
    oarraySet $name $desired
    set at [whereToPutPlot $w $thisRange $resultRange]
    set col [lindex [split $at .] 1]

    if { $col > 0 } {
	$w insert $at "\n \n" "$name"
	set at [$w index "$at +1char"]
    }
    # compute where we will try to display.
    # try to leave top of window where it is, but if not
    # scroll lines up just the amount necessary to make the
    # window visible.

    set h1 [winfo height $w]
    set h2 [oget  $name height]
    set begin [$w index @0,0]
    set ind $at
    set dl [$w dlineinfo $ind]
    set y0 [lindex $dl 1]
    set prev ""
    if { "$y0" != "" } {
	while { [$w compare $begin <= $ind] } {
	    set dl [$w dlineinfo $ind]

	    if { "$dl" == "" } { break }
	    if { $y0 - [lindex $dl 1] + $h2 +5 < $h1  } {
		set prev $ind
		set ind [$w index "$ind - 1 line" ]
	    } else {
		break
	    }
	}
    }

    bind $name <Destroy> "catch {$w yview [$w index @0,0] } ; eval $w delete \[$w tag  nextrange $name 0.0 \]"

    if { "$prev" != "" } { set ind $prev }
    $w insert $at " " "$name center"
    $w window create  $at+1char -window $name
    $w tag add "center $name" $at "$at+2char"
    update
    $w yview $ind
    # somehow the single button click gets run positioning the cursor
    # near where the
    after 1 $w mark set insert [$w index insert]
    return $ind
}

## endsource eopenplot.tcl
###### EMaxima.tcl ######
############################################################
# Netmath       Copyright (C) 1998 William F. Schelter     #
# For distribution under GNU public License.  See COPYING. #
############################################################


#
#-----------------------------------------------------------------
#
# insertResult_maxima --  insert result RES, in text window W,
# into RESULTRANGE.  The command which was sent to maxima came
# from THISRANGE.   For plots if a resultRANGE is missing,
# we use a space just after the end of the line of THISRANGE.
# checks if this is plotdata, and if so makes plot win for it.
#
#  Results: none
#
#  Side Effects:  inserts in text or graph in window W.
#
#----------------------------------------------------------------
#

proc insertResult_maxima {  w thisRange resultRange res } {
    set program maxima

    #    puts <lengthres=[llength $res],thisRange=$thisRange,resultRange=$resultRange>

    if { 0 == [string compare "$res" "cant connect"] } {
	bgerror [concat [mc "unable to call"] "$program"]
    }
    if { [regexp "\{plot\[23\]d" $res] || [regexp "\{plotdf" $res] \
             || [regexp "\{scene" $res] } {
	#puts "its a plot"
	set name [plotWindowName $w [lindex $res 0]]
	eval plot2dData $name $res [getDimensions $w $name]
	set desired [setDesiredDims $w $name $thisRange ]
	ShowPlotWindow $w $name  $thisRange $resultRange $desired
	return 0
    }

    if { "$resultRange" != "" }   {
	set name $w.plot[oset $w counter [expr {1 + [oget $w counter]}]]
	insertResult $w $resultRange $res
	
    }
    return 0
}

## endsource emaxima.tcl
###### EHref.tcl ######
############################################################
# Netmath       Copyright (C) 1998 William F. Schelter     #
# For distribution under GNU public License.  See COPYING. #
############################################################


#
#-----------------------------------------------------------------
#
# eval_href --  Follow a link to another om document
#
#  Results:
#
#  Side Effects:
#
#----------------------------------------------------------------
#

proc obsoleteeval_href { program w this nextResult} {
    set arg ""
    foreach v [$w tag names [lindex $this 0]] {
	if { [string first "\{ThrefArg" $v] == 0 } {
	    set arg $v
	    break
	}
    }
    set arglist [getTargTags $w $this]
    if { [llength $arglist] != 1 } {
	return -code error -errorinfo  [concat "[llength $arglist]" [mc "args to href.  Wanted 1, got:"] "$arglist"]
    }
    puts "arglist=$arglist"

    set arg [lindex $arglist 0]
    puts "arg=$arg"
    set list [lrange $arg 1 end]
    set doc [assoc -src $list ""]

    set searchregexp [assoc -searchregexp $list ""]
    set search [assoc -search $list ""]

    puts "doc=$doc"

    if { "$doc" != "" } {
	puts "       OpenMathOpenUrl $doc -commandpanel [omPanel $w]"
	OpenMathOpenUrl $doc -commandpanel [omPanel $w]
    }
    makeLocal  [omPanel $w] textwin
    set ind ""
    if { "$searchregexp" != "" } {
	set ind [ $textwin search -regexp -- $searchregexp 1.0]
    } elseif { "$search" != "" } {
	set ind [ $textwin search -exact -- $search 1.0]
    }
    if { "$ind" != "" } {
	$textwin yview $ind
    }
    return 0
}



## endsource ehref.tcl
############################################################
# Browser.tcl                                              #
# Copyright (C) 1998 William F. Schelter                   #
# For distribution under GNU public License.  See COPYING. #
#                                                          #
#     Modified by Jaime E. Villate                         #
############################################################

proc peekLastCommand {win} {
    if { [info exists ::xmaxima_priv(lastcom,$win)] } {
	return $::xmaxima_priv(lastcom,$win)
    }
}

proc pushCommand { win command arglist } {
    set ::xmaxima_priv(lastcom,$win) [list $command $arglist]
}
#
#-----------------------------------------------------------------
#
# tkTextInsert --  we add some things to the default tkTextInsert
#  so that tags present before or after the insert, which are sticky
#  are added to the inserted string.   As usual, ones on both sides
#  are added.
#
#  Results:
#
#  Side Effects:
#
#----------------------------------------------------------------
#
proc tkTextInsert { w s } {
    set after [$w tag names insert]
    set before [$w tag names "insert-1char"]
    set both [intersect $after $before]
    # puts "after=$after"
    # puts "before=$before"

    foreach v [concat $after $before] {
	if { [regexp -- $::xmaxima_priv(sticky) $v] } {
	    lappend both $v
	}
    }

    if { [info exists ::xmaxima_priv($w,inputTag) ] } {
	lappend both $::xmaxima_priv($w,inputTag)
    }

    if {($s == "") || ([$w cget -state] == "disabled")} {
	return
    }
    catch {
	if {[$w compare sel.first <= insert]
	    && [$w compare sel.last >= insert]} {
	    $w delete sel.first sel.last
	}
    }
    $w insert insert $s $both
    $w see insert
}

proc getRange { win a b }  {
    if { [$win compare $a < $b ] } {
	return "$a $b" 
    } else { 
	return "$b $a"
    }
}
#
#-----------------------------------------------------------------
#
# tagRanges --  find ranges on WINDOW for TAG from FROMINDEX below TOINDEX
#
#  Results: a list of ranges start1 stop1 start2 stop2 ..
# which are contained in [fromindex,toindex] such that TAG is on from
# start1 to stop1 etc.
#
#  Side Effects:
#
#----------------------------------------------------------------
#
proc tagRanges { win tag begin end } {
    if {  [$win  compare $begin <= 1.0 ]  && \
	      [$win  compare $end >= end ] } {
	return [$win tag ranges $tag ] 
    } else {
	set answer ""
	    set begin [$win index $begin]
	    set end [$win index $end]
	    if { [lsearch [$win tag names $begin] $tag ]>=0 } {
		set prev [$win tag prevrange $tag $begin+1chars]
		set to [lindex $prev 1]
		if { [$win compare $to > $end ] } {
		    set to $end
		}
		append answer "$begin $to "
		set begin $to
	    }
	    #puts "<$begin $end>"
	    while { [$win compare $begin < $end ] } {
		set next [$win tag nextrange $tag $begin]
		#puts "next=$next"
		if { "$next" == "" } { return $answer }
		if { [$win compare [lindex $next 1] <= $end]} {
		    append answer "$next "
		    set begin [lindex $next 1]
		} elseif {[$win compare [lindex $next 0] < $end ]} {
		    append answer "[lindex $next 0] $end"
		    return $answer
		} else {
		    return $answer
		}
	    }
	    return $answer
	}
}
#
#-----------------------------------------------------------------
#
# quoteBraces --  given a STRING such that
# puts $file "set new [quoteBraces $string]"
# when re read by eval would make value of NEW identical to STRING
#
#  Results: a string
#
#  Side Effects:
#
#----------------------------------------------------------------
#
proc quoteBraces {string } {
    regsub -all {[{}]} $string {\\&} val
    return [list $val]
}

proc thisRange { win tag index } {
    set prev [$win tag prevrange $tag $index]
    if { "$prev" != "" && [$win compare [lindex $prev 1] >= $index] } {
	return $prev
    }
    set next [$win tag nextrange $tag $index]
    if { "$next" != ""  && [$win compare [lindex $next 0] <= $index] } {
	return $next
    }
    return ""
}
#
#-----------------------------------------------------------------
#
# insertRichText --  insert rich text in TEXTWINDOW at INDEX according
# to commands and data in LIST.   The latter must be of the form
#  command1 arg1 ..argn command2 arg1 ..argn2 ..
# for example if `Tins' takes two args
#  and the commands must be in
# since the rich text might come from a selection or some or an untrusted
# file we want to be careful not to do any bad evals.
#  Results: none
#
#  Side Effects:  the rich text commands are invoked to do insertions
# on the window.
#
#----------------------------------------------------------------
#
proc insertRichText {win index list } {
    set ::xmaxima_priv(currentwin) $win
    set ::xmaxima_priv(point) $index
    foreach v $::xmaxima_priv(richTextCommands) {
	set ::xmaxima_priv($v,richTextCommand) [llength [info args $v]]
    }
    set i 0
    set ll [llength $list]
    while { $i < $ll } {
	set com [lindex $list $i]
	incr i
	if { [catch { set n $::xmaxima_priv($com,richTextCommand)} ] } {
	    return -code error -errorinfo [concat [mc "illegal command in rich text:"] "$com"]
	}
	set form [concat $com [lrange $list $i [expr {$i +$n -1}]]]
	if { [catch {eval $form } ] } {
	    return -code error -errorinfo [concat [mc "unable to evaluate command:"] "`$form'"] }
	
	incr i $n
    }
}
proc Tins { tags text } {
    # foreach v $args { append text $v }
    $::xmaxima_priv(currentwin) insert $::xmaxima_priv(point) $text  $tags
}

proc TinsSlashEnd { tags text } {
    # foreach v $args { append text $v }
    $::xmaxima_priv(currentwin) insert $::xmaxima_priv(point) "$text\\"  $tags
}

proc underTop {top win} {
    if { "$top" == "." } {
	return $win
    } else {
	return $top$win
    }
}

proc deleteAllTraces {var} {
    foreach v [uplevel "#0" trace vinfo $var] {
	uplevel "#0" trace vdelete $var [lindex $v 0] [list [lindex $v 1]]
    }
}

# now unused
proc resetHistory { win list args } {
    set action [lindex $args 1]
    if { [catch {
	if { "$action" == "history" } {
	    $list delete 0 end
	    if { [winfo exists $list] } {
		foreach v [oget $win history] {
		    $list insert end [oget $v location]
		}
	    }
	}
	$list selection clear 0 end
	$list selection set [oget $win historyIndex]
	after 200 raise [winfo parent $list]

    } ] } {
	deleteAllTraces [oloc $win history]
	deleteAllTraces [oloc $win historyIndex]
    }
}

proc startDragPlacedWindow { win x y } {
    oset $win placeinfo [list $x $y [place info $win]]
}

proc dragPlacedWindow { win w1 x y } {
    global me recursive
    makeLocal $win placeinfo
    catch { after cancel [oget $win after]}
    set me [oget $win placeinfo]
    #puts "have=[oget $win placeinfo]"
    desetq "px py pinfo" [oget $win placeinfo]
    set dx [expr {$x - $px}]
    set dy [expr {$y - $py}]
    set nx [expr {$dx + [assoc -x $pinfo]}]
    set ny [expr {$dy + [assoc -y $pinfo]}]
    set new "-x $nx -y $ny"
    eval place $win $new
    oset $win placeinfo [list $x $y $new]
}

# now unused
proc OpenMathMoveHistory { win  n } {
    makeLocal $win history historyIndex
    incr historyIndex $n
    if { $historyIndex >= [llength $history] } {
	set historyIndex  [expr {[llength $history] -1}] 
    }
    if { $historyIndex < 0 } { set historyIndex 0}
    if { "[lindex $history $historyIndex]" != ""} {
	OpenMathGetWindow $win [lindex $history $historyIndex]
	oset $win historyIndex $historyIndex
    }
}

proc toLocalFilename { url } {
    set type [assoc type $url]
    switch -- $type {
	http {
	    return [assoc filename $url]
	}
	file {
	    return [file join / [assoc dirname $url] [assoc filename $url] ]

	}
        xmaxima {
            return [assoc filename $url]
        }
	default {error "unknown type: $type"}
    }
}

proc OpenMathGetWindow { commandPanel win } {
    if { "[winfo parent [oget $commandPanel textwin]]" != "$win" } {
	catch { pack forget [winfo parent [oget $commandPanel textwin]] }
	pack $win -expand 1 -fill both
	# pack $win
	oset $commandPanel textwin $win.text
	oset $commandPanel location [oget $win location]
	set tem [toLocalFilename [decodeURL [oget $win location]]]
	oset $commandPanel savefilename  [file root $tem].txt
    }
}

proc getw { s } {
    eval pack forget [winfo children . ] ; pack $s
}

proc try1 { file } {
    global ccc
    eval pack forget [winfo children . ]
    mkOpenMath [set w .t[incr ccc]]
    uplevel "#0" source $file
}

proc filesplit { x } {
    set l [split $x /]
    set n [llength $l ]
    set dir [lrange $l 0 [expr {$n - 2}]]
    set file [lindex $l [expr {$n - 1}]]
    return [list [join $dir /] $file]
}

proc decodeURL { name } {
    set server ""
    if { [regexp  {([^#]*)#(.*)$} $name junk name anchor] } {
	lappend answer anchor $anchor
	# puts "answer=$answer"
    }
    if { [regexp {^([a-z]+)[(]?([0-9]*)[)]?:/(.+)$} $name all type port path ] } {
	lappend answer type $type
    } else {
	set path $name ; set type ""
    }

    set path [removeDotDot $path]
    #puts "path=$path"
    desetq "dirname filename" [filesplit $path]
    #puts "dirname=$dirname,path=$path,filename=$filename"
    set po [assoc $type {http 80 nmtp 4443} ]
    if { "$po" != "" } {
	if { "$port" == "" } {set port $po }

	if { [regexp {^/([^/:]*)(:([0-9]+))?(.*)$} $dirname all server \
		  jun po dirname] } {
	    # puts "hi ther,server=$server"
	    if { "$po" != ""} {set port $po}
	    if { "$dirname" == "" } {set dirname / }
	} elseif { "$server" == "" } {
	    set server $filename
	    set dirname /
	    set filename {}
	}
	lappend answer port $port server $server
    }
    lappend answer dirname $dirname filename $filename
    return $answer
}

proc removeDotDot { path } {
    while { [regsub  {/[^/]+/[.][.](/|$)} $path "\\1" path] } {list}
    return $path
}

proc appendSeparate { var before item separator } {
    if { "$item" != "" } {
	uplevel 1 append $var $before $item $separator
    }
}

proc dirnamePlusFilename { lis } {
    return  [string trimright [assoc dirname $lis ""] /]/[assoc filename $lis ""]
}
proc encodeURL { lis } {
    set type [assoc type $lis ""]
    switch -- $type {
	nmtp {
	    if { [ set port [assoc port $lis 4443]] != 4443 } {
		append type "($port)"
	    }
	    appendSeparate ans "" $type ://[assoc server $lis ""]
	    append ans [dirnamePlusFilename $lis]
	    appendSeparate ans "#" [assoc anchor $lis ""] ""
	}
	http  {
	    if { [ set port [assoc port $lis 80]] != 80 } {
		append type "($port)"
	    }
	    appendSeparate ans "" $type ://[assoc server $lis ""]
	    append ans [dirnamePlusFilename $lis]
	    #appendSeparate ans "" [assoc dirname $lis ""]
	    #appendSeparate ans "/" [assoc filename $lis ""] ""
	    appendSeparate ans "#" [assoc anchor $lis ""] ""
	}
	file {
	    appendSeparate ans "" $type :/
	    append ans  [dirnamePlusFilename $lis]
	    #	   appendSeparate ans "" [assoc dirname $lis ""] "/"
	    #	   appendSeparate ans "" [assoc filename $lis ""] ""
	    appendSeparate ans "#" [assoc anchor $lis ""] ""
	}
        xmaxima {
            appendSeparate ans "" $type :/
            append ans  [dirnamePlusFilename $lis]
        }
	default {error "unsupported url type: $type"}
    }
    return $ans
}

proc resolveURL { name current {post ""} } {
    set decode [decodeURL $name]
    #puts "name=$name,current=$current"
    set ans ""
    set relative 0
    if { "[assoc type $decode {} ]" == "" } {set relative 1}
    if { $relative == 0 } {
	set ans  $decode
    } else {
	foreach {x y } $current {
	    switch -- $x {
		dirname {
		    set ndir [assoc dirname $decode ""]
		    set cdir [assoc dirname $current ""]
		    if { [string match /* $ndir] } {
			set new $ndir
		    } elseif { "$ndir" != "" } {
			if { "$cdir" != ""  } {
			    set new [string trimright $cdir /]/$ndir
			} else {
			    set new $ndir
			}
		    } else {
			set new $cdir
		    }
		    lappend ans dirname [removeDotDot $new]
		}
		filename {
		    if { "[assoc filename $decode]" == "" && "[assoc anchor $decode]" != "" } {
			lappend ans $x $y
		    }
		}
		post {
		    list
		}
		default {
		    lappend ans $x  [assoc $x $decode $y]
		}
	    }
	}
	foreach { key val } $decode {
	    if { "[assoc $key $ans --none--]" == "--none--" } {
		lappend ans $key $val
	    }
	}
    }
    if { "$post" != "" } {
	set ans [putassoc post $ans $post]
    }
    return $ans
}

proc getURLrequest { path server port types {post ""} {meth ""} } {
    if { "$meth" != "" } {
	set method $meth 
    } else {
	set method GET
	if { "$post" != "" } {set method POST}
    }
    #puts "getURLrequest $path $server $port [list $types]"
    foreach {v handler}  $::xmaxima_priv(urlHandlers) {
	lappend types $v,
    }
    set ans "$method $path HTTP/1.0\nConnection: Keep-Alive\nUser-agent: netmath\nHost: $server:$port\nAccept: $types\n"
    if { "$post" != "" } {
	# append ans "Content-length: [string length $post]\n\n$post"
	append ans "Content-type: application/x-www-form-urlencoded\nContent-length: [string length $post]\n\n$post"
    }
    return $ans
}

proc canonicalizeContentType { type } {
    regexp -nocase {([---a-zA-Z]+)/([---a-zA-Z]+)} $type type
    return [string tolower $type]
}

proc getURL { resolved type {mimeheader ""} {post ""} } {
    set res $resolved
    set ans ""
    set method ""
    if { "$mimeheader" != ""} {
	uplevel 1 set $mimeheader \[list\]
    }
    uplevel 1 set $type "unknown"
    #puts "getting $resolved,post=<$post>"
    switch [assoc type $res] {
	http {
	    #mike FIXME: replace with http get
	    # puts $res
	    # puts "socket [assoc server $res] [assoc port $res 80]"
	    if { [info exists ::xmaxima_priv(proxy,http) ] } {
		set sock [eval socket $::xmaxima_priv(proxy,http)]
		#		puts "opening proxy request socket $::xmaxima_priv(proxy,http)"
	    } else {
		set server [assoc server $res]
		set port [assoc port $res 80]
		#mike FIXME - use async sockets and dns
		if {[catch {socket $server $port} sock]} {
		    global errorInfo
		    tk_messageBox -title Error -icon error -message \
                        [mc "Error connecting to %s on %s\n%s" \
				      $server $port $sock]
		    return
		}
	    }
	    fconfigure $sock -blocking 0
	    ##DO NOT DELETE THE FOLLOWING !!!!!puts!!!!!!!!
	    #puts request=[getURLrequest [dirnamePlusFilename $res] [assoc server $res] [assoc port $res] image/gif $post]
	    #	    set path [dirnamePlusFilename $res]
	    set path [encodeURL $res]
	    set server [assoc server $res]
	    set port  [assoc port $res]
	    puts $sock [getURLrequest $path $server $port image/gif $post]
	    if { "$post" == "" } {
		oset $sock cachename "http://$server:$port$path"
	    } else {
		oset $sock cachename ""
	    }
	    flush $sock
	    if { [readAllData $sock -tovar ::xmaxima_priv(url_result) \
		      -translation binary -mimeheader ::xmaxima_priv(mimeheader)  \
		      -timeout 120000 -chunksize 2024] > 0 } {
		
		#puts "length=[string length $::xmaxima_priv(url_result)]"
		#	flush stdout
		set contentType [canonicalizeContentType [assoc content-type $::xmaxima_priv(mimeheader) text/plain]]
		uplevel 1 set $type [list $contentType]
		if { "$mimeheader" != "" } {
		    uplevel 1 set $mimeheader \[ uplevel "#0" set ::xmaxima_priv(mimeheader) \]
		}
		set ans $::xmaxima_priv(url_result)
		unset ::xmaxima_priv(url_result)
		return $ans
	    } else {
		return "had error"
	    }
	}
	file {
	    set name [toLocalFilename $res]
            if {[file isfile $name]} {
                set fi [open $name r]
            } else {
                set answer "<h1>Error</h1>\n<p>File: $name not found.</p>"
                set contentType text/html
                uplevel 1 set $type $contentType
                return $answer
            }
	    set answer [read $fi]
	    if { [regexp -nocase {[.]html?$} $name ] || [regexp -nocase "^(\[ \n\t\r\])*<html>" $answer] } {
		set contentType text/html
	    } elseif {  [regexp {[.]gif([^/]*)$} $name ] } {
		set contentType image/gif
	    } elseif {  [regexp {[.]png([^/]*)$} $name ] } {
		set contentType image/png
	    } elseif {  [regexp {[.]jpe?g([^/]*)$} $name ] } {
		set contentType image/jpeg
	    } else {
		set contentType text/plain
	    }
	    uplevel 1 set $type $contentType

	    close $fi
	    return $answer
	}
        xmaxima {
            set answer $::xmaxima_priv(error)
            set contentType text/html
            uplevel 1 set $type $contentType
            return $answer
        }
	default {
	    #mike dirpath?
	    error [concat [mc "not supported"] "[lindex $res 0]"]
	}
    }
}

proc getImage { resolved width height} {
    set res $resolved
    #puts [list getImage [list $resolved] $width $height]
    set ans ""
    catch {
	if { "" != "[image type $::xmaxima_priv(image,$res,$width,$height)]" } {
	    set ans $::xmaxima_priv(image,$res,$width,$height)
	}
    }
    if { "$ans" != "" } { return $ans }

    set image [image create photo -width $width -height $height]
    after 10 backgroundGetImage $image [list $resolved] $width $height
    set ::xmaxima_priv(image,$res,$width,$height) $image
    return $image
}

proc backgroundGetImage  { image res width height }   {
    #puts [list backgroundGetImage  $image $res $width $height ]
    if { [catch { backgroundGetImage1 $image $res $width $height } err ] } {
        set im ::img::brokenimage
	$image config -width [image width $im] -height [image height $im]
	$image copy $im
    }
}

proc backgroundGetImage1  { image res width height }   {
    #puts  "resolved=$res"
    #puts [list backgroundGetImage $image $res $width $height]
    switch [assoc type $res] {
	http {
	    set server [assoc server $res]
	    set port [assoc port $res 80]
	    if { [info exists ::xmaxima_priv(proxy,http) ] } {
		set s [eval socket $::xmaxima_priv(proxy,http)]
		#		puts "opening proxy request socket $::xmaxima_priv(proxy,http)"
	    } else {
		set s [socket [assoc server $res] [assoc port $res 80]]
	    }
	    fconfigure $s -blocking 0
	    ##DO NOT DELETE THE FOLLOWING !!!!!puts!!!!!!!!
	    puts $s [getURLrequest [encodeURL $res] \
			 $server $port {image/gif image/png image/jpeg image/x-bitmap}]
	    flush $s


	    if { [regexp -nocase $::xmaxima_priv(imgregexp) [assoc filename $res] mm extension] } {
		fconfigure $s -translation binary
		set tmp xxtmp[incr ::xmaxima_priv(imagecounter)].$extension

		if { [info exists ::xmaxima_priv(inbrowser)] ||  [catch {set out [open $tmp w] } ] } {
		    # if have binary..
		    if { "[info command binary]" != "binary" } {
			error [mc "need version of tk with 'binary' command for images"]}
		    #puts "hi binary" ; flush stdout
		    if {  [readAllData $s -tovar \
			       ::xmaxima_priv($s,url_result) -mimeheader \
			       ::xmaxima_priv($s,mimeheader)
			  ] > 0  && [string match *$extension [assoc content-type $::xmaxima_priv($s,mimeheader)]] } {
			set ans $image
			$image configure -data [tobase64 $::xmaxima_priv($s,url_result)]

			unset ::xmaxima_priv($s,mimeheader)
			unset ::xmaxima_priv($s,url_result)
			
		    } else  {
			error [mc "could not get image"]
		    }
		} else {
		    fconfigure $out -translation binary -blocking 0
		    if { [readAllData $s -tochannel $out \
			      -translation binary \
			      -mimeheader \
			      ::xmaxima_priv($s,mimeheader) -timeout 15000 -chunksize 2024 ] > 0 } {
			set ans $image
			$image config  -file \
			    $tmp
			unset ::xmaxima_priv($s,mimeheader)
		    }
		    # all the below just to try to remove the file..
		    #  depending on versions and in environments..
		}
	    }
	}
	file {
	    $image config -file [toLocalFilename $res]
	    set ans $image
	    # puts "$image config -file [toLocalFilename $res]"
	    #set ans [image create photo -file [toLocalFilename $res]]
	
	
	}
	default { error [mc "unknown type of image"] }
    }
    ## if we opened an out channel try hard to remove the tmp file.
    if { [info exists out] &&
	 [catch { file delete $tmp } ] && [catch { rm $tmp }]
	 && [catch { exec rm $tmp }] } {
	puts [concat [mc "cant remove tmp file"] "$tmp"]
    }
    if { "$ans" == "" } {
	error [concat [mc "Unable to open an image for"] "[encodeURL $res]"]
    }

}
#
#-----------------------------------------------------------------
#
# readData --  read data from S, storing the result in
# ::xmaxima_priv($s,url_result).   It times out after TIMEOUT without any
# data coming.
# It can be aborted by setting set ::xmaxima_priv($s,done)  -1
#
#
#  Results: -1 on failure and 1 on success.
#
#  Side Effects: it initially  empties ::xmaxima_priv($s,url_result) and then
#  adds data to it as read.   ::xmaxima_priv($s,done) is initialized to 0
#
#----------------------------------------------------------------
#
proc readData { s { timeout 10000 }} {
    after $timeout "set ::xmaxima_priv($s,done) -1"
    fconfigure $s  -blocking 0
    set ::xmaxima_priv($s,done) 0
    set ::xmaxima_priv($s,url_result) ""

    #mike FIXME: this is a wrong use of after cancel
    fileevent $s readable \
	"after cancel {set ::xmaxima_priv($s,done) -1} ; after $timeout {set ::xmaxima_priv($s,done) -1} ; set da \[read $s 8000] ; append ::xmaxima_priv($s,url_result) \$da; if { \[string length \$da] < 8000  && \[eof $s] } {after cancel {set ::xmaxima_priv($s,done) -1} ; set ::xmaxima_priv($s,done) 1; fileevent $s readable {} ;  }"
    myVwait ::xmaxima_priv($s,done)
    catch { close $s }
    #mike FIXME: this is a wrong use of after cancel
    after cancel "set ::xmaxima_priv($s,done) -1"
    return $::xmaxima_priv($s,done)
}

proc doRead { sock } {
    #puts reading; flush stdout;
    set tem [read $sock]
    append ::xmaxima_priv(url_result)  $tem
    # puts read:<$tem>
    # flush stdout
    if { [eof $sock] } {
	set ::xmaxima_priv(done) 1
	close $sock
    }
}

proc tempName { name extension } {
    set count [pid]
    while { [file exists $name[incr count].$extension] } { list }
    return $name$count.$extension
}

proc ws_outputToTemp { string file ext encoding } {
    upvar 1 $string result
    set tmp [tempName $file $ext ]
    set open $tmp
    if { [lsearch {x-gzip x-compress}  $encoding] >= 0 } { 
	# FIXME: Unix only
	lappend dogzip |gzip -dc > $open ; set open $dogzip
    }
    set fi [open $open w]
    fconfigure $fi -translation binary
    puts -nonewline $fi $result
    flush $fi
    close $fi
    return $tmp
}

proc OpenMathOpenUrl { name args} {
    if {![winfo exists .browser]} {createBrowser .browser}
    
    # Removes any white spaces at the end of the Url given
    set name [string trimright $name]

    maxStatus [concat [mc "Opening"] "$name"]

    #puts "OpenMathOpenUrl  $name $args "
    set history "" ; set historyIndex -1 ; set currentUrl ""
    set prevwindow ""
    set commandPanel [assoc -commandpanel $args ]
    if { "$commandPanel" == "" } {
	linkLocal . omPanel
	if { [info exists omPanel] } {
	    set commandPanel $omPanel
	}
    }
    set toplevel [assoc -toplevel $args ""]
    if { "$toplevel" == "" } {set toplevel ".browser"}
    if { "$toplevel" == "." } {set toplevel ""}
    set reload [assoc -reload $args 0]
    set post [assoc -post $args ""]
    #puts "post=$post"
    if { [winfo exists $commandPanel ] }  {
	makeLocal $commandPanel history historyIndex textwin
#	set toplevel [winfo paren $commandPanel]
#	if { "$toplevel" == "." } {set toplevel ""}
	# eval pack forget [winfo parent $textwin ]
	set prevwin [winfo parent $textwin]
	set currentUrl [oget $textwin currentUrl]
	catch { set currentUrl [decodeURL [oget $textwin baseurl]] }

	if { $reload == 0} {
	
	    set new [resolveURL $name $currentUrl $post]
	    if { [set anchor [assoc anchor $new]] != "" } {
		set new [delassoc anchor $new]
	    }
	    set ii -1
	    foreach v $history {
		incr ii
		if { "[delassoc post $new]" == "[delassoc post [oget $v.text currentUrl]]" } {
		    # puts "new=$new\nold=[oget $v.text currentUrl]"
		}
		if   { "$new" == "[delassoc anchor [oget $v.text currentUrl]]" } {
		    OpenMathMoveHistory $commandPanel [expr {$ii - $historyIndex }]
		    if { "$anchor" != "" } {
			update
			catch {  $v.text yview anchor:$anchor }
		    }
		
		    #    OpenMathGetWindow $commandPanel $v
		    #    pushHistory $commandPanel $v
		    return
		}
	    }
	} else {
	    # reload=1
	    list
	}
    }
    set count 5
    while { [incr count -1] > 0 } {
	set new [resolveURL $name $currentUrl $post]
	set result [getURL $new contentType mimeheader $post]
	if { [set tem [assoc location $mimeheader]] == "" } {
	    break
	}
	set name $tem
    }
    #puts "contentType defined:[info exists contentType]"
    set handler [assoc $contentType $::xmaxima_priv(urlHandlers)]
    if { "$handler" != "netmath" && "$handler" != "" } {
	set tmp [ws_outputToTemp result netmath ps "[assoc content-encoding $mimeheader]"]
	# to do fix this for windows #####
	exec sh -c "[format $handler $tmp] ; rm -f $tmp" &
	return
    }
    #puts contentType=$contentType
    #puts "got [string length $result] bytes"
    #puts ", result= [string range $result 0 70] .."

    if { [catch { set baseprogram [oget $textwin baseprogram] }] } {
	set baseprogram [decodeURL [getBaseprogram]]
    }
    # puts "using  $baseprogram"
    if { $reload } {   forgetCurrent $commandPanel }

    #puts "::xmaxima_priv(counter)=$::xmaxima_priv(counter)"
    set win [mkOpenMath [set w $toplevel.t[incr ::xmaxima_priv(counter)]] ]

    #puts "::xmaxima_priv(counter)=$::xmaxima_priv(counter)"
    makeLocal $w commandPanel
    #puts "resolveURL $name $currentUrl"
    if { [set anchor [assoc anchor $new]] != "" } {
	set new [delassoc anchor $new]
    }
    if { "[assoc filename $new]" == "" } {
	set new [putassoc  filename $new index.html]
    }
    # puts "...> $new"
    oset $w.text currentUrl $new
    oset $commandPanel location [encodeURL $new]
    oset $commandPanel textwin $win
    oset $w location  [encodeURL $new]
    # puts "new=$new"
    oset $commandPanel savefilename [file root [toLocalFilename $new]].txt
    set tem [assoc filename $new ""]
    #puts $contentType
    if { "$contentType" != "text/html" } {
	if { [string match "image/*" $contentType] } {
	    set im [image  create photo -data $result]
	    $win image create 0.0 -image $im
	    set err 0
	} else {
	    set err [catch {   $win insert 0.0 $result } ]
	}
    } elseif { 1 }  {
	xHMinit_win $win
	xHMset_state $win url [encodeURL $new]
	oset $win baseprogram $baseprogram
	# puts win=$win,lengres=[string length $result]
	set errmsg1 ""
	set err 0
	global debugParse
	if { $debugParse } {
	    xHMparse_html $result "xHMrender $win"
	    set err 0
	} else {
	    set err [catch {
		xHMparse_html $result "xHMrender $win"
	    } errmsg1 ]
	}
	catch {
	    if { "$anchor" != "" } {
		update
		$win yview anchor:$anchor
	    }
	}
	#   foreach v {Tresult Teval} {  $win tag raise $v}	
    } else {
	###Never get here.. must change to make be the rich text case..	
	# drop comment lines
	regsub -all "(^|\n)#\[^\n\]*\n" $result \n result ;
	#puts input=$result
	
	# note netscape would just truncate the history
	# at historyIndex, and start to grow it there,
	# losing the record of all files you have visited after..
	# maybe we should do this.
	#puts "history=$history"
	set err [catch { insertRichText $win insert $result }]
    }
    if { $err == 0 } {
	pushHistory $commandPanel $w
    }
    if { $err } {
	global errorInfo
	#puts "======begin======"
	#puts $result
	#puts "======end========"
	puts "$errmsg1"
	error [concat [mc "unable to evaluate"] "[encodeURL $new]\n$errmsg1\n$errorInfo"]
    }
}

proc pushHistory { commandPanel win } {
    global [oarray $commandPanel]
    makeLocal $commandPanel history historyIndex

    if { [llength $history] == 0 } {
	oset $commandPanel historyIndex -1
    }
    if { "[lindex $history $historyIndex ]" != "$win" } {
	oset $commandPanel history [linsert $history [incr [oloc $commandPanel historyIndex]] $win]
    }
}
#
#-----------------------------------------------------------------
#
# omScrollPage --  scroll the page by N pages, keeping the insert
# cursor visible.
#
#  Results: none
#
#  Side Effects: page scrolls
#
#----------------------------------------------------------------
#
proc omScrollPage { win n } {
    tkTextScrollPages $win $n
    set bbox [$win bbox insert]
    if { "" == "$bbox" } {
	if { $n > 0 } {
	    $win mark set insert @0,0
	} else {$win mark set insert @0,[$win cget -height]}
    }
}

proc addTagSameRange { win oldtag newtag index } {
    if { [lsearch [$win tag names $index] $oldtag ] >= 0 } {
	set this [$win tag prevrange $oldtag $index+1char]
	if { "$this" != "" && [$win compare $index < [lindex $this 1]] } {
	    $win tag remove $newtag 0.0 end
	    $win tag add $newtag [lindex $this 0] [lindex $this 1]
	    $win tag raise $newtag
	}
    }
}

proc getBaseprogram { } {
    return [lindex  $::xmaxima_default(defaultservers) 0]
}

#mike FIXME: This is an abomination
proc fileBaseprogram { textwin parent x y } {
    set e $textwin.e
    catch { destroy $e }
    set x [expr {[winfo rootx $parent] + $x +30 - [winfo rootx $textwin]} ]
    set x 30
    set y [expr {[winfo rooty $parent] + $y - [winfo rooty $textwin]} ]
    global xHMpriv
    set xHMpriv(baseprogram) [encodeURL [oget $textwin baseprogram]]
    entry $e -width 40 -textvariable xHMpriv(baseprogram)
    place $e -in $textwin -x $x -y $y
    raise $e
    set com "destroy $e ; oset $textwin baseprogram \[decodeURL \$xHMpriv(baseprogram)] "
    bind $e <Leave> $com
    bind $e <Return> $com
}

proc fontDialog { top } {
    set font [xHMmapFont font:propor:normal:r:3]
    if {[winfo exists $top]} {catch { destroy $top }}

    toplevel $top
    wm iconify  $top

    set win $top.text
    text $win -font [list [font config $font -family] [font config $font -size]] -height 20
    wm deiconify $top

    foreach fam {propor fixed} {
	set lis ""
	set i 0
	while { $i <= 8 } {
	    lappend lis [expr {$i - 3}]
	    incr i
	}
	if { "$fam" == "fixed" } { set fixed 1 } else {
	    set fixed 0
	}
	mkLabelListBoxChooser $win.size$fam "list $lis" ::xmaxima_default($fam,adjust)
	mkLabelListBoxChooser $win.family$fam "getFontFamilies $fixed " ::xmaxima_default($fam)
	set fo [xHMmapFont "font:$fam:normal:r:3"]
	catch { set ::xmaxima_default($fam) [assoc -family [font actual $fo]]}
    }
    $win insert insert [mc "Font Settings\nThe proportional font is "]
    $win window create insert -window $win.familypropor
    $win insert insert [mc "with a size adjustment of "]
    $win window create insert -window $win.sizepropor
    $win insert insert [mc "\nThe fixed font is "]
    $win window create insert -window $win.familyfixed
    $win insert insert [mc "with a size adjustment of "]
    $win window create insert -window $win.sizefixed
    $win insert insert "\n"
    $win insert insert [mc "Default nmtp servers  "]
    global _servers
    set _servers $::xmaxima_default(defaultservers)
    entry $win.entry -textvariable _servers -width 40
    $win window create insert -window $win.entry
    $win insert insert "\n\n"
    $win insert insert [mc "http Proxy host and port:"]
    entry $win.entryproxy  -width 40
    catch { $win.entryproxy insert 0 $::xmaxima_priv(proxy,http) }
    $win window create insert -window $win.entryproxy
    $win insert insert [mc "\nIf you are behind a firewall enter the name of your http proxy host and port,\n eg: `some.server.example.org 3128', otherwise leave this blank"]

    set men [tk_optionMenu $win.plottype ::xmaxima_default(plotwindow) embedded separate multiple ]
    $win insert insert [mc "\nShould plot windows be "]
    $win window create insert -window $win.plottype
    $win insert insert "?"
    $win insert insert "\n\n\n"
    $win insert insert [mc " Apply and Quit "] "bye raised"
    $win insert insert "      "
    $win insert insert [mc " Apply "] "click raised"
    $win insert insert "      "
    $win insert insert [mc " Cancel "] "cancel raised"
    proc _FontDialogApply { win } {
	global _servers ::xmaxima_priv
	set ::xmaxima_default(defaultservers) $_servers
	catch {xHMresetFonts .}
	if { [llength [$win.entryproxy get]] == 2 } {
	    set ::xmaxima_priv(proxy,http) [$win.entryproxy get]
	}
    }
    $win tag bind click <1> "_FontDialogApply $win"
    $win tag bind bye <1> "_FontDialogApply $win ; destroy $top"
    $win tag bind cancel <1> "destroy $top"
    $win tag configure raised -relief raised -borderwidth 2
    $win insert insert "      "
    $win insert insert [mc " Save Preferences "] "save raised"
    $win tag bind save <1> "_FontDialogApply $win ; savePreferences"
    pack $win
    #    place $win -in [oget [omPanel .] textwin] -x 10 -y 10
}

proc savePreferences {} {
    makeLocal {.maxima.text} inputs

    # Save current console size in ::xmaxima_default
    set console [lindex [array get ::xmaxima_priv cConsoleText] end]
    set ::xmaxima_default(iConsoleWidth) [textWindowWidth $console]
    set ::xmaxima_default(iConsoleHeight) [textWindowHeight $console]

    catch {
        # Save the state of the browser (1=opened, 0=closed)
        if {[winfo exists .browser]} {
            set ::xmaxima_default(browser) 1
        } else {
            set ::xmaxima_default(browser) 0}

        # Save the ::xmaxima_default array into $::xmaxima_priv(conffile)
        # Each line will contain a key and value separated by space
        # and the keys will be in alphabetical order
        #
        set fileId [open $::xmaxima_priv(conffile) w]
        foreach {k v} [array get ::xmaxima_default *] {
            lappend all [list $k $v]
        }
        set all [lsort $all]
        foreach v $all { puts $fileId $v }

        #mike FIXME: make this a _default
        # if { [info exists ::xmaxima_priv(proxy,http)] && \
        #          [llength $::xmaxima_priv(proxy,http)] == 2   } {
        #     puts $fileId [list array set ::xmaxima_priv [array get ::xmaxima_priv proxy,http]
	# 	 ]
        # }   Villate: This block seems wrong to me.
        
        close $fileId

        # Save the command history to $::xmaxima_priv(history)
        # Up to 200 last commands are saved, each one as a Tcl list
        #
        set fileId [open "$::xmaxima_priv(history)" w]
        foreach v [lrange $inputs end-199 end] { puts $fileId [list $v] }
        close $fileId
    }
}
#
#-----------------------------------------------------------------
#
# mkLabelListBoxChooser --  creates a button called WIN with textvariable
#  $TEXTVAR.  When clicked on the WIN, brings down
#  a list of items, and clicking on one of them selects that item. and
#  resets $TEXTVAR
#
#  Results: none
#
#  Side Effects: the TEXTVAR value is changed, and so consequently the label.
#
#----------------------------------------------------------------
#
proc mkLabelListBoxChooser { win items  textvar} {
    button $win -textvariable $textvar -command "listBoxChoose $win [list $items] $textvar"
}

proc listBoxChoose { win  items textvar  } {
    set whei [winfo height $win]
    set items [eval $items]
    set hei [llength $items]
    set fr ${win}frame
    frame ${win}frame
    set list $fr.list
    set scroll $fr.scroll
    scrollbar $scroll -command "$list yview"
    listbox $list -yscroll "$scroll set" -setgrid 1 -height 8
    pack $scroll -side right -fill y
    pack $list -side left -expand 1 -fill both
    set wid 0
    foreach v $items {
	set xx [string length $v] ;
	set wid [expr {($xx > $wid ? $xx : $wid)}]
    }
    eval [concat $list insert 0 $items]
    catch { $list selection set [lsearch $items [set $textvar]] }
    bind $list <1> "set $textvar \[$list get \[$list nearest %y\]\]; destroy $fr"
    place $fr -in $win -x 0  -y 0 -anchor n
}

proc quoteForRegexp { s } {
    regsub -all {[\]\[$+()\\.?*]} $s {\\\0}  ans
    return $ans
}

###### Bindings.tcl ######
############################################################
# Netmath       Copyright (C) 1998 William F. Schelter     #
# For distribution under GNU public License.  See COPYING. #
############################################################

global NCtextHelp
set NCtextHelp [mc "
Bindings:
<Return>    This sends the current expression (ie where the insert
            cursor is)  for evaluation.
<Linefeed>  (Control-j) This inserts a newline, and is useful
            for entering multiline input.
<Control-k> Kills the current line and puts it in kill ring.
            Successive control-k's append their output together.
<Control-y> Yank out the last kill, Meta-y cycles through previous
            kills.
<Control-g> Interrupts the current computation.
<Alt-p>     Gets the previous input in the history of inputs; if the
            first input is reached, it proceeds to the last input. If
            some characters are written before clicking on Alt-p, only
            history items containing those characters will be considered.
<Alt-n>     Gets the next input in the history of inputs; if the end is
            reached, it proceeds to the first input. If some characters
            are written before clicking on Alt-n, only history items
            containing those characters will be considered.
<Alt-s>     Print again the Maxima input prompt.
"]

proc vMAXSetCNTextBindings {w} {
    # Prevent deleting output fields with BackSpace key
    bind CNtext <Key-BackSpace> {
	if {[lsearch [%W tag names [%W index insert-1c]] output] >= 0} break
    }

    # Disable default keyboard bindings in output fields 
    bind CNtext <Key> {
	if {[lsearch [%W tag names [%W index insert]] output] >= 0} break
    }

    # Keep only default bindings for the cursor movement keys
    foreach Key {<Left> <Right> <Up> <Down> <Next> <Prior> <Home> <End>
	<Shift-Left> <Shift-Right> <Shift-Up> <Shift-Down> <Shift-Home>
	<Shift-End> <Control-Shift-Home> <Control-Shift-End>
	<Control-a> <Control-b> <Control-e> <Control-f> <Control-n> <Control-p>
	<Control-Home> <Control-End> <Meta-less> <Meta-greater> <Meta-b>
	<Meta-f>} {
	bind CNtext $Key "# nothing"
    }
	
    # The "Return" key is bound to command evaluation, except in output tags
    bind CNtext <Return> {
	if {[lsearch [%W tag names [%W index insert]] output] >= 0} {
	    break
	} else {
	    CMeval %W
	    break
	}
    }

    # Special keys (see NCtextHelp above for explanation)
    bind CNtext <Control-g> "CMinterrupt %W "
    bind CNtext <Control-G> "CMinterrupt %W "
    bind CNtext <Control-u> "CNclearinput %W "
    bind CNtext <Control-U> "CNclearinput %W "
    bind CNtext "\)"  "CNblinkMatchingParen %W %A"
    bind CNtext "\]"  "CNblinkMatchingParen %W %A"
    bind CNtext "\}"  "CNblinkMatchingParen %W %A"
    bind CNtext <Control-j> "tkTextInsert %W %A ; openMathAnyKey %W %K  %A"
    bind CNtext <Control-J> "tkTextInsert %W %A ; openMathAnyKey %W %K  %A"
    bind CNtext <Alt-p>  "CNpreviousInput $w -1"
    bind CNtext <Alt-P>  "CNpreviousInput $w -1"
    bind CNtext <Alt-n>  "CNpreviousInput $w 1"
    bind CNtext <Alt-N>  "CNpreviousInput $w 1"
    bind CNtext <Alt-s>  {sendMaxima %W ":s\n" }
    bind CNtext <Alt-S>  {sendMaxima %W ":s\n" }
    bind CNtext <Control-Key-c>  {tk_textCopy %W ;break}
    bind CNtext <Control-Key-C>  {tk_textCopy %W ;break}
    bind CNtext <Control-Key-x>  {tk_textCut %W ;break}
    bind CNtext <Control-Key-X>  {tk_textCut %W ;break}
    bind CNtext <Control-Key-v>  {tk_textPaste %W ;break}
    bind CNtext <Control-Key-V>  {tk_textPaste %W ;break}
}

set ::xmaxima_priv(doublek) 0

bind OpenMathText <Control-Key-k><Control-Key-k> {
    set ::xmaxima_priv(doublek) 1
}
bind OpenMathText <Control-Key-K><Control-Key-K> {
    set ::xmaxima_priv(doublek) 1
}

if {0} {
    # xmaxima should not be binding the Text class
    if {! [info exists ::xmaxima_priv(bindings_added) ] } {
	bind Text <Control-Key-k> "+openMathControlK %W"
	bind Text <B3-Motion> [bind Text <B2-Motion>]
	bind Text <Button-3> [bind Text <Button-2>]

	set ::xmaxima_priv(bindings_added) 1
    }
} else {
    bind OpenMathText <Control-Key-k> "+openMathControlK %W"
    bind OpenMathText <Control-Key-K> "+openMathControlK %W"
}

#mike - I'm decreeing windows Cut/Copy/Paste conventions for
# keybindings, and will preobably reserve Alt-key for menu shortcuts.

bind OpenMathText <Control-Key-y> "OpenMathYank %W 0; break"
bind OpenMathText <Alt-Key-y> "OpenMathYank %W 1; break"
bind OpenMathText <Meta-Key-y> "OpenMathYank %W 1; break"

# put the clipboard paste on Control-Shift-y
# event add <<Paste>> <Control-Shift-y>

# Copy
bind OpenMathText <Alt-Key-w> {
    pushCommand %W SaveSelection ""
    if { "[selection own -displayof %W]" == "%W"} {
	pushl [saveText %W sel.first sel.last] killRing
	selection clear -displayof %W
    }
}

bind OpenMathText <Key> {openMathAnyKey %W %K %A}
bind OpenMathText <Alt-Key> {openMathAnyKey %W %K ALT_%A}

# stop the double button click word selection in openMathText..
bind OpenMathText <Double-Button-1> { break; }
bind OpenMathText <Control-c><Key-e> {doInvoke %W insert ; break}

# ok - mark
bind OpenMathText <Control-Key-space> {
    pushCommand %W SetAnchor ""
    %W mark set anchor insert 
}

#
#-----------------------------------------------------------------
#
# binding --   push the current selection on the killRing, and
# if there is no selection, push the region between the anchor and
# the point.
#  Results:
#
#  Side Effects:
#
#----------------------------------------------------------------
#

bind OpenMathText <Control-Key-w> {
    pushCommand %W OpenMathTextCut ""
    # in the first case the <<Cut>> event on Text will delete the selection.
    if { [catch { pushl [saveText %W sel.first sel.last] killRing } ] } {
	catch {
	    set range [getRange %W anchor insert]
	    pushl [eval saveText %W $range] killRing
	    eval %W delete $range
	}
    }
}

proc openMathAnyKey { win keysym s  } {
    # puts "$win `$keysym' `$s'"
    if { "$s" != "" } {
	pushCommand $win openMathAnyKey [list $win  $keysym $s]
    }

    if { "$s" != "" && [doInsertp [$win tag names insert]]
	 && ("$s" == "$keysym"  || [regexp -- "\[\n\t \]" "$s" junk] )} {
	setModifiedFlag $win insert
    }
}

#mike this code is impenetrable:
proc OpenMathYank {win level} {
    #puts "doing OpenMathYank $win $level"
    if { $level == 0 } {
	set ::xmaxima_priv(currentwin) $win
	pushCommand $win OpenMathYank [list $win $level]
	set ::xmaxima_priv(point) insert
	$win mark set beforeyank insert
	$win mark gravity beforeyank left
	eval [peekl killRing "" ]
    } elseif { ![info exists ::xmaxima_priv(lastcom,$win)]} {
	#mike this case was not forseen in the code below and
	# it always occurs on the first Yank if nothing has benn Killed
    } elseif { [catch {
	set last $::xmaxima_priv(lastcom,$win)
	set m [lindex [lindex $last 1] 1]
	incr m
	if { [lindex $last 0] == "OpenMathYank" && \
		"$::xmaxima_priv(currentwin)" == "$win" && \
		"$::xmaxima_priv(point)" == "insert"} {
	    set doit 1
	} else {
	    #mike the following was missing, and its 
	    # lack was obscurred by the catch
  	    set doit 0
	}
    } err] || "$doit" == "0"} {
	pushCommand $win Error "" 
    } else {
	set res [peekl killRing _none_ [expr {$m + 1}]]
	if { "$res" == "_none_" } {
	    # this will cause to cycle
	    set m 0
	} else {
	    $win delete beforeyank insert
	    eval $res
	}
	pushCommand $win OpenMathYank [list $win $m]
    }
    catch {$win see insert}
}

proc saveText { win args } {

    if {[catch {$win index [lindex $args 1 ]} endregion]} {return ""}

    set tags [ldelete sel  [$win tag names]]
    set prev [lindex $args 0]

    if { "$prev" == "" } {set prev 0.0 }
    if { "$endregion" == "" } {set endregion end}

    set allar($prev) 1
    set allar($endregion) 1
    foreach v $tags {
	set ranges [tagRanges $win $v  $prev $endregion]
	foreach {begin end} $ranges {
	    lappend start($begin) $v
	    lappend stop($end) $v
	    set allar($begin) 1
	    set allar($end) 1
	
	}
    }
    proc __comp { a b} " return  \[$win compare \$a > \$b \] "
    set all [lsort -command __comp [array names allar]]
    set result ""
    foreach v $all {
	append result "Tins [list [array names currentTags]] [quoteBraces [$win get $prev $v]]\n"
	set prev $v


	if { [info exists start($v)] } {

	    foreach u $start($v) { set currentTags($u) 1}
	}

	if { [info exists stop($v)] } {

	    foreach u $stop($v) { unset currentTags($u) }
	}



	#puts -nonewline "..deleting{$stop($v)} giving {$currentTags}"

	# puts ">>"

    }
    return $result
}

proc openMathControlK { win } {
    if { $::xmaxima_priv(doublek) != 0 } {
	set now [popl killRing ""]
    } else {
	set now ""
    }
    set ::xmaxima_priv(doublek) 0
    if { [$win compare insert == "insert lineend" ]  } {
	if { [$win compare insert < end] } {
	    append now "\nTins {[ldelete sel [$win tag names insert]]} {\n}"
	} } else {
	    append now "\n[saveText $win insert {insert lineend}]"
	}
    pushl $now killRing
}


###### wmenu.tcl ###########################################
#
# Copyright (C) 1998 William F. Schelter
# For distribution under GNU public License.  See COPYING.tcl
#
############################################################

# implement a menu bar without toplevel windows.
# wet

proc wmenubar { name  } {
    if { "[string index $name 0]" == "." } {
	frame $name
	# puts "rename $name $name-orig"
	rename $name $name-orig
	set top [winfo toplevel $name]
	oset $top helpwin ""
	proc $name { option args } "wmenubarInternal $name \$option \$args"
	set parent [winfo parent $name]
	# maybe change this to do traversal toward side leaving on..
	oset $name items ""
    } else {
	error [mc "needs a window name arg"]
    }
}


proc eswitch { key lis } {
    foreach {k act} $lis { lappend allowd $k}
    lappend lis default [concat [mc "error"] "$key" [mc "must be one of:"] "$allowd"]
    uplevel 1 switch -- $key  [list  $lis]
}

proc ogetr { win var dflt } {
    set w $win
    while { 1 } {
	if { 0 == [catch { set val [oget $w $var] }] } {
	    return $val
	}
	global [oarray $w]
	# puts w=$w,[array get [oarray $w]]
	set w [winfo parent $w]
	if { "$w" == "" } {return $dflt}
    }
}

proc deleteHelp { win } {
    #mike FIXME: This is being called even if show_balloons = 0
    linkLocal $win helpPending
    if { [info exists  helpPending] } {
	after cancel $helpPending
	unset helpPending
    }
    set top [winfo toplevel $win]
    set helpwin [oget $top helpwin]
    if {$helpwin != "" && [winfo exists $helpwin]} {
	place forget $helpwin
    }
}

proc setHelp {win  help args } {
    # set c [ogetr $win c "cant"]
    if { "$help" == "" } {set help [concat [mc "This is a menu window"] "$win"]}
    set enter ""
    set exit ""
    if  { [catch { set current [$win cget -relief] } ] || "$current" \
	    != "flat" } {
	set enter ""
	set exit ""
    } else {
	set enter "$win configure -relief raised" ;
	set exit "$win configure -relief $current"
    }
    # puts "current=$current"

    bind $win <Enter> "$enter; showHelp $win  {$help} $args"
    bind $win <Leave> "$exit; deleteHelp $win"
}


#
#-----------------------------------------------------------------
#
# showHelp --  for WINDOW show a HELP message using ANCHOR positions.
#  WINDOW may be a window or a rectangle specifier: x,y,wid,height
#  ANCHOR positions may be either n,w,e,s,nw,ne,se,sw,center or
#  one of these followed by two floating point numbers indicating
#  the fraction of the width and height of the window one is away from
#  the upper left x,y of the window.
#  Results: none
#
#  Side Effects: display a window.
#
#----------------------------------------------------------------
#
proc showHelp { win help args } {
    global show_balloons helpwin
    if { $show_balloons == 0 } {
	#mike FIXME: $win is a list not a window
	set top [winfo toplevel [lindex $win 0]]
	set helpwin [oget $top helpwin]
	if {$helpwin != "" && [winfo exists $helpwin]} {
	    place forget $helpwin 
	}
	return
    }
    linkLocal [lindex $win 0] helpPending
    #mike FIXME: $win is a list not a window - needs an eval
    set helpPending [after 1000 [list showHelp1 $win $help $args]]
}

proc showHelp1 { win help args } {
    global  tk_version
    set top [winfo toplevel [lindex $win 0]]
    #    set anchors $args
    #    append anchors "  w  e s ne n sw nw"
    #    set anchors " nw"
    #    set anchors "w e n {nw .2 1.2} {ne .8 1.2} s se"
    #     set anchors "w e n {nw .2 1.2} {ne .8 1.2} s se"
    set anchors "sw w e n {nw .2 1.2} {ne .8 1.2} s se"
    makeLocal $top helpwin
    if { "$helpwin" == "" } {
	set tt $top
	if { "$tt" == "." } {set tt ""}
	set helpwin $tt.balloonhelpwin
	if { ![winfo exists $helpwin] } {
	
	    label $helpwin -width 0 -height 0  -borderwidth 1 \
		    -background beige -padx 4 -pady 4 -justify left
	}
	$helpwin config -relief solid
	
	oset $top helpwin $helpwin
    }
    if { [string first _eval $help ] == 0 } {
	catch { set help [eval [concat list [lindex $help 1]]]}
    }

    $helpwin configure -text $help \
	-wraplength [expr {round(.34 * [winfo width $top])}]
    global anchorPositions
    if { [llength $win] == 5 } {
	desetq "win wx wy wxdim wydim" $win
    }  else {
	set wx [expr {[winfo rootx $win ] - [winfo rootx $top]}]
	set wy [expr {[winfo rooty $win ] - [winfo rooty $top]}]
	set wxdim [winfo width $win]
	set wydim [winfo height $win]
    }
    set nxdim [winfo reqwidth $helpwin]
    set nydim [winfo reqheight $helpwin]
    set topxdim  [winfo width $top]
    set topydim  [winfo height $top]
    global anchorPositions
    foreach an $anchors {
	if {[llength $an] == 3} {
	    desetq "an rx ry" $an
	} else {
	    desetq "rx ry" [lsublis { {0 1.1 } {1 -.1}} $anchorPositions($an)]
	}
	# puts "rx=$rx,ry=$ry"
	set yoff [expr { $ry > 1 ? 8 : $ry < 0 ? -8 : 0 } ]
	desetq "x y" [getPlaceCoords 0 $yoff $rx $ry $an $wx $wy $wxdim $wydim $nxdim $nydim]
	# puts "for $win $an rx=$rx,ry=$ry x=$x,y=$y :[expr {$x >5}],[expr {$y > 5}],[expr {$x+$nxdim < $topxdim}],[expr {$y +$nydim < $topydim}]"
	if { $x > 5 && $y > 5 && $x+$nxdim < $topxdim && \
		$y +$nydim < $topydim } {
	    place forget $helpwin

    	    place $helpwin -x $x -y $y -anchor nw
	    after idle raise $helpwin
	    return
	}
    }
}

proc wmenubarInternal { win  option  lis } {
    # puts "{wmenubarInternal $win $option $lis}"
    set key [lindex $lis 0]
    set lis [lrange $lis 1 end]
    eswitch $option {
	add {
	    set parent [winfo parent $win]
	    if { "$parent" == "."} {set parent ""}
	    set men [assoc -menu $lis $parent.item[llength [oget $win items]]]
 	    bindAltForUnderline $key "wmenuPost $key"
	    frame $men -relief raised -borderwidth 2p
	    setHelp $key [assoc -help $lis] n nw ne
	    rename $men $men-orig
	    set body "wmenuInternal $key \$option \$args"
	    proc $men {option args } $body
	    pack $key -in $win -side left -expand 0 -fill both
	    global [oarray $win]
	    lappend [oloc $win items] $key
	    oset $key menu $men
	    oset $men items ""
	    oset $key parent $win
	    bind $key <Button-1>  {wmenuPost %W}
	    return $men
	}
	configure {
	    return [eval $win-orig configure $key $lis]

	}
	invoke {
	    set w [lindex [oget $win items] $key]
	    wmenuPost $w
	}
	cget {
	    return [eval $win cget $key $lis]
	}
    }
}

proc getSomeOpts { opts lis } {
    set answer ""
    foreach {ke val } $lis {
	if { [lsearch $opts $ke] >= 0  } {
	    lappend answer $ke $val
	}
    }
    return $answer
}

proc excludeSomeOpts { opts lis } {
    set answer ""
    foreach {ke val } $lis {
	if { [lsearch $opts $ke] < 0  } {
	    lappend answer $ke $val
	}
    }
    return $answer
}

proc lsublis { subs lis } {
    foreach v $subs {
	set key [lindex $v 0]
	while { [set i [lsearch $lis $key]] >= 0 } {
	    if { [llength $v] > 1 } {
		set lis [lreplace $lis $i $i [lindex $v 1]]
	    } else {
		set lis [lreplace $lis $i $i]
	    }
	}
    }
    return $lis
}

proc wmenuInternal {win option  olist } {
    set key [lindex $olist 0]
    set lis [lrange $olist 1 end]
    makeLocal $win menu parent
    makeLocal $menu items
    eswitch $option {
	add {
	    if { [catch {set counter [oget $menu counter] }] }   {
		set counter 0
	    }
	    oset $menu counter [incr counter]
	    # set new to be the new menu item window
	    # set com to be the command for 'invoke' to invoke.
	    set opts [excludeSomeOpts "-textvariable -image -label -underline -help" $lis]
	    set labopts [lsublis {{-label -text}} \
		    [getSomeOpts "-image -label -textvariable -underline" $lis]]
	    append labopts " -justify left -anchor w -padx 2"
	    eswitch $key {
		radio {
		    set new $menu.fr$counter
		    frame $new -borderwidth 1
		    # puts "new=$new"
		    label $new.label {*}$labopts
		    pack $new.label -side left -fill x
		    set opts [lsublis {{-radiovariable -textvariable}} $opts]
		    radiobutton $new.radio {*}$opts
		    pack $new.radio -side right -anchor e
		    set com "$new.radio invoke"
		}
		check {
		    set new $menu.fr$counter
		    frame $new -borderwidth 1
		    # puts "new=$new"
		    label $new.label {*}$labopts
		    pack $new.label -side left
		    set opts [lsublis {{-checkvariable -textvariable}} $opts]
		    checkbutton $new.check {*}$opts
		    pack $new.check -side right
		    # puts "$var --> $val"
		    set com "$new.check invoke"
		}
		command {
		    set com [assoc -command $lis]
		    set new $menu.fr$counter
		    frame $new -borderwidth 1
		    label $new.label {*}$labopts
		    pack $new.label -in $new -side left
		    # puts "bind $new.label <Button-1> $com"
		    bind $new.label <Button-1> $com
		    bind $new <Button-1> $com
		}
		window {
		    set new [assoc -window $lis]
		    set com [assoc -command $lis list]
		}
		entry {
		    set new $menu.fr$counter
		    frame $new -borderwidth 1
		    label $new.label {*}$labopts
		    set opts [lsublis {{-entryvariable -textvariable}} $opts]
		    entry $new.entry {*}$opts
		    pack $new.label -side top -in $new -anchor w
		    pack $new.entry  -side top -in $new
		    set com "focus $new.entry"
		}
		separator {
		    set new $menu.sep$counter
		    frame $new -height 4
		    propagate $new 0
		    set com ""
		}
		
	    }
	    bindAltForUnderline $new.label "$menu invoke $new"
	    pack $new -in $menu -side top -fill both -expand 0
	    oset $menu items [lappend items $new]
	    oset $menu command$new $com
	    setHelp $new [assoc -help $lis] w e
	    return $new
	}
	configure {
	    return [eval $win configure $key $lis]
	}
	invoke {
	    makeLocal $menu items
	    if { ![winfo exists $key] }  {
		# it is an index
		set key [lindex $items $key]
	    }
	    eval [oget $menu command$key]
	    return
	}
	post {
	
	    place $menu -anchor nw -relx 0 -rely 0 -bordermode outside -in $win
	    bind $menu <Leave> "place forget $menu"
	    focus $menu
	    #bind $menu <FocusIn> "puts focus in"
	    #bind $menu <FocusOut> "puts {leave for focus  menu}"
	    raise $menu
	}
    }
}

proc wmenuPost { win } {
    makeLocal $win parent menu
    bind $menu <Leave> "place forget $menu"
    place $menu -anchor nw -relx 0 -rely 1.0 -bordermode outside -in $win
    raise $menu
}

proc bindAltForUnderline { item command } {
    set ind -1
    catch { set ind [$item cget -underline] }
    if { $ind >= 0 } {
	set letter [string index [$item cget -text] $ind]
	set to [winfo toplevel $item]
	bind $to <Alt-Key-$letter> $command
    }
}

proc showSomeEvents { win } {
    foreach v { Enter FocusIn FocusOut Visibility Leave} {  
	bind $win <$v> "puts {$win $v %x %y}"
    }
}

global anchorPositions
array set anchorPositions {
    n {.5 0} nw { 0 0 } se {1 1} e {1 .5} center {.5 .5}
    s { .5 1} sw { 0 1} w { 0 .5} ne { 0 1}
}

proc getPlaceCoords { x y relx rely anchor xIn yIn xdimIn ydimIn xdim ydim } {
    global anchorPositions

    # puts "xIn=$xIn,yIn=$yIn,xdimIn=$xdimIn,ydimIn=$ydimIn,xdim=$xdim,ydim=$ydim"
    set x1 [expr {$x + $xIn+$relx * $xdimIn}]
    set y1 [expr {$y + $yIn+$rely * $ydimIn}]
    desetq "fx1 fy1" $anchorPositions($anchor)
    set atx [expr {$x1 - $fx1*$xdim}]
    set aty [expr {$y1 - $fy1*$ydim}]

    return [list $atx $aty]
}

## endsource wmenu.tcl
###### Myhtml.tcl ######
############################################################
# Netmath       Copyright (C) 1998 William F. Schelter     #
# For distribution under GNU public License.  See COPYING. #
############################################################

# parsing routines for html
# try to be compatible from calling level with the package by stephen uhler.
# to use:
#  set html [exec cat /home/wfs/tclet/server/sample.html] ; xHMinit_win .t ; xHMset_state .t url sample.html ; xHMparse_html $html "xHMrender .t" ;     array set wvar $args
# source myhtml.tcl ; catch {destroy .t } ; text .t ;  set html [exec cat /home/wfs/tclet/server/sample.html] ; xHMinit_win .t ; xHMset_state .t url sample.html ; xHMparse_html $html "xHMrender .t"

proc testit { file } {
    global xHMpriv
    source myhtml.tcl
    catch {destroy .t }
    foreach {k val} [array get xHMpriv geom*] {unset xHMpriv($k) }
    frame .t
    text .t.text
    set t .t.text
    set html [exec cat $file]
    xHMinit_win $t
    xHMset_state $t url $file
    xHMparse_html $html "xHMrender $t"
    pack .t
    pack $t
    raise .
}

#
#     xHMparse_html $html "xHMrender .t"
# you can change the state of the parse engine by using
#    xHMset_state .t key1 val1 key2 val2...

#########

#  the HTML tags:

# becomes

# idea: some tags like font,indent,link have only one per but the tag
# varies..  others have a constant tag... eg 'strike' 'underline' ...
# or fill.  You cant have
# and are either on or off...
# have pushConstantTag win tag
# have popConstantTag win tag
# have pushNamedTag win name tag
# have popNamedTag win name tag   :sets current to be this one and pushes previous..
# and these maintain things so that
# [array names xHMtaglist$win] should provide the taglist to do

proc xHMpushConstantTag { win tag } {
    upvar #0 xHMtaglist$win taglist
    if { [catch {incr taglist($tag) } ] } {
	set taglist($tag) 1 }
}

proc xHMpopConstantTag {win tag} {
    upvar #0 xHMtaglist$win taglist
    catch {
	set i [incr  taglist($tag) -1]
	if { $i <= 0 } {unset taglist($tag) }
    }
}

proc xHMpushNamedTag {win name tag} {
     upvar #0 xHMvar$win wvar
    #puts "push $win <$name> <$tag>"
    if { [catch { set now [lindex [set wvar($name)] end] }] } {
	set now "" }
    lappend wvar($name) $tag
}

proc xHMpopNamedTag {win name} {
    upvar #0 xHMvar$win wvar
    set v [set wvar($name)]
    set now [lindex $v end]
    catch { set v [lreplace $v end end] }
    set wvar($name) $v
    return $now
}

proc xHMgetNamedTag {win tag } {
    upvar #0 xHMvar$win wvar
    set res ""
    catch  { set res [lindex $win($tag) end] }
    return $res
}

proc xHMpushAindent { win i } {
    upvar #0 xHMvar$win wvar
    upvar #0 xHMtaglist$win taglist
    set n [incr wvar(indent) $i]
    # puts "taglist:[array names taglist ]"
    unset taglist(indent:[expr {$n - $i}])
    set taglist(indent:$n) 1
}

proc xHMpopAindent { win i } {
    upvar #0 xHMtaglist$win taglist
    upvar #0 xHMvar$win wvar
    set n 0
    set n [set wvar(indent)]

    unset taglist(indent:$n)
    set n [expr {$n - $i}]
    if { $n < 0 } { set n 0 }
    set wvar(indent) $n
    set taglist(indent:$n) 1

}

# font and indent wil


#
 #-----------------------------------------------------------------
 #
 # defTag --  creates an executable scripts to invoke when the TAG
 #  or /TAG are encountered.
 #     -alter  takes a list of key1 val1 key2 val2
 #         generally these are pushed onto stacks for TAG and popped for /TAG
 #         the value of xHMtaglist$win  should get altered
 #     -before  set the prefix for text inserted for TAG
 #     -after   set the prefix for text inserted for /TAG
 #     -body   additional body to use for TAG
 #     -sbody   additional body to use for the /TAG
 #  The variables { tag  params text }  are bound when
 #  the BODY is evaluated.   Thus for example $text would get the
 #  text following the tag, and
 # 	set paramList [xHMsplitParams $params]
 #  could be used to decode the params.
 #
 #  Results: none
 #
 #  Side Effects: saves the script in xHMtag array under TAG and /TAG
 #
 #----------------------------------------------------------------
#
proc defTag { htag args } {
    global xHMtag
    foreach {key val } $args { set $key $val }
    if { [info exists -alter] } {
	foreach { key tag } ${-alter} {
	    if { [string match A* $key] } {
		append body "\nxHMpush$key \$win $tag"
		append sbody "\nxHMpop$key \$win $tag"
	    } elseif { [string match C* $key] } {
		append body "\nxHMpushConstantTag \$win $tag"
		append sbody "\nxHMpopConstantTag \$win $tag"
	    } else {
		append body "\nxHMpushNamedTag \$win $key $tag"
		append sbody "\nxHMpopNamedTag \$win $key"
	    }
	}
	array set toalter ${-alter}
	foreach prop { family size weight style} {
	    if { [info exists toalter($prop)] } { append fontprops " $prop"}
	}
	catch {
	    append body "\nxHMalterFont \$win $fontprops"
	    append sbody "\nxHMalterFont \$win $fontprops"
	}
    }
    catch { append body \n${-body} }
    catch { append sbody \n${-sbody} }
    catch { append body "\nset prefix \"[slashNewline ${-before}]\"" }
    catch {append sbody "\nset prefix \"[slashNewline ${-after}]\""  }
    catch { set xHMtag($htag) $body }
    catch { set xHMtag(/$htag) $sbody }
}

proc slashNewline { s } {
    regsub -all "\n" $s "\\n" s
    return $s
}

# netscape uses fonts in the following progression.
# we will have the font labels looking like:
#  font:propor:normal:r:4   to indicate size 4
# In an application if the user sets the default
# nfont:nfamily:nweight:nstyle:nsize
# where nfamily is in {propor,fixed}
# where nweight is in {normal,bold}
# where nstyle  is in {i,r}
# where nsize   is in {1,2,3,4,5,6,7}
# then we map the label to a particular font....
# propor-->times
# fixed->courier

# set the font to be what it would map to for X.
proc xHMsetFont { win fonttag  } {
    upvar #0 xHMvar$win wvar
    set fo [xHMmapFont $fonttag]
    set wvar($fonttag) 1
    $win tag config $fonttag -font $fo
}


#convert a fonttag into an actual font specifier, using preferences.
# mapping propor,fixed to font families, and dobing size adjusting based
# on font type.
 proc xHMmapFont {  fonttag } {
    # font:family:weight:style:size
    global xHMfonts
    if { [info exists xHMfonts($fonttag) ] } {
	return $xHMfonts($fonttag)
    } else {
	set xHMfonts($fonttag) [set fo [font create]]
	xHMconfigFont $fonttag
	return $fo
	
    }
 }

 proc xHMconfigFont {  fonttag } {
    # font:family:weight:style:size
    global xHMfonts
    set font $xHMfonts($fonttag)
    set s [split $fonttag :]
    if {[llength $s] < "2"} {
	error [concat [mc "Internal font error:"] "$fonttag '$xHMfonts($fonttag)'"]
    }
    set fam [lindex $s 1]
    #puts "fam=$fam,fonttag=$fonttag,s=$s"
    if { "$fam" == "" } {
	set fam propor
    }
    set si [expr {$::xmaxima_default($fam,adjust) + [lindex $s 4]}]
    #set si [lindex $s 4]
    set si [expr {($si < 1 ? 1 : ($si > 8 ? 8 : $si))}]
    set elt [lindex $s 1]
    if {![info exists ::xmaxima_default($fam)]} {
	error [concat [mc "Internal font error:"] "'$fam'"]
    }
    set family $::xmaxima_default($fam)
    set weight [lindex $s 2]
    set slant [lindex $s 3]
    if { "$slant" == "i" } { 
	set slant italic
    } else {
	set slant roman
    }
    #puts "font config $font -family $family -size $::xmaxima_default($fam,$si) -slant $slant -weight $weight"
    if { "$::tcl_platform(platform)" == "unix" } {
	set usePixel "-"
    } else {
	set usePixel ""
    }
    font config $font -family $family -size $usePixel$::xmaxima_default($fam,$si) -slant $slant -weight $weight
    return
 }

 ### the following resets all the fonts
 ### for any windows now that font objects are interned

 proc xHMresetFonts { win } {
     global xHMfonts
     foreach v [array names xHMfonts] {
	 xHMconfigFont $v
     }
 }

proc xHMfontPointSize { string } {
    #mike FIXME: hard coded font name and $string is ignored
    set si [font config $string -size]
    return [expr { $si < 0 ? - $si : $si }]
}




proc xHMalterFont {win args } {
    upvar #0 xHMvar$win wvar
    upvar #0 xHMtaglist$win taglist

#    puts "font:$args,[array get wvar *]"
    foreach v {family weight style size adjust}  {
	set $v [lindex $wvar($v) end]
    }

    set si $size
    if { [catch { set si [expr {$si + $adjust}] }] } {
	# puts "too many pops"
	return
    }
    set font font:$family:$weight:$style:$si
    if { ![catch { set fo $wvar(font) }] } {
	catch { unset taglist($fo) } }
#    puts "font=$font, wvar=[array get wvar fon*]"
    set  wvar(font) $font
    if { ![info exists wvar($font)] } {
	xHMsetFont $win $font }
    set taglist($font) 1
	
   # return "-*-$family-$weight-$style-normal-*-*-${size}0-*-*-*-*-*-*"
}

proc xHMsplitParams { param } {
    if { "$param" == "" } { return ""}
   set reg "(\[^= \t\n\]+)\[ \t\n]*((=\[ \t\n]*((\"(\[^\"\]*)\")|('(\[^'\]*)')|(\[^ \t\n\]*)))|(\[ \t\n\])|\$)"

   # set sub "{1=\\1,2=\\2,3=\\3,4=\\4,5=\\5,6=\\6,7==\\7,8=\\8,9=\\9}"
   # regsub -all $reg $param $sub  joe
   # puts joe=$joe

    set sub "\\1\\6\\8\\9"
    regsub -all $reg $param $sub  joe
    foreach { dummy key val } [lreplace [split $joe ] end end]  { lappend new [string tolower $key] $val}
    return $new
}

proc xHMextract_param {paramList  key args} {
    foreach { k val } $paramList {
	if { "$k" == "$key" } {
	    uplevel 1 set $key [list $val]
	return 1}}
	if { "$args" != "" } {
	    uplevel 1 set $key  [list [lindex $args 0] ]
	}
	return 0
    }

global xHMtag
if {[info exists xHMtag]} {catch {unset xHMtag}}

defTag a -alter {Cdoaref doaref} -body xHMdo_a  -sbody xHMdo_/a
defTag b -alter {weight bold }
defTag -body xHMdo_body
defTag br -before "\n"
defTag center -alter {Ccenter center}
defTag cite -alter {style i}
defTag code -alter {family fixed}
defTag dd -before "\n" -after "\n"
defTag dfn -alter {style i}
defTag dt -before "\n"
defTag em -alter {style i}
defTag h1 -alter {size 7 weight bold} -body {xHMassureNewlines 1} -after "\n"
defTag h2 -alter {size 6} -body {xHMassureNewlines 1} -after "\n"
defTag h3 -alter {size 6} -body {xHMassureNewlines 1} -after "\n"
defTag h4 -alter {size 5} -body {xHMassureNewlines 1} -after "\n"
defTag h5 -alter {size 4} -before "\n" -after "\n"
defTag h6 -alter {size 3 style i} -before "\n" -after "\n"
defTag i -alter {style i}
defTag img -body xHMdo_img

defTag kbd -alter {family fixed weight bold}
defTag li -body xHMdo_li

defTag dl  -body xHMlistEnter -sbody xHMlistExit
defTag dir  -body xHMlistEnter -sbody xHMlistExit
defTag menu -body xHMlistEnter -sbody xHMlistExit
defTag ol  -body {
    xHMlistEnter
    set wvar(listindex$wvar(indent)) 0} -sbody {
	xHMlistExit }	

defTag title  -body {wm title [winfo toplevel $win] $text ; set text ""} -sbody {list }
defTag ul -alter {Aindent 1} -body { xHMlistEnter
  set paramList [xHMsplitParams $params]
  set _iii -1
  if { [xHMextract_param $paramList type ""] } {
      set _iii [lsearch {disc circle square} $type]
  }
  if { $_iii < 0 } {
      set _iii [expr {($wvar(indent)/2 > 3 ? 3 : $wvar(indent)/2) -1 }]
     if { $_iii < 0 } { set _iii 0}
  }
  # push an index which will say disc, circle or square.
  xHMpushNamedTag $win ultype $_iii
}  -sbody { xHMlistExit ; catch { xHMpopNamedTag $win ultype }}


#defTag p -before "\n\n" -sbody {}
#defTag p -before "\n\n" -sbody {}
defTag p -before "\n" -body { xHMassureNewlines 1 } -sbody { xHMassureNewlines 1 }
defTag blockquote -before "\n\n" -after "\n"
defTag pre -alter {family fixed Cnowrap nowrap} -before "\n" /pre "\n"
defTag samp -alter {family fixed}
defTag strike -alter {Cstrike strike}
defTag strong -alter {weight bold}
defTag sup -alter {Csup sup}
defTag sub -alter {Csub sub}

defTag tt -alter {family fixed}
defTag u -alter {Cunderline underline}

defTag hrx  -body { $win insert $wvar(W_insert) "\n" ;
     $win insert $wvar(W_insert) "\n" hrule
    } -sbody {}
defTag hr -before \n  -body {
     $win insert $wvar(W_insert) "                  " underline
    } -sbody {}

defTag var -alter {style i}

defTag hmstart -alter {	family propor   weight normal   style r   size 3
	list list
        adjust 0 } -body { set wvar(counter) 0 }

defTag font -body {
    set paramList [xHMsplitParams $params]
    xHMpushNamedTag $win adjust [assoc size $paramList 0]
    xHMalterFont $win adjust
    }  -sbody {
	xHMpopNamedTag $win adjust
	xHMalterFont $win adjust
    }

proc notyet { args } {
    puts [concat [mc "not yet"] "$args"]
}

defTag isindex -body xHMdo_isindex -sbody {}
defTag meta -body list -sbody list
defTag form  -before "\n" -after "\n"  -body {
    global xHMpriv
    set xHMpriv(form) [gensym form]
    upvar #0 $xHMpriv(form) form
    set paramList [xHMsplitParams $params]
    #puts "paramList=$paramList"
    if { [xHMextract_param $paramList action ""] } {
	set form(action) $action
    }
    xHMextract_param $paramList method "get"
    set form(method) $method

  } -sbody { global xHMpriv ;
    if { [info exists xHMpriv(form) ] } {
	upvar #0 $xHMpriv(form) form
	#puts form=$xHMpriv(form)
	#puts "form values=[array get form]"

	if { ![info exists form(f_has_submit)] } {
	    set params ""
	    xHMtextInsert $win "\n"
	    xHMdo_input submit
	}
	unset xHMpriv(form)
     }
    }
defTag input -body xHMdo_input
defTag select -body "xHMdo_input select" -sbody {
#    puts wvar=[array get wvar f_in_select]
    #catch {
    global xHMpriv
    upvar #0 $xHMpriv(form) form
    puts "\[array get wvar f_in_select*]=[array get wvar f_in_select*]"
    set na [lindex $wvar(f_in_select) 0]
     	
    set w $form(f_select,$na)
    foreach v [lrange $wvar(f_in_select) 1 end] {
	$w.list insert end $v
    }
    xHMresetListbox $w $wvar(f_selected,$na)
    append form(f_reset) " ; xHMresetListbox $w [list $wvar(f_selected,$na)]"
    #puts $w
    if { [winfo exists ${w}label] } {
	#puts "have label $w and ${w}label"
	bind  ${w}label <1> "place $w -anchor center -relx 0 -rely 1.0 -bordermode outside -in ${w}label ; raise $w"
	bind  $w <Leave> "xHMresetListbox $w \[$w.list curselection\] ; place forget $w"
    }
    if { [$w.list cget -height] > 0  && [llength $wvar(f_select_values)] > [$w.list cget -height] } {
	scrollbar $w.scroll -orient v -command "$w.list yview" -takefocus 0
	$w.list configure -yscrollcommand "$w.scroll set"
	pack $w.scroll -side right -fill y
    }

    set form(f_select_list,$na) $wvar(f_select_values)
    if { [catch { unset wvar(f_selected,$na) }] } { puts "failed= unset wvar(f_selected,$na)"}
    if { [catch  { unset wvar(f_select_values) }] } { puts "failed=unset wvar(f_select_values)"}
    #}
}

proc   xHMresetListbox  { w selected } {
    $w.list selection clear 0 end
    foreach v $selected { $w.list selection set $v}
    set i 0
    if { [llength $selected] > 0 } {
	set i [lindex $selected 0]
    }
    if { [winfo exists ${w}label] } {
	${w}label configure -text [$w.list get $i]
    }
}

defTag textarea -body "xHMdo_input textarea"
proc configColor { args } {
    set color [lindex $args end]
    if { [catch { eval $args } ] } {
	set color [lindex $args end]
	set args [lreplace $args end end "#$color"]
	catch { eval $args }
    }
}


defTag html -body "list " -sbody "list "
defTag head -body "list " -sbody "list "
defTag body -body {
    #puts "<body $params> $text"
     set paramList [xHMsplitParams $params]
    if { [xHMextract_param $paramList bgcolor ""] } {
	configColor $win config -background $bgcolor
	configColor $win tag  config hrule -font {courier 2} -background $bgcolor
    }
    if { [xHMextract_param $paramList baseprogram ] } {
        oset $win baseprogram [resolveURL $baseprogram [oget $win baseprogram]]
	oset $win baseprogram [decodeURL $baseprogram]
    }


    set _text $text
    if { [xHMextract_param $paramList text ""] } {
	 configColor $win config -foreground $text
    }
    set text ${_text}
    foreach {ll tag} {evalrelief Teval resultrelief  Tresult aevalrelief currenteval resultmodifiedrelief Tmodified }  {
	if { [xHMextract_param $paramList $ll ""] } {
	    $win tag configure $tag -relief [set $ll]
	}
    }

    foreach {ll tag} {bgeval Teval bgresult Tresult bgresultmodified Tmodified bgaeval currenteval}  {
	if { [xHMextract_param $paramList $ll ""] } {
	      configColor $win tag configure $tag -background [set $ll]
	}
    }
    foreach {ll tag} {link href alink currenthrefforeground eval Teval result Tresult resultmodified Tmodified aeval currenteval}  {
	if { [xHMextract_param $paramList $ll ""] } {
	configColor $win tag configure $tag -foreground [set $ll]
	}
    }
   } -sbody "list "

defTag base -body {       set paramList [xHMsplitParams $params]
   if { [xHMextract_param $paramList href ""] } {
       set wvar(baseurl) $href
      #xHMset_state $win baseurl $href
       oset $win baseurl $href
   }
  }



defTag option -body { set text [string trimright $text]
       set paramList [xHMsplitParams $params]
       xHMextract_param $paramList value $text
       lappend wvar(f_select_values) $value
       lappend wvar(f_in_select) $text
       if { [xHMextract_param $paramList selected] } {
	   #puts "hi==wvar(f_selected,[lindex $wvar(f_in_select) 0])"
	   lappend wvar(f_selected,[lindex $wvar(f_in_select) 0]) [expr {[llength $wvar(f_in_select)] -2}]
       }
       set text ""
}

global xHMpriv
set xHMpriv(counter) 0

#
 #-----------------------------------------------------------------
 #
 # ldelete --  remove all copies of ITEM from LIST
 #
 #  Results: new list without item
 #
 #  Side Effects:
 #
 #----------------------------------------------------------------
#
proc ldelete { item list } {
    while { [set i [lsearch $list $item]] >= 0} {
	set list [lreplace $list $i $i]
    }
    return $list
}
if { ![info exists _gensymCounter] } {set _gensymCounter  0}
proc gensym { name } {
    global _gensymCounter
    incr _gensymCounter
    set var ${name}_${_gensymCounter}
    catch { uplevel "#0"  unset $var}
    return $var
}

proc xHMdo_input {{type ""}} {
    global xHMpriv
    if { ![info exists xHMpriv(form)] } {
	set xHMpriv(form) [gensym form]
    }
    upvar 1 win win
    upvar #0 $xHMpriv(form) form
    upvar #0 xHMvar$win wvar
    upvar 1 params params
    set form(url) $wvar(url)

    set paramList [xHMsplitParams $params]

    set w $win.input[incr wvar(counter)]
#    bindtags $w [ldelete maxlength [bindtags $w]]
    xHMextract_param $paramList name ""
   if { "$type" == "" } {
    xHMextract_param $paramList type text
   }
    xHMextract_param $paramList value ""
    set value  [xHMconvert_ampersand $value]
    switch -regexp -- $type {
	{text$|password|int$|string} {
	    xHMextract_param $paramList size 20
	    entry $w -width $size
	    if { "$type" == "password" } { $w config -show * }
	    if { [xHMextract_param $paramList maxlength] } {
		bindtags $w [concat [bindtags $w] maxlength]
		bind maxlength <KeyPress> "xHMdeleteTooLong $win %W"
		
		set wvar($w,maxlength) $maxlength
	    }

	    $w insert end $value

	    append form(f_reset) " ; $w delete 0 end ; $w insert end [list $value] "
	    set form(f_submit,$name) "$w get"
	}
	select {
	    xHMextract_param $paramList size 1
	    xHMextract_param $paramList mode single
	    set lis $w
	    if { $size == 1 } {
		set w ${w}label
		label $w -relief raised
	    }
	    frame $lis
	    listbox $lis.list  -selectmode $mode -width 0 -exportselection 0 -height [expr {$size > 1 ? $size : 0}]
	    pack $lis.list -side left

	    # will contain list "window value1 value2 value3 .."
	    # added to by <option>
	    set wvar(f_selected,$name) ""
	    set form(f_select,$name) $lis
	    set wvar(f_in_select) $name
	    set wvar(f_select_values) $name
	    # throw away any text after select
	    set text ""
	
	}
	textarea {
	    upvar 1 text text
	    xHMextract_param $paramList cols 30
	    xHMextract_param $paramList rows 5
	    catch {
	      frame $w
	      puts "w=$w"
	    scrollbar $w.yscroll -command "$w.text yview" -orient v
	    text $w.text -height $rows -width $cols -wrap none \
		    -yscrollcommand "$w.yscroll set"  -padx 2 -pady 2
	     $w.text insert 0.0 $text
	
	    set text ""
	    pack $w.text
	    set form(f_submit,$name) "$w.text get 0.0 end"
	    append form(f_reset) " ; $w.text delete 0.0 end ; $w.text insert end [list $text]"
	} errm ;
	    puts errm=$errm;
	
	}
	image {

	    xHMextract_param $paramList width 0
	    xHMextract_param $paramList height 0
	    xHMextract_param $paramList src "broken.ppm"
	    set form(f_has_submit) 1
	    catch { set base $wvar(url) ; set base $wvar(baseurl) }
	    label $w -image [xHMgetImage $win $src $base $width $height] \
		    -background [$win cget -background]
	    bind $w <ButtonRelease-1>   "xHMdoSubmit $w $xHMpriv(form) {$name.x %x $name.y %y}"
	    bind $w <Return> "xHMdoSubmit $w $xHMpriv(form) {$name.x 0 $name.y 0}"
	    bind $w <Leave> "$w configure -relief raised"
	
	    }
	radio {

	    if { [catch { set var $form(radio,$name) } ] } {
		set var [set form(radio,$name) [gensym radio_value]]
	    }
	    radiobutton $w -variable $var -value $value -text " "
	    if { [xHMextract_param $paramList checked] } {
		append form(f_reset) "; $w select"
		$w select
		
	    } else {
		append form(f_reset) "; $w deselect"
		$w deselect
		
	    }

	    set form(f_submit,$name) "uplevel #0 set $var"

	}
	checkbox {
	    ######### to do fix this..failed: http://www.ncsa.uiuc.edu/SDG/Software/Mosaic/Forms/example-4.html
	    if { [catch { set var $form(checkbox,$name) } ] } {
		set var [set form(checkbox,$name) [gensym checkbox_value]]
	    }
	    xHMextract_param $paramList value on
	    checkbutton $w -on $value -variable $var -off _dontsubmit_ \
		    -text " "

	    set form(f_submit,$name) "uplevel #0 set $var"
	
	    if { [xHMextract_param $paramList checked] } {
		append form(f_reset) " ; $w select"
		$w select;
	    } else {
		$w deselect
		append form(f_reset) " ; $w deselect"
	    }

	}
	hidden {
	    set form(f_submit,$name) "list  [list $value]"
	    set w ""
	}
	reset {
	    if { "$value" == "" } {set value "Reset"}
	    button $w -text $value -command "xHMdoReset $xHMpriv(form)"

	}
	submit {
	    set form(f_has_submit) 1
	    if { "$value" == "" } { set value "Submit Query" }
	    if { "$name" != "" } {
		button $w -text $value -command [list xHMdoSubmit $w $xHMpriv(form) [list $name $value]]
	    } else {
		button $w -text $value -command "xHMdoSubmit $w $xHMpriv(form) [list {}]"
	    }
	
	}
    }
#    if { [info exists form(f_submit,$name)] } {
#	lappend form(f_tosubmit) $name
#    }
    #dputs "type=$type,w=$w"
    #dputs "form(reset)=$form(f_reset)"
    if { "$w" != "" } {
	#catch { puts "class=[winfo class $w]" }
	if { [catch {   $win window create $wvar(W_insert) -window $w -align bottom -padx 1 -pady 1 } ] } {
	    puts [concat "$w" [mc "bad window"] "?"]
	}
	
	### todo handle focus of forms.. with tabbing.
	
    }

}

proc xHMsetSubmitPosition { formvar name x y } {
    upvar #0 $formvar form
    set form(f_submit,$name.x) "list $x"
    set form(f_submit,$name.y) "list $y"
}



proc xHMdoReset { formVar } {
    upvar #0 $formVar form
    eval $form(f_reset)
}
proc xHMdoSubmit { w formVar nameVals } {
    upvar #0 $formVar form
    set ans ""
    set win [omPanel $w]
    foreach { name value } $nameVals {
	puts "value=$value--><[xHMencode_get $value]>"
	if { "$name" != "" } { append ans "&$name=[xHMencode_get $value]"}
    }

#    foreach name $form(f_tosubmit) {
#	set val [eval $form(f_submit,$name)]
#	if { "$val" != "_dontsubmit_" } {
#	    append ans "&$name=[xHMencode_get $val]"
#	}
#    }
    set n [string length f_submit,]
    foreach {name value}  [array get form f_submit,* ] {
	 puts "form submit:[array get form f_submit,*]"
	set val [eval $value]
	puts "name=$name,val=$val-->[xHMencode_get $val]"
	if { "$val" != "_dontsubmit_" } {
	append ans "&[string range $name $n end]=[xHMencode_get $val]"
	}
    }
    # do the select listboxes:

    foreach { name w } [array get form f_select,*] {
	set name [string range $name [string length f_select,] end]
	
	set values [lrange $form(f_select_list,$name) 1 end]
	set ans1 ""

	foreach v [$w.list curselection] {
	    lappend ans1 [lindex $values $v]
	}
	puts w=$w.list,name=$name,ans1=$ans1,
	set ans1 [join $ans1 " "]
	append ans "&$name=[xHMencode_get $ans1]"
    }
    #puts ans=$ans
    #puts form=[array get form]
    set action $form(action)
    if { "[string tolower $form(method)]" == "get" } {
	xHMfindUrl $win $form(method) $form(action)?[string range $ans 1 end]
    } else {
	xHMfindUrl $win $form(method) $form(action) [string range $ans 1 end]
}
		}

proc xHMfindUrl { win method  url { body "" }} {
    #puts "$win,$method,$url,$body"
    set method "[string tolower $method]"
    if { "$method" == "get" } {
	OpenMathOpenUrl $url -commandpanel $win
    } elseif { "$method" == "post" } {
	if { "$body" == "" } {set body " "}
	OpenMathOpenUrl $url -commandpanel $win -post $body
    }
}

proc xHMdeleteTooLong { win w } {
    upvar #0 xHMvar$win wvar
    catch { $w delete $wvar($w,maxlength) end }
    #puts $wvar($w,maxlength)
}

proc xHMconvert_ampersand { text } {
    if {![regexp & $text]} {return $text}
    regsub  -all {([[\\])|(&((#([0-9][0-9]?[0-9]?))|([a-zA-Z]+));?)} $text {[xHM_do1 \\\1  \5 : \6]} tmp
    return [subst -novariables $tmp]
}

proc xHM_do1 { a b {c xx} } {
    global isoLatin1
   if { "$a" == " " } {
      if { "$b" == ":" } {
	  #set result ?
	  if { [catch { set result $isoLatin1($c) }] } {
	     return "&$c"
	  }
	  return $result
      } else {
	  return [format %c $b]
      }
   } else {
       return [string index $a 0]
   }
}

proc xHMdo_li {} {
    uplevel 1 {
	set i $wvar(indent)
	set taglist(listindex) 1
	set text [string trimleft $text]
	if { ![catch { incr wvar(listindex$i) }] } {
	    xHMpopAindent $win 1
	    xHMtextInsert $win "\n\t$wvar(listindex$i).\t"
	    xHMpushAindent $win 1
	} else {
	    set ii 0
	    catch { set ii [lindex $wvar(ultype) end] }
	    xHMpopAindent $win 1
	    xHMtextInsert $win "\n\t"
	    xHMinsertBullet $win $ii
	    xHMtextInsert $win "\t"
	    xHMpushAindent $win 1
	}
    unset  taglist(listindex)
 }
}

proc xHMinsertBullet { win i } {
    global xHMulBMPdata xHMpriv
    upvar #0 xHMvar$win wvar
    set fg [$win cget -foreground]
    set image ""
    if {[catch { set image $xHMpriv(ul,$fg,$i) }] } {
	catch { set image [set xHMpriv(ul,$fg,$i) [image create bitmap -data [lindex $xHMulBMPdata $i] -foreground $fg]] }
    }
    # if we cant get the image, or cant insert it fall back to
    # inserting a simple character
    if { "$image" == "" || [catch { $win  image create $wvar(W_insert) -image $image } ] } {
	if { $i > 2 } { set i 2}
	$win tag configure listindex -foreground red		
	xHMtextInsert $win [string range "oo*" $i $i]
    }
}

defTag th -body list
defTag td -body list -after "\t\t\t\t"
defTag tr -body list -after "\n"





proc xHMdo_a  {} {
   uplevel 1  {
       set paramList [xHMsplitParams $params]
       if { [xHMextract_param $paramList href] } {
	   # in case they forget </a>
	   foreach v [array names taglist h:*] {
	       unset taglist($v)
	   }
	   $win tag bind h:$href <Enter> "HMdoaref enter $win %x %y"
	   $win tag bind h:$href <Leave> "HMdoaref leave $win %x %y"
	   $win tag bind h:$href <1> "HMdoaref click $win %x %y"
	   set taglist(h:$href) 1
	   set taglist(href) 1
	
       }
       if { [xHMextract_param $paramList name] } {
	   $win mark set anchor:$name "$wvar(W_insert) -1 chars"
	   $win mark gravity anchor:$name left
	   }
       }
}

proc xHMdo_/a  {} {
    uplevel 1 {
	foreach v [array names taglist h:*] { unset taglist($v) }
	catch {unset taglist(href)}
    }
}

proc xHMdo_body { win } {
    global xHMOptions
    upvar 1 params params
    upvar #0 xHMvar$win wvar
    set paramList [xHMsplitParams $params]
    foreach {key val } $paramList {
	catch { $win config -$key $val }
	set wvar(option,$key) $val
    }
}

proc xHMdo_img {} {
    upvar 1 params params
    upvar 1 wvar wvar
    upvar 1 taglist taglist
    upvar 1 win win
    set paramList [xHMsplitParams $params]

    xHMextract_param $paramList align bottom
    xHMextract_param $paramList border 1
    xHMextract_param $paramList width 0
    xHMextract_param $paramList height 0
    xHMextract_param $paramList src ""
#    xHMextract_param $paramList alt <image:[file tail $src]>
    xHMextract_param $paramList alt <image:$src>
    #puts "img:$src,$alt,$width,$height"
    if { [lsearch {bottom top center} $align ] < 0 } { set align bottom}
	set w $win.fr[incr wvar(counter)]
    set base ""
    set bg [$win cget -background]

    catch { set base $wvar(url) ; set base $wvar(baseurl) }
    if { [catch { set im [xHMgetImage $win $src $base $width $height] }] } {
	error "dont get here now"
	frame $w -width $width -height $height -background $bg
	label $w.label -text $alt -background $bg
	if { $width && $height } { pack  propagate  $w 0 }
	pack $w.label -fill both -expand 1
    } else {
	if { $wvar(measure) >= 0 } {
	    incr wvar(measure) [image width $image]
	}
	label $w -image $im -background $bg
	bind $w <Enter> [list set ::xmaxima_priv(load_rate) "$alt" ]
	bind $w <Leave> [list set ::xmaxima_priv(load_rate) ""  ]

    }
    catch { $w configure -border $border}
    set href [lindex [array names taglist h:*] 0]
    if { "$href" != "" }  {
	bind $w <1> "OpenMathOpenUrl [string range $href 2 end] \
			-commandpanel [omPanel $win]"
    }
    foreach v [array names taglist] { $win tag add $v $wvar(W_insert)}
    $win window create $wvar(W_insert) -window $w -align $align -padx 1 -pady 1


## to do add links for call backs
}

# return an image object..
proc xHMgetImage {win src baseurl width height } {
#     puts "$win,$src,$baseurl,$width,$height"
#     puts "getImage [resolveURL $src [decodeURL $baseurl]] $width $height"
    return [getImage [resolveURL $src [decodeURL $baseurl]] $width $height]
}

proc xHMget { url } {
}

proc xHMlistEnter {} 	{
    uplevel 1 {
	xHMassureNewlines [expr {($wvar(indent) < 2 ?  1 : 0)}]
	set _ii [expr {(($wvar(indent) <= 0  ) ? 2 : 1)}]
	xHMpushAindent $win $_ii
	catch { unset wvar(listindex$wvar(indent))}
    }
}

proc xHMlistExit {} 	{
    uplevel 1 {
	set _ii [expr {($wvar(indent) <= 2) ? 2 : 1}]
	xHMpopAindent $win $_ii
	xHMassureNewlines [expr {($wvar(indent) < 2 ?  1 : 0)}]
	
    }
}

proc dupString { s n } {
    set ans ""
    while { [incr n -1] >= 0 } { append ans $s }
    return $ans
}

### to do fix this to see how many blank lines there are at our insert
### point and to insert ones to make up.
proc xHMassureNewlines { n } {

    uplevel 1 set _n $n
    uplevel 1 {
	set _have 0
	foreach _v [lrange [split [$win get "$wvar(W_insert)-4char" $wvar(W_insert)] \n] 1 end] {
	    if { [string trim "$_v"  " "] == "" } {
		incr _have
	    } else {
		set _have 0
	    }
	}
#    set _have  [$win  compare $wvar(W_insert) == "$wvar(W_insert) linestart"]
	xHMtextInsert $win [dupString "\n" [expr {$_n - $_have}]]
    }
}

proc xHMsetDefaultPreferences {} {
    if { "$::tcl_platform(platform)" == "unix" } {
	set pairs {  1 8
	    2 10
	    3 12
	    4 14
	    5 18
	    6 24
	    7 24
	    8 34	
	}
    } else {
	set pairs {  1 6
	    2 8
	    3 8
	    4 10
	    5 12
	    6 14
	    7 16
	    8 18	
	}
    }

    foreach fam {propor fixed} {
	foreach {n si} $pairs { set ::xmaxima_default($fam,$n) $si}
    }
    set ::xmaxima_default(propor,adjust) [expr {$::xmaxima_default(adjust) + 0}]
    set ::xmaxima_default(fixed,adjust) [expr {$::xmaxima_default(adjust)  + 0}]
    array set ::xmaxima_default { propor arial fixed courier  indentwidth .7 }
}

xHMsetDefaultPreferences

proc dputs {x} {
    puts $x ; flush stdout
}

proc xHMinit_state { win args } {
    upvar #0 xHMvar$win wvar
    upvar #0 xHMtaglist$win taglist
    array set saveme [array get wvar W_*]
    catch { unset wvar}
        catch { unset taglist}
    array set wvar {
	family propor   weight normal   style r   size 3
	list list
	indent 0
	adjust 0
	measure -1
	W_insert insert
	W_update 15
    }
    array set wvar [array get saveme]
    array set taglist {indent:0 1}

}

proc xHMrender { win tag  params text } {
    global xHMtag
    upvar #0 xHMtaglist$win taglist
    upvar #0 xHMvar$win wvar
    set prefix ""

    set tag [string tolower $tag]
    # the following will go in a catch after debugging:
    #dputs "doing <$tag>"
    #dputs text=<<$text>>
    # puts "xHMtag($tag)=[set xHMtag($tag)]"


   # eval [set xHMtag($tag)]
    if { [info exists xHMtag($tag)] } {
	# if { [catch { eval [set xHMtag($tag)] }] } { puts [concat [mc "error evaling tag:"] "$tag"] }
	eval [set xHMtag($tag)]
    } else {
	if { [string match "!--*" $tag] } { list} else {
	#puts "undefined $tag: puts comment:$text"
    }
		}


    if { [regexp & $text] }  {
       set text [xHMconvert_ampersand $text]
    }

    #dputs "nowrap=[info exists taglist(nowrap)]"
    if { ![info exists taglist(nowrap)] } {
	regsub -all "\[ \t\r\n\]+" $text " " text
	if { "$prefix" != "" } { set text [string trimleft $text] }
    }
    xHMtextInsert $win $prefix$text
}

# make a copy of it.
proc xHMrender_orig [info args xHMrender] [info body xHMrender]


proc xHMtextInsert { win text } {
    global xHMtaglist$win
    upvar #0 xHMvar$win wvar
    # dputs "$win insert $wvar(W_insert) [list $text] [list [array names xHMtaglist$win ]]"
    # we calculate the longest unbroken line...
    if { 0 && $wvar(measure) >= 0 } {
	# puts "hi"
	set fo [xHMmapFont  $wvar(font)]
	set lis [split $text \n]
	set ll [font measure $fo [lindex $lis 0]]
	incr wvar(measure) $ll
	foreach vv [lrange $lis 1 end] {
	    maxIn wvar(maxwidth) $wvar(measure)
	    set wvar(measure)   [font measure $fo $vv]
	}
	maxIn wvar(maxwidth) $wvar(measure)
    }
    $win insert $wvar(W_insert) $text [array names xHMtaglist$win ]
}

proc xHMset_state { win args } {
    upvar #0 xHMvar$win wvar

    array set wvar $args

}

proc toPixelWidth { dim win } {
    if { [regexp {([.0-9]+)c} $dim junk d] } {
	return [expr {round($d*[winfo screenwidth $win] /(.1*[winfo screenmmwidth $win]))}] } else {
		return $dim}
    }
	

proc xHMinit_win { win } {
    upvar #0 xHMvar$win wvar
    # global xHMvar$win
   # catch { unset xHMvar$win }
    xHMinit_state $win
    $win config -font [xHMmapFont font:fixed:normal:r:3]
    catch { eval destroy [winfo children $win] }
    set iwidth [toPixelWidth  [set ::xmaxima_default(indentwidth)]c $win]
    # puts iwidth=$iwidth
    for { set i 0 } { $i < 12 } { incr i } {
	set half [expr {$iwidth/2.0 }]
	set w [expr {$i * $iwidth}]
	$win tag configure indent:$i -lmargin1 ${w} -lmargin2 ${w} -tabs \
		"[expr {$w + $half}] [expr {$w + 2*$half}]"
    }
   # $win tag bind doaref <Enter> "HMdoaref enter $win %x %y"
   # $win tag bind doaref <Leave> "HMdoaref leave $win %x %y"
   # $win tag bind doaref <1> "HMdoaref click $win %x %y"

    $win tag configure indent:0 -lmargin1 ${half} -lmargin2 ${half} -tabs "${half} [expr {2 * $half}]"
    $win tag configure href -borderwidth 2 -foreground blue -underline 1

    $win tag configure nowrap -wrap none
    $win tag configure rindent -rmargin $iwidth
    $win tag configure strike -overstrike 1

    $win tag configure underline -underline 1
    $win tag configure center -justify center
    $win configure -wrap word
}

global HMdefaultOptions
set HMdefaultOptions {
    {atagforeground blue "foreground for <a href=...>  tags"}
    {currenthrefforeground red "foreground of current <a href=..> tags"}
    {foreground black "foreground"}
    {background white "background "}
    {atagbackground blue "background for <a href=...>  tags" }
}

foreach v $HMdefaultOptions {set HMOption([lindex $v 0]) [lindex $v 1] }

proc xHMwget { win key dflt } {
    upvar #0 xHMvar$win wvar
    if { [info exists wvar($key)] } {
	return $wvar($key)
    } else {
	return $dflt
}
		}

proc HMdoaref { action win x y } {
    global HMOption
    set tags [$win tag names  @$x,$y ]
    set i [lsearch $tags h:*]
    set tag [lindex $tags $i]
    set reference [string range [lindex $tags $i] 2 end]
    # puts "$action $x $y"do_a
    switch -- $action {
	enter {
	    if { $i >= 0  }  {
		set ranges [$win tag ranges $tag]
		eval $win tag add currenthref $ranges
		textShowHelp $win currenthref @$x,$y [concat [mc "Click to follow link to"] "$reference"]

		$win tag bind $tag <Leave> "deleteHelp $win ;$win tag remove currenthref $ranges"
		$win tag  config currenthref -foreground [xHMwget $win option,atagforeground $HMOption(currenthrefforeground)] }
	    }
	click {
	    if { $i>= 0 } {
		global [oarray $win]
		if { [info exists [oloc $win dontopen]] } {
		    unset [oloc $win dontopen]
		} else {
		    oset $win dontopen 1
		    OpenMathOpenUrl $reference \
			    -commandpanel [omPanel $win]
		    catch {  unset [oloc $win dontopen] }
		}
		    return
	    }

	}
	    leave {
		
		$win tag delete currenthref
	    }
	}
    }

proc xHMdo_isindex {} {
    uplevel 1 {
	set paramList [xHMsplitParams $params]
	xHMextract_param $paramList prompt [mc " Enter search keywords: "]
	xHMtextInsert $win $prompt
	set w $win.entry[incr wvar(counter)]
	entry $w
	# puts "wvar=[array get wvar]"
        $win window create $wvar(W_insert) -window $w  -padx 1 -pady 1
	bind $w <Return> "xHMget $wvar(url)?\[xHMencode_get \[$w get\]\]"
    }
}

# encode a string where
#  " " --> "+"
#  "\n" --> "%0d%0a"
#  [a-zA-Z0-9] --> self
#   c --> [format %.2x $c]

# make a list of all characters, to get char code from char.
global xHMallchars
set xHMallchars ""
for { set i 1} { $i <256 } {incr i } { append xHMallchars [format %c $i] }

proc xHMhexChar { c } {
    global xHMallchars
    set i [string first $c $xHMallchars]
    return %[format %.2x [expr {$i + 1}]]
}

# "ISO 8879-1986//ENTITIES Added Latin 1 substitutions
array set isoLatin1 {
    	AElig \xc6 	Aacute \xc1 	Acirc \xc2 	Agrave \xc0
	Aring \xc5 	Atilde \xc3 	Auml \xc4 	Ccedil \xc7
	ETH \xd0 	Eacute \xc9 	Ecirc \xca 	Egrave \xc8
	Euml \xcb 	Iacute \xcd 	Icirc \xce 	Igrave \xcc
	Iuml \xcf 	Ntilde \xd1 	Oacute \xd3 	Ocirc \xd4
	Ograve \xd2 	Oslash \xd8 	Otilde \xd5 	Ouml \xd6
	THORN \xde 	Uacute \xda 	Ucirc \xdb 	Ugrave \xd9
	Uuml \xdc 	Yacute \xdd 	aacute \xe1 	acirc \xe2
	acute \xb4 	aelig \xe6 	agrave \xe0 	amp \x26
	aring \xe5 	atilde \xe3 	auml \xe4 	brvbar \xa6
	cb \x7d 	ccedil \xe7 	cedil \xb8 	cent \xa2
	copy \xa9 	curren \xa4 	deg \xb0 	divide \xf7
	eacute \xe9 	ecirc \xea 	egrave \xe8 	eth \xf0
	euml \xeb 	frac12 \xbd 	frac14 \xbc 	frac34 \xbe
	gt \x3e 	hibar \xaf 	iacute \xed 	icirc \xee
	iexcl \xa1 	igrave \xec 	iquest \xbf 	iuml \xef
	laquo \xab 	lt \x3c 	micro \xb5 	middot \xb7
	nbsp \xa0 	not \xac 	ntilde \xf1 	oacute \xf3
	ob \x7b 	ocirc \xf4 	ograve \xf2 	ordf \xaa
	ordm \xba 	oslash \xf8 	otilde \xf5 	ouml \xf6
	para \xb6 	plusmn \xb1 	pound \xa3 	quot \x22
	raquo \xbb 	reg \xae 	sect \xa7 	shy \xad
	sup1 \xb9 	sup2 \xb2 	sup3 \xb3 	szlig \xdf
	thorn \xfe 	times \xd7 	uacute \xfa 	ucirc \xfb
	ugrave \xf9 	uml \xa8 	uuml \xfc 	yacute \xfd
	yen \xa5 	yuml \xff
}

proc xHMencode_get { str } {
    regsub -all "\[^a-zA-Z0-9\]" $str "\[xHMencode_get1 {x&x}]" str
    regsub -all "{x(\[{}\])x}" $str \{\\\\\\1x\} str
    return [subst  -novariables -nobackslashes $str ]
}

proc xHMencode_get1 { s } {
    set c [string index $s 1]
    switch -- $c {
	\n  { return %0d%0a }
	" " { return + }
	default { return [xHMhexChar $c ]}
    }
}


proc HexDecode { me }  {
    regsub -all {\+} $me " "  me
  if { [regexp % $me] } {
     regsub -all {\[} $me {[dec1 5b]} me
    regsub -all {%([0-9A-Fa-f][0-9A-Fa-f])} $me {[dec1 \1]}  me
    subst -nobackslashes -novariables $me
 } else {
		return $me }
}
proc dec1 { s } {
    if { [scan  $s %x d] } {
	format %c $d
    } else {
	error [concat [mc "cant decode hex"] "$s"]
    }
}




#
 #-----------------------------------------------------------------
 #
 # xHMparse_html --  takes HTML containing valid html code, and
 #  converts it into a sequence of calls to CMD.   These
 #  CMD should take 4 arguments:
 #     tagname slash tagArguments followingText
 #  where slash is {} or {/} depending on whether the TAGNAME was
 #  prefixed with a '/'.   The tagAguments are not parsed: eg
 #  <foo bil=good joe> hi there <next> this is
 #  would turn into
 #  $CMD {foo} {} {bil=good joe} {hi there}
 #  $CMD {next} {} {}   {this is..}
 #  We have tried to stay call compatible with a similar command
 #  written by Stephen Uhler.   Our handling of all the tags is different
 #  however.
 #
 #  Results: none
 #
 #  Side Effects: the sequence of $CMD is evald.
 #
 #----------------------------------------------------------------
#
proc xHMparse_html {html {cmd HMtest_parse} {firstTag hmstart}} {
    #dputs "beginning parse"

     global meee ; set meee $html;
     regsub -all {(['\"])\./\.\.} $html {\1..} html 
     regsub -- "^.*<!DOCTYPE\[^>\]*>" $html {} html
     regsub -all -- "--(\[ \t\n\]*)>" $html "\001\\1\002" html
     regsub -all -- "<--(\[^\001\]*)\001(\[^\002\]*)\002" $html \
	 {\&lt;--\1--\2\&gt;} html
     regsub -all -- "<!--\[^\001\]*\001(\[^\002\]*)\002"  $html {} html

     regsub -all \} <$firstTag>\n$html\n</$firstTag> {\&cb;} html
     #dputs "beginning parse1"
     regsub -all \{ $html {\&ob;} html
     # prevent getting \} \{ or \\n in a braces expression.
     regsub -all "\\\\(\[\n<>])" $html "\\&#92;\\1" html
     #regsub -all "<(/?)(\[^ \t\n\r>]+)\[ \t\n\r\]*(\[^>]*)>" $html \
	 "\}\n$cmd {\\2} {\\1} {\\3} \{" html
     regsub -all "<(\[^ \t\n\r>]+)\[ \t\n\r\]*(\[^>]*)>" $html \
	 "\}\n$cmd {\\1}  {\\2} \{" html
     # puts "<html=$html>"
     #dputs "beginning end splitparse1"

     #dputs "list {$html}"
     eval "list {$html}"

}

proc myPost { win menu } {
    bind $menu <Leave> "place forget $menu"
    place $menu -anchor center -relx 0 -rely 1.0 -bordermode outside -in $win
    raise $menu
}
## endsource myhtml.tcl
###### Myhtml1.tcl ######
############################################################
# Netmath       Copyright (C) 1998 William F. Schelter     #
# For distribution under GNU public License.  See COPYING. #
############################################################

defTag eval -alter {family fixed Cnowrap nowrap adjust 0} \
    -body {
	set paramList [xHMsplitParams $params]
	if { [xHMextract_param $paramList program ""] } {
	    set wvar(evalPushed) "Teval"
	    xHMpushConstantTag $win Teval
	    foreach { k val } $paramList {
		if { "$k" == "doinsert" } {
		    set doinsert $val
		    if { "$doinsert" != "[defaultInsertMode $program]" } {
			lappend wvar(evalPushed) [list Targs -doinsert $doinsert]
			xHMpushConstantTag $win [list Targs -doinsert $doinsert]
		    }
		} else {
		    set tem "$k:$val"
		    xHMpushConstantTag $win $tem
		    lappend wvar(evalPushed) $tem
		}
	    }
	}
    }  -sbody {
	catch {foreach v $wvar(evalPushed) { xHMpopConstantTag $win $v } }
    }


defTag result  -alter {family fixed  weight bold  adjust 0} -body {
    set paramList [xHMsplitParams $params]
    set wvar(resultPushed) Tresult
    set taglist(Tresult) 1
    if { [xHMextract_param $paramList modified ""] } {
	lappend wvar(resultPushed) Tmodified
	set taglist(Tmodified) 1
    }
    if { [xHMextract_param $paramList name ""] } {
	lappend wvar(resultPushed) result:$name
	set taglist(result:$name) 1
    }
}   -sbody {
    catch {foreach v $wvar(resultPushed) { xHMpopConstantTag $win $v } }
}

defTag netmath -body {
    set paramList [xHMsplitParams $params]
    catch {
	if { [xHMextract_param $paramList version ""] } {
	    if { [clock scan $version] > [clock scan $::xmaxima_priv(date)] } {

		xHMextract_param $paramList oldversion ""
		append oldversion $text
		set text $oldversion
	    }
	}
	#  swallow the following text if the browser is netmath enabled...
	if { [xHMextract_param $paramList swallow] } {
	    set text ""
	}

    }
}

defTag math -body {
    set paramList [xHMsplitParams $params]
    upvar #0 xHMtaglist$win taglist
    global xHMpriv
    set pre {$}
    if { [xHMextract_param $paramList display] } {
	set pre {$\displaystyle}
	xHMassureNewlines 1
    }

    set wc $win.c[incr xHMpriv(counter)]
    canvas $wc 		-background [$win cget -background] -highlightthickness 0 -borderwidth 0

    set si [expr {[lindex $wvar(size) end] + [lindex $wvar(adjust) end]}]
    if { [xHMextract_param $paramList size] } {
	catch { incr si $size }
    }
    set si [expr {($si < 1 ? 1 : ($si > 7 ? 7 : $si))}]

    set ptsize $::xmaxima_default([lindex $wvar(family) end],$si)
    if { [regexp & $text] }  {
	set text [xHMconvert_ampersand $text]
    }
    if { [catch { set it [ $wc create stext 0 0 \
			       -anchor nw -stext "$pre $text \$" -pointsize $ptsize \
			      ] } ]  } {
	xHMpushConstantTag $win "center"
	xHMtextInsert $win $text
	xHMpopConstantTag $win "center"
	set text ""
	destroy $wc
    } else {
	set text ""
	set dims [$wc bbox $it]
	$wc config -width [lindex $dims 2] -height [lindex $dims 3]
	xHMpushConstantTag $win "center"
	xHMtextInsert $win " "
	$win window create $wvar(W_insert) -window $wc  -padx 1 -pady 1
	xHMpopConstantTag $win "center"
    }
} -sbody {list }

proc getDim { dim  max } {
    if { [regexp {([0-9.]+)%$} $dim junk amt] } {
	return [expr {round($amt * .01 * $max) }]
    } elseif { $dim  < 0 } {
	return $max
    } else {
	return $dim
    }
}

defTag embed  -body {
    set paramList [xHMsplitParams $params]
    xHMextract_param $paramList width -1
    # allow for things like 50%
    set width [getDim [set width] [expr {.95 * [winfo width $win]}]]
    xHMextract_param $paramList height -1
    set height [getDim [set height] [expr {.95 * [winfo height $win]}]]
    set ewin [makeEmbedWin $win $width $height]
    $win window create $wvar(W_insert) -window $ewin  -padx 1 -pady 1
    set slave [oget $ewin slave]
    if { [    xHMextract_param $paramList src] } {
	set data [HMgetURL $win $src text]
	interp eval $slave $data
    }
} -sbody {}


proc HMgetURL {  textwin url type } {
    set currentUrl [oget $textwin currentUrl]
    catch { set currentUrl [decodeURL [oget $textwin baseurl]] }
    set new [resolveURL $url $currentUrl ]
    return [uplevel 1 getURL [list $new] type]
}


## endsource "myhtml1.tcl"
###### Base64.tcl ######
############################################################
# Netmath       Copyright (C) 1998 William F. Schelter     #
# For distribution under GNU public License.  See COPYING. #
############################################################

proc tobase64 { binary } {
    set ll [string length $binary ]
    set n [binary scan  $binary "c*" ans]
    lappend ans 0 0 0
    foreach { x y z } $ans {
	#	puts "$x $y $z $n"
	catch {
	    append new  \
		    [char64 [expr {(($x & 255)>>2) }]][char64 \
		    [expr {((($x & 3)<<4) | (($y >> 4) & 15))}]][char64 \
		    [expr {((($y & 15)<<2) | (($z &255) >> 6))}]][char64 \
		    [expr {($z & 63) }]]
	
	}
    }
    return $new
}

proc char64 { x } {
    string range "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" $x $x
}

## endsource base64.tcl
###### Bitmaps.tcl ######
############################################################
# Netmath       Copyright (C) 1998 William F. Schelter     #
# For distribution under GNU public License.  See COPYING. #
############################################################

global xHMulBMPdata
set xHMulBMPdata ""
lappend xHMulBMPdata "#define disc_width 6\n#define disc_height 6
static unsigned char disc_bits[] = {
   0xde, 0xff, 0xff, 0xff, 0xff, 0xde};"

lappend xHMulBMPdata  "#define circ_width 8\n#define circ_height 8
static unsigned char circ_bits[] = {
   0x3c, 0x42, 0x81, 0x81, 0x81, 0x81, 0x42, 0x3c};"

lappend xHMulBMPdata "#define rect_width 11\n#define rect_height 11
static unsigned char rect_bits[] = {
   0xff, 0x07, 0x01, 0x04, 0x01, 0x04, 0x01, 0x04, 0x01, 0x04, 0x01, 0x04,
   0x01, 0x04, 0x01, 0x04, 0x01, 0x04, 0x01, 0x04, 0xff, 0x07};"






## endsource bitmaps.tcl
############################################################
# Tryembed.tcl                                             #
# Copyright (C) 1998 William F. Schelter                   #
# For distribution under GNU public License.  See COPYING. #
#                                                          #
############################################################

## the following worked to have an entry box that spoke...
# %     safe::interpCreate jack
# jack
# % set slave jack
# jack
# %     safe::interpInit $slave
# jack
# %     interp eval $slave set ::env(DISPLAY) $::env(DISPLAY)
# :0.0
# %     load {} Tk $slave
# % interp eval jack {entry .ja ; pack .ja}
# %     interp eval $slave { proc policy {args } {} }
# %     Safesock_PolicyInit $slave
# %     setupUnknown $slave
# %     setupPrintVariables $slave
# % interp eval jack plot2d -xfun {sin(x)}

proc makeEmbedWin { parent width height } {
    global auto_index
    set win $parent.embed[incr ::xmaxima_priv(counter)]
    set fr [frame $win -width $width -height $height -container 1]
    set slave tclet$::xmaxima_priv(counter)
    safe::interpCreate $slave
    # make it exist somehow the autoload stuff doesn't make it a command
    if { [info exists auto_index(::safe::allowTk) ]  } {
	::safe::allowTk $slave [list -use [winfo id $fr]]
	::safe::TkInit $slave
	::safe::tkInterpInit $slave [list -use [winfo id $fr]]
	interp eval $slave [list set argv [list -use [winfo id $fr]]]	
    } else {
	safe::interpInit $slave
	interp eval $slave [list set argv [list -use [winfo id $fr]]]	
    }

    if { [info exists ::env(DISPLAY)] } {
	interp eval $slave set ::env(DISPLAY) $::env(DISPLAY)
    }
    interp eval $slave { proc policy {args } {} }
    #    $slave alias bgerror bgerror
    load {} Tk $slave
    Safesock_PolicyInit $slave
    setupUnknown $slave
    setupPrintVariables $slave
    oset $fr slave $slave
    return $fr
}

proc setupUnknown { slave } {
    interp eval $slave {rename auto_load auto_load-orig}
    interp alias $slave auto_load1 {} auto_load1 $slave
    interp eval $slave { proc auto_load {args} {
	if { [eval auto_load1 $args] } { return 1 }
	uplevel 1 auto_load-orig $args
    }
    }
}

proc auto_load1 { slave name {namespace ""} } {
    if { "[info proc $name ]" != "" } {
	set arglist [info args $name]
	set theargs {}
	foreach v $arglist {
	    if { [info default $name $v theDefault] } {
		lappend theargs [list $v $theDefault]
	    } else {
		lappend theargs $v
	    }
	}
	interp eval $slave [list proc $name $theargs [info body $name]]
	return 1
    }
    return 0
}

proc setupPrintVariables { slave } {
    global printOption fontSize show_balloons getOp parse_table Parser \
        axisGray paperSizes printOptions \
        doExit fontCourier8
    foreach v {printOption fontSize show_balloons getOp parse_table Parser
	axisGray ::plot2dOptions ::plot3dOptions paperSizes printOptions
	doExit  fontCourier8 ::plotdfOptions ::xmaxima_priv} {
	if { [array exists  $v] } {
	    interp eval $slave [list array set $v [array get $v *] ]
	} else {interp eval $slave [list set $v [set $v ]]}}}

if { "[info command policy]" != "policy" } {proc policy { args } { }}

## source nsafesock.tcl

###### nsafesock.tcl ######
# The Safesock Security Policy.
# -----------------------------
#
# Author: Jacob Levy & Brent Welch, 3/10/97
#
# This policy allows a safe slave to connect to remote sockets under the
# control of a master. The URL from which the applet is classified as
# either "inside" or "outside" and the host is added to the set of "inside"
# and "outside" hosts that this Tclet is allowed to connect to. Then, on
# the first request to connect to a host, if the host is classified as
# "inside" then subsequently the Tclet is allowed to connect only to hosts
# that are classified as "inside" (the same for if the first attempt is to
# connect to a host classified as "outside").
#
# The arrays used to drive this policy are defined in safesock.data.

# Remember the location of the data file for the Safesock policy, so that
# it can be reloaded each time the policy is used, to reflect changes.

global safesockDataFile
set safesockDataFile [file join [file dirname [info script]] safesock.data]

proc Safesock_PolicyInit {slave {version 1.0}} {
    global browser_state		;# Browser state
    global safesock_inside safesock_outside

    interp alias $slave socket {} SafesockSocketAlias $slave
    interp alias $slave fconfigure {} SafesockFconfigureAlias $slave

    uplevel "#0" {source $safesockDataFile}


    # Attempt to get the URL and extract the server and port portions:

    set server "" ; set port "" ; set url ""
    catch {set url $browser_state($slave,url)}
    if {[regexp -nocase {http://([^:/]+)(:([0-9]+))?/} $url \
	     x server y port]} {
	if {[string length $port] == 0} {
	    set port 80
	}
	set server [string tolower $server]
    } elseif {[string match "file:*" $url]} {
	set server localhost
	set port 80
    }

    # At this time it is unknown whether the slave will use inside
    # or outside connections:

    set browser_state($slave,safesock,permissions) unknown

    # Save the homebase for this Tclet:
    set browser_state($slave,safesock,homebase) $server

    # Tell the slave about itself:
    interp eval $slave [list set ::env(SERVER) $server]
    interp eval $slave [list set ::env(PORT) $port]
    interp eval $slave [list set ::env(URL) $url]

    browser_log $slave security installed policy Safesock
}

proc SafesockDecideInsideOrOutside {slave server} {
    global safesock_insideExclude safesock_outsideExclude
    global safesock_inside safesock_outside

    set status unknown

    # If the server matches anything outside and nothing in the outside
    # exclusion list, then it's outside:

    foreach i [array names safesock_outside] {
	if {[string match $i $server]} {
	    set status outside
	    break
	}
    }

    if {"$status" == "outside"} {
	foreach i [array names safesock_outsideExclude] {
	    if {[string match $i $server]} {
		set status unknown
		break
	    }
	}
    }

    # If the status is unknown, check whether it might be inside. It is
    # inside if the server matches anything inside and nothing in the
    # inside exclusion list:

    if {"$status" == "unknown"} {
	foreach i [array names safesock_inside] {
	    if {[string match $i $server]} {
		set status inside
		break
	    }
	}

	if {"$status" == "inside"} {
	    foreach i [array names safesock_insideExclude] {
		if {[string match $i $server]} {
		    set status unknown
		    break
		}
	    }
	}
    }

    # If the status is unknown at this point, raise an error

    if {"$status" == "unknown"} {
	error [concat [mc "unknown host:"] "$server"]
    }

    return $status
}

# This procedure is invoked when the slave is destroyed to clean up
# any associated state. It frees up the array of hosts and ports that
# the slave is allowed to connect to:

proc Safesock_PolicyCleanup {slave} {
    global browser_state

    foreach i [array names browser_state $slave,safesock,*] {
	unset browser_state($i)
    }
}


#
#-----------------------------------------------------------------
#
# SafesockServerAnswer --  will replace COMMAND in a `socket -server command'
#  request.   Checks if the incoming connection is allowed and if so
#  invokes the original command.   Allowed is based on the same criteria
#  as the outgoing connection.
#
#  Results: none
#
#  Side Effects: if connect is allowed, transfer the socket to the slave
#  and eval the original command there.
#
#----------------------------------------------------------------
#
proc SafesockServerAnswer { slave command sock host port } {
    set peer [fconfigure $sock -peername]
    set host [lindex $peer 1]
    set host [string tolower $host]
    if { [SafesockAllow $slave $host [lindex $peer 2]] > 0 } {
	interp transfer {} $sock $slave
	interp eval $slave $command $sock $host $port
    } else {
	interp eval $slave [list error [mc "connection from %s and %s disallowed" $host $port] ]
    }
}



#
#-----------------------------------------------------------------
#
# SafesockAllow --  check if connection by SLAVE to HOST at PORT is allowed,
#  based on the inside/outside history of slave and data in safesock.data
#
#  Results: 1 if succeeds and 0 if it fails to allow
#
#  Side Effects:  set GOOD to ok port in the caller
#
#----------------------------------------------------------------
#
proc SafesockAllow { slave host port} {
    global browser_state
    global safesock_insideExclude safesock_outsideExclude
    global safesock_inside safesock_outside
    upvar 1 good good
    set host [string tolower $host]
    if {"$browser_state($slave,safesock,permissions)" == "unknown"} {
	if {[catch {set this [SafesockDecideInsideOrOutside $slave $host]}]} {
	    if {"$host" == "$browser_state($slave,safesock,homebase)"} {
	        set this homebase
	    } else {
	        error [concat [mc "unknown host:"] "$host"]
	    }
	}
	set browser_state($slave,safesock,permissions) $this
	browser_log $slave security $slave classified as $this
    }

    set portset -
    if {"$browser_state($slave,safesock,permissions)" == "homebase"} {
	if {"$host" == "$browser_state($slave,safesock,homebase)"} {
	    set portset $browser_state($slave,safesock,homeport)
	}
    } elseif {"$browser_state($slave,safesock,permissions)" == "inside"} {
	foreach hostpat [array names safesock_inside] {
	    if {[string match $hostpat $host]} {
		set portset $safesock_inside($hostpat)
		break
	    }
	}
	if {"$portset" != "-"} {
	    foreach hostpat [array names safesock_insideExclude] {
		if {[string match $hostpat $host]} {
		    set portset -
		    break
		}
	    }
	}
    } else {
	foreach hostpat [array names safesock_outside] {
	    if {[string match $hostpat $host]} {
		set portset $safesock_outside($hostpat)
		break
	    }
	}
	if {"$portset" != "-"} {
	    foreach hostpat [array names safesock_outsideExclude] {
		if {[string match $hostpat $host]} {
		    set portset -
		    break
		}
	    }
	}
    }

    if {"$portset" == "-"} {
	error [concat [mc "unknown host:"] "$host"]
    }

    if { [safesockPortMatches $port $portset] } {
	set good $port
	return 1
    }
    return 0
}

proc safesockPortMatches { port portset } {
    foreach portspec $portset {
	set low [set high ""]
	if {[regexp {^([0-9]+)-([0-9]*)$} $portspec x low high]} {
	    if {($low <= $port && $high == "") ||
		($low <= $port && $high >= $port)} {
                return 1
		break
	    }
	} elseif {$port == $portspec} {
	    return 1
	}
    }
    return 0
}

# the following should be set in safesock.data
global safesockAllowedServerPorts
if { ![info exists safesockAllowedServerPorts ] } {
    set safesockAllowedServerPorts { 1025-3000 }
}

proc SafesockSocketAlias {slave host port args} {
    global safesockAllowedServerPorts
    set option {}
    if { "$host" == "-server" } {
	set command $port
	set port [lindex $args 0]
	if { ![safesockPortMatches $port $safesockAllowedServerPorts] } {
	    error [concat [mc "bad port:"] "$port"]
	}
	set sock [socket -server \
		      "SafesockServerAnswer $slave [list $command]" $port]
	interp transfer {} $sock $slave
	browser_log $slave normal socket -server $port
	return $sock
    } elseif { "$host" == "-async" } {
	set option $host
	set host $port
	set port [lindex $args 0]
    } else {
	if { [llength $args ] != 0 } {
	    error [mc "wrong args: socket host port OR socket -server command port"]
	}
	set serverCommand ""
    }
    SafesockAllow $slave $host $port
    if [info exists good] {
	if { "$option" != "" } {
	    set sock [interp invokehidden $slave socket $option $host $good]
	} else {
	    set sock [interp invokehidden $slave socket $host $good]
	}
	browser_log $slave normal socket $host $port
	return $sock
    }
    error [concat [mc "bad port:"] "$port"]
}

# This procedure handles the "fconfigure" alias from the slave:

proc SafesockFconfigureAlias {slave sock args} {
    global jack
    if {[llength $args] == 0} {
	return [interp invokehidden $slave fconfigure $sock]
    } elseif {[llength $args] == 1} {
	set flag [lindex $args 0]
	return [interp invokehidden $slave fconfigure $sock $flag]
    } else {
	browser_log $slave normal fconfigure $sock $args

	array set config [interp invokehidden $slave fconfigure $sock]
	foreach {flag value} $args {
	    switch -- $flag {
		-peername -
		-peerport {
		    error [concat [mc "Cannot change"] "$flag configuration"]]
		}
		-blocking -
		-buffering -
		-buffersize -
		-eofchar -
		-translation {
		    set config($flag) $value
		}
		default {
		    error [concat [mc "unknown option"] "$flag"]
		}
	    }
	}
	lappend jack [list interp invokehidden $slave fconfigure $sock \
			  -blocking $config(-blocking) \
			  -buffering $config(-buffering) \
			  -buffersize $config(-buffersize) \
			  -eofchar $config(-eofchar) \
			  -translation $config(-translation)]
	return [interp invokehidden $slave fconfigure $sock \
		    -blocking $config(-blocking) \
		    -buffering $config(-buffering) \
		    -buffersize $config(-buffersize) \
		    -eofchar $config(-eofchar) \
		    -translation $config(-translation)]
    }
}

## endsource nsafesock.tcl


## endsource tryembed.tcl
###### OpenMath.tcl ####################################################
#
# Copyright (C) 1998 William F. Schelter
# For distribution under GNU public License.  See COPYING.tcl
#
#     Modified by Jaime E. Villate                         #
########################################################################

proc genSample { x n } {
    set sample $x
    set m 1
    while { 1 } {
	if { $m >= $n } { return $sample }
    	if { [set tem [expr {2*$m}]] <= $n } {
	    append sample $sample
	    set m $tem
	} else {
	    return [append sample [genSample $x [expr {$n - $m}]]]
	}
    }
}

# font measuring is very slow so we cache the result of measuring a line
# of x's.
proc fontMeasure { font size } {
    set ll $::xmaxima_priv(linelength)
    if { ![catch {set answer [set $::xmaxima_priv($font,$size,$ll)]} ] } { return $answer}
    set sample [genSample x $ll]
    set  ::xmaxima_priv($font,$size,$ll)  [font measure [list $font $size] $sample]
    return $::xmaxima_priv($font,$size,$ll)
}

proc getDefaultFontSize { width } {
    global fixedFont
    set answer "10 480"
    catch {
	set wid1 [fontMeasure $fixedFont 10]
	set guess [expr {round($width/double($wid1) * 10.0)}]
	while { [fontMeasure $fixedFont $guess] < $width && $guess <= 14 } {
	    incr guess
	}
	incr guess -1
	while { [fontMeasure $fixedFont $guess] > $width } { incr guess -1 }
	set answer   [list $guess [fontMeasure $fixedFont $guess]]
    }
    return $answer
}

proc getMaxDimensions { } {
    global embed_args
    set dims "800 600"
    if { [catch { set dims "$embed_args(width) $embed_args(height)" } ] } {
	set dims "[expr round(.85* [winfo screenwidth .])] [expr round(.9* [winfo screenheight .])]"} else {
	    set dims "[getPercentDim [lindex $dims 0] width .] [getPercentDim [lindex $dims 1] height .]"
	}
    return $dims
}

proc getPercentDim { dim direction win } {
    if { [regexp {([0-9]+)%} $dim junk val] } {
	set dim [winfo $direction $win]
	catch { set dim [expr {round($val * $dim * .01)}] }
	return $dim
    }
    return $dim
}

proc computeTextWinDimensions { win width height } {
    # leave room for scroll bar
    global fixedFont
    # desetq "fsize wid" [getDefaultFontSize [expr {$width -15}]]
    set wid $width
    # set fixedFont [xHMmapFont font:fixed:normal:r:3]
    set fsize [xHMfontPointSize $fixedFont]

    set lh [expr {$fsize +1}]
    catch {   set lh [font metrics $fixedFont -linespace] }
    oset $win fixedFont $fixedFont
    oset $win fontSize $fsize
    oset $win width $width
    oset $win width_chars $::xmaxima_priv(linelength)
    set hei [expr {round($height/$lh)}]
    oset $win height_chars $hei
    oset $win height [expr {$hei * $lh}]
    oset $win lineheight $lh
}

proc setFontOptions { fsize }     {
    global _fixed_default _prop_default fontSize
    set helvetica $_prop_default
    set courier $_fixed_default
    global buttonfont entryfont labelfont fixedtextfont
    set  buttonfont [font create -family $helvetica -size $fsize]
    set  labelfont [font create -family $helvetica -size $fsize]
    set  fixedtextfont [font create -family $courier -size $fsize]
    set  entryfont [font create -family $courier -size $fsize]

    return

    if { $fsize > 10 } { set fsize 12 }
    if { $fsize == 8 } { set entrysize 10 } else {set entrysize $fsize }
    #puts "fsize=$fsize"
    catch {
	#mike FIXME: these are broken for windows
	set  buttonfont [font create -family Helvetica -size $fsize]
	set  labelfont [font create -family helvetica -size $fsize]
	set  fixedtextfont [font create -family courier -size $fsize]
	set  entryfont [font create -family courier -size $fsize]

	#mike: maxima should not be playing with these
	# option add *Button.font $buttonfont
	# option add *Label.font $labelfont
	# option add *Entry.font $entryfont
	option add  *Dialog.msg.wrapLength 500
    }
}
# omPanel
# Creates the browser window
#
proc omPanel { w args } {
    global buttonfont entryfont labelfont
    set top [winfo toplevel $w]
    linkLocal $top omPanel
    if { [info exists omPanel] } {return $omPanel }
    set top [winfo parent $w]
    #
    if { "$top" == "." } { set top ""}	
    set win $top.textcommands
    set omPanel $win
    makeLocal $w fontSize
    setFontOptions $fontSize

    global [oarray $top.textcommands]
    set menubar $top.textcommands
    if { [winfo exists $menubar] } {
	return $menubar
    }
    oset $win history ""
    oset $win historyIndex 0
    wmenubar $menubar
    pack $menubar -side top -expand 1 -fill x -anchor nw

    button $win.back -image ::img::previous -text [mc Back] -relief flat \
        -width 30 -height 30 -command "OpenMathMoveHistory $win -1"
    button $win.forward -image ::img::next -text [mc Forward] \
	-relief flat -width 30 -height 30 -command "OpenMathMoveHistory $win 1"
    pack $win.back $win.forward -side left -expand 0

    global location
    if {1} {
	menubutton $win.url -image ::img::track -text Url: -relief flat \
            -width 30 -height 30 
	menu $win.url.m -tearoff 0 \
	    -postcommand [list vMaxOMUrlPostCommand $win $win.url.m]
	$win.url configure -menu $win.url.m
	pack $win.url -side left -fill both -expand 0
	proc vMaxOMUrlPostCommand {win m} {
	    $m delete 0 end
	    foreach v [oget $win history] {
		set url [oget $v location]
		$m add command -label $url \
		    -command [list OpenMathOpenUrl $url -commandpanel  $win]
	    }
	}
    } else {
	#mike slate the old history list for demolition
	button $win.loclabel -text " Url:" \
	    -command "OpenMathOpenUrl \[$win.location get\] -commandpanel  $win"
	setHelp $win.loclabel [mc {Fetch the URL or FILE indicated in the entry box. \
				   A local file is something like file:/home/wfs/foo.om, and a URL \
				   begins with http.}]

	pack $win.loclabel -side left -fill x -expand 0
    }

    entry $win.location -textvariable [oloc $win location] -width 40
    setHelp $win.location [mc {Address of the current document.  You may modify it and type Enter, to fetch a new document.}]
    bind $win.location <Key-Return> "OpenMathOpenUrl \[$win.location get\] -commandpanel  $win"
    pack $win.location  -side left -fill x -expand 1
    label $win.locspace -text " "
    pack $win.locspace -side left -fill x -expand 0

    oset $win history ""
    pack $win -side top -expand 1 -fill x

    oset $win status $::xmaxima_priv(cStatusWindow)
    return $win
}

proc forgetCurrent { win } {
    makeLocal $win history historyIndex
    set i 0
    if { [llength $history] > 1 } {
	set w [lindex $history $historyIndex]
	set history [lreplace $history $historyIndex $historyIndex]
	# might have caused two identical ones to be next to each other
	if { "[lindex $history $historyIndex]" == "[lindex $history [expr {$historyIndex -1 }]]" } {
	    set history [lreplace $history $historyIndex $historyIndex]
	    set i -1
	}
	if { [lsearch  $history $w] < 0 } {
	    after 2000 "destroy $w"
	}
	oset $win history $history
	OpenMathMoveHistory $win $i
    }
}

proc omDoStop { win } {
    set st $::xmaxima_priv(cStatusWindow)
    set var [$st.scale cget -variable]
    if { [regexp {sock[0-9]+} $var sock] } {
	oset $sock done -1
	if { ![catch { close $sock} ] } {
	    append ::xmaxima_priv(load_rate) "--aborted"
	}
    }
}
#
#-----------------------------------------------------------------
#
# setTypeForEval --  insert special editing of options, into MENU for PROGRAM
#
#  Results:
#
#  Side Effects:
#
#----------------------------------------------------------------
#
proc setTypeForEval { menu program } {
    #puts "$menu program"
    set slaves [pack slaves $menu.program ]
    set men $menu.program.$program
    if { [llength $slaves] > 0 } {eval pack forget $slaves}
    if { ![catch { set options $::xmaxima_priv(options,$program) } ] } {
	if { ![winfo exists $menu.program.$program] } {
	    #puts "options=$options"
	    # puts "there"
	    ### set up to add menu items to a new frame
	    set key $menu.program

	    frame $men
	    rename $men $men-orig
	    set body "wmenuInternal $key \$option \$args"
	    oset $menu.program menu $men
	    oset $men items ""
	    oset $key parent $menu
	    proc $men {option args } $body
	    ##### end

	    foreach v $options {
		desetq "key dflt help" $v
		if { [catch { set ::xmaxima_priv(options,$program,$key)} ] } {
		    set ::xmaxima_priv(options,$program,$key) $dflt
		}
		switch [lindex $v 3] {
		    boolean {
			$men add check -label $key -variable ::xmaxima_priv(options,$program,$key) -help [concat $program option -$key: $help] -onvalue 1 -offvalue 0
		    }
		    default {
            		$men add entry -label "$key:" -entryvariable ::xmaxima_priv(options,$program,$key) -help [concat $program option -$key: $help]
		    }
		}
		#		label $new.label -text $key:
		#		entry $new.entry  -textvariable ::xmaxima_priv(options,$program,$key)
		#		pack $new.label $new.entry -side top -anchor w -fill x
		#		pack $new -fill x
		#		setHelp $new [concat $program option -$v: $help]

	    }
	}
	
    }
    catch { pack $men}
}
#
#-----------------------------------------------------------------
#
# getGlobalOptions --  Convert the current global options for program,
# to an option list:  -key1 value1 -key2 value2 ..
#
#  Results: the option list
#
#  Side Effects: none
#
#----------------------------------------------------------------
#
proc getGlobalOptions { program } {
    set ans ""
    if { ![catch { set options $::xmaxima_priv(options,$program) } ] } {
	foreach v $options {
	    set key [lindex $v 0]
	    set dflt [lindex $v 1]
	    if { ![catch { set val $::xmaxima_priv(options,$program,$key) }] } {
		if { "$val" != "$dflt" } {
		    lappend ans -$key $val
		}
	    }
	}
    }
    return $ans
}
#
#-----------------------------------------------------------------
#
# setGlobalOptions --  set the current global values of the options for PROGRAM
# according to the values specified in OPTIONLIST.   If a value is not specified
# use the value supplied in the defaults: $::xmaxima_priv(options,$program)
#
#  Results:  none
#
#  Side Effects: the entries ::xmaxima_priv(options,$program,$key) are changed
#  for each $key which is an option for program.
#
#----------------------------------------------------------------
#
proc setGlobalOptions { program list } {
    if { [catch { set options $::xmaxima_priv(options,$program) } ] } {
	foreach  v $options {
	    set key [lindex $v 0]
	    set dflt [lindex $v 1]
	    set $::xmaxima_priv(options,$program,$key) \
		[assoc -$key $list $dflt]
	}
    }
}

proc toggleEditBar  {win} {
    makeLocal $win showEditBar editbar
    if { [winfo viewable $editbar] }  {
	pack forget $editbar
	oset $win showEditBar "show edit bar"
    } else {
	pack $editbar -in $win -side bottom -expand 1 -fill x
	oset $win showEditBar "hide edit bar"
    }
}

proc getPrefixed { prefix  tags } {
    set i [lsearch $tags ${prefix}*]
    if { $i >= 0 } {
	return [string range [lindex $tags $i] [string length $prefix] end]
    } else {
	return ""
    }
}

proc programFromTags {tags} {
    if {[lsearch $tags Teval ] < 0 } {
	return ""
    }
    return [getPrefixed program: $tags]
}

proc saveToFile { commandPanel label file } {
    makeLocal $commandPanel textwin
    $label configure -relief sunken
    set lab [$label cget -text]

    # save just as text
    set text [$textwin get 0.0 end]

    if { [catch { set fi [open $file w] } err] } {
	return -code error \
	    [mc "Could not open file %s\n%s" [file native $file] $err]
    }
    puts $fi $text
    close $fi
    $label configure -relief raised -text [concat [mc "wrote"] "$file"]
    after 1200 [list $label configure -text $lab]
}

if { [catch { package require Safesock } ] } {
    catch { policy  home }
    # catch {  policy outside }

}

proc mkOpenMath { win  } {
    set w $win
    if {[winfo exists $w]} {catch {destroy $w}}
    if { [catch { package require Safesock } ] } {
	# policy network home
	catch {  policy  outside }
    }
    desetq "width height" [getMaxDimensions]
    computeTextWinDimensions $win $width $height
    makeLocal $win fontSize width_chars height_chars fixedFont
    set font $fixedFont
    # puts "fontSize=$fontSize"
    frame $w
    set commandPanel [omPanel $w ]
    oset $w commandPanel $commandPanel
    set prevwindow ""
    catch { set prevwindow [oget $commandPanel textwin] }
    oset $commandPanel textwin $w.text
    # pack $commandPanel -in $w -side top -fill x -pady 2m
    # raise  $commandPanel
    text $w.text -yscrollcommand "$w.scroll set" \
	-selectbackground "#808080" \
	-width $width_chars  -height $height_chars -font $font -wrap word
    bind $w.text <Configure> "resizeSubPlotWindows $w.text %w %h"
    set ::xmaxima_priv(currentwin) $w.text
    set ::xmaxima_priv(point) end

    $w.text tag bind "currenteval" <Leave> "$w.text tag remove currenteval 0.0 end ; addTagSameRange %W Teval currenteval @%x,%y;"
    $w.text tag config "currenteval" -foreground red
    $w.text tag bind Teval <Double-Button-1> {doInvoke %W @%x,%y }
    $w.text tag bind Teval <Enter> {addTagSameRange %W Teval currenteval @%x,%y; textShowHelp %W Teval @%x,%y [mc "Double clicking (with the left mouse button), in the marked region will cause evaluation. "]}
    $w.text tag bind Teval <Leave> {deleteHelp %W}
    $w.text tag config hrule -font {Courier 1} -background black
    $w.text mark set insert 0.0
    # try "#d0d0d0" or "#ffffd0" or yellow
    $w.text tag configure Teval -foreground blue -font $font  -border 1 -lmargin1 20
    $w.text tag configure bold -font [xHMmapFont font:propor:bold:r:3] -lmargin1 15
    $w.text tag configure plain -font [xHMmapFont font:propor:bold:r:3] -lmargin1 10
    $w.text tag configure Tresult -font [xHMmapFont font:fixed:bold:r:3] -lmargin1 10
    $w.text tag configure Tmodified -font [xHMmapFont font:fixed:normal:r:3] -background pink -relief sunken -border 1
    $w.text tag configure Thref -font [xHMmapFont font:fixed:normal:r:3]  -foreground blue  -relief flat
    set lh [oget $win lineheight]
    $w.text tag configure sub -offset [expr {-round($lh*.6) }]
    $w.text tag configure sup -offset [expr {round($lh*.6) }]
    oset $w.text counter 0
    # allow some openmath text bindings to take precedence
    bindtags $w.text "OpenMathText [bindtags $w.text]"
    scrollbar $w.scroll -command "$w.text yview"
    pack $w.scroll -side right -fill y
    pack $w.text -expand 1  -fill both
    pack $w -expand 1 -fill both
    if {[winfo exists $prevwindow] } { pack forget [winfo parent $prevwindow] }
    return  $w.text

}

#source emaxima.tcl
#source egp.tcl

# Create bindings for tags.

# set ActiveTags {
#   gap-eval
#   gap-eval-insert
#   octave-eval
#   octave-eval-insert
#   face-jump-to-bkmark
#   xlsp-eval
#   xlsp-eval-insert
#   gcl-eval
#   gcl-eval-insert
#   emacs-lisp-eval
#   emacs-lisp-eval-insert
#   mma-eval
#   mma-eval-insert
#   Splus-eval
#   Splus-eval-insert
#   gp-eval
#   gp-eval-insert
#   maple-eval
#   maple-eval-insert
#   shell-eval-region
#   gnuplot-eval
#   xplot-eval
#   maxima-eval
#   maxima-eval-insert
#   dfplot-eval
#   book-shell-eval-insert
#   book-image-insert
#   book-postscript-insert
#   book-tex-math-mode
#   book-elisp-eval
#   book-shell-eval
#  }

global evalPrograms
# add in Toctave, Topenplot, Thref etc... ie ones with eval_* defined
foreach v [info proc insertResult_*] {
    lappend evalPrograms [string range $v 13 end]
}
#
#-----------------------------------------------------------------
#
# defaultInsertMode --  each program can have a default insert mode.
#  If the insert method is not noted specifically then it uses the default.
#  maxima and gp have default to insert.
#  Results: 0 or 1
#
#  Side Effects: none
#
#----------------------------------------------------------------
#
proc defaultInsertMode { program } {
    if { [catch {  set dflt [getOptionDefault doinsert $::xmaxima_priv(options,$program)]} ] } { return 1}
    if { "$dflt" == "" } {set dflt  1}
    return $dflt
}

proc doInsertp { tags } {
    set program [programFromTags $tags]
    # puts "program=$program," ; flush stdout
    return [getEvalArg -doinsert $tags [defaultInsertMode [programName $program]]]
}
#
#-----------------------------------------------------------------
#
# doInvoke --  invoked when user clicks on WINDOW at INDEX
# this will either call the program whose tag is in the list of
# tags at this point, on the expression which is highlighted for this
# or else call the special code in eval_$program if the latter exists.
#  Results: none
#
#  Side Effects: The modified result of the insert field will be cleared,
#  and the value there will be changed.
#----------------------------------------------------------------
#
proc doInvoke { w index } {
    global evalPrograms
    set tags [$w tag names $index]
    $w tag delete sel
    set program [programFromTags $tags]
    if { "$program" == "" } {
	return
    }
    # puts "base=[oget $w baseprogram],w=$w"
    set res [resolveURL $program [oget $w baseprogram]]
    # puts "program=$program,baseprogram[oget $w baseprogram],res=$res"
    set this [thisRange $w  program:$program $index]
    # puts "this=$this"
    set nextResult ""
    set doinsert [doInsertp $tags]
    # puts "doinsert=$doinsert"
    if { $doinsert} {
	set name [getPrefixed name: $tags]
	if { "$name" != "" } {
	    set nextResult [$w tag nextrange result:$name [lindex $this 1]]
	    if { 0 == [llength $nextResult] } {
		error [concat [mc "No result field with"] "name=$name"]
	    }
	} else {
	    set next [$w tag nextrange Teval [lindex $this 1]]
	    set nextResult [$w tag nextrange Tresult [lindex $this 1]]
	    if {
		[llength $nextResult] == 0
		||    ([llength $next] !=0
		       &&  [$w  compare [lindex $nextResult 0] > [lindex $next 0]] )
	    } {
		$w insert "[lindex $this 1]+1 char" " " "Tresult"
		set nextResult [$w tag nextrange Tresult [lindex $this 1]]
		# error "no place to put result"
	    }
	}
	if { "$nextResult" != "" } {
	    eval $w  tag add Tmodified $nextResult
	}
    }
    set prog [programName $program]
    if { [info proc eval_$prog] != "" } {
	if {[eval_$prog $program $w $this $nextResult] != 0 }  {
	    error [mc "Failed to eval region"]
	}
    } else {
	global err
	if { [catch { sendOneInsertTextWin $program [eval $w get $this] $w $this $nextResult} err ] && [regexp "Can't connect" $err ]} {
	    set now [encodeURL [oget $w baseprogram] ]
	    set tem [ldelete $now $::xmaxima_default(defaultservers)]
	    if { [tk_dialog .jil 0 "$err: connect to one of $tem?" "" 0 change "keep $now"] == 0 } {
		set ::xmaxima_default(defaultservers)  $tem
		oset $w baseprogram [decodeURL [getBaseprogram]]
		doInvoke $w $index
		return
	    } else {
		return
	    }

	}
    }
}

proc getEvalArg { key names {dflt ""} } {

    foreach v $names {
	if { "[string range $v 0 5]" == "Targs "} {
	    return [assoc $key [lrange $v 1 end] $dflt]
	}
    }
    return $dflt
}
#
#-----------------------------------------------------------------
#
# setModifiedFlag --  add the Tmodified tag to the next Tresult field
#  after the current expression.
#  Results:
#
#  Side Effects:
#
#----------------------------------------------------------------
#
proc setModifiedFlag { win index } {
    if { [lsearch [$win tag names $index] Teval] >= 0 } {
	set next [$win tag nextrange Tresult $index]
	if { "$next" != "" } {
	    eval $win  tag add Tmodified $next
	}
    }
}
#
#-----------------------------------------------------------------
#
# insertResult --  replace RESULTRANGE of the text buffer by VALUE,
#  and clear the Tmodified tag if there is one.
#  most eval_$program programs will call this to insert their result.
#  Results:
#
#  Side Effects:
#
#----------------------------------------------------------------
#
proc insertResult { w resultRange value } {
    set tags [$w tag names [lindex $resultRange 0]]
    set value [xHMuntabify $value]
    # append a newline to a multiline result that has no newline after it.
    if { [regexp "\n.*\[^\n]\$" $value ] } {append value "\n"}
    eval $w delete $resultRange
    # dont lose the whole thing!!
    if { "$value" == "" } { set value " "}
    $w insert [lindex $resultRange 0] $value  [ldelete Tmodified $tags]
}
#
#-----------------------------------------------------------------
#
# addPreloads --  Tack any preloads or preevals on to the
#  command.
#  Results: the new COMMAND
#
#  Side Effects:
#
#----------------------------------------------------------------
#
proc addPreloads {command program win this } {
    set preload [getTagsMatching $win ^pre(load|eval):* $this]
    if { "$preload" != "" &&  ![preeval $program $preload] } {
	if { [regexp \{pre(load|eval):(.*)\} $preload junk op url] ||
	     [regexp pre(load|eval):(.*) $preload junk op url]} {
	    if { "$op" == "load" } {
		set res [HMgetURL $win $url type]
		append res $command
		set command $res
	    } else {
		append url $command
		set command $url
	    }
	}
    }
    return $command
}
#
#-----------------------------------------------------------------
#
# sendOneInsertTextWin --  send PROGRAM the COMMAND for insertion
# in the text window WIN at RANGE.   There may be a program specific
# insertResult_maxima, .. in which case this does the job.   It
# is also passed the field of where the command came from.
# We mark these fields with a tag, since they may get moved by typing
# before the result comes back.   The com:* tags also provide omDoAbort
# with the program names that are currently active, so that it can abort.
#  Results:
#
#  Side Effects: until the evaluation succeeds the tags
#  res:pdata($PROGRAM,result,$i) and a similar com: indicate the
#  result field, and the command field.
#
#----------------------------------------------------------------
#
proc sendOneInsertTextWin { program command win this range} {
    set eval [getTagsMatching $win ^eval(sub|):* $this]
    if { "$eval" != "" } {
	if { [regexp \{eval(sub|):(.*)\}  $eval junk op val ]  } {
	    if { "$op" == "sub" } {
		regsub -all "\\&" $val $command val
	    }
	    set command $val
	}
    }
    set command [addPreloads $command $program $win $this ]

    # puts "preload=$preload,command:$command"
    set loc [sendOneDoCommand $program $command "sendOneInsertTextWin1 $win $program "]
    if { "$range" != "" } {
	$win tag add res:$loc [lindex $range 0] [lindex $range 1]
    }
    $win tag add com:$loc [lindex $this 0] [lindex $this 1]
}

proc sendOneInsertTextWin1 { win program location } {
    #puts "entering trace:sendOneInsertTextWin1 $win $location"
    #flush stdout
    message "received result"
    set resultRange [$win tag nextrange res:$location 0.0]
    set this [$win tag nextrange com:$location 0.0]
    $win tag delete res:$location com:$location
    #    if { "$resultRange" == ""} {
    #	puts "somebody removed result place for $location"
    #	return ""
    #    }
    if {[info command insertResult_[programName $program]] != "" } {
	insertResult_[programName $program] \
	    $win $this $resultRange \
 	    [uplevel "#0" set $location]
    } else {
	insertResult $win $resultRange [uplevel "#0" set $location]
    }
    uplevel "#0" unset $location
}

proc xHMuntabify { s } {
    set lis [split $s \n]
    set ans [lindex $lis 0]
    foreach v [lrange $lis 1 end] {
	append ans \n[xHMuntabifyLine $v]
    }
    return $ans
}

proc xHMuntabifyLine { s } {
    set l [split $s \t]
    set ans [lindex $l 0]
    set rest [lrange $l 1 end]
    foreach w $rest {
	set n [expr {[string length $ans]%8}]
	append ans [string range "        " $n end]
	append ans $w
    }
    return $ans
}
#
#-----------------------------------------------------------------
#
# textBbox --  Compute the bounding box of a range of characters
# starting at IND1 and running to IND2.
#
#  Results: return "x y width height" where x, y are the coordinates
#  of the upper left corner.
#
#  Side Effects:
#
#----------------------------------------------------------------
#
proc textBbox { win ind1 ind2 } {
    foreach i { 1 2 } {
	set ind [eval $win index [set ind$i]]
	set ind$i $ind
	set line$i [lindex [split $ind .] 0]
	if { [catch {desetq "x$i y$i xdim$i ydim$i" [eval $win bbox $ind]}] } {
	    # not visible
	    return ""}
    }
    if { $line1 == $line2 } {
	return "$x1 $y1 [expr {$x2-$x1+$xdim2}] [expr {$y2-$y1+$ydim2}]"
    } else {
	set xrange "$x1 $x2+$xdim2"
	set yrange "$y1 $y2+$ydim2"
	for { set j $line1 } { $j < $line2 } { incr j } {
	    desetq "x y xdim ydim" [$win dlineinfo $j.0]
	    set xrange [minMax $xrange $x [expr {$x + $xdim}]]
	    set yrange [minMax $yrange $y [expr {$y + $ydim}]]
	}
	desetq "x y xdim ydim" [$win dlineinfo $line2.0]
	set xrange [minMax $xrange $x [expr {$x + $xdim}]]
	set yrange [minMax $yrange [expr {$y + $ydim}]]
	desetq "x1 x2 y1 y2" "$xrange $yrange"
	return "$x1 $y1 [expr {$x2 - $x1}] [expr {$y2 - $y1}]"
    }
}

proc textShowHelp { win tag index msg } {
    set this [thisRange $win $tag $index]
    if { "$this" == "" } { return }
    set tags [$win tag names $index]
    if { "$tag" == "Teval" } {
	set program [programFromTags $tags]
	if { "$program" != ""} {
	    set msg [string trimright $msg ". "]
	    append msg [mc " by %s." $program]
	}
	if { [doInsertp $tags] } {
	    append msg [mc " The result will be inserted."]
	}
	if { "[getPrefixed name: $tags]" != "" } {
	    append msg [concat [mc "  The result field is named"] "`[getPrefixed name: $tags]'."]
	}
    }
    if { [catch { desetq "x y wid hei" [eval textBbox $win  $this] } ] } {
	# cant get position
	return ""
    }
    set top [winfo toplevel $win]
    set x [expr {$x + [winfo rootx $win] - [winfo rootx $top]}]
    set y [expr {$y + [winfo rooty $win] - [winfo rooty $top]}]
    #puts "showHelp $win $x $y $wid $hei"
    #mike FIXME: $arg1 is a list not a window
    showHelp "$win $x $y $wid $hei" $msg
}

proc getTagsMatching { win regexp range } {
    foreach ind $range {
	foreach v [$win tag names $ind] {
	    if { [regexp -- $regexp $v] } {
		set there($v) 1
	    }
	}
    }
    set dump [eval $win dump -tag $range]
    set i 1
    set ll [llength $dump]
    while { $i < $ll } {
	set v [lindex $dump $i]
	if { [regexp -- $regexp $v] } {
	    set there($v) 1
	}
	incr i 3
    }
    return [array names there]
}

proc markForProgram { w args } {
    global evalTags
    set win [omPanel $w]
    set program [assoc -program $args [oget $win currentProgram]]
    set range [assoc -range $args [$w tag nextrange sel 0.0]]
    if { "$range" == ""} {
	return ""
    }
    set tags [assoc -tags $args ""]
    if { "$tags" == ""} {
	set tags [list Teval program:$program ]
	set opts [getGlobalOptions [programName $program]]
	if { "$opts" != ""} {  lappend tags [concat Targs $opts] }
    }
    # puts "tags=$tags"
    eval $w tag remove Teval $range
    foreach v [getTagsMatching $w "^Targs |^program:" $range] {
	eval $w tag remove [list $v] $range
    }
    foreach v $tags {eval $w tag add [list $v] $range}
    set insert [doInsertp $tags]
    if { $insert } {
	set nextResult [$w tag nextrange Tresult [lindex $range 1]]
	set next [$w tag nextrange Teval [lindex $range 1]]
	if { [llength $nextResult] == 0 ||
	     ([llength $next] !=0)
	     &&  [$w compare [lindex $nextResult 0] > [lindex $next 0]] } {

	    set templates [list " yields " " evaluates to "  \
			       " returns " " produces " " gives "]
	    $w mark set tmp [lindex $range 1]	

	    $w insert tmp [lindex $templates [expr {[clock clicks]%[llength $templates]}]] plain
	    $w insert tmp RESULT {Tresult Tmodified}
	    $w insert tmp " "  {plain}
	} else {
	    $w tag add Tmodified {*}$nextResult}}}

## endsource preamble.tcl
###### NConsole.tcl ######
############################################################
# Netmath       Copyright (C) 1998 William F. Schelter     #
# For distribution under GNU public License.  See COPYING. #
############################################################

proc mkConsole { fr program } {
    catch { destroy $fr }
    global NCtextHelp
    frame $fr
    pack $fr -expand 1 -fill both
    set w $fr.text
    label [set msg $fr.label]  -height 1 -relief sunken \
	    -textvariable ::xmaxima_priv(load_rate)
    oset $w program $program
    oset $w prompt "% "
    text $w
    bind $w <Configure> "resizeSubPlotWindows $w %w %h"
    $w tag configure input -foreground blue
    # -relief sunken -borderwidth 1
    bindtags $w [linsert [bindtags $w] 1 CNtext OpenMathText ]
    if { ![regexp -- $::xmaxima_priv(sticky) input] } {
	append ::xmaxima_priv(sticky) {|^input$}
    }
    CNinsertPrompt $w
    $w mark gravity lastStart left
    pack $w -side top -expand 1 -fill both
    pack $msg -side bottom -expand 0 -fill x
    raise $w
}

proc CNinterrupt { w } {
    sendInterrupt [oget $w program]
}

proc CNclearinput { w } {
    if { [$w compare lastStart < insert] } {
	pushl "[saveText $w lastStart insert ]" killRing
	$w delete lastStart insert
    }
}

proc CNinsertPrompt { w } {
    set prompt [oget $w prompt]
    $w mark set insert end
    if { [$w compare insert > "insert linestart"] } {
	$w insert insert \n
    }
    $w insert insert "$prompt" prompt
    $w mark set lastStart [$w index "end -1char"]
    $w see end
    #puts [$w dump -all "[$w index end] -2 lines" end]
}

proc CNeval { w } {
    linkLocal $w inputs inputIndex
    set prev ""
    if { [$w compare insert < lastStart] } {
	set this [thisRange $w input insert]
	if { "$this" != "" } {
	    set code [eval $w get $this]
	    set prev [string trimright [$w get lastStart end] \n]

	    $w delete lastStart end
	    $w insert lastStart $code input
	}
    }
    set expr [string trimright [$w get lastStart end] \n]
    $w tag add input lastStart end
    lappend inputs $expr
    set inputIndex [expr {[llength $inputs] - 1}]
    set tag ""
    #puts "sendind <$expr>"
    set res [sendOneWait [oget $w program] $expr]
    message "received result"
    if { "$res" != "" } {
	if { ![regexp \n $res] } {
	    set tag center
	    set res "\n $res"
	}

	if { [regexp "\{plot\[23\]d" $res] } {
	    linkLocal $w counter
	    #puts res=$res
	    if { ![info exists counter] } {set counter 0}
	    set name $w.plot[oset $w counter [expr {1 + [oget $w counter]}]]
	    eval plot2dData $name $res [getDimensions $w $name]
	    set e [$w index end]
	    set view [ShowPlotWindow $w $name  "$e $e" "$e $e"  ""]
	    append view " -1 line"
	} else {
	    $w insert end $res "$tag result"
	}
    }
    CNinsertPrompt $w
    if { [info exists view] } {$w yview $view }
    if { "$prev" != "" }  {$w insert insert $prev}
}

proc CNpreviousInput { w direction } {
    linkLocal $w  inputIndex matching
    if { [catch {makeLocal $w inputs}] } { return }
    if { [$w compare insert < lastStart ] } { return }
    set last [lindex [peekLastCommand $w] 1]
    if {  ("[lindex $last 2]" != "ALT_p" && "[lindex $last 2]" != "ALT_n") || \
	      ![info exists inputIndex] } {
	set inputIndex [expr {$direction < 0 ? [llength $inputs] : -1}]
	set matching [string trim [$w get lastStart end] " \n"]
    }
    if {[info exists $matching]} {
	lappend inputs $matching
    }
    set n [llength $inputs]
    set j 0
    set matchRegexp "[quoteForRegexp $matching]"
    while {[incr j] <= $n } {
	set inputIndex [expr {($inputIndex + $direction+ $n)%$n}]
	# [string match "$matching*" [lindex $inputs $inputIndex]]
    	if { [regexp -- $matchRegexp [lindex $inputs $inputIndex]] } {
	    $w delete lastStart end
	    $w insert insert [lindex $inputs $inputIndex]
	    $w see insert
	    break
	}
    }
}

proc CNblinkMatchingParen { win ch } {
    $win tag delete blink
    if { [string first $ch "\}\)\]"] >= 0 } {
	set tem [$win get "@0,0" "insert"]
	set ind [matchingParen $tem]
	if { "$ind" != "" } {
	    set ind [expr {[string length $tem] - $ind}]
	    catch { after cancel [oget $win blinkAfter] }
	    set i [$win index "insert -$ind chars"]
	    $win tag add blink "$i" "$i +1char"
	    $win tag configure blink -foreground red
	    oset $win blinkAfter [after 1000 $win tag delete blink]
	}
    }
}
#
#-----------------------------------------------------------------
#
# matchingParen --  Return index of STRING which a close paren
#   would match if added to end.
#  Results: index
#
#  Side Effects: none
#
#----------------------------------------------------------------
#
proc matchingParen { s1  } {
    set s $s1
    set ind [string length $s]
    set count -1
    regsub -all "\[\01\02\]" $s x s
    regsub -all "\[\]\}\)\]" $s "\01c" s
    regsub -all "\[\[\{\(\]" $s "\01o" s
    set lis [split $s \01]
    set n [llength $lis]
    while { [incr n -1] > 0 } {
	set v [lindex $lis $n]
	incr ind -[string length $v]
	set c [string index $v 0]
	if { "$c" == "c" } {
	    incr count -1
	} else {
	    incr count
	}
	if { $count == 0 } {
	    return $ind
	}
    }
}

## endsource nconsole.tcl
###### String.tcl ######


#
#-----------------------------------------------------------------
#
# trimSpace --  If a STRING contains no embedded newlines, then remove
#  the surrounding whitespace, otherwise just remove trailing whitespace.
#
#  Results:
#
#  Side Effects: none
#
#----------------------------------------------------------------
#
proc trimSpace { ans } {
    if { ![regexp "\n" $ans] } {
	set ans [string trim $ans "\n \t"]
    } elseif { [regexp "^\[\n\t \](\[^\n\]+)\[\n\t \]\$" $ans junk item] } {
	set ans [string trim $ans "\n \t"]
    } else {
	# set ans [string range $ans 0 [expr {[string length $ans] - 2}]]
	# try to make multiline things start with ans
	set ans \n[string trimleft $ans \n]
    }
    return $ans

    if { [regexp "^\[\n\t \]*(\[^\n\]+)\[\n\t \]*\$" $ans junk item] } {
	set ans [string trim $ans "\n \t"]
    } elseif { [regexp "\n" $ans] } {
	set ans [string trim $ans "\n \t"]
	return "\n$ans"
    }    else {
	set ans [string trimright $ans "\n \t"]
    }
    return $ans
}


#
#-----------------------------------------------------------------
#
# genword --  make a string by copying STRING a total of COUNT times
#
#  Results:string
#
#  Side Effects: none
#
#----------------------------------------------------------------
#
proc genword { string count } {
    set ans ""
    while { [incr count -1] >= 0 } { append ans $string }
    return $ans
}

proc resetMaximaFont { w } {
    $w config -font [xHMmapFont font:fixed:normal:r:[expr $::xmaxima_default(fontAdjust) + 3]]
}

## endsource string.tcl
############################################################
# RunMaxima.tcl                                            #
# Copyright (C) 1998 William F. Schelter                   #
# For distribution under GNU public License.  See COPYING. #
#                                                          #
#     Modified by Jaime E. Villate                         #
############################################################
proc textWindowWidth { w } {
    set font [$w cget -font]
    set w20 [font measure [$w cget -font] -displayof $w "01234567890123456789"]
    return [expr round(floor([winfo width $w]*20.0/$w20))]
}

proc textWindowHeight { w } {
    set font [$w cget -font]
    set h1 [font metrics [$w cget -font] -displayof $w -linespace]
    return [expr round([winfo height $w]/$h1)]
}

proc resizeMaxima { win width height } {
    linkLocal $win pid
    if { [info exists pid] && $pid != "none" } {
	set wid [expr [textWindowWidth $win]-6]
	sendMaxima $win ":lisp-quiet (setq \$linel $wid)\n"
    }
}

# proc packBoth {fr browser} {
#     pack forget $fr $browser
#     pack $fr -expand 1 -fill both -side top
#     pack $browser -side bottom -expand 1 -fill both
# }

proc CMeval { w } {
    linkLocal $w inputs
    oset $w output 0
    set prev ""
    #puts "CMeval $w, [$w compare insert < lastStart]"
    if { [$w compare insert < lastStart] } {
	set this [thisRange $w input insert]
	if { [llength $this] > 1 } {
            set code [$w get [lindex $this 0]+1c [lindex $this 1]]
	    set code [string trimright $code \n]
	    set prev [string trimright [$w get lastStart end] \n]
	    $w delete lastStart end
	    $w insert lastStart $code input
	}
    }
    # puts "expr=<[$w get lastStart end]>"
    # puts "tags=[$w tag names insert],insert=[$w index insert]"
    # if { [lsearch [$w tag names insert] insert] >= 0 } {
    # 	 $w mark set lastStart [lindex [$w tag prevrange input insert] 0]
    # }
    set expr [string trimright [$w get lastStart end] \n]
    # puts "command-line: ([$w index lastStart], [$w index end])"
    # puts "command: $expr"
    if { ![regexp {^[ \n\t]*:|[;\$][ \t]*$|^\?[\?!]?[ \t]+[^ \t]} $expr] } {
	$w insert insert "\n"
	$w see insert
	if { [catch {set atprompt [oget $w atMaximaPrompt]}] } {
	    puts {atMaximaPrompt not defined}
	} elseif { $atprompt } {
	    # puts "atMaximaPrompt=$atprompt"
	    return
	}
    }

    $w tag add input lastStart-1c "end -1char"
    $w tag add mprompt "lastStart linestart" lastStart
    $w mark set  lastStart "end -1char"
    lappend inputs $expr

    oset $w inputIndex [expr {[llength $inputs] - 1}]
    openMathAnyKey $w [string index $expr end] [string index $expr end]

    set tag ""
    # puts "sending <$expr>"
    # set res [sendMaxima $w $expr ]
    set res [sendMaxima $w $expr\n ]
    # set res [sendMaxima $w $expr ]
    # puts "[$w dump -all "lastStart linestart" end]"
    #message "send form"
}

proc acceptMaxima { win port filter } {
    set count 3
    catch { close [oget $win server] }
    while {[incr count -1 ] > 0 } {
	if { ![catch {oset $win server [socket -server "runMaxima $win $filter" $port]} ] } {
	    # puts "server sock [oget $win server]"
	    return $port
	} else {
	    incr port
	}
    }
    return -1
}

proc openMaxima { win filter } {
    if {$::xmaxima_priv(localMaximaServer) == ""} {
	return -code error [mc "Could not start Maxima - empty command"]
    }
    set port $::xmaxima_default(iLocalPort)
    set port [acceptMaxima $win $port $filter]
    if { $port >= 0 } {
	set com ""
	set command [list eval exec]
	# This may be needed under CYGWIN
	# if {$::xmaxima_priv(platform) == "cygwin"} {lappend command "/bin/bash"}
	append com    $::xmaxima_priv(localMaximaServer)
	regsub PORT $com $port com
	if { [info exists ::env(MAXIMA_INT_INPUT_STRING)] } {
	    regsub PORT $::env(MAXIMA_INT_INPUT_STRING) $port ::env(MAXIMA_INT_INPUT_STRING)
	    #puts ::env(MAXIMA_INT_LISP_PRELOAD)=$::env(MAXIMA_INT_LISP_PRELOAD)
	    #puts ::env(MAXIMA_INT_INPUT_STRING)=$::env(MAXIMA_INT_INPUT_STRING)
	}
	#puts com=$com
	set command [concat $command  $com]
	if { [catch $command err ] } {
	    #mike Must return an error to stop runOneMaxima from continuing
	    return -code error [concat [mc "Can't execute"] "$com\n$err"]
	}
    } else {
	return -code error [mc "Could not open a socket "]
    }
}


proc runMaxima { win  filter sock args } {
    linkLocal $win server
    oset $win maximaSocket $sock
    fconfigure $sock -blocking 0 -translation lf
    
    # Starting from 5.47post, Maxima now outputs UTF-8
    fconfigure $sock -encoding utf-8
    
    fileevent $sock readable "$filter $win $sock"

    if { [info exists server] } {
	# puts "closing server $server"
	catch {
	    close $server
	    unset server
	}
    } else {
	# puts "server unset ??"
    }
}

proc closeMaxima { win } {
    global pdata
    linkLocal $win maximaSocket pid

    # first close the open Maxima session
    catch { sendMaxima $win "quit();" } 
 
    # and then close the socket
    if {[info exists maximaSocket]} {
	if {$maximaSocket != ""} {
	    set err ""
	    catch {
		close $maximaSocket
	    } err
	    maxStatus [concat [mc "Closed socket"] "$maximaSocket: $err"]
	    unset maximaSocket
	    after 500
	    # Maxima takes time to shutdown?
	}
    } else {
	# tk_messageBox -icon error -message "no socket $win"
    }

    if {[info exists pid]} {
	if {$pid != "" && [string is int $pid]} {
	    set err ""
	    catch {
		CMkill -TERM $pid
	    } err
	    maxStatus [concat [mc "Killed process"] "'$pid': $err"]	    
	    unset pid
	    # Maxima takes time to shutdown?
	    after 500
	}
    } else {
	# tk_messageBox -icon error -message "no pid $win"
    }

    if {[info exists pdata]} {
	foreach v [array names pdata maxima*] { unset pdata($v) }
    }

}


#
#-----------------------------------------------------------------
#
# maximaFilter --  filter the output on SOCKET inserting in WINDOW
# recognizing
#     \032\032:file:line:charpos\n
#               -->redisplay in other window
# \032\031tcl: command \n
#           --> eval tcl command o
#
#
#  Results: none
#
#  Side Effects:  input is read from SOCK and WIN has items displayed.
#
#----------------------------------------------------------------
#
#todo fix sendMaximaWait win expr
proc maximaFilter { win sock } {
    linkLocal $win plotPending output
    if {![info exists output]} {set output 1}
    global pdata
    if { [eof $sock] } {
	# puts "at end"
	close $sock
	return ""
    }
    set it [read $sock]
    # puts "read=<$it>"
    if { [string first "\032\032" $it] >= 0 &&
	 [regexp  -indices "\032\032(\[^:]+):(\[0-9]+):\[^\n]*\n" $it junk file line] } {
	
	dblDisplayFrame [getMatch $it $file] [getMatch $it $line]
	append res [string range $it 0 [expr { [lindex $junk 0] -1 } ]]
	append res [string range $it [expr { 1+[lindex $junk 1]}] end]
	set it $res
    }
    if { [string first "\032\031tcl:" $it] >= 0 && \
	     [regexp  -indices "\032\031tcl:(\\[^\n]*)\n" $it junk com]} {
	eval $com
	append res [string range $it 0 [expr { [lindex $junk 0] -1 } ]]
	append res [string range $it [expr { 1+[lindex $junk 1]}] end]
	set it $res
    }
    # puts "it=<$it>"
    if { [regexp -indices "\{(plotdf|plot2d|plot3d|scene)" $it inds] } {
	set plotPending [string range $it [lindex $inds 0] end]
	set it ""
	if { [regexp {\(\(C|%i\)[0-9]+\) $} $it ff] } {
	    regexp "\{(plotdf|plot2d|plot3d|scene).*\}" $ff it
	    #	set it $ff
	}
    }
    if { [info exists plotPending] } {
	# puts "plotPending=<$plotPending>,it=<$it>"
	append plotPending $it
	set it ""
	if { [regexp -indices "\n\\((C|%i)\[0-9\]+\\)" $plotPending  inds] } {
	    set it [string range $plotPending [lindex $inds 0] end]
	    set plotPending [string range $plotPending 0 [lindex $inds 0]]
            # Work around for ccl, which does not put a new-line character
            # between the plot command and the ouput prompt
            if { [regexp -indices "\[^\n\]\\((D|%o)\[0-9\]+\\)" $plotPending \
                      inds] } {
                append data [string range $plotPending 0 [lindex $inds 0]] \
                    "\n" [string range $plotPending [lindex $inds 0]+1 end]
            } else {
                set data $plotPending
            }
	    unset plotPending
	    # puts "itplot=<$it>,$inds"
	    # puts "plotdata=<$data>"
	    doShowPlot $win $data

	}
    }

    if {[string length $it] > 0} {
	# Make sure Maxima's output starts on a new line but do not tag the
	# new line as output
        set it2 $it
	if {$output == 0} {
	    if {[string equal -length 1 $it "\n"]} {
		set it2 [string range $it 1 end]
	    }
	    $win insert end "\n" input
	    set output 1
	}
	$win insert end $it2 output
	$win mark set lastStart "end -1char"
    }
    if { [regexp {\((?:C|%i)[0-9]+\) $|\(dbm:[0-9]+\) $|(MAXIMA>? ?)$|(none'?:? ?)$} $it junk lisp describe]  } {
	# puts "junk=$junk, lisp=$lisp,[expr {0 == [string compare $lisp {}]}]"
	# puts "it=<$it>,pdata={[array get pdata *]},[$win index end],[$win index insert]"

	if { [info exists pdata($sock,wait) ] && $pdata($sock,wait) > 0 } {
	    # puts "it=<$it>,begin=$pdata($sock,begin),end=[$win index {end linestart}]"
	    # puts dump=[$win dump -all "insert -3 lines" end]
	    setAct pdata($sock,result) [$win get $pdata($sock,begin) "end -1char linestart" ]
	    # puts result=$pdata($sock,result)
	    set pdata($sock,wait) 0
	}
	$win mark set lastStart "end -1char"
	$win tag add  input "end -1char" end
	oset $win atMaximaPrompt [expr { 0 == [string compare $lisp {}] && 0 == [string compare $describe {} ] } ]
	
    }
    $win see end
    #moves the cursor to the end
    $win mark set insert output.last
    return
}

proc littleFilter {win sock } {
    global pdata
    set tem [gets $sock]
    append pdata(maximaInit,$sock) $tem
    debugsend "littlefilter got:<$tem>"
    if { [regexp {pid=([---0-9]+)} $tem junk pid] } {
	fileevent $sock readable ""
	oset $win pid $pid
	oset $win socket $sock
    }
}

if { ![info exists ::xmaxima_priv(timeout)] } {

    set ::xmaxima_priv(timeout) 60000
}

proc runOneMaxima { win } {
    global pdata

    closeMaxima $win
    linkLocal $win pid
    set pid "none"

    openMaxima $win littleFilter

    while { $pid == "none" } {
	set af [after $::xmaxima_priv(timeout) oset $win pid "none" ]
	# puts "waiting pid=$pid"
	maxStatus [mc "Starting Maxima"]
	vwait [oloc $win pid]
	after cancel $af
	if { $pid  == "none" } {
	    if {[tk_messageBox -type yesno -title "Connection" -icon question \
                     -message [mc "Starting maxima timed out. Wait longer?"]]} {
		continue
	    } else {
		catch {closeMaxima $win}
		set err [mc "Starting Maxima timed out"]
		if {![catch {oget $win socket} sock] && \
			[info exists pdata(maximaInit,$sock)] } {
		    append err : $pdata(maximaInit,$sock)
		}
		return -code error $err
	    }
	}
    }

    if {[catch {oget $win socket} sock]} {
	return -code error [mc "Failed to start Maxima"]
    }
    maxStatus [mc "Started Maxima"]
    
    SetPlotFormat $::xmaxima_priv(cConsoleText)

    set res [list [oget $win pid] $sock ]
    global pdata
    set pdata(maxima,socket) $sock
    fileevent $sock readable  [list maximaFilter $win $sock]
    sendMaxima $win ":lisp-quiet (setq \$maxima_frontend \"Xmaxima\")\n"
    sendMaxima $win ":lisp-quiet (setq \$maxima_frontend_version \"$::autoconf(version)\")\n"
    sendMaxima $win ":lisp-quiet (setq \$maxima_frontend_bugreportinfo \"XMaxima is part of maxima.\")\n"
    sendMaxima $win ":lisp-quiet (defun display-frontend-topics (wanted) (display-html-topics wanted))\n"
    return $res

}

proc sendMaxima { win form } {
    linkLocal $win maximaSocket
    if {![info exists maximaSocket] || $maximaSocket == ""} {return}

    if { ![regexp "\[\$;\]\[ \t\n\r\]*\$" $form ] } {
	# append form ";"
    }
    if {[catch {
	puts -nonewline $maximaSocket $form
	flush $maximaSocket} err]} {
	set mess [mc "Error sending to Maxima:"]
	if {[string match "can not find channel named*" err]} {
	    # The maxima went away
	    set maximaSocket ""
	    unset maximaSocket
	    set mess [concat "$mess\n%s\n" [mc "You must Restart"] $err]
	} else {
	    set mess [concat "$mess:\n%s\n" [mc "You may need to Restart"] $err]
	}
	tk_messageBox -title Error -icon error -message $mess
    }
}


proc sendMaximaWait { win form {timeout 20000 }} {
    linkLocal $win maximaWait

    set form [string trimright $form "\n \t\r"]

    if { ![regexp "\[\$;\]|^\[ \t]*:" $form ] } {
	append form ";"
    }
    sendMaximaCall $win "$form\n" [list oset $win maximaWait 1]
    #mike FIXME: This should be a counter
    set maximaWait -1
    set af [after $timeout oset $win maximaWait -1]
    vwait [oloc $win maximaWait]
    after cancel $af

    set sock [oget $win maximaSocket]
    if {$sock == ""} {
	error [concat "sendMaximaWait $form" [mc "socket closed"]]
    }
    if { $maximaWait > 0 } {
	global pdata
	return [trim_maxima $pdata(${sock},result)]
    } else {
	error [concat "sendMaximaWait $form" [mc "timed out"]]
    }
}



#
#-----------------------------------------------------------------
#
# sendMaximaCall --  send FORM to maxima process in WIN
# and when it gets the result have it execute CALL
#
#  Results: none
#
#  Side Effects: maxima executes form and then call may
#  do something like insert it somewhere in a buffer.
#
#  # todo: should probably make it so this guy looks at maxima c, d numbers
#    and matches results ..
#----------------------------------------------------------------
#
proc sendMaximaCall { win form call } {
    linkLocal $win maximaSocket
    if {![info exists maximaSocket] || $maximaSocket == ""} {return}

    global pdata
    set begin [$win index lastStart]
    if { [regexp {(C|%i)([0-9]+)} [$win get "$begin linestart" $begin] junk \
	      counter ] } {
	#	set af [after 5000 set pdata($maximaSocket,wait) -1]
	set pdata($maximaSocket,wait) 1
	
	set pdata($maximaSocket,begin) $begin
    } else {
	catch { unset pdata($maximaSocket,wait) }
    }
    if {[catch {
	puts -nonewline $maximaSocket $form
	flush $maximaSocket} err]} {
	set mess [mc "Error sending to Maxima:"]
	if {[string match "can not find channel named*" err]} {
	    # The maxima went away
	    set maximaSocket ""
	    unset maximaSocket
	    set mess [concat "$mess\n%s\n" [mc "You must Restart"] $err]
	} else {
	    set mess [concat "$mess:\n%s\n" [mc "You may need to Restart"] $err]
	}
	tk_messageBox -title Error -icon error -message $mess
	return
    }
    if { [info exists counter] } {
	setAction pdata($maximaSocket,result) $call
    }
}

proc setAction { var action } {
    global _actions
    set _actions($var) $action
}

proc setAct { var val } {
    global _actions
    uplevel "#0" set $var [list $val]
    if { [info exists _actions($var)] } {
	uplevel "#0" $_actions($var)
	unset _actions($var)
    }
}

proc CMresetFilter { win } {
    set sock [oget $win maximaSocket]
    fileevent $sock readable "maximaFilter $win $sock"
}

proc CMkill {  signal pid } {
    # Windows pids can be negative
    if {[string is int $pid]} {
	maxStatus [mc "Sending signal %s to process %s" "$signal" "$pid"]
	if {$::tcl_platform(platform) == "windows" } {
	    exec $::xmaxima_priv(kill) $signal $pid
	} else {
	    exec $::xmaxima_priv(kill) $signal $pid
	}
    }
}

proc CMinterrupt { win } {

    set pid [oget $win pid]
    if {$pid != "" && $pid != "none"} {
	CMkill   -INT $pid
    }
    CMresetFilter $win
}

proc doShowPlot { w data } {
    #puts data=$data
    set command [lindex [lindex $data 0] 0]
    set name [plotWindowName $w $command]
    if { "$command" == "plotdf" || $command == "scene" } {
	set command [lindex $data 0]
    } else {
	lappend command -data [lindex $data 0]
    }
    lappend command -windowname $name
    #	puts $command
    eval $command
    #	return
    set e [$w index end]
    if { [catch {set view [ShowPlotWindow $w $name  "$e $e" "$e $e"  ""] }]} {
    return }
    if { "$view" == "" } { return }
    append view " -1 line"
    set tem [$w dump -window $view end]
    global billy
    set billy $tem
    if { [llength $tem] == 3 } {
	after 80 $w see [lindex $tem 2]
	#after 400 $w see [lindex $tem 2]
	#puts "	    after 400 $w see [lindex $tem 2]"
    }
}


proc dblDisplayFrame { location line } {
    OpenMathOpenUrl $location
    set panel [omPanel .]
    set w [oget $panel textwin]
    $w tag remove currentLine 0.0 end
    $w tag add currentLine "$line.0" "$line.0 lineend"
    $w tag config currentLine -foreground red
    set beg [lindex [split [$w index "@0,0"] .] 0]
    set end [lindex [split [$w index "@0,3000"] .] 0]
    # puts "line=$line,beg=$beg,end=$end"
    if { "$beg" != "" &&  ( $line < $beg + 3 || $line > $end - 3) } {
	$w yview [expr $line - 3]
    }
    $w see $line.0
}



#
#-----------------------------------------------------------------
# required:
#
# trim_maxima --  takes STRING and trims off the prompt
# and trailing space if desired.   Usually single line results
# have their white space completely trimmed, while multiline
# results will be left so that they display properly from left margin
#
#  Results:  a string with white space trimmed off
#
#  Side Effects:
#
#----------------------------------------------------------------
#
proc trim_maxima { string } {
    debugsend "in trim_maxima input=<$string>"
    if { [string first \n $string] == 0 } {
	set string [string range $string 1 end]
    }
    if { [regexp -indices "(^|\n)(\\((D|%o)\[0-9\]+\\))" $string all junk inds] } {
        set len [expr {[lindex $inds 1]  - [lindex $inds 0] }]
        set repl [genword " " $len]
        set ans [string range $string 0 [expr {[lindex $inds 0 ] -1}]]
        append ans $repl
        append ans [string range $string  [expr {[lindex $inds 1 ] +1}] end ]
	debugsend "in trim_maxima ans=<$ans>"
	set string [trimSpace $ans]

    }
    return $string
}

proc dshow { args  } {
    foreach v $args { append ans $v=[uplevel 1 set $v], }
    puts $ans
}
proc maxima_insert { w this next val args } {
    catch {
	set res [uplevel "#0" set $val]
    }
    catch {
	insertResult_maxima $w $this $next [trim_maxima $res]
    }
}

proc eval_maxima { prog win this nextResult } {
    set w $::xmaxima_priv(maximaWindow)
    linkLocal $w maximaSocket
    if {![info exists maximaSocket] || $maximaSocket == ""} {return}

    set form [string trimright [eval $win get $this] " \t\n;$"]
    set form [addPreloads $form maxima $win $this]
    if { "[lindex $nextResult 0]" != "" } {
	sendMaximaCall $w "$form;\n" [list maxima_insert $win $this  $nextResult pdata($maximaSocket,result)]
	
	#         set res [sendMaximaWait $::xmaxima_priv(maximaWindow) "$form;"]
	#	insertResult_maxima $win $this  $nextResult $res
    } else {
	sendMaxima $::xmaxima_priv(maximaWindow) "$form;\n"
    }
    return 0
}





proc changeSize { win  y } {
    set del 0
    set tem [expr { [winfo rooty $win] + [winfo height $win] } ]
    set del [expr {abs($y-$tem) <20 ? 0: $y-$tem < 0 ? -1 : 1 }]
    if { $del } {
	set h [$win cget -height]
	incr h $del
	if { $h >= 1 } {
	    $win config -height $h
	}
    }

}
############################################################
# Menu.tcl                                                 #
# Copyright (C) 1998 William F. Schelter                   #
# For distribution under GNU public License.  See COPYING. #
#                                                          #
#     Modified by Jaime E. Villate                         #
############################################################

proc zoomConsole {f} {
    set ffamily [lindex $::xmaxima_default(ConsoleFont) 0]
    set fsize [lindex $::xmaxima_default(ConsoleFont) 1]
    set fsize [expr round($fsize*pow(1.2,$f))]
    font configure ConsoleFont -family $ffamily -size $fsize
    set text $::xmaxima_priv(cConsoleText)
    resizeSubPlotWindows $text [winfo width $text] [winfo height $text]
    resizeMaxima $text [winfo width $text] [winfo height $text]
    set ::xmaxima_default(ConsoleFont) [list $ffamily $fsize]
}

proc fileType {type} {
    switch -exact -- $type output {
        return [list {"Output Files" .out} {"All Files" *}]
    } lisp {
        return [list {"Lisp Files" {.lisp}} {"All Files" *}]
    } maxima {
        return [list {"Maxima Files" {.mac .mc .dem}} {"All Files" *}]
    } all - default {
        return [list {"All Files" *}]}}

proc getOpenFile {title {type "all"}} {
    set types [fileType $type]
    set file $::xmaxima_default(OpenFile)
    if {$file ne ""} {set dir [file dir $file]} {set dir ""}
    set proc tk_getOpenFile
    set list [list $proc -title $title -filetypes $types]
    if {$dir ne ""} {lappend list  -initialdir [file native $dir]}
    if {[catch {eval $list} retval]} {
	global errorInfo
	tk_messageBox -title Error -icon error -message \
            [mc "Error opening file:\n%s" $errorInfo]
	return ""}
    if {$retval ne ""} { set ::xmaxima_default(OpenFile) $retval }
    return $retval}

proc getSaveFile {title {type "all"}} {
    set types [fileType $type]
    set file $::xmaxima_default(SaveFile)
    if {$file ne ""} {set dir [file dir $file]} {set dir ""}
    set proc tk_getSaveFile
    set list [list $proc -title $title -filetypes $types]
    if {$dir ne ""} {lappend list -initialdir [file native $dir]}
    if {[catch {eval $list} retval]} {
	global errorInfo
	tk_messageBox -title Error -icon error -message \
            [mc "Error saving file:\n%s" $errorInfo]
	return ""}
    if {$retval ne ""} { set ::xmaxima_default(SaveFile) $retval }
    return $retval}

proc cIDECreateEvent {text label code} {
    set z [winfo toplevel $text]
    set event "<<[join $label -]>>"
    bind $text $event $code
    return [list event generate $text $event]
}

proc pMAXSaveTexToFile {text} {
    set file [getSaveFile [mc "Save to a file"] output]
    if {$file != ""} {
	set contents [$text get 1.0 end]
	set fd [open $file w]
	if {[catch {puts $fd $contents} err]} {
	    tk_messageBox -title Error -icon error -message \
                [mc "Error writing to file:\n%s" $err]
	}
	catch {close $fd}
    }
}

proc vMAXAddBrowserMenu {win} {
    if {[winfo exists .browser.menu]} {destroy .browser.menu}
    set bm .browser.menu
    menu $bm
    .browser configure -menu .browser.menu
    foreach m {file edit options help} {
        $bm add cascade -label [string totitle $m] -underline 0 \
            -menu [menu $bm.$m -tearoff 0]
    }
    $bm.file add command -label [mc Reload] -underline 0 \
	-command "OpenMathOpenUrl \[oget \[omPanel $win\] location\] -reload 1 \
		      -commandpanel \[omPanel $win\]"
    $bm.file add command -label [mc Interrupt] -underline 0 \
        -command "omDoInterrupt \[oget \[omPanel $win\] textwin\]"
    $bm.file add command -label [mc Abort] -underline 0 \
	-command "omDoAbort \[oget \[omPanel $win\] textwin\]"
    $bm.file add command -label [mc Stop] -underline 1 \
	-command "omDoStop \[oget \[omPanel $win\] textwin\]"
    $bm.file add command -label [mc Forget] -underline 0 \
        -command  "forgetCurrent \[omPanel $win\]"
    $bm.file add command -label [mc Save] -underline 0\
	-command "pMAXSaveTexToFile \[oget \[omPanel $win\] textwin\]"
    $bm.file add separator
    $bm.file add command -label [mc {Close}] -underline 0 \
        -command "destroy $win"
    $bm.options add command -label [mc {Fonts}] -underline 0 \
        -command {fontDialog .fontdialog}
}

proc vMAXAddSystemMenu {fr text} {
    set win $fr.textcommands
    # Build a menubar
    if {[winfo exists .menu]} {destroy .menu}
    menu .menu
    . configure -menu .menu
    # Add a File menu
    set m [menu .menu.file -tearoff 0]
    .menu add cascade -label [mc "File"] -menu $m -underline 0
    $m add command -underline 0 \
	-accel {Alt+b} \
	-label [set label [mc "Batch File"]] \
	-command [set command [cIDECreateEvent $text $label {
	    set file [getOpenFile [mc "Open a file to Batch"] maxima]
	    if {$file != ""} {
		sendMaxima $::xmaxima_priv(cConsoleText) "batch(\"$file\")\$\n"
		maxStatus [concat [mc "Batched File "] "$file"]
	    }
	}]]
    bind $text <Alt-Key-b> $command
    $m add command -underline 11 \
	-accel {Alt+o} \
	-label [set label [mc "Batch File Silently"]] \
	-command [set command [cIDECreateEvent $text $label {
	    set file [getOpenFile [mc "Open a file to Batch Silently"] maxima]
	    if {$file != ""} {
		sendMaxima $::xmaxima_priv(cConsoleText) "batchload(\"$file\")\$\n"
		maxStatus [concat [mc "Batched File "] "$file"]
	    }
	}]]
    bind $text <Alt-Key-o> $command

    $m add command -underline 11 \
	-accel {Alt+i} \
	-label [set label [mc "Restore Maxima State"]] \
	-command [set command [cIDECreateEvent $text $label {
	    set file [getOpenFile [mc "Open a file to Restore State"] lisp]
	    if {$file != ""} {
		sendMaxima $::xmaxima_priv(cConsoleText) ":lisp-quiet (prog2 (mfuncall '\$load \"$file\") nil)\n"
		maxStatus [concat [mc "Maxima State Restored from "] "$file"]
	    }
	}]]
    bind $text <Alt-Key-i> $command

    $m add separator
    $m add command -underline 0 \
	-label [set label [mc "Save Maxima State to File"]] \
	-accel {Ctrl+s} \
	-command [set command [cIDECreateEvent $text $label {
	    set file [getSaveFile [mc "Save to a file"] lisp]
	    if {$file != ""} {
		sendMaxima $::xmaxima_priv(cConsoleText) ":lisp-quiet (prog2 (mfuncall '\$save \"$file\" '\$all) nil)\n"
		maxStatus [concat [mc "Maxima State Saved to "] "$file"]
	    }
	}]]
    bind $text <Control-Key-s> $command

    $m add command -underline 1 \
	-label [set label [mc "Save Maxima Input to File"]] \
	-accel {Ctrl+a} \
	-command [set command [cIDECreateEvent $text $label {
	    set file [getSaveFile [mc "Save to a file"] maxima]
	    if {$file != ""} {
		sendMaxima $::xmaxima_priv(cConsoleText) ":lisp-quiet (prog2 (mfuncall '\$stringout \"$file\" '\$input) nil)\n"
		maxStatus [concat [mc "Maxima Input Saved to "] "$file"]
	    }
	}]]
    bind $text <Control-Key-a> $command
    $m add sep
    $m add command -underline 0 \
	-label [mc "Interrupt"] \
	-accel {Ctrl+g} \
	-command [list event generate $text <Control-Key-g>]
    $m add command -underline 0 \
	-label [mc "Restart"] \
	-command [list runOneMaxima $text]
    $m add command -underline 0 \
	-label [mc "Input prompt"] \
	-accel {Alt+s} \
	-command [list event generate $text <Alt-Key-s>]

    $m add separator
    $m add command -underline 1 -label [mc "Exit"] \
        -command [list maxExit $text]

    # Add an Edit menubutton
    set m [menu .menu.edit -tearoff 0]
    .menu add cascade -label [mc "Edit"] -menu $m -underline 0
    $m add command -underline 2 \
	-label [mc "Cut"] \
	-accel {Ctrl+x} \
	-command [list event generate $text <Control-Key-x>]
    $m add command -underline 0 \
	-label [mc "Copy"] \
	-accel {Ctrl+c} \
	-command [list event generate $text <Control-Key-c>]
    $m add command -underline 0 \
	-label [mc "Paste"] \
	-accel {Ctrl+v} \
	-command [list event generate $text <Control-Key-v>]
    #mike distinguish from Cut/Copy/Past and Kill/Yank
    $m add separator
    $m add command -underline 0 \
	-label [mc "Kill"] \
	-accel {Ctrl+k} \
	-command [list event generate $text <Control-Key-k>]
    $m add command -underline 0 \
	-label [mc "Yank"] \
	-accel {Ctrl+y} \
	-command [list event generate $text <Control-Key-y>]
    $m add separator
    #mike FIXME: use event generate
    $m add command -underline 0 \
	-label [mc "Previous Input"] \
	-accel {Alt-p} \
	-command [list CNpreviousInput $text -1]
    $m add command -underline 0 \
	-label [mc "Next Input"] \
	-accel {Alt-n} \
	-command [list CNpreviousInput $text 1]
    $m add command -underline 9 -label [mc "Clear input"] \
	-accel {Ctrl+u} \
	-command [list CNclearinput $text]
    $m add separator
    $m add command -underline 0 -label [mc "Save Console to File"] \
	-command [list pMAXSaveTexToFile $::xmaxima_priv(cConsoleText)]

    # Add an Options menubutton
    set m [menu .menu.options -tearoff 0]
    .menu add cascade -label [mc "Options"] -menu $m -underline 0
    $m add separator
    $m add command -label [mc "Open the Browser"] \
        -command [list createBrowser .browser]
    set pm [menu $m.plot]
    $m add cascade -label [mc "Plot Windows"] -menu $pm
    foreach elt { embedded separate multiple } {
	$pm add radio -label [mc [string totit $elt]] \
	    -variable ::xmaxima_default(plotwindow) \
	    -value $elt -command [list SetPlotFormat $text ]
    }
    # $m add separator
    # $m add command -underline 0 \
    #     -label [mc "Preferences"] \
    #     -command {fontDialog .preferences}
    if {[info commands console] == "console" } {
	$m add sep
	$m add command -underline 0 -label [mc "Show Tcl Console"] \
	    -command [list console show]
    }

    # Add a Maxima menubutton
    set m [menu .menu.maxima -tearoff 0]
    .menu add cascade -label "Maxima" -menu $m -underline 0
    set km [menu $m.kill]
    $m add cascade -label [mc "Clear Memory"] -menu $km
    $km add command -label [mc "Kill All"] \
	-command [list sendMaxima $text "kill(all)\$\n"]
    $km add separator
    foreach elt {labels values functions macros arrays \
		     myoptions props aliases rules gradefs \
		     dependencies let_rule_packages} {
	$km add command -label [mc [string totit $elt]] \
	    -command [list sendMaxima $text "kill($elt)\$\n"]
    }
    $m add separator  
    set dir $::xmaxima_priv(pTestsDir)  
    if {[file isdir $dir]} {
	set state normal
    } else {
	set state disabled
    }
    $m add command -underline 0 \
	-state $state \
	-label [mc "Run Tests"] \
	-command [list sendMaxima $text "run_testsuite()\$\n"]
    $m add command -underline 0 \
	-state $state \
	-label [mc "About Maxima"] \
	-command [list sendMaxima $text "build_info();\n"]

    # Add a Help menubutton
    set m [menu .menu.help -tearoff 0]
    .menu add cascade -label [mc "Help"] -menu $m -underline 0

    # Xmaxima manual
    set xmaximahelpfile [file join $::xmaxima_priv(maxima_verpkgdatadir) xmaxima html index.html]
    set xmaximahelpfile [file normalize $xmaximahelpfile]
    set xstate normal
    # if {[file isfile $xmaximahelpfile]} {
    #     set xstate normal
    # } else {
    #     set xstate disabled
    # }
    # Maxima manual
    set file $::xmaxima_priv(pReferenceToc)
    if {$::tcl_platform(platform) == "windows"} {
        # decodeURL is broken and needs fixing
        # This is a workaround
        set file [file attrib $file -shortname]
    }
    set state normal
    # if {[file isfile $file]} {
    #     set state normal
    # } else {
    #     set state disabled
    # }
    if {$::tcl_platform(platform) == "windows"} {
        if {[string match *maxima.chm* $file]} {
            $m add command -underline 1 -label [mc "Maxima Manual"] \
         	    -state $state \
	            -command [list exec hh.exe $file & ]
        } else {
            $m add command -underline 1 -label [mc "Maxima Manual (xmaxima browser)"] \
        	    -state normal \
	            -command "OpenMathOpenUrl \"file:/$file\""
        }
        $m add command -underline 4 -label [mc "Xmaxima Manual (xmaxima browser)"] \
        	-state $xstate \
	        -command "OpenMathOpenUrl \"file:/$xmaximahelpfile\""
    } else {
        $m add command -underline 1 -label [mc "Maxima Manual (xmaxima browser)"] \
        	-state $state \
	        -command "OpenMathOpenUrl \"file:/$file\""
        $m add command -underline 4 -label [mc "Xmaxima Manual (xmaxima browser)"] \
        	-state $xstate \
	        -command "OpenMathOpenUrl \"file:/$xmaximahelpfile\""
    }
    set browse {exec}

    # FIXME: get a browser object
    if {$::tcl_platform(platform) == "windows"} {
	if {$::tcl_platform(os) == "Windows 95"} {
	    # Windows 95/98/ME
	    lappend browse start
	} else {
	    # Windows NT / 2000
	    lappend browse cmd.exe /c start
	}
    } else {
	set selectedbrowser xdg-open
	foreach b { xdg-open htmlview firefox chromium-browser google-chrome konqueror epiphany galeon amaya opera } {
	    if { ! [catch {exec which $b} ] } {
		set selectedbrowser $b
		break
            }
        }
	lappend browse $selectedbrowser
    }
    $m add separator
    if {$::tcl_platform(platform) != "windows"} {
	$m add command -underline 0 -label [mc "Maxima Manual (web browser)"] \
	    -command [list eval $browse "file://$file" &]
    }
    $m add command -underline 0 -label [mc "Xmaxima Manual (web browser)"] \
	-command [list eval $browse "file://$xmaximahelpfile" &]
    $m add separator
    $m add command -underline 7 -label [mc "Maxima Homepage"] \
	-command [list eval $browse http://maxima.sourceforge.net &]
    $m add command -underline 0 -label [mc "Project Page"] \
	-command [list eval $browse https://sourceforge.net/projects/maxima/ &]
    $m add command -underline 0 -label [mc "Bug Reports"] \
	-command [list eval $browse https://sourceforge.net/p/maxima/bugs/ &]
    rename vMAXAddSystemMenu ""
    # vMAXSystemMenuHandlers $text $event
    # Backwards compatibility
    return $win
}

proc vMAXAddSystemBar {} {
    set tb [frame .toolbar -borderwidth 1]
    pack $tb -side top -fill x
    button $tb.zoomin -image ::img::zoom-in -text [mc "Zoom in"] \
        -command "zoomConsole 1" -relief flat -width 30 -height 30
    button $tb.zoomout -image ::img::zoom-out -text [mc "Zoom out"] \
        -command "zoomConsole -1" -relief flat -width 30 -height 30
    pack $tb.zoomin $tb.zoomout -side left
}

proc SetPlotFormat { text } {
    if { $::xmaxima_default(plotwindow) == "embedded" } {
	sendMaxima $text ":lisp-quiet (prog2 (\$set_plot_option '((mlist simp) \$plot_format \$xmaxima)) nil) \n"
    }
}


############################################################
# Paths.tcl                                                #
# Copyright (C) 1998 William F. Schelter                   #
# For distribution under GNU public License.  See COPYING. #
#                                                          #
############################################################
#
# Attach this near the bottom of the xmaxima code to find the paths needed
# to start up the interface.

proc setMaxDir {} {
    if {$::tcl_platform(platform) == "windows"} {
	# Make sure the signals thread is started
	set ::env(MAXIMA_SIGNALS_THREAD) "1"

	# Assume the executable is one level down from the top
	# for 5.6 this was src/ and for 5.9 its bin/
	set up [file dir [file dir [info name]]]

	if {[info exists ::autoconf] && \
		[info exists ::autoconf(prefix)] && \
		[info exists ::autoconf(exec_prefix)] && \
		[info exists ::autoconf(libdir)] && \
		[info exists ::autoconf(libexecdir)] && \
		[info exists ::autoconf(datadir)] && \
		[info exists ::autoconf(infodir)] && \
		[info exists ::autoconf(version)] && \
		[info exists ::autoconf(package)] && \
		[file isdir  $::autoconf(datadir)] && \
		[file isdir \
		     [file join $::autoconf(datadir) \
			  $::autoconf(package) $::autoconf(version)]]} {
	    # Assume it's CYGWIN or  MSYS in /usr/local
	} elseif {[file isdir $up/lib] && \
		      [file isdir $up/bin] && \
		      [file isdir $up/libexec] && \
		      [file isdir $up/info] && \
		      [file isdir $up/share]} {
	    set ::autoconf(prefix) $up
	    set ::env(MAXIMA_PREFIX) $up
	    set ::autoconf(exec_prefix) $up
	    set ::autoconf(libdir) "$up/lib"
	    set ::autoconf(libexecdir) "$up/libexec"
	    set ::autoconf(datadir) "$up/share"
	    set ::autoconf(infodir) "$up/info"
	    # These two should be valid
	    # set ::autoconf(package) "maxima"
	    # set ::autoconf(version) "5.9.0rc1"
	} else {
	    # Old windows 5.5 layout
	    # Assume we are in the same directory as saved_maxima
	    if {[file isfile [set exe $up/src/saved_maxima.exe]]} {
		set ::env(MAXIMA_DIRECTORY) $up
		set ::xmaxima_priv(maxima_verpkgdatadir) \
		    $::env(MAXIMA_DIRECTORY)
		set ::xmaxima_priv(xmaxima_maxima) $exe
		set ::xmaxima_priv(maxima_xmaximadir) [file dir $exe]

		# This should be unused
		set ::xmaxima_priv(maxima_verpkglibdir) \
		    $::env(MAXIMA_DIRECTORY)
		set ::xmaxima_priv(maxima_verpkgdatadir) \
		    $::env(MAXIMA_DIRECTORY)

		# This should be unused
		set ::xmaxima_priv(maxima_prefix) \
		    $::env(MAXIMA_DIRECTORY)
	    }
	}
    }
    #mike Could someone document all of these environment variables?
    # ::autoconf(prefix) does not seem to me to be the equivalent of
    # $::env(MAXIMA_DIRECTORY) so I don't understand the next statement

    # jfa: MAXIMA_PREFIX supersedes MAXIMA_DIRECTORY. (Why? Because the
    #      option to configure is --prefix. MAXIMA_PREFIX is thus a runtime
    #      change of --prefix.)
    #      Yes, MAXIMA_DIRECTORY means the same thing. We only include
    #      it for some level of backward compatibility.
    if { [info exists ::env(MAXIMA_DIRECTORY)] } {
	set ::env(MAXIMA_PREFIX) $::env(MAXIMA_DIRECTORY)
    }

    # jfa: This whole routine is a disaster. The general plan for maxima
    # paths is as follows:
    #   1) Use the environment variables if they exist.
    #   2) Otherwise, attempt to use the compile-time settings from
    #      ::autoconf.
    #   3) If the entire package has been moved to a prefix other than
    #      that given at compile time, use the location of the (x)maxima
    #      executable to determine the new prefix.
    # The corresponding path setting procedure in the maxima source can
    # be found in init-cl.lisp.

    # The following section should be considered temporary work-around.
    if { [info exists ::env(MAXIMA_VERPKGDATADIR)] } {
	set ::xmaxima_priv(maxima_verpkgdatadir) $::env(MAXIMA_VERPKGDATADIR)
    }
    # End temporary workaround. It's only a workaround because the next
    # section is backwards: 

    #mike Is it correct to assume that ::autoconf exists and is valid
    # for binary windows distributions? I think it would be better
    # to make (MAXIMA_DIRECTORY) take precedence, and work off
    # [info nameofexe] if necessary.

    if {[info exists ::xmaxima_priv(maxima_prefix)]} {
	# drop through
    } elseif { [info exists ::env(MAXIMA_PREFIX)] } {
	set ::xmaxima_priv(maxima_prefix) $::env(MAXIMA_PREFIX)
    } else {
	set ::xmaxima_priv(maxima_prefix) $::autoconf(prefix)
    }
    if {[info exists ::xmaxima_priv(maxima_verpkgdatadir)]} {
	# drop through
    } else {
	if { [info exists ::env(MAXIMA_DATADIR)] } {
	    set maxima_datadir $::env(MAXIMA_DATADIR)
	} elseif { [info exists ::env(MAXIMA_PREFIX)] } {
	    set maxima_datadir \
		[file join $::env(MAXIMA_PREFIX) share]
	} else {
	    set maxima_datadir $::autoconf(datadir)
	}
	# maxima_datadir is unused outside of this proc

	if {![file isdir $maxima_datadir]} {
	    tk_messageBox -title Warning -icon warning -message \
                [mc "Maxima data directory not found in '%s'" \
			     [file native  $maxima_datadir]]
	}
	set ::xmaxima_priv(maxima_verpkgdatadir) \
	    [file join $maxima_datadir $::autoconf(package) \
		 $::autoconf(version)]
    }

    # omplotdata messages
    #::msgcat::mcload [file join $::xmaxima_priv(maxima_verpkgdatadir) msgs]

    if {[info exists ::xmaxima_priv(maxima_verpkglibdir)]} {
	# drop through
    } elseif { [info exists ::env(MAXIMA_VERPKGLIBDIR)] } {
	set ::xmaxima_priv(maxima_verpkglibdir) $::env(MAXIMA_VERPKGLIBDIR)
    } elseif { [info exists ::env(MAXIMA_PREFIX)] } {
	set ::xmaxima_priv(maxima_verpkglibdir) \
	    [file join $::env(MAXIMA_PREFIX) lib $::autoconf(package) \
		 $::autoconf(version)]
    } else {
	set ::xmaxima_priv(maxima_verpkglibdir) \
	    [file join $::autoconf(libdir) $::autoconf(package) \
		 $::autoconf(version)]
    }
    if {[info exists ::xmaxima_priv(maxima_xmaximadir)]} {
	# drop through
    } elseif { [info exists ::env(MAXIMA_XMAXIMADIR)] } {
	set ::xmaxima_priv(maxima_xmaximadir) $::env(MAXIMA_XMAXIMADIR)
    } else {
	set ::xmaxima_priv(maxima_xmaximadir) \
	    [file join $::xmaxima_priv(maxima_verpkgdatadir) xmaxima]
    }

    # xmaxima messages
    ::msgcat::mcload [file join $::xmaxima_priv(maxima_xmaximadir) msgs]

    # Define maxima_lang_subdir
    if { [info exists ::env(MAXIMA_LANG_SUBDIR)] } {
	set ::xmaxima_priv(maxima_lang_subdir) $::env(MAXIMA_LANG_SUBDIR)
    } else {
	if { $::tcl_platform(platform) == "windows" } {
    	    set wlocale [ ::msgcat::mclocale ]
	} else {
    	    set wlocale ""
	    if { [info exists ::env(LC_ALL)] } { 
		set wlocale $::env(LC_ALL) 
	    } elseif { [info exists ::env(LC_MESSAGES)] } { 
		set wlocale $::env(LC_MESSAGES) 
	    } elseif { [info exists ::env(LANG)] } { 
		set wlocale $::env(LANG) }
	}	
	# Only languages known to Maxima
	set wlocale [string tolower $wlocale]
	switch -glob $wlocale {
	  "es*utf*" {
		    set ::xmaxima_priv(maxima_lang_subdir) "es.utf8"
		}
	  "es*" {
		    set ::xmaxima_priv(maxima_lang_subdir) "es"
		}
	  "pt_br*utf*" {
		    set ::xmaxima_priv(maxima_lang_subdir) "pt_BR.utf8"
		}
	  "pt_br*" {
		    set ::xmaxima_priv(maxima_lang_subdir) "pt_BR"
		}
	  "pt*utf*" {
		    set ::xmaxima_priv(maxima_lang_subdir) "pt.utf8"
		}
	  "pt*" {
		    set ::xmaxima_priv(maxima_lang_subdir) "pt"
		}
	  "de*utf*" {
		    set ::xmaxima_priv(maxima_lang_subdir) "de.utf8"
		}
	  "de*" {
		    set ::xmaxima_priv(maxima_lang_subdir) "de"
		}
	  "fr*utf*" {
		    set ::xmaxima_priv(maxima_lang_subdir) "fr.utf8"
		}
	  "fr*" {
		    set ::xmaxima_priv(maxima_lang_subdir) "fr"
		}
	  "it*utf*" {
		    set ::xmaxima_priv(maxima_lang_subdir) "it.utf8"
		}
	  "it*" {
		    set ::xmaxima_priv(maxima_lang_subdir) "it"
		}
	  "ru*utf*" {
		    set ::xmaxima_priv(maxima_lang_subdir) "ru.utf8"
		}
	  "ru*koi*" {
		    set ::xmaxima_priv(maxima_lang_subdir) "ru.koi8r"
		}
	  "ru*" {
		    set ::xmaxima_priv(maxima_lang_subdir) "ru"
		}
	  default 
	        {
		    set ::xmaxima_priv(maxima_lang_subdir) ""
		}
	}
	#puts $::xmaxima_priv(maxima_lang_subdir)
    }

    # On Windows ::msgcat::mclocale is a good way to derive locale 
    if { $::tcl_platform(platform) == "windows" } {
	    set ::env(LANG) [ ::msgcat::mclocale ]
    }

    # Bring derived quantities up here too so we can see the
    # side effects of setting the above variables

    # used in Menu.tcl CMMenu.tcl
    if {[file isdir [set dir [file join  $::xmaxima_priv(maxima_verpkgdatadir) info]]]} {
	# 5.6 and down
	set ::xmaxima_priv(pReferenceToc) \
	    [file join $dir index.html]
    } elseif {[file isdir [set dir [file join  $::xmaxima_priv(maxima_verpkgdatadir) doc]]]} {
	# 5.9 and up
	# first choose the HTML documentation
	if { $::xmaxima_priv(maxima_lang_subdir) != "" && \
	     [file exists [file join $dir html $::xmaxima_priv(maxima_lang_subdir) index.html] ] } {
	    set ::xmaxima_priv(pReferenceToc) [file join $dir html $::xmaxima_priv(maxima_lang_subdir) index.html]
	} else {
	    set ::xmaxima_priv(pReferenceToc) [file join $dir html index.html]
	}
	# if the platform is Windows and Maxima is running localized, try the following help files
	# if they exist:
	# 1st priority: localized CHM
	# 2nd priority: localized HTML
	# 3rd priority: english CHM
	# 4th priority: english HTML
        if { $::tcl_platform(platform) == "windows" } {
	    if { $::xmaxima_priv(maxima_lang_subdir) != "" } {
		if {[file exists [file join $dir chm $::xmaxima_priv(maxima_lang_subdir) maxima.chm] ] } {
		    set ::xmaxima_priv(pReferenceToc) [file join $dir chm $::xmaxima_priv(maxima_lang_subdir) maxima.chm]
		} else {
		    if {[file exists [file join $dir html $::xmaxima_priv(maxima_lang_subdir) index.html] ] } {
			set ::xmaxima_priv(pReferenceToc) [file join $dir html $::xmaxima_priv(maxima_lang_subdir) index.html]
		    } else {
			if {[file exists [file join $dir chm maxima.chm] ] } {
			    set ::xmaxima_priv(pReferenceToc) [file join $dir chm maxima.chm]
			} else {
			    set ::xmaxima_priv(pReferenceToc) [file join $dir html index.html]
			}
		    }
		}
	    } else {
		if {[file exists [file join $dir chm maxima.chm] ] } {
		    set ::xmaxima_priv(pReferenceToc) [file join $dir chm maxima.chm]
		} else {
		    set ::xmaxima_priv(pReferenceToc) [file join $dir html index.html]
		}
	    }
	} else {
	    # Platform != windows, just choose the HTML documentation
	    if { $::xmaxima_priv(maxima_lang_subdir) != "" && \
		[file exists [file join $dir html $::xmaxima_priv(maxima_lang_subdir) index.html] ] } {
		set ::xmaxima_priv(pReferenceToc) [file join $dir html $::xmaxima_priv(maxima_lang_subdir) index.html]
	    } else {
		set ::xmaxima_priv(pReferenceToc) [file join $dir html index.html]
	    }
	}
    } else {
	tk_messageBox -title Warning -icon warning -message \
            [mc "Documentation not found in '%s'" \
                 [file native  $::xmaxima_priv(maxima_verpkgdatadir)]]
    }

    # used in Menu.tcl CMMenu.tcl
    if {[file isdir [set dir [file join  $::xmaxima_priv(maxima_verpkgdatadir) tests]]]} {
	# 5.9 and up
	set ::xmaxima_priv(pTestsDir) $dir
    } elseif {[file isdir [set dir [file join  $::xmaxima_priv(maxima_verpkgdatadir) doc]]]} {
	# 5.6 and down
	set ::xmaxima_priv(pTestsDir) $dir
    } else {
	# who cares
    }
    set file [file join $::xmaxima_priv(maxima_xmaximadir) "intro.html"]
    if {$::tcl_platform(platform) == "windows"} {
        # convert to unix
        set file [file dir $file]/[file tail $file]
    }
    # FIXME: This is bogus - need a FileToUrl
    set ::xmaxima_priv(firstUrl) file:/$file

    # set up for autoloading
    global auto_path
    set dir [file join $::xmaxima_priv(maxima_xmaximadir) Tkmaxima]
    if {[file isdir $dir]} {
	lappend auto_path $dir
    }
    # jfa: Windows 98 users were seeing long startup times because
    # MAXIMA_USERDIR defaults to HOME, which is usually C:\.
    # Make the default something else under Windows 98 as a workaround.
    # This is ugly.
    if {$::tcl_platform(os) == "Windows 95"} {
	if {![info exists ::env(MAXIMA_USERDIR)]} {
	    set ::env(MAXIMA_USERDIR) "$::xmaxima_priv(maxima_prefix)/user"
	}
    }
    # jfa: extend path so that gcl can see gcc in windows package
    # I don't know that this is the best place for this
    if {$::tcl_platform(platform) == "windows"} {
	# jfa: This is an attempt to get a working path designation
	# on various Windows versions.
	if {$::tcl_platform(os) == "Windows 95"} {
	    # Windows 95 or Windows 98
	    regsub -all {/} "$::xmaxima_priv(maxima_prefix)\\BIN" {\\} maxbinpath
	} else {
	    # Other versions of Windows
	    set maxbinpath "$::xmaxima_priv(maxima_prefix)/bin"
	}
	set ::env(PATH) "$maxbinpath;$::env(PATH)"
    }
}

proc vMAXSetMaximaCommand {} {
    set ::xmaxima_priv(localMaximaServer) ""
    if {[info exists ::xmaxima_priv(xmaxima_maxima)] && \
	    $::xmaxima_priv(xmaxima_maxima) != ""} {
	if {[set exe [auto_execok $::xmaxima_priv(xmaxima_maxima)]] == "" } {

	    tk_messageBox -title Error -icon error -message \
                [mc "Maxima executable not found\n%s\n\n Try setting the environment variable XMAXIMA_MAXIMA." \
			      [file native $::xmaxima_priv(xmaxima_maxima)]]
	    return
	}
    } elseif { [info exists ::env(XMAXIMA_MAXIMA)] } {
	set ::xmaxima_priv(xmaxima_maxima) $::env(XMAXIMA_MAXIMA)
	if {[set exe [auto_execok $::xmaxima_priv(xmaxima_maxima)]] == "" } {
	    tk_messageBox -title Error -icon error -message \
                [concat [mc "Maxima executable not found."] "\n%s\nXMAXIMA_MAXIMA=$::env(XMAXIMA_MAXIMA)"]
	    return
	}
    } else {
	set ::xmaxima_priv(xmaxima_maxima) maxima
	if {[set exe [auto_execok $::xmaxima_priv(xmaxima_maxima)]] == "" } {
	    tk_messageBox -title Error -icon error -message \
                [mc "Maxima executable not found\n\n Try setting the environment variable  XMAXIMA_MAXIMA."]
	}
	# jfa: bypass maxima script on windows
        # vvz: on Windows 9X/ME only
	if {$::tcl_platform(os) == "Windows 95"} {
	    # maybe it's in lib - I don't like this
	    set dir $::xmaxima_priv(maxima_verpkglibdir)
	    # FIXME - need ::autoconf(lisp) so we don't need glob
	    set exes [glob -nocomplain $dir/binary-*/maxima.exe]
	    if {[llength $exes] != "1" || \
		    [set exe [lindex $exes 0]] == "" || \
		    ![file isfile $exe]} {
		tk_messageBox -title Error -icon error -message \
                    [mc "Maxima executable not found\n\n Try setting the environment variable  XMAXIMA_MAXIMA."]
		return
	    }
	} else {
	    set ::xmaxima_priv(xmaxima_maxima) maxima
	    if {[set exe [auto_execok $::xmaxima_priv(xmaxima_maxima)]] == "" } {
                tk_messageBox -title Error -icon error -message \
                    [mc "Maxima executable not found\n\n Try setting the environment variable  XMAXIMA_MAXIMA."]
	    }
	}
    }
    set command {}
    lappend command $exe
    eval lappend command $::xmaxima_priv(opts)
    lappend command -s PORT
    if {$::tcl_platform(platform) == "windows"} {
        lappend command > NUL
    } else {
        lappend command > /dev/null
    }
    lappend command &
    set ::xmaxima_priv(localMaximaServer) $command
}
############################################################
# Gui.tcl                                                  #
# Copyright (C) 1998 William F. Schelter                   #
# For distribution under GNU public License.  See COPYING. #
#                                                          #
#     Modified by Jaime E. Villate                         #
############################################################

# Creates the browser if it doesn't exist
proc createBrowser {bname} {
    if {[winfo exists $bname]} {
        focus $bname
    } else {
        toplevel $bname
        wm title $bname [mc {Xmaxima: browser}]
        if {[file isfile [string map {file:/ ""} $::xmaxima_priv(firstUrl)]]} {
            OpenMathOpenUrl $::xmaxima_priv(firstUrl) -toplevel $bname
        } else {
            set ::xmaxima_priv(error) \
                "<h1>Error</h1>\
                <p>Maxima primer not found in: $::xmaxima_priv(firstUrl)</p>"
             OpenMathOpenUrl "xmaxima://error" -toplevel $bname
        }
        set ::xmaxima_priv(cBrowser) $bname
        set ::xmaxima_default(browser) 1
        # Adds the menubar and the toolbar to the browser
        vMAXAddBrowserMenu $bname}}

# Creates the Maxima console
proc createConsole {cname} {
    # Makes the status panel....
    set st .status
    frame $st
    set ::xmaxima_priv(cStatusWindow) $st
    label $st.rate -width 35 -bd 1 -relief sunken  -justify left \
        -textvariable ::xmaxima_priv(load_rate) -anchor w
    scale $st.scale -showvalue 0 -length 200  -orient horizontal
    pack $st.rate -side left -fill x -expand 1 -anchor w
    pack $st.scale -side left
    pack $st -side bottom -fill x -anchor w
    set ::xmaxima_priv(cStatusLabel) $st.rate

    # Adds the toolbar to the Maxima console
    vMAXAddSystemBar
    frame $cname
    pack $cname -expand 1 -fill both -side top
    set w $cname.text
    clearLocal $w
    oset $w heightDesired 80%
    set ::xmaxima_priv(maximaWindow) $w
    closeMaxima $w
    clearLocal $w

    # oset $w program $program
    oset $w prompt "% "
    if {[winfo exists $w]} {catch { destroy $w }}
    frame $cname.bottom -height 2
    $cname.bottom config -cursor double_arrow
    bind  $cname.bottom <B1-Motion> "changeSize $w %Y"
    pack $cname.bottom -side bottom -fill x
    text $w -yscrollcommand "$cname.scroll set" \
	    	-selectbackground yellow -selectforeground blue
    set ::xmaxima_priv($w,inputTag) input
    # resetMaximaFont $w
    scrollbar $cname.scroll -command "$w yview"
    pack $cname.scroll -side right -fill y
    pack $cname.text -expand 1 -fill both -side left
    $w mark set lastStart end
    $w mark gravity lastStart left
    bind $w <Configure> "resizeSubPlotWindows $w %w %h; resizeMaxima $w %w %h"
    $w configure -background "#FFFAEE"
    $w configure -foreground "#008600"
    $w tag configure input -foreground blue
    $w tag configure output -foreground black
    $w tag configure mprompt -foreground red

    # binding order will be: window bindings, CNtext bindings,
    # OpenMathText bindings and default bindings (usually Text . all)
    # CNtext ans OpenMathText bindings are set up in Bindings.tcl
    bindtags $w [linsert [bindtags $w] 1 CNtext OpenMathText ]

    if {![regexp -- input $::xmaxima_priv(sticky)] } {
        append ::xmaxima_priv(sticky) {|^input$}}
    set ::xmaxima_priv(cConsoleText) $cname.text
    vMAXSetCNTextBindings $w
    wm protocol . WM_DELETE_WINDOW [list maxExit $w]

    # Sets up the console size and font
    $w configure -height $::xmaxima_default(iConsoleHeight) \
        -width $::xmaxima_default(iConsoleWidth)
    font configure ConsoleFont -family [lindex $::xmaxima_default(ConsoleFont) 0] \
        -size [lindex $::xmaxima_default(ConsoleFont) 1]
    $w configure -font ConsoleFont

    # Adds the menu bar to the Maxima console
    vMAXAddSystemMenu $cname $cname.text

    # Reads the history from previous runs
    if {[file isfile $::xmaxima_priv(history)]} {
        set fileId [open $::xmaxima_priv(history) r]
        set commands [read $fileId]
        close $fileId
        regsub {oset[^\n]*\n} $commands {} $commands
        regsub {\n\s*\}\s*\n} $commands {} $commands
        if {[catch {oset {.maxima.text} inputs $commands} err]} {
            tk_messageBox -title Error -icon error -message \
                [mc "Error sourcing %s\n%s" [file native $histfile] $err]
        }
    }
    return $w}

# Updates the information in the status bar at the bottom of the console
proc maxStatus {mess} {
    set ::xmaxima_priv(load_rate) $mess
    $::xmaxima_priv(cStatusLabel) configure -text $mess
}
############################################################
# Tkmaxima.tcl                                                  #
# Copyright (C) 1998 William F. Schelter                   #
# For distribution under GNU public License.  See COPYING. #
#                                                          #
############################################################

# The Header.tcl is created by autoconf to make the xmaxima script
# auto executable. After the header the various tcl pieces are put together:

#mike The following files are prepended, and could be sourced instead.
# The only problem about sourcing them is that the way of finding
# the directory they're in may differ in a wrapped executable.
# Note that the order of required files may be important.

# Source Tkmaxima/COPYING.tcl           ;# license info
# Source Tkmaxima/Cygwin.tcl 		;# required - must not be autoloaded
# Source Tkmaxima/Constants.tcl 	;# required - must not be autoloaded
# Source Tkmaxima/Preamble.tcl 		;# required - must not be autoloaded
# Source Tkmaxima/Readdata.tcl 		;# can be autoloaded
# Source Tkmaxima/Getdata1.tcl 		;# can be autoloaded
# Source Tkmaxima/Macros.tcl 		;# can be autoloaded
# Source Tkmaxima/Proxy.tcl 		;# can be autoloaded
# Source Tkmaxima/Send-some.tcl 	;# sets global variables
# Source Tkmaxima/Plotting.tcl 		;# sets global variables
# Source Tkmaxima/Fonts.tcl 		;# sets global variables
# Source Tkmaxima/colors.tcl
# Source Tkmaxima/Private.tcl 		;# can be autoloaded
# Source Tkmaxima/Getopt.tcl 		;# can be autoloaded
# Source Tkmaxima/Parse.tcl 		;# sets global variables
# Source Tkmaxima/Textinsert.tcl 	;# can be autoloaded
# Source Tkmaxima/Printops.tcl 		;# can be autoloaded
# Source Tkmaxima/Push.tcl 		;# can be autoloaded
# Source Tkmaxima/Plotconf.tcl 		;# can be autoloaded
# Source Tkmaxima/Adams.tcl 		;# can be autoloaded
# Source Tkmaxima/Rk.tcl 		;# can be autoloaded
# Source Tkmaxima/Plotdf.tcl 		;# can be autoloaded
# Source Tkmaxima/Plot2d.tcl 		;# defined globals
# Source Tkmaxima/Matrix.tcl 		;# can be autoloaded
# Source Tkmaxima/Plot3d.tcl 		;# defined globals
# Source Tkmaxima/scene.tcl 		;# can be autoloaded
# Source Tkmaxima/NPlot3d.tcl 		;# can be autoloaded
# Source Tkmaxima/EOctave.tcl 		;# can be autoloaded
# Source Tkmaxima/EOpenplot.tcl  	;# can be autoloaded
# Source Tkmaxima/EMaxima.tcl 		;# can be autoloaded
# Source Tkmaxima/EHref.tcl 		;# can be autoloaded
# Source Tkmaxima/Browser.tcl 		;# defines globals
# Source Tkmaxima/Bindings.tcl 		;# defines bindings
# Source Tkmaxima/Wmenu.tcl 		;# can be autoloaded
# Source Tkmaxima/Myhtml.tcl 		;# defines globals and tags
# Source Tkmaxima/Myhtml1.tcl 		;# can be autoloaded
# Source Tkmaxima/Base64.tcl 		;# can be autoloaded
# Source Tkmaxima/Bitmaps.tcl 		;# defines globals
# Source Tkmaxima/Tryembed.tcl 		;# defines globals?
# Source Tkmaxima/OpenMath.tcl 		;# active
# Source Tkmaxima/NConsole.tcl 		;# can be autoloaded
# Source Tkmaxima/String.tcl 		;# can be autoloaded
# Source Tkmaxima/RunMaxima.tcl		;# can be autoloaded
# Source Tkmaxima/Menu.tcl
# Source Tkmaxima/Paths.tcl
# Source Tkmaxima/Gui.tcl
# Source Tkmaxima/Tkmaxima.tcl

proc vMaxUsage {script {error {}}} {
    set msg [mc "$error\n\nUsage: $script \[options\] \[filenames\]

Options:
   -h, 
   --help                           Display this message
   --url <site>                     Start browser at site 
   -u <ver>, 
   --use-version <ver>              Launch maxima version ver
   -l <flavor>, 
   --lisp <flavor>                  Use lisp implementation flavor
   -X <Lisp options>
   --lisp-options <Lisp options>    Options to be given to the underlying Lisp.
                                    Option lines containing spaces have to be
                                    quoted to be passed to the lisp as a whole.
"]
    # Originally this program output a graphical message box instead of a message
    # on stdout - which looked nice, but is nonstandard => Replaced it by a
    # text-only message.
    #
    # tk_messageBox -type ok -icon info -title "Usage" -message $msg -parent .
    puts $msg
    exit
}

proc lMaxInitSetOpts {} {
    global argv argv0
    set ::xmaxima_priv(opts) {}
    set ::xmaxima_priv(plotfile) {}
    set state key
    foreach arg $argv {
	switch -- $state {
	    key {
		switch -regexp -- $arg {
		    {^--help$}         {vMaxUsage $argv0}
		    {^-h(elp)?$}       {vMaxUsage $argv0}
		    {^-(-)?url$}       {set state url}
		    {^-u(se-version)?$} {set state version}
		    {^--use-version$}  {set state version}
		    {^-l(isp)?$}       {set state lisp}
		    {^--lisp$}         {set state lisp}
		    {^--lisp-options$} {set state lispoptions}
		    {^-X$}             {set state lispoptions}
		    {^--$}             {set state noopts}
		    {^-.*}             {vMaxUsage $argv0 "Unknown option $arg"}
		    default {
			lappend ::xmaxima_priv(plotfile) $arg
			set state file
		    }
		}
	    }
	    file {
		switch -glob -- $arg {
		    -* {vMaxUsage $argv0 "Misplaced option $arg"}
		    default {lappend plotfile $arg}
		}
	    }
	    url     {set ::xmaxima_priv(firstUrl) $arg; set state key}
	    version {lappend ::xmaxima_priv(opts) -u $arg; set state key}
	    lisp    {lappend ::xmaxima_priv(opts) -l $arg; set state key}
	    lispoptions  {lappend ::xmaxima_priv(opts) [format " -X \"%s\" " $arg]}
	    noopts  {lappend file $arg}
	}
    }
}

# Exists Maxima after saving the current settings
proc maxExit {{text ""} {val "0"}} {
    # save user settings for future sessions
    catch {savePreferences}
    update
    if {$text eq ""} {
        if {[info exists ::xmaxima_priv(cConsoleText)]} {
            set text $::xmaxima_priv(cConsoleText)}
    } elseif {[catch {closeMaxima $text} err]} {
        tk_messageBox -title Error -icon error -message $err}
    tkexit $val}
# -*- tcl -*-

global autoconf
set autoconf(defaultlisp) "sbcl"
set autoconf(prefix) "/usr"
set autoconf(exec_prefix) "/usr"
set autoconf(package) "maxima"
set autoconf(version) "5.50.0"
set autoconf(libdir) "/usr/lib"
set autoconf(libexecdir) "/usr/lib"
set autoconf(datadir) "/usr/share"
set autoconf(infodir) "/usr/share/info"
#     xmaxima-trailer.tcl
#
# Attach this at the bottom of the xmaxima code to start up the interface.

setMaxDir
cMAXINITBeforeIni
cMAXINITReadIni
cMAXINITAfterIni 

if { [llength $::xmaxima_priv(plotfile)] > 0 } {
    set fptr [open [lindex $::xmaxima_priv(plotfile) 0] r]
    regsub -all -- {/\*.*?\*/} [read $fptr] {} inputdata
    close $fptr
    regsub -all -- {[[:space:]]+} $inputdata { } inputdata
    string trim $inputdata
     if {[catch {eval $inputdata}]} {
	 bgerror [mc "Input file has syntax errors"]
	 exit
     }
} else {
    ################ MAXTkmaxima tkmaxima
    if {$tcl_platform(platform) == "windows" } {
        set dir [file dir [info name]]
        # These should be in the same directory as the xmaxima.exe
        set ::xmaxima_priv(kill) [file join $dir winkill.exe]
        set file [file join $dir tclwinkill.dll]
        if {[file isfile $file]} {catch {load  $file}}
        unset file
    } else {
        # unix
        set ::xmaxima_priv(kill) kill}
    ################
    rename exit tkexit
    #    proc exit {{val "0"}} {maxExit "" $val}
    ####### tkmaxima install
    wm withdraw .
    wm title . [mc {Xmaxima: console}]
    set fr .maxima
    ### replacemen for old object gui
    if {$tcl_platform(platform) == "windows" && \
            [info commands winico] != ""} {
        set file [file join \
                      $::xmaxima_priv(maxima_xmaximadir) \
                      max.ico]
        if {[file isfile $file]} {
            set ico [winico createfrom $file]
            winico setwindow . $ico}}
    
    if {[winfo exists $fr]} {catch { destroy $fr }}
    # Creates the Maxima console       
    set w [createConsole $fr]
    
    wm deiconify .
    # Creates the browser in a separate window
    if {$::xmaxima_default(browser)} {createBrowser .browser}
    
    ### end of replacement o object gui
    
    #mike Defer looking for maxima until the interface has been built
    vMAXSetMaximaCommand
    
    #mike Defer the starting of maxima until the interface has been built
    if {[catch {runOneMaxima $w} err]} {
        tide_failure [concat [mc "Error starting Maxima:"] "\n$err"]
        return
    }
    after idle focus $::xmaxima_priv(cConsoleText)
}
