#----------------------------------------------------------------------
# Eskil, Plugin handling
#
# Copyright (c) 2008, Peter Spjuth (peter.spjuth@gmail.com)
#
# 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; see the file COPYING. If not, write to
# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
#
#----------------------------------------------------------------------
# $Revision$
#----------------------------------------------------------------------
proc PluginSearchPath {} {
set dirs [list . ./plugins]
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
proc LocatePlugin {plugin} {
set src ""
set dirs [PluginSearchPath]
foreach dir $dirs {
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 data [read $ch 20]
close $ch
if {[string match "##Eskil Plugin*" $data]} {
set src $file
break
}
}
if {$src ne ""} break
}
return $src
}
proc createPluginInterp {plugin info allow pinfoName} {
upvar 1 $pinfoName pinfo
set src [LocatePlugin $plugin]
if {$src eq ""} {
return ""
}
# Create interpreter and load source
if {$allow} {
set pi [interp create]
$pi eval source $src
} else {
set pi [interp create -safe]
$pi invokehidden -global source $src
}
# Setup info
$pi eval [list set ::WhoAmI [file rootname [file tail $src]]]
$pi eval [list set ::Info $info]
interp share {} stdout $pi
# Expose needed commands
if {!$allow} {
interp expose $pi fconfigure ;# ??
interp hide $pi close
}
set pinfo {file 0 dir 0}
dict set pinfo allow $allow
if {[$pi eval info proc PreProcess] ne ""} {
dict set pinfo file 1
}
if {[$pi eval info proc FileCompare] ne ""} {
dict set pinfo dir 1
}
return $pi
}
proc printPlugin {plugin} {
set src [LocatePlugin $plugin]
if {$src eq ""} {
printPlugins
return
}
set ch [open $src]
puts -nonewline [read $ch]
close $ch
}
proc listPlugins {} {
set dirs [PluginSearchPath]
set result {}
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 data [read $ch 200]
if {[regexp {^\#\#Eskil Plugin :(.*?)(\n|$)} $data -> 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 data [read $ch]
if {[string first "proc PreProcess " $data] >= 0} {
dict set result $root "file" 1
}
if {[string first "proc FileCompare " $data] >= 0} {
dict set result $root "dir" 1
}
}
close $ch
}
}
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
}
puts "Available plugins:"
foreach {plugin info} $plugins {
set descr [dict get $info descr]
puts "Plugin \"$plugin\" : $descr"
}
}
proc preparePlugin {top} {
disallowEdit $top
set allow [dict get $::eskil($top,pluginpinfo) allow]
# Pass ::argv to plugin
$::eskil($top,plugin) eval [list set ::argv $::eskil(argv)]
# Pass ::Pref to plugin
$::eskil($top,plugin) eval [list array set ::Pref [array get ::Pref]]
set out1 [tmpFile]
set out2 [tmpFile]
set chi [open $::eskil($top,leftFile) r]
set cho [open $out1 w]
set chi2 [open $::eskil($top,rightFile) r]
set cho2 [open $out2 w]
interp share {} $chi $::eskil($top,plugin)
interp share {} $cho $::eskil($top,plugin)
interp share {} $chi2 $::eskil($top,plugin)
interp share {} $cho2 $::eskil($top,plugin)
set cmd1 [list PreProcess left $chi $cho]
set cmd2 [list PreProcess right $chi2 $cho2]
if {[info commands yield] ne ""} {
# When in 8.6, this is done in coroutines allowing each call
# to yield and to alternate between them until done
set c1 __plugin_cr1$top
set c2 __plugin_cr2$top
set cmd1 [linsert $cmd1 0 coroutine $c1]
set cmd2 [linsert $cmd2 0 coroutine $c2]
set usenew1 [$::eskil($top,plugin) eval $cmd1]
set usenew2 [$::eskil($top,plugin) eval $cmd2]
interp alias {} pnw $::eskil($top,plugin) namespace which
while {[pnw $c1] ne {} || [pnw $c2] ne {}} {
if {[pnw $c1] ne {}} {
set usenew1 [$::eskil($top,plugin) eval $c1]
}
if {[pnw $c2] ne {}} {
set usenew2 [$::eskil($top,plugin) eval $c2]
}
}
} else {
set usenew1 [$::eskil($top,plugin) eval $cmd1]
set usenew2 [$::eskil($top,plugin) eval $cmd2]
}
if {$allow} {
$::eskil($top,plugin) eval close $chi
$::eskil($top,plugin) eval close $cho
$::eskil($top,plugin) eval close $chi2
$::eskil($top,plugin) eval close $cho2
} else {
$::eskil($top,plugin) invokehidden close $chi
$::eskil($top,plugin) invokehidden close $cho
$::eskil($top,plugin) invokehidden close $chi2
$::eskil($top,plugin) invokehidden close $cho2
}
close $chi
close $cho
close $chi2
close $cho2
if {$usenew1} {
# The file after processing should be used both
# for comparison and for displaying.
set ::eskil($top,leftFileBak) $::eskil($top,leftFile)
set ::eskil($top,leftFile) $out1
} else {
set ::eskil($top,leftFileDiff) $out1
#set ::eskil($top,leftLabel) "$::eskil($top,RevFile) $tag"
}
if {$usenew2} {
set ::eskil($top,rightFileBak) $::eskil($top,rightFile)
set ::eskil($top,rightFile) $out2
} else {
set ::eskil($top,rightFileDiff) $out2
#set ::eskil($top,rightLabel) $::eskil($top,RevFile)
}
}
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 w $top.prefplugin
# Create window
destroy $w
toplevel $w -padx 3 -pady 3
ttk::frame $w._bg
place $w._bg -x 0 -y 0 -relwidth 1.0 -relheight 1.0 -border outside
wm title $w "Preferences: Plugins"
set plugins [listPlugins]
if {[llength $plugins] == 0} {
grid [ttk::label $w.l -text "No plugins found."] - -padx 3 -pady 3
}
if {![info exists ::eskil($top,pluginname)]} {
set ::eskil($top,pluginname) ""
}
if {![info exists ::eskil($top,plugininfo)]} {
set ::eskil($top,plugininfo) ""
}
set ::eskil($top,edit,pluginname) $::eskil($top,pluginname)
set ::eskil($top,edit,plugininfo) $::eskil($top,plugininfo)
set t 0
foreach {plugin info} $plugins {
set descr [dict get $info descr]
if {$dirdiff && ![dict get $info dir]} continue
ttk::radiobutton $w.rb$t -variable ::eskil($top,edit,pluginname) -value $plugin -text $plugin
ttk::label $w.l$t -text $descr -anchor "w"
grid $w.rb$t $w.l$t -sticky we -padx 3 -pady 3
incr t
}
ttk::radiobutton $w.rb$t -variable ::eskil($top,edit,pluginname) -value "" -text "No Plugin"
grid $w.rb$t -sticky we -padx 3 -pady 3
ttk::label $w.li -text "Info" -anchor "w"
ttk::entry $w.ei -textvariable ::eskil($top,edit,plugininfo)
grid $w.li $w.ei -sticky we -padx 3 -pady 3
ttk::frame $w.fb -padding 3
ttk::button $w.fb.b1 -text "Ok" -command [list EditPrefPluginsOk $top $w]
ttk::button $w.fb.b2 -text "Show" \
-command "ShowPlugin $w \$::eskil($top,edit,pluginname)"
ttk::button $w.fb.b3 -text "Cancel" -command [list destroy $w]
set ::widgets($top,prefPluginsOk) $w.fb.b1
grid $w.fb.b1 x $w.fb.b2 x $w.fb.b3 -sticky we
grid columnconfigure $w.fb {0 2 4} -uniform a
grid columnconfigure $w.fb {1 3} -weight 1
grid $w.fb - -sticky we
grid columnconfigure $w 1 -weight 1
}
proc EditPrefPluginsOk {top w} {
destroy $w
set ::eskil($top,pluginname) $::eskil($top,edit,pluginname)
set ::eskil($top,plugininfo) $::eskil($top,edit,plugininfo)
if {$::eskil($top,pluginname) ne ""} {
set pinterp [createPluginInterp $::eskil($top,pluginname) \
$::eskil($top,plugininfo) 0 pinfo]
} else {
set pinterp ""
set pinfo ""
}
set ::eskil($top,plugin) $pinterp
set ::eskil($top,pluginpinfo) $pinfo
}
# Put Tcl code in a text widget, with some syntax highlighting
proc TextViewTcl {t data} {
$t tag configure comment -foreground "#b22222"
foreach line [split $data \n] {
if {[regexp {^\s*#} $line]} {
$t insert end $line\n comment
} elseif {[regexp {^(.*;\s*)(#.*)$} $line -> pre post]} {
$t insert end $pre
$t insert end $post\n comment
} else {
$t insert end $line\n
}
}
}
proc ShowPlugin {parent plugin} {
set src [LocatePlugin $plugin]
if {$src eq ""} return
set ch [open $src]
set data [read $ch]
close $ch
set w $parent.plugin
if {[winfo exists $w]} {
wm deiconify $w
} else {
toplevel $w -padx 3 -pady 3
}
destroy {*}[winfo children $w]
ttk::frame $w._bg
place $w._bg -x 0 -y 0 -relwidth 1.0 -relheight 1.0 -border outside
wm title $w "Plugin: $plugin"
set t [Scroll both text $w.t -width 80 -height 30 -font myfont -wrap none]
pack $w.t -fill both -expand 1
bind $t <Control-a> "[list $t tag add sel 1.0 end];break"
TextViewTcl $t $data
}