Eskil

newsrc: eskil.vfs/src/eskil.tcl

src/TAGS: $(SRCFILES)
	etags -o src/TAGS --regex="/proc[ \t]+\([^ \t]+\)/\1/" $(SRCFILES) \
	eskil.vfs/lib/*/*.tcl

setup: links src/TAGS

# Check modules against local copies
tmcheck:
	@ls -ltr `find . -name '*.tm'` `find /home/peter/mystuff -name '*.tm'`


# Use this to rebuild the docs when command line changes or
# new wiki files are added.
docs:
	echo "<title>Usage</title>" > htdocs/usage.wiki
	echo "" >> htdocs/usage.wiki
	echo "<h1>Command Line Usage</h1>" >> htdocs/usage.wiki

# Testing
#----------------------------------------------------------------

spell:
	@cat doc/*.txt | ispell -d british -l | sort -u

CHKFILES = $(SRCFILES) $(wildcard plugins/*.tcl) \
	eskil.vfs/lib/psmenu-1.1.tm \
	eskil.vfs/lib/pstools-1.0.tm \
	eskil.vfs/lib/psballoon-1.3.tm
NAGELFARFLAGS = -s syntaxdb.tcl -pkgpicky -filter "*Non constant definition*" -quiet -plugin nfplugin.tcl

# Create a common "header" file for all source files.
eskil_h.syntax: $(SRCFILES) src/eskil.syntax nfplugin.tcl
	@echo Creating syntax header file...
	@$(NAGELFAR) $(NAGELFARFLAGS) -header eskil_h.syntax $(SRCFILES)

    set msg [regsub -all "\n" $msg " "]
    # Remove multiple whitespace
    set msg [regsub -all {\s+} $msg " "]
    set msg [string trim $msg]
    # Any explicitly requested newlines?
    set msg [regsub -all {\\n\s*} $msg "\n"]
    # Any remaining substs like tabs?
    set msg [subst -nocommands -novariables $msg]
    # Further line breaks by length?
    set lines {}
    foreach line [split $msg \n] {
        while {[string length $line] > 80} {
            # There should be no path through this loop that does not
            # shorten $line
            set ix [string last " " $line 80]

    } else {
        if {[string index $msg 0] eq "\["} {
            set msg [subst -novariables -nobackslashes $msg]
        }
        set bWidth [Measure $font $msg]
    }

    if { ! $create} return

    # Preferred position of the balloon
    set rootX [expr {[winfo rootx $W] + $itemX}]
    set rootY [expr {[winfo rooty $W] + $itemY + $wHeight + 2}]

    set useframe $balloon(frame,$W)

    # More calls with more cascades work
    psmenu::psmenu . {
        "&Debug" {
            "Reread &Source" -acc F1 -cmd _rs
        }
    }
}

##nagelfar syntax psmenu::PopEntry v
##nagelfar syntax tk::AmpMenuArgs x*

# Main call for psmenu. Some optional arguments are for internal use.
# Canbe called with an existing menu, but then -top must be given.
proc psmenu::psmenu {top args} {
    set def [lindex $args end]
    set args [lrange $args 0 end-1]

            set top $opts(-top)
        }
    }

    if {$opts(-recursive)} {
        # Locate a free window name for the menu, for internal call
        while {[winfo exists $m]} {
            if {[regexp {^(.*?)(\d+)$} $m -> prefix Index]} {
                incr Index
            } else {
                set prefix $m
                set Index 0
            }
            set m $prefix$Index
        }
    }
    # It might exist for a second user call
    if { ! [winfo exists $m]} {
        # Create
        menu $m -tearoff 0
    }

                    set value [lindex $body $t]
                } else {
                    set value $label
                }
                lappend radioDef $label -value $value {*}$options
            }
            #puts "RADIO '$radioDef'"

            # Prepend
            set def [list {*}$radioDef {*}$def]
            # TBD FIXA
            continue
        }

        # Conditionals

        #puts "Label   '$label'"
        #puts "Options '$options'"
        # Figure out type
        if {[string match "-*" $label]} {
            set type separator
            set label ""
        } elseif {[dict exists $options -menu]} {
            set type "cascade"
        } elseif {[dict exists $options -value]} {
            set type radiobutton
        } elseif {[dict exists $options -var]} {
            set type checkbutton
        } else {
            set type command
        }

                    # Just let through
                    lappend newOptions $opt $val
                }
            }
        }

        if {$variable ne ""} {
            ##nagelfar ignore Non constant level
            upvar \#$opts(-level) $variable __vv
            if { ! [info exists __vv]} {
                set __vv $default
            }
        }

        # TK helper to handle & in label
        ::tk::AmpMenuArgs $m add $type {*}$newOptions

#---------------------------------------------------------*-tcl-*------
#
#  pstools.tcl,
#     a package providing misc facilites
#
#  Copyright (c) 2003, Peter Spjuth  (peter.spjuth@gmail.com)
#
#  Permission is granted to use this code under the same terms as

##nagelfar syntax _ipexists l
##nagelfar syntax _ipset    v
##nagelfar syntax _iparray  s v

# Load a preference file
# Args lists the variables allowed to be set by the file
# If -existing is given, only existing variables and elements may be set
##nagelfar syntax pstools::safeLoad x o* v*
proc pstools::safeLoad {file args} {

    interp create -safe loadinterp
    interp alias {} _ipexists loadinterp info exists
    interp alias {} _ipset    loadinterp set
    interp alias {} _iparray  loadinterp array

    interp invokehidden loadinterp source $file

    set existing 0
    foreach arg $args {
        if {$arg eq "-existing"} {
            set existing 1
            continue
        }
        ##nagelfar vartype arg varName
        upvar 1 $arg TheVar
        if {[_iparray exists $arg]} {
            foreach {key val} [_iparray get $arg] {
                if { ! $existing || [info exists TheVar($key)]} {
                    set TheVar($key) $val
                }
            }
        } elseif {[_ipexists $arg]} {
            if { ! $existing || [info exists TheVar]} {
                set TheVar [_ipset $arg]
            }
        }
    }

    interp delete loadinterp
}

    while {[file type $tmplink] eq "link"} {
        set tmplink [file readlink $tmplink]
        set tmplink [file normalize [file join $::eskil(thisDir) $tmplink]]
        set ::eskil(thisDir) [file dirname $tmplink]
    }

    set libDir [file join $::eskil(thisDir) .. lib]
    if { ! [file isdirectory $libDir]} {
        # Try the local file from devel
        set libDir [file join $::eskil(thisDir) .. eskil.vfs lib]
    }
    ::tcl::tm::path add $libDir

    package require pstools
    namespace import -force pstools::*