Eskil

#----------------------------------------------------------------------
# Make file for Eskil
#----------------------------------------------------------------------

# This string is used to generate release file names
VERSION = 284
# This string is used to tag the version shown in Eskil
DOTVERSION = 2.8.4

# Path to the TclKits used for creating StarPacks.
TCLKIT = /user/asic/scripts/tclkit
TCLKIT_LINUX   = $(TCLKIT)/tclkit863
TCLKIT_WIN     = $(TCLKIT)/tclkit865.exe
TCLKIT_MAC     = $(TCLKIT)/tclkit-mac

# Paths to the libraries used.
# If you do not have access to all these, you can get them from an Eskil kit
# as explained below.
TEXTSEARCH = /home/$(USER)/src/textsearch
DIFFUTIL   = /home/$(USER)/src/DiffUtilTcl/lib.vfs/DiffUtil
WCB        = /home/$(USER)/src/packages/wcb3.5

# Packaging/Releasing
#----------------------------------------------------------------

tagversion:
	echo "Version $(DOTVERSION) `date --iso-8601`" > eskil.vfs/version.txt

wrap: tagversion
	sdx wrap eskil.kit -interp tclsh

wrapexe: tagversion
	@\rm -f eskil.linux eskil.exe
	sdx wrap eskil.linux   -runtime $(TCLKIT_LINUX)
#	sdx wrap eskil.mac     -runtime $(TCLKIT_MAC)
#	cd eskil.vfs/lib ; ln -s $(TWAPI) twapi
	sdx wrap eskil.exe     -runtime $(TCLKIT_WIN)
#	rm eskil.vfs/lib/twapi

release: setup wrap wrapexe
	@cp eskil.kit eskil`date +%Y%m%d`.kit
	@cp eskil.kit eskil$(VERSION).kit
	@gzip eskil.linux
	@mv eskil.linux.gz eskil$(VERSION).linux.gz
#	@gzip eskil.mac
#	@mv eskil.mac.gz eskil$(VERSION).mac.gz
	@zip eskil$(VERSION).win.zip eskil.exe
	@zip eskil`date +%Y%m%d`.win.zip eskil.exe

tofossil:
	fossil unversioned add eskil$(VERSION).kit      --as htdocs/download/eskil$(VERSION).kit
	fossil unversioned add eskil$(VERSION).linux.gz --as htdocs/download/eskil$(VERSION).linux.gz
	fossil unversioned add eskil$(VERSION).mac.gz   --as htdocs/download/eskil$(VERSION).mac.gz
	fossil unversioned add eskil$(VERSION).win.zip  --as htdocs/download/eskil$(VERSION).win.zip
	fossil unversioned list
	@echo 'Remember: fossil unversioned sync'

    $top.m add cascade -label "Options" -underline 0 -menu $top.m.mo
    menu $top.m.mo
    $top.m.mo add cascade -label "Font" -underline 0 -menu $top.m.mo.f
    $top.m.mo add cascade -label "Ignore" -underline 0 -menu $top.m.mo.i
    $top.m.mo add command -label "Preprocess..." -underline 0 \
            -command [list EditPrefPreprocess $top]
    $top.m.mo add command -label "Plugins..." -underline 1 \
            -command [list editPrefPlugins $top]
    $top.m.mo add cascade -label "Parse" -underline 1 -menu $top.m.mo.p
    $top.m.mo add command -label "Colours..." -underline 0 -command makePrefWin
    $top.m.mo add cascade -label "Context" -underline 1 -menu $top.m.mo.c
    $top.m.mo add cascade -label "Pivot" -underline 2 -menu $top.m.mo.piv
    $top.m.mo add separator
    $top.m.mo add checkbutton -label "Toolbar" -variable ::Pref(toolbar)
    $top.m.mo add separator

    lappend dirs [file join $::eskil(thisDir) .. ..]
    lappend dirs [file join $::eskil(thisDir) .. .. plugins]
    lappend dirs [file join $::eskil(thisDir) .. plugins]
    return $dirs
}

# Locate plugin source and extract some info
# Data structure in this return dict:
# name: Plugin name.
# file: Source file name. "_" for a runtime plugin.
# data: Source code.
# opts: Options accepted by plugin.
proc LocatePlugin {plugin} {
    set res [dict create name "" file "" opts "" data ""]
    set fSrc ""
    set code ""

    # Search runtime plugins first
    foreach name [dict keys $::eskil(plugins)] {
        if {$name eq $plugin} {
            set fSrc "_"
            set code [dict get $::eskil(plugins) $name data]
        }
    }

    if {$fSrc eq ""} {
        foreach dir [PluginSearchPath] {
            set dir [file normalize $dir]
            set files {}
            lappend files [file join $dir $plugin]
            lappend files [file join $dir $plugin.tcl]
            foreach file $files {
                if { ! [file exists   $file]} continue
                if { ! [file isfile   $file]} continue
                if { ! [file readable $file]} continue
                set ch [open $file r]
                set code [read $ch 20]
                close $ch
                # Magic pattern to identify a plugin
                if {[string match "##Eskil Plugin*" $code]} {
                    set fSrc $file
                    break
                }
            }
            if {$fSrc ne ""} break
        }
    }

    if {$fSrc eq "_"} {
        dict set res "name" $plugin
        dict set res "file" $fSrc
        dict set res "data" $code

    } elseif {$fSrc ne ""} {
        dict set res "name" $plugin
        dict set res "file" $fSrc
        # Plugin source is reloaded each time to facilitate debug/rerun.
        set ch [open $fSrc r]
        set code [read $ch]
        close $ch
        dict set res "data" $code
    }

    # Look for declarations of command line options
    foreach line [split $code \n] {
        # Only look until empty line
        if {[string trim $line] eq ""} break
        if {[regexp {^\#\# Option\s+(\S+)(.*)} $line -> name rest]} {
            # structure is name flag doc
            dict lappend res opts $name 0 [string trim $rest " :"]
        }
        if {[regexp {^\#\# Flag\s+(\S+)(.*)} $line -> name rest]} {
            dict lappend res opts $name 1 [string trim $rest " :"]
        }


    }

    return $res
}

# Return value: Handle to interpreter
#
# pinfo dict structure:
#  file : File plugin
#  dir  : Directory plugin
#  allow: Raised privileges
proc createPluginInterp {plugin info allow pinfoName} {
    upvar 1 $pinfoName pinfo
    set res [LocatePlugin $plugin]
    set code [dict get $res data]
    set fSrc [dict get $res file]

    if {$code eq ""} {
        return ""
    }

    # Create interpreter and load source
    if {$allow} {
        set pi [interp create]
        $pi eval $code
    } else {
        set pi [interp create -safe]
        $pi eval $code
    }

    # Setup info
    $pi eval [list set ::WhoAmI [file rootname [file tail $fSrc]]]
    $pi eval [list set ::WhoAmIFull [file normalize $fSrc]]
    $pi eval [list set ::Info $info]
    interp share {} stdout $pi

    # Expose needed commands
    if { ! $allow} {
        interp expose $pi fconfigure ;# needed??
        interp hide $pi close

    }

    return $pi
}

proc printPlugin {plugin {short 0}} {
    set res [LocatePlugin $plugin]
    set fSrc [dict get $res file]
    if {$fSrc eq ""} {
        printPlugins
        return
    }


    foreach line [split [dict get $res data] \n] {
        set lineT [string trim $line]
        if {$short} {
            if { ! [string match "#*" $lineT]} {
                break
            }
        }
        puts $line
    }

}

proc listPlugins {} {
    set dirs [PluginSearchPath]
    set result {}

    foreach name [dict keys $::eskil(plugins)] {
        dict set result $name [dict get $::eskil(plugins) $name]
    }

    foreach dir $dirs {
        set dir [file normalize $dir]
        set files [glob -nocomplain [file join $dir *.tcl]]
        foreach file $files {
            set file [file normalize $file]
            if {[info exists done($file)]} continue
            if { ! [file exists $file]} continue
            if { ! [file isfile $file]} continue
            if { ! [file readable $file]} continue

            set done($file) 1
            set ch [open $file r]
            set code [read $ch 200]
            if {[regexp {^\#\#Eskil Plugin :(.*?)(\n|$)} $code -> descr]} {
                set root [file rootname [file tail $file]]
                dict set result $root "descr" $descr
                dict set result $root "file" 0
                dict set result $root "dir"  0
                # Load it all for inspection
                append code [read $ch]
                dict set result $root "data" $code
            }
        }
    }
    foreach root [dict keys $result] {
        set code [dict get $result $root data]
        if {[regexp {^\#\#Eskil Plugin :(.*?)(\n|$)} $code -> descr]} {
            dict set result $root "descr" $descr
        }
        if {[string first "proc PreProcess " $code] >= 0} {
            dict set result $root "file" 1
        }
        if {[string first "proc FileCompare " $code] >= 0} {
            dict set result $root "dir" 1
        }
    }



    set resultSort {}
    foreach elem [lsort -dictionary [dict keys $result]] {
        dict set resultSort $elem [dict get $result $elem]
    }
    return $resultSort
}

proc printPlugins {} {
    set plugins [listPlugins]
    if {[llength $plugins] == 0} {
        puts "No plugins found."
        return
    }
    # Longest name?
    set w 0
    foreach {plugin info} $plugins {
        if {[string length $plugin] > $w} {
            set w [string length $plugin]
        }
    }
    # Room for quote marks in output
    incr w 2

    puts "Available plugins:"
    foreach {plugin info} $plugins {
        set descr [dict get $info descr]
        puts "Plugin [format %-*s $w \"$plugin\"] : $descr"
    }
}

# Handle plugins for a diff session that uses plugins.
# Returns true if something has been done that needs cleanup.
proc preparePlugin {top} {
    if {$::eskil($top,plugin,1) eq "" || \
                ![dict get $::eskil($top,pluginpinfo,1) file]} {
        return 0
    }

    disallowEdit $top

        # For next plugin, if any
        set in1 $out1
        set in2 $out2
    }
    return 1
}

# After diff is done, this is called if preparePlugin returned true.
proc cleanupPlugin {top} {
    if {[info exists ::eskil($top,leftFileBak)]} {
        set ::eskil($top,leftFile) $::eskil($top,leftFileBak)
    }
    if {[info exists ::eskil($top,rightFileBak)]} {
        set ::eskil($top,rightFile) $::eskil($top,rightFileBak)
    }
    unset -nocomplain \
            ::eskil($top,leftFileBak) ::eskil($top,rightFileBak) \
            ::eskil($top,leftFileDiff) ::eskil($top,rightFileDiff)
}

# GUI for plugin selection
proc editPrefPlugins {top {dirdiff 0}} {
    set wt $top.prefplugin

    # Create window
    destroy $wt
    toplevel $wt -padx 3 -pady 3
    ttk::frame $wt._bg
    place $wt._bg -x 0 -y 0 -relwidth 1.0 -relheight 1.0 -border outside

    grid columnconfigure $wt.lfs 1 -weight 1

    set t 0
    foreach {plugin info} $plugins {
        set descr [dict get $info descr]
        if {$dirdiff && ![dict get $info dir]} continue
        ttk::radiobutton $wt.rb$t -variable ::eskil($top,edit,pluginname,$pI) \
                -value $plugin -text $plugin -command "SelectPlugin $top $pI $plugin"
        ttk::label $wt.l$t -text $descr -anchor w
        grid $wt.rb$t $wt.l$t -  - -in $wt.lfs -sticky we -padx 3 -pady 3
        incr t
    }
    ttk::radiobutton $wt.rb$t -variable ::eskil($top,edit,pluginname,$pI) \
            -value "" -text "No Plugin" -command "SelectPlugin $top $pI $plugin"
    ttk::button $wt.bs -text "Show" -state disable \
            -command "ShowPlugin $wt \$::eskil($top,edit,pluginname,$pI)"
    addBalloon $wt.bs "Show plugin source code."
    ttk::button $wt.bc -text "Clone" -state disable \
            -command "ClonePlugin $wt \$::eskil($top,edit,pluginname,$pI)"
    addBalloon $wt.bc "Clone to a runtime plugin."
    ttk::button $wt.be -text "Edit" -state disable \
            -command "EditPlugin $wt \$::eskil($top,edit,pluginname,$pI)"
    set ::eskil($top,edit,showW,$pI) $wt.bs
    set ::eskil($top,edit,cloneW,$pI) $wt.bc
    set ::eskil($top,edit,editW,$pI) $wt.be
    addBalloon $wt.be "Edit a runtime plugin."
    SelectPlugin $top $pI $::eskil($top,edit,pluginname,$pI)

    grid $wt.rb$t $wt.be $wt.bc $wt.bs -in $wt.lfs -sticky we -padx 3 -pady 3
    grid $wt.bs $wt.bc $wt.be -sticky e

    ttk::labelframe $wt.lfgc -text "Generic Configuration"
    grid columnconfigure $wt.lfgc 1 -weight 1

    ttk::label $wt.li -text "Info" -anchor w
    addBalloon $wt.li "Info passed to plugin. Plugin specific."
    ttk::entry $wt.ei -textvariable ::eskil($top,edit,plugininfo,$pI)

            $tW insert end $pre
            $tW insert end $post\n comment
        } else {
            $tW insert end $line\n
        }
    }
}

proc SelectPlugin {top pI plugin} {
    $::eskil($top,edit,showW,$pI)  configure -state disable
    $::eskil($top,edit,cloneW,$pI) configure -state disable
    $::eskil($top,edit,editW,$pI)  configure -state disable
    if {$plugin eq ""} {
        return
    }

    $::eskil($top,edit,showW,$pI)  configure -state normal
    # TODO: Enable when this works.
    #$::eskil($top,edit,cloneW,$pI) configure -state normal
    foreach name [dict keys $::eskil(plugins)] {
        if {$name eq $plugin} {
            # TODO: Enable when this works.
            #$::eskil($top,edit,editW,$pI)  configure -state normal
        }
    }
}

proc EditPlugin {parent plugin} {
    # TODO
}

proc ClonePlugin {parent plugin} {
    set res [LocatePlugin $plugin]
    dict set res name clone_$plugin
    dict set ::eskil(plugins) clone_$plugin $res
}

# Show plugin source
proc ShowPlugin {parent plugin} {
    set res [LocatePlugin $plugin]
    set data [dict get $res data]
    if {$data eq ""} return



    set wt $parent.plugin
    if {[winfo exists $wt]} {
        wm deiconify $wt
    } else {
        toplevel $wt -padx 3 -pady 3
    }
    destroy {*}[winfo children $wt]

        }
    }
}

# Global code is only run the first time to be able to reread source
if { ! [info exists ::eskil(gurkmeja)]} {
    set ::eskil(gurkmeja) 1
    set ::eskil(plugins) {}

    package require pstools
    namespace import -force pstools::*
    getOptions
    if { ! [info exists ::eskil_testsuite]} {
        InitSourceEarly
        parseCommandLine