#---------------------------------------------------------*-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
# for the Tcl core code.
#
#----------------------------------------------------------------------
# This is used as a Tcl Module. Use it like this:
# ::tcl::tm::path add <path-to-dir-with-module>
# package require pstools
# namespace import pstools::*
#----------------------------------------------------------------------
package provide pstools 1.0
#package require Tcl 8.4
namespace eval pstools {
namespace export safeLoad commonYScroll locateTmp locateEditor
if {[info commands ::ttk::*] ne ""} {
catch {namespace path ::ttk}
}
}
##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
}
# Procedures for common y-scroll
proc pstools::CommonYScroll_YView {sby args} {
variable yscroll
foreach w $yscroll($sby) {
eval [list $w yview] $args
}
}
proc pstools::CommonYScroll_YScroll {sby args} {
eval [list $sby set] $args
CommonYScroll_YView $sby moveto [lindex $args 0]
}
# Set up a common yscrollbar for a few scrollable widgets
proc pstools::commonYScroll {sby args} {
variable yscroll
$sby configure -command [list pstools::CommonYScroll_YView $sby]
foreach w $args {
$w configure -yscrollcommand [list pstools::CommonYScroll_YScroll $sby]
}
set yscroll($sby) $args
}
# A simple window for displaying e.g. help.
# Returns the frame where things can be put.
proc pstools::helpWin {W title} {
destroy $W
toplevel $W -padx 2 -pady 2
wm title $W $title
bind $W <Key-Return> [list destroy $W]
bind $W <Key-Escape> [list destroy $W]
frame $W.f
button $W.b -text "Close" -command [list destroy $W] -width 10 \
-default active
pack $W.b -side bottom -pady 2
pack $W.f -side top -expand y -fill both -padx 2 -pady 2
focus $W
return $W.f
}
# Figure out a place to store temporary files.
proc pstools::locateTmp {globVar} {
upvar "#0" $globVar var
set candidates {}
if {[info exists ::env(TEMP)]} {
lappend candidates $::env(TEMP)
}
if {[info exists ::env(TMP)]} {
lappend candidates $::env(TMP)
}
lappend candidates /tmp . ~
foreach cand $candidates {
set cand [file normalize $cand]
if {[file isdirectory $cand] && [file writable $cand]} {
set var $cand
return
}
}
# Panic?
set var .
}
# This is called when an editor is needed to display a file.
# It sets up the variable with the path, unless the var
# already exists.
proc pstools::locateEditor {globVar} {
upvar "#0" $globVar var
if {[info exists var]} return
set candidates {}
if {[info exists ::env(VISUAL)]} {
lappend candidates $::env(VISUAL)
}
if {[info exists ::env(EDITOR)]} {
lappend candidates $::env(EDITOR)
}
if {$::tcl_platform(platform) == "windows"} {
# Try to locate some common installation points for Emacs
set dirs [glob -nocomplain c:/apps/emacs*]
lappend dirs {*}[glob -nocomplain "C:/Program Files/emacs*"]
lappend dirs {*}[glob -nocomplain "C:/Program Files/emacs*/*"]
foreach dir [lsort -decreasing -dictionary $dirs] {
set em [file join $dir bin runemacs.exe]
set em [file normalize $em]
if {[file exists $em]} {
lappend candidates $em
break
}
}
lappend candidates runemacs wordpad
}
# What is a good value on Mac?
# Add some more for fallback
lappend candidates emacs gvim gedit kate
foreach cand $candidates {
if {[auto_execok $cand] ne ""} {
set var [list $cand]
return
}
}
# If we fall through here we are kind of lost...
set var "could_not_find_editor"
}