1119 lines
36 KiB
Tcl
Executable file
1119 lines
36 KiB
Tcl
Executable file
#!/usr/bin/wish
|
|
#
|
|
# Copyright: 2009-2012
|
|
# Author: Dewey Garrett <dgarrett@panix.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; if not, write to the Free Software
|
|
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
|
|
#
|
|
# As standalone tool table editor
|
|
# Usage:
|
|
# tooleditor.tcl filename
|
|
# tooleditor.tcl [column_1 ... column_n] filename
|
|
#
|
|
# This file can also be sourced and included in tcl scripts
|
|
# The namespace ::tooledit exports a single function:
|
|
# ::tooledit::tooledit
|
|
# A single global array ::te() stores private data
|
|
|
|
# Supports tool offsets along all axes (x y z a b c u v w)
|
|
# Older tool table formats are not supported
|
|
# No distinction is made between mill or lathe tools
|
|
# Text on a line following a semicolon (;) is treated as comment
|
|
# Comment-only lines are preserved
|
|
|
|
package require BWidget ;# for ScrolledWindow, ScrollableFrame
|
|
|
|
namespace eval ::tooledit {
|
|
namespace export tooledit ;# public interface
|
|
}
|
|
|
|
#-----------------------------------------------------------------------
|
|
# Internationalization
|
|
|
|
# use the tcl-package named Emc to set up I18n support
|
|
if [catch {package require Linuxcnc} msg] {
|
|
# if user is trying to use as standalone in an unconfigured (non-Emc)
|
|
# environment, just continue without internationalization
|
|
puts stderr "Internationalization not available: <$msg>"
|
|
}
|
|
# use a command or proc named "_" for ::msgcat::mc
|
|
# when embedded in axis, a command named "_" is predefined,
|
|
# since "_" is not defined for standalone usage, make a proc named "_"
|
|
if {"" == [info command "_"]} {
|
|
package require msgcat
|
|
proc _ {s} {return [::msgcat::mc $s]}
|
|
}
|
|
#-----------------------------------------------------------------------
|
|
|
|
|
|
proc ::tooledit::init { {columns ""} } {
|
|
if [file readable ~/.tooleditrc] {
|
|
if [catch {source ~/.tooleditrc} msg] {
|
|
puts stderr "[_ "Problem reading ~/.tooleditrc"]:"\n$msg"
|
|
}
|
|
if [info exists geometry] {
|
|
set ::te(top,restore,geometry) $geometry
|
|
}
|
|
}
|
|
if {"$columns" == ""} {
|
|
set columns $::te(allcolumns)
|
|
} else {
|
|
set columns [string tolower $columns]
|
|
set ::te(user_specified_columns) $columns
|
|
}
|
|
|
|
# disallow duplicate columns (order according to first occurrence)
|
|
set checked_columns {}
|
|
foreach cname $columns {
|
|
if {[lsearch $checked_columns $cname] >= 0} {
|
|
puts stderr [format [_ "Note: Ignoring duplicate column name: %s"] $cname]
|
|
continue ;# duplicate col name
|
|
}
|
|
lappend checked_columns $cname
|
|
}
|
|
|
|
# include only allowed column names:
|
|
foreach cname $checked_columns {
|
|
if {[lsearch $::te(allcolumns) $cname] >= 0} {
|
|
lappend ::te(columns) $cname
|
|
} else {
|
|
puts stderr [format [_ "Unknown column: %s"] $cname]
|
|
}
|
|
}
|
|
|
|
set ::te(filemod) 0
|
|
set ::te(fmt,int) %d
|
|
set ::te(fmt,real) %g
|
|
set ::te(fmt,angle) %f
|
|
set ::te(msg,last) ""
|
|
set ::te(pollms) 2000
|
|
|
|
set ::te(initial,width) 0 ;# initial width as reqd
|
|
set ::te(initial,height) 110 ;# initial height limit here
|
|
set ::te(hincr) 1 ;# height increment to bump scrollable size
|
|
|
|
set ::te(autocolumns) {tool poc}
|
|
set ::te(header) [concat $::te(autocolumns) $::te(columns) comment]
|
|
|
|
foreach item $::te(header) { set ::te(type,$item) real ;# default }
|
|
set ::te(type,tool) integer
|
|
set ::te(type,poc) integer
|
|
set ::te(type,orien) integer
|
|
set ::te(type,comment) ascii
|
|
|
|
# include values for each (header) item:
|
|
set ::te(tool,width) 5; set ::te(tool,tag) T
|
|
set ::te(poc,width) 5; set ::te(poc,tag) P
|
|
set ::te(x,width) 7; set ::te(x,tag) X
|
|
set ::te(y,width) 7; set ::te(y,tag) Y
|
|
set ::te(z,width) 7; set ::te(z,tag) Z
|
|
set ::te(a,width) 7; set ::te(a,tag) A
|
|
set ::te(b,width) 7; set ::te(b,tag) B
|
|
set ::te(c,width) 7; set ::te(c,tag) C
|
|
set ::te(u,width) 7; set ::te(u,tag) U
|
|
set ::te(v,width) 7; set ::te(v,tag) V
|
|
set ::te(w,width) 7; set ::te(w,tag) W
|
|
set ::te(diam,width) 7; set ::te(diam,tag) D
|
|
set ::te(front,width) 7; set ::te(front,tag) I
|
|
set ::te(back,width) 7; set ::te(back,tag) J
|
|
set ::te(orien,width) 6; set ::te(orien,tag) Q
|
|
set ::te(comment,width) 20; set ::te(comment,tag) \;
|
|
# note: width 0 expands with text in entry widget
|
|
# when using Bwidget scrollable frame
|
|
} ;# init
|
|
|
|
proc ::tooledit::validangle {v} {
|
|
if {[string trim $v] == ""} {return 1} ;# allow null value
|
|
if {$v <= 360 && $v >= -360} {return 1}
|
|
return 0
|
|
} ;# validangle
|
|
|
|
proc ::tooledit::isnegative {v} {
|
|
if {$v < 0} {return 1}
|
|
if {[string first - $v] >=0} {return 1} ;# this gets -0
|
|
return 0
|
|
} ;# ispositive
|
|
|
|
proc ::tooledit::isinteger {v} {
|
|
if ![isnumber $v] {return 0}
|
|
if {[string first . $v] >=0} {return 0}
|
|
if {[string first e [string tolower $v]] >= 0} {return 0}
|
|
return 1
|
|
} ;# isinteger
|
|
|
|
proc ::tooledit::isnumber {v} {
|
|
if {[string trim $v] == ""} {return 1} ;# allow null value
|
|
if [catch {format %f $v}] {
|
|
return 0
|
|
} else {
|
|
return 1
|
|
}
|
|
} ;# isnumber
|
|
|
|
proc ::tooledit::qid {} {
|
|
# generate unique id
|
|
if { ![info exists ::te(qid)]} {
|
|
set ::te(qid) 0
|
|
}
|
|
incr ::te(qid)
|
|
return q$::te(qid)
|
|
} ;# qid
|
|
|
|
proc ::tooledit::ventry {f validatenumber tvar \
|
|
{twidth 12} {expand 0} {justify left} {fill x}} {
|
|
if {$validatenumber} {
|
|
set e [entry $f.[qid] \
|
|
-width $twidth -relief sunken -justify $justify \
|
|
-textvariable $tvar \
|
|
-bg white \
|
|
-validate all \
|
|
-validatecommand [list ::tooledit::validateNumber $tvar %W %s %P] \
|
|
-invalidcommand [list ::tooledit::invalidNumber $tvar %W] \
|
|
]
|
|
pack $e -side left -expand $expand -fill $fill
|
|
} else {
|
|
set e [entry $f.[qid] \
|
|
-width $twidth -relief sunken -justify $justify\
|
|
-textvariable $tvar \
|
|
-bg white \
|
|
-validate all \
|
|
-validatecommand [list ::tooledit::validateOther $tvar %W %s %P] \
|
|
]
|
|
pack $e -side left -expand $expand -fill $fill
|
|
}
|
|
return $e
|
|
} ;# ventry
|
|
|
|
proc ::tooledit::validateOther {varname widget current new} {
|
|
if {"$current" != $new} {
|
|
incr ::te(filemod)
|
|
}
|
|
return 1 ;# 1==>ok
|
|
} ;# validateOther
|
|
|
|
proc ::tooledit::validateNumber {varname widget current new} {
|
|
if ![info exists $varname] {return 1}
|
|
if {"$new" == ""} {return 1}
|
|
if {"$new" == "[_ "NEW"]"} {
|
|
return 1 ;# 1==>ok dont flag items tagged "NEW"
|
|
}
|
|
if {"$current" == "[_ "NEW"]"} {
|
|
$widget configure -selectbackground $::te(restore,selectbackground)
|
|
$widget configure -selectforeground $::te(restore,selectforeground)
|
|
}
|
|
if [catch {format %f $new} ] {
|
|
$widget configure -fg red
|
|
message verror
|
|
return 1 ;# problem but return ok (just change color)
|
|
} else {
|
|
if {"$current" != "$new"} {message modified}
|
|
$widget configure -fg black
|
|
incr ::te(filemod)
|
|
return 1 ;# 1==>ok
|
|
}
|
|
} ;# validateNumber
|
|
|
|
proc ::tooledit::invalidNumber {varname widget} {
|
|
tk_dialog .problem \
|
|
Problem \
|
|
"[format [_ "%s must be a number"] $varname]" \
|
|
{} \
|
|
0 \
|
|
ok
|
|
$widget configure -validate all ;# restore validation
|
|
} ;# invalidNumber
|
|
|
|
proc ::tooledit::readfile {filename} {
|
|
if {[file exists $filename] && ![file readable $filename]} {
|
|
lappend msg [format [_ "filename: <%s> not readable"] $filename]
|
|
}
|
|
if [file exists $filename] {
|
|
if ![file writable $filename] {
|
|
lappend msg "[format [_ "filename: <%s> not writable"] $filename]"
|
|
}
|
|
} else {
|
|
set new 1
|
|
if ![file writable [file dirname $filename]] {
|
|
lappend msg "[format [_ "directory: <%s> not writable"] $filename]"
|
|
}
|
|
}
|
|
|
|
if [info exists msg] {return -code error $msg}
|
|
if [info exists new] {
|
|
makeline new
|
|
incr ::te(filemod)
|
|
message newfile
|
|
return
|
|
}
|
|
|
|
set fd [open $filename r]
|
|
|
|
set bct 0
|
|
set lno 0
|
|
while {1} {
|
|
gets $fd newline
|
|
incr lno ;# starts at 1
|
|
if [eof $fd] break
|
|
foreach item {t p x y z a b c u v w d i j q comment} {
|
|
set u($item) ""
|
|
}
|
|
set newline [string tolower $newline]
|
|
set i1 [string first \; $newline]
|
|
if {$i1 >= 0} {
|
|
set u(comment) [string range $newline [expr $i1 +1] end]
|
|
set u(comment) [string trim $u(comment)]
|
|
set newline [string range $newline 0 [expr -1 + $i1]]
|
|
set newline [string trim $newline]
|
|
}
|
|
|
|
if {"$newline" == ""} {
|
|
lappend ::te(global,comments) $u(comment)
|
|
continue
|
|
}
|
|
|
|
set bogus 0
|
|
foreach tagvalue [split [string trim $newline]] {
|
|
set tagvalue [string trim $tagvalue]
|
|
if {"$tagvalue" == ""} continue
|
|
set tag [string range $tagvalue 0 0 ]
|
|
set value [string range $tagvalue 1 end ]
|
|
if ![isnumber $value] {
|
|
puts stderr [format [_ "Skipping linenumber %d for tag %s, value <%s> is not a number"] \
|
|
$lno $tag $value]
|
|
incr bct; set bogus 1
|
|
}
|
|
switch $tag {
|
|
t - p - q { if ![isinteger $value] {
|
|
puts stderr [format [_ "Skipping linenumber %d for tag %s, expected integer not <%s>"] \
|
|
$lno $tag $value]
|
|
incr bct; set bogus 1
|
|
}
|
|
}
|
|
}
|
|
# catch errors since format is already checked
|
|
# (line will not be displayed)
|
|
# this allows all errors on a line to be flagged in one pass
|
|
switch $tag {
|
|
t - p - q {catch {set u($tag) [format "$::te(fmt,int)" $value]}}
|
|
x - y - z -
|
|
a - b - c -
|
|
u - v - w -
|
|
d {catch {set u($tag) [format "$::te(fmt,real)" $value]}}
|
|
i - j {catch {set u($tag) [format "$::te(fmt,angle)" $value]}}
|
|
default {puts stderr [format [_ "At linenumber %d, Unknown tag <%s>"] \
|
|
$lno $tag]
|
|
incr bct; set bogus 1
|
|
}
|
|
}
|
|
}
|
|
if $bogus continue
|
|
makeline u
|
|
::tooledit::repack
|
|
} ;# while
|
|
close $fd
|
|
if {$bct >0} {
|
|
# schedule message after message widget is created
|
|
after 0 {::tooledit::message bogus}
|
|
}
|
|
message opened
|
|
::tooledit::column_sort $::te(entry,header,tool) tool 1
|
|
set ::te(filemod) 0
|
|
return
|
|
} ;# readfile
|
|
|
|
proc ::tooledit::watch {args} {
|
|
catch {after cancel $::te(afterid)}
|
|
if ![file exists $::te(filename)] {
|
|
::tooledit::message filegone
|
|
set ::te(afterid) [after $::te(pollms) ::tooledit::watch]
|
|
return
|
|
}
|
|
set mtime [file mtime $::te(filename)]
|
|
switch $args {
|
|
start {
|
|
set ::te(mtime) $mtime
|
|
set ::te(md5sum) [eval exec md5sum $::te(filename)]
|
|
}
|
|
stop {return}
|
|
default {
|
|
if {$mtime > $::te(mtime)} {
|
|
set ::te(mtime) $mtime
|
|
set md5sum $::te(md5sum)
|
|
set ::te(md5sum) [eval exec md5sum $::te(filename)]
|
|
# no message if file contents unchanged
|
|
if {"$md5sum" != "$::te(md5sum)"} {
|
|
::tooledit::message changed
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# try to clear error display in case user clears error before check
|
|
# skip if newtool since error is annoying
|
|
# skip if filegone|changed|bogus since important
|
|
if { "$::te(msg,last)" != "newtool"
|
|
&& "$::te(msg,last)" != "filegone"
|
|
&& "$::te(msg,last)" != "changed"
|
|
&& "$::te(msg,last)" != "bogus"
|
|
&& "$::te(msg,last)" != "isort"
|
|
&& "$::te(msg,last)" != "dsort"
|
|
} {
|
|
::tooledit::toolvalidate silent ;# to clear errors
|
|
}
|
|
if [info exists ::te(load,button)] {
|
|
if ![sendaxis ping] {
|
|
# axis disappeared
|
|
pack forget $::te(load,button)
|
|
unset ::te(load,button)
|
|
} else {
|
|
if [sendaxis check_for_reload] {
|
|
$::te(load,button) configure -state normal
|
|
} else {
|
|
$::te(load,button) configure -state disabled
|
|
}
|
|
}
|
|
}
|
|
set ::te(afterid) [after $::te(pollms) ::tooledit::watch]
|
|
} ;# watch
|
|
|
|
proc ::tooledit::tooledit {filename {columns ""} } {
|
|
package require Tk
|
|
if {[package vcompare $::tcl_version 8.5] >= 0} {
|
|
# tcl8.5 lsort -indices available
|
|
set ::te(enable_column_sorting) 1
|
|
} else {
|
|
set prog [file tail $::argv0]
|
|
puts stderr [format [_ "%s: Column sorting not available with tcl_version==%s"] \
|
|
$prog $::tcl_version]
|
|
}
|
|
::tooledit::init $columns
|
|
set ::te(filename) $filename
|
|
|
|
# allow for translated names for header columns:
|
|
foreach h $::te(header) {
|
|
switch -exact $h {
|
|
tool {set ::te($h,show) [_ "tool"]}
|
|
poc {set ::te($h,show) [_ "poc"]}
|
|
diam {set ::te($h,show) [_ "diam"]}
|
|
front {set ::te($h,show) [_ "front"]}
|
|
back {set ::te($h,show) [_ "back"]}
|
|
orien {set ::te($h,show) [_ "orien"]}
|
|
comment {set ::te($h,show) [_ "comment"]}
|
|
default {set ::te($h,show) $h}
|
|
}
|
|
set ::te($h,show) [string toupper $::te($h,show)]
|
|
}
|
|
|
|
set ::te(top) [toplevel .tooledit]
|
|
wm withdraw $::te(top); update
|
|
wm resizable $::te(top) 1 1
|
|
wm protocol $::te(top) WM_DELETE_WINDOW ::tooledit::bye
|
|
wm title $::te(top) "tooledit: [file tail $::te(filename)]"
|
|
if [info exists ::te(tooledit,geometry)] {
|
|
wm geometry $::te(top) $::te(tooledit,geometry)
|
|
}
|
|
|
|
# note: never pack ::te(scroll,frame), handled by ScrolledWindow
|
|
set ::te(scroll,window) [ScrolledWindow $::te(top).scrolled \
|
|
-scrollbar vertical -auto none]
|
|
set ::te(scroll,frame) [ScrollableFrame $::te(top).scrolled.sff \
|
|
-height $::te(initial,height) -width $::te(initial,width) \
|
|
-constrainedwidth 1]
|
|
$::te(scroll,window) setwidget $::te(scroll,frame) ;# associates scrollbars
|
|
set ::te(main,frame) [$::te(scroll,frame) getframe] ;# this is parent
|
|
|
|
set ::te(lasti) 0
|
|
|
|
# header frame -------------------------------------------------
|
|
set f [frame $::te(top).header]
|
|
set ::te(header,frame) $f
|
|
pack $f -side top -expand 1 -fill x -anchor n
|
|
pack [label $f.b -text [_ "Del"] -width 3] -side left -expand 0
|
|
|
|
foreach h $::te(header) {
|
|
set e 0;set j center
|
|
if {"$h" == "comment"} {set e 1;set j left}
|
|
set ey [entry $f.$::te(lasti)$h -justify $j -textvariable ::te($h,show) \
|
|
-state disabled -relief groove \
|
|
-disabledforeground black \
|
|
-width $::te($h,width)]
|
|
pack $ey -side left -fill x -expand $e
|
|
set ::te(entry,header,$h) $ey
|
|
$ey configure -cursor arrow
|
|
bind $ey <ButtonRelease-1> "::tooledit::column_sort $ey $h"
|
|
}
|
|
|
|
readfile $::te(filename)
|
|
if [file exists $::te(filename)] {watch start}
|
|
|
|
pack $::te(scroll,window) -side top -fill x -expand 0 -anchor nw
|
|
|
|
# button frame -------------------------------------------------
|
|
set bf [frame $::te(top).[qid]]
|
|
pack $bf -side top -expand 0 -fill both -anchor nw
|
|
|
|
pack [button $bf.[qid] -text "[_ "Quit"]" \
|
|
-command ::tooledit::bye] \
|
|
-side right -fill x -expand 1
|
|
|
|
if {[sendaxis ping] && [sendaxis tool_table_filename]} {
|
|
set ::te(load,button) [button $bf.[qid] -text "[_ "ReLoadTable"]" \
|
|
-state disabled \
|
|
-command [list ::tooledit::sendaxis reload_tool_table]]
|
|
pack $::te(load,button) -side right -fill x -expand 1
|
|
}
|
|
pack [button $bf.[qid] -text "[_ "SaveFile"]" \
|
|
-command [list ::tooledit::writefile $::te(filename)]] \
|
|
-side right -fill x -expand 1
|
|
# pack [button $bf.[qid] -text "[_ "Check Entries"]" \
|
|
# -command [list ::tooledit::toolvalidate]] -side right -fill x -expand 1
|
|
pack [button $bf.[qid] -text "[_ "ReRead"]" \
|
|
-command ::tooledit::toolreread] -side right -fill x -expand 1
|
|
pack [button $bf.[qid] -text "[_ "AddTool"]" \
|
|
-command {::tooledit::makeline new}] -side right -fill x -expand 1
|
|
|
|
set bb [button $bf.[qid] -text "[_ "Delete"]"\
|
|
-command {::tooledit::deleteline}]
|
|
pack $bb -side right -fill x -expand 1
|
|
set ::te(deletebutton) $bb
|
|
checkdelete
|
|
|
|
|
|
# message frame -------------------------------------------------
|
|
set mf [frame $::te(top).[qid]]
|
|
pack $mf -side top -expand 0 -fill x
|
|
|
|
set msg [label $mf.msg -anchor w]
|
|
set ::te(msg,widget) $msg
|
|
pack $msg -side top -expand 0 -fill x -anchor w
|
|
|
|
update ;# wait for display before binding Configure events
|
|
if [info exists ::te(top,restore,geometry)] {
|
|
wm geometry $::te(top) $::te(top,restore,geometry)
|
|
unset ::te(top,restore,geometry)
|
|
}
|
|
set ::te(top,geometry) [wm geometry $::te(top)]
|
|
set ::te(top,height) [winfo height $::te(top)]
|
|
# set min width so top cannot be disappeared inadvertently
|
|
# set min height to initial
|
|
wm minsize $::te(top) 100 $::te(top,height)
|
|
bind $::te(top) <Configure> {::tooledit::configure %W %w %h}
|
|
wm deiconify $::te(top)
|
|
} ;# tooledit
|
|
|
|
proc ::tooledit::configure {W w h} {
|
|
if {"$W" != "$::te(top)"} return
|
|
if {"$W" == $::te(top) && $::te(top,geometry) != [wm geometry $::te(top)]} {
|
|
set ::te(top,geometry) [wm geometry $::te(top)]
|
|
set deltah [expr $h - $::te(top,height)]
|
|
set fsize [$::te(scroll,frame) cget -height]
|
|
if {[expr abs($deltah)] > $::te(hincr)} {
|
|
$::te(scroll,frame) configure -height [expr $fsize + $deltah]
|
|
set ::te(top,height) $h
|
|
}
|
|
}
|
|
} ;# configure
|
|
|
|
proc ::tooledit::message {mtype} {
|
|
if ![info exists ::te(msg,widget)] return
|
|
set w $::te(msg,widget)
|
|
set dt [clock format [clock seconds]]
|
|
switch $mtype {
|
|
opened {$w conf -text "$dt: [format [_ "Opened %s"] $::te(filename)]" -fg darkblue}
|
|
newfile {$w conf -text "$dt: [format [_ "Created %s"] $::te(filename)]" -fg darkblue}
|
|
write {$w conf -text "$dt: [_ "File updated"]" -fg green4}
|
|
modified {$w conf -text "$dt: [_ "File modified"]" -fg darkred}
|
|
checke {$w conf -text "$dt: [_ "File check errors"]" -fg red}
|
|
checkok {$w conf -text "$dt: [_ "File checked"]" -fg darkgreen}
|
|
delete {$w conf -text "$dt: [_ "File items deleted"]" -fg cyan4}
|
|
bogus {$w conf -text "$dt: [_ "Bogus lines in file ignored"]" -fg darkorange}
|
|
verror {$w conf -text "$dt: [_ "File errors -- Check Entries"]" -fg red}
|
|
changed {$w conf -text "$dt: [_ "Warning: File changed by another process"]" -fg red}
|
|
filegone {$w conf -text "$dt: [_ "Warning: File deleted by another process"]" -fg red}
|
|
newtool {$w conf -text "$dt: [_ "Added Tool"]" -fg green4
|
|
update idletasks
|
|
$::te(scroll,frame) yview moveto 1.0
|
|
}
|
|
isort {$w conf -text "$dt: [format [_ "Sorted by %s, increasing"] $::te(lastsort)]" -fg darkgreen}
|
|
dsort {$w conf -text "$dt: [format [_ "Sorted by %s, decreasing"] $::te(lastsort)]" -fg darkgreen}
|
|
}
|
|
set ::te(msg,last) $mtype
|
|
} ;# message
|
|
|
|
proc ::tooledit::deleteline {} {
|
|
set dct 0
|
|
catch {unset dlines}
|
|
foreach item [array names ::te "parm,*,deleteme"] {
|
|
if {$::te($item) == 1} {
|
|
set i1 [expr 1 + [string first , $item]]
|
|
set i2 [expr -1 + [string last , $item]]
|
|
lappend dlines [string range $item $i1 $i2]
|
|
}
|
|
}
|
|
if ![info exists dlines] continue
|
|
foreach i $dlines {
|
|
destroy $::te(entry,$i,frame); unset ::te(entry,$i,frame)
|
|
incr dct
|
|
|
|
if [info exists ::te(items)] {
|
|
set idx [lsearch $::te(items) $i]
|
|
if {$idx >= 0} {
|
|
set ::te(items) [lreplace $::te(items) $idx $idx]
|
|
}
|
|
if {[string length $::te(items)] == 0} {
|
|
unset ::te(items)
|
|
}
|
|
}
|
|
|
|
foreach name [array names ::te parm,$i,*] {
|
|
unset ::te($name)
|
|
}
|
|
}
|
|
checkdelete
|
|
if {$dct >0} { message delete}
|
|
incr ::te(filemod)
|
|
} ;# deleteline
|
|
|
|
proc ::tooledit::makeline {ay_name} {
|
|
if {"$ay_name" == "new"} {
|
|
set new 1
|
|
set date "[_ "Added"] [clock format [clock seconds] -format %Y%m%d]"
|
|
|
|
foreach item {t p x y z a b c u v w d i j q} {
|
|
set ay($item) ""
|
|
}
|
|
set ay(p) [_ "NEW"] ;# support translation of special entry item value
|
|
set ay(t) [_ "NEW"] ;# support translation of special entry item value
|
|
set ay(comment) "$date"
|
|
after 0 {::tooledit::message newtool}
|
|
} else {
|
|
upvar $ay_name ay
|
|
}
|
|
|
|
set i $::te(lasti)
|
|
set f [frame $::te(main,frame).[qid]]
|
|
set ::te(entry,$i,frame) $f
|
|
if {"$ay_name" == "new"} {
|
|
pack $f -side top -expand 1 -fill x -anchor n
|
|
} else {
|
|
# caller must pack (use ::tooledit::repack)
|
|
}
|
|
lappend ::te(items) $i
|
|
set ::te(parm,$i,tool) $ay(t)
|
|
set ::te(parm,$i,poc) $ay(p)
|
|
set ::te(parm,$i,x) $ay(x)
|
|
set ::te(parm,$i,y) $ay(y)
|
|
set ::te(parm,$i,z) $ay(z)
|
|
set ::te(parm,$i,a) $ay(a)
|
|
set ::te(parm,$i,b) $ay(b)
|
|
set ::te(parm,$i,c) $ay(c)
|
|
set ::te(parm,$i,u) $ay(u)
|
|
set ::te(parm,$i,v) $ay(v)
|
|
set ::te(parm,$i,w) $ay(w)
|
|
set ::te(parm,$i,diam) $ay(d)
|
|
set ::te(parm,$i,front) $ay(i)
|
|
set ::te(parm,$i,back) $ay(j)
|
|
set ::te(parm,$i,orien) $ay(q)
|
|
set ::te(parm,$i,comment) [string trim $ay(comment)]
|
|
pack [checkbutton $f.b -variable ::te(parm,$i,deleteme)\
|
|
-command "::tooledit::checkdelete"] -side left -expand 0
|
|
foreach h $::te(header) {
|
|
set e 0;set j right;set v 1
|
|
if {"$h" == "comment"} {set e 1; set j left;set v 0}
|
|
set ve [ventry $f $v ::te(parm,$i,$h) $::te($h,width) $e $j]
|
|
if {[info exists new] && "$h" == "tool"} {set vefocus $ve}
|
|
entrybindings $ve $h $i
|
|
}
|
|
incr ::te(lasti)
|
|
if [info exists vefocus] {
|
|
set ::te(restore,selectbackground) [$vefocus cget -selectbackground]
|
|
set ::te(restore,selectforeground) [$vefocus cget -selectforeground]
|
|
$vefocus configure -selectbackground white
|
|
$vefocus configure -selectforeground red
|
|
$vefocus selection to end
|
|
focus $vefocus
|
|
}
|
|
} ;# makeline
|
|
|
|
proc ::tooledit::entrybindings {e h i} {
|
|
$e conf -takefocus 1
|
|
set ::te($i,$h,entry) $e
|
|
bind $e <Key-Up> "::tooledit::bindactions $h $i %K"
|
|
bind $e <Key-Down> "::tooledit::bindactions $h $i %K"
|
|
bind $e <Key-Left> "::tooledit::bindactions $h $i %K"
|
|
bind $e <Key-Right> "::tooledit::bindactions $h $i %K"
|
|
} ;# entrybindings
|
|
|
|
proc ::tooledit::bindactions {h i key args} {
|
|
set nexth $h;set nexti $i;
|
|
switch $key {
|
|
Up {
|
|
set nexti [expr $i -1]
|
|
if {$nexti <0} {
|
|
set nexti [expr $::te(lasti) -0]
|
|
after 0 [list ::tooledit::bindactions $h $nexti $key]
|
|
return
|
|
}
|
|
}
|
|
Down {
|
|
set nexti [expr $i + 1]
|
|
if {$nexti >= $::te(lasti)} {
|
|
set nexti -1
|
|
after 0 [list ::tooledit::bindactions $h $nexti $key]
|
|
return
|
|
}
|
|
}
|
|
Right {
|
|
if {"$h" == "nosuch"} {
|
|
set nextidx 0
|
|
} else {
|
|
set idx [lsearch $::te(header) $h]
|
|
set nextidx [expr $idx + 1]
|
|
if {$nextidx >= [llength $::te(header)]} {
|
|
after 0 [list ::tooledit::bindactions nosuch $nexti $key]
|
|
return
|
|
}
|
|
}
|
|
set nexth [lindex $::te(header) $nextidx]
|
|
}
|
|
Left {
|
|
if {"$h" == "nosuch"} {
|
|
set nextidx [expr [llength $::te(header)] -1]
|
|
} else {
|
|
set idx [lsearch $::te(header) $h]
|
|
set nextidx [expr $idx + -1]
|
|
if {$nextidx < 0} {
|
|
after 0 [list ::tooledit::bindactions nosuch $nexti $key]
|
|
return
|
|
}
|
|
}
|
|
set nexth [lindex $::te(header) $nextidx]
|
|
}
|
|
}
|
|
if [info exists ::te($nexti,$nexth,entry)] {
|
|
$::te($nexti,$nexth,entry) selection to end
|
|
focus $::te($nexti,$nexth,entry)
|
|
} else {
|
|
# frame has been deleted
|
|
switch $key {
|
|
Up - Down {
|
|
set nexti [expr $nexti + 0]
|
|
after 0 [list ::tooledit::bindactions $h $nexti $key]
|
|
return
|
|
}
|
|
}
|
|
}
|
|
} ;# bindactions
|
|
|
|
proc ::tooledit::checkdelete {} {
|
|
set ct 0
|
|
foreach name [array names ::te parm,*,deleteme] {
|
|
if {$::te($name) == 1} {incr ct}
|
|
}
|
|
if {$ct > 0} {
|
|
$::te(deletebutton) conf -fg red -state normal
|
|
} else {
|
|
$::te(deletebutton) conf -fg black -state disabled
|
|
}
|
|
focus $::te(deletebutton)
|
|
} ;# checkdelete
|
|
|
|
proc ::tooledit::toolreread {} {
|
|
set ::te(tooledit,geometry) [wm geometry $::te(top)]
|
|
|
|
for {set i 0} {$i < $::te(lasti)} {incr i} {
|
|
catch {
|
|
destroy $::te(entry,$i,frame)
|
|
unset ::te(entry,$i,frame)
|
|
} ;# it may already be gone
|
|
}
|
|
set ::te(lasti) 0
|
|
# can be missing for some prior file open errors
|
|
catch {unset ::te(items)}
|
|
|
|
readfile $::te(filename)
|
|
if [file exists $::te(filename)] {watch start}
|
|
} ;# toolreread
|
|
|
|
proc ::tooledit::writefile {filename} {
|
|
if [toolvalidate] return ;# failed validation
|
|
if [file exists $filename] {
|
|
set backup $filename.bak
|
|
file rename -force $filename $backup
|
|
}
|
|
|
|
set fd [open $filename w]
|
|
|
|
if [info exists ::te(global,comments)] {
|
|
foreach c $::te(global,comments) {
|
|
puts $fd ";$c"
|
|
}
|
|
}
|
|
|
|
# write to all populated header items (to preserve values if not displayed)
|
|
set allheader [concat $::te(autocolumns) $::te(allcolumns) comment]
|
|
|
|
foreach i $::te(items) {
|
|
foreach h $allheader {
|
|
set j ""
|
|
set w $::te($h,width)
|
|
# correct entries with leading zeros
|
|
if {$h != "comment" &&
|
|
[string first 0 [string trim $::te(parm,$i,$h)]] == 0} {
|
|
set ::te(parm,$i,$h) [format %g $::te(parm,$i,$h)]
|
|
}
|
|
set value [string trim $::te(parm,$i,$h)]
|
|
if {"$value" != ""} {
|
|
puts -nonewline $fd "$::te($h,tag)$value "
|
|
}
|
|
}
|
|
puts $fd "" ;# new line
|
|
}
|
|
watch stop
|
|
close $fd
|
|
watch start
|
|
message write
|
|
set ::te(filemod) 0
|
|
} ;# writefile
|
|
|
|
proc ::tooledit::toolvalidate {args} {
|
|
set msg ""
|
|
set silent 0
|
|
if {"$args" == "silent"} {set silent 1}
|
|
|
|
if [info exists ::te(items)] {
|
|
foreach i $::te(items) {
|
|
foreach h $::te(header) {
|
|
if {"$h" == "comment"} continue
|
|
if ![isnumber $::te(parm,$i,$h)] {
|
|
set nextmsg [format [_ "Tool %s, Column %s, parameter %s is not a number"] \
|
|
$::te(parm,$i,tool) $h $::te(parm,$i,$h)]
|
|
if {[lsearch $msg $nextmsg] >= 0} continue
|
|
lappend msg $nextmsg
|
|
}
|
|
|
|
switch -glob $h {
|
|
tool* - poc* {
|
|
if {![isinteger $::te(parm,$i,$h)] || [isnegative $::te(parm,$i,$h)]} {
|
|
lappend msg [format [_ "Tool %s, parameter %s must be nonnegative integer"] \
|
|
$::te(parm,$i,tool) $h]
|
|
|
|
}
|
|
}
|
|
orien* {
|
|
if { "$::te(parm,$i,$h)" != "" \
|
|
&& [lsearch {0 1 2 3 4 5 6 7 8 9} $::te(parm,$i,$h)] < 0} {
|
|
lappend msg [format [_ "Tool %s: <Orientation> must be 0..9 integer"] \
|
|
$::te(parm,$i,tool)]
|
|
|
|
}
|
|
}
|
|
front* - back* {
|
|
if {![validangle $::te(parm,$i,$h)] } {
|
|
lappend msg [format [_ "Tool %s: <%s> must be between -360 and 360"] \
|
|
$::te(parm,$i,tool) $h]
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# check for multiple uses of a single pocket
|
|
if [info exists ::te(items)] {
|
|
set pocs ""
|
|
foreach i $::te(items) {
|
|
set p $::te(parm,$i,poc)
|
|
|
|
if {[lsearch $pocs $p] >= 0} {
|
|
set nextmsg [format [_ "Pocket <%s> specified multiple times"] $p]
|
|
if {[lsearch $msg $nextmsg] >= 0} continue
|
|
lappend msg $nextmsg
|
|
} else {
|
|
lappend pocs $p
|
|
}
|
|
}
|
|
}
|
|
# check for multiple uses of a single tool
|
|
if [info exists ::te(items)] {
|
|
set tools ""
|
|
foreach i $::te(items) {
|
|
set t $::te(parm,$i,tool)
|
|
|
|
if {[lsearch $tools $t] >= 0} {
|
|
set nextmsg [format [_ "Tool <%s> specified multiple times"] $t]
|
|
if {[lsearch $msg $nextmsg] >= 0} continue
|
|
lappend msg $nextmsg
|
|
} else {
|
|
lappend tools $t
|
|
}
|
|
}
|
|
}
|
|
|
|
if {"$msg" != ""} {
|
|
if {!$silent} {showerr $msg}
|
|
message checke
|
|
return 1 ;#fail
|
|
}
|
|
message checkok
|
|
return 0
|
|
} ;# toolvalidate
|
|
|
|
proc ::tooledit::showerr {msg} {
|
|
set w .showerr
|
|
catch {destroy $w}
|
|
set w [toplevel $w]
|
|
set l [label $w.l -justify left]
|
|
set text ""
|
|
set msg [lsort $msg]
|
|
foreach item $msg {set text "$text\n$item"}
|
|
$l configure -text $text
|
|
pack $l -side top
|
|
set b [button $w.b -text Dismiss -command "destroy $w"]
|
|
pack $b -side top
|
|
focus $b
|
|
wm withdraw $w
|
|
wm title $w Error
|
|
update idletasks
|
|
set x [expr [winfo screenwidth $w]/2 \
|
|
- [winfo reqwidth $w]/2 - [winfo vrootx [winfo parent $w]]]
|
|
set y [expr [winfo screenheight $w]/2 \
|
|
- [winfo reqheight $w]/2 - [winfo vrooty [winfo parent $w]]]
|
|
wm geom $w +$x+$y
|
|
wm deiconify $w
|
|
} ;# showerr
|
|
|
|
proc ::tooledit::bye {} {
|
|
if $::te(filemod) {
|
|
set ans [tk_dialog .filemod \
|
|
"[_ "File Modified"]" \
|
|
"[_ "Save Modifications to File?"]" \
|
|
{} \
|
|
0 \
|
|
Yes No]
|
|
if {$ans == 0} {
|
|
::tooledit::writefile $::te(filename)
|
|
}
|
|
}
|
|
|
|
catch {after cancel $::te(afterid)}
|
|
|
|
if ![file exists ~/.tooleditrc] {
|
|
# first time use presumed, instruct for configuring columns
|
|
set used ""
|
|
foreach item $::te(items) {
|
|
foreach col $::te(allcolumns) {
|
|
if {"$::te(parm,$item,$col)" != ""} {lappend used $col}
|
|
}
|
|
}
|
|
# make used list unique:
|
|
foreach item $used { set tmp($item) "" }
|
|
set used [array names tmp]
|
|
|
|
if { ![info exists ::te(user_specified_columns)] \
|
|
&& ("$used" != "") \
|
|
&& ([llength $used] < [llength $::te(allcolumns)]) } {
|
|
set prog [file tail $::argv0]
|
|
set msg "[format [_ "Only these columns are currently used:\n\n %s"] $used] \
|
|
\n\n[_ "Limit display to these columns by specifying"]:\
|
|
\n \[DISPLAY\]TOOL_EDITOR = $prog $used\
|
|
\n\n[_ "Format for ini file is"]:\
|
|
\n \[DISPLAY\]TOOL_EDITOR = $prog col_1 col_2 ... col_n\
|
|
\n\n[_ "For standalone use, invoke as"]:\
|
|
\n\n $prog col_1 col_2 ... col_n [_ "tool_table_filename"]
|
|
"
|
|
catch {destroy .msg}
|
|
toplevel .msg
|
|
set txt [text .msg.txt -width 80 -height 14]
|
|
$txt insert end $msg
|
|
pack $txt -side top -fill x -expand 0
|
|
pack [button .msg.b -text OK -command {destroy .msg}] -side top
|
|
}
|
|
update
|
|
}
|
|
while 1 {
|
|
if ![winfo exists .msg] break
|
|
after 1000
|
|
update
|
|
}
|
|
|
|
if [winfo exists $::te(top)] {
|
|
set fd [open ~/.tooleditrc w]
|
|
set time [clock format [clock seconds] -format %Y%m%d.%H.%M.%S]
|
|
puts $fd "# $time [format [_ "Created by %s"] [file normalize $::argv0]]"
|
|
puts $fd "\n# [_ "Saved geometry (updated on program termination)"]:"
|
|
puts $fd "set geometry [wm geometry $::te(top)]"
|
|
close $fd
|
|
destroy $::te(top) ;# for embedded usage
|
|
}
|
|
set ::tooledit::finis 1 ;# for standalone usage
|
|
} ;# bye
|
|
|
|
proc ::tooledit::sendaxis {cmd} {
|
|
# return 1==>ok
|
|
switch $cmd {
|
|
ping {
|
|
# must ping to see if axis is running and get its pwd
|
|
if ![catch {set ::te(axis,pwd) [send axis pwd]} msg] {return 1 ;#ok}
|
|
}
|
|
tool_table_filename {
|
|
set prog [file tail $::argv0]
|
|
# check that tooledit opened with same filename as axis
|
|
if [catch {set f [send axis inifindall EMCIO TOOL_TABLE]} msg] {
|
|
return -code error "::tooledit::sendaxis tool_table_filename <$msg>"
|
|
}
|
|
if {[llength $f] > 1} {
|
|
set f [lindex $f 0] ;# use first item specified for compatibility
|
|
puts stderr [format [_ "%s: Axis inifile specifies multiple inifile items for: \[EMCIO\]TOOL_TABLE"] $prog]
|
|
puts stderr [format [_ "%s: Using: %s"] $prog $f]
|
|
}
|
|
if {[file pathtype $f] == "relative"} {
|
|
set f [file join $::te(axis,pwd) $f]
|
|
}
|
|
set ::te(axis,filename) [file normalize $f]
|
|
if {"$::te(axis,filename)" == [file normalize $::te(filename)]} {
|
|
return 1 ;# ok
|
|
} else {
|
|
puts stderr [format [_ "%s: Warning: Axis is running but the tool table file <%s>\
|
|
\ndiffers from the standalone startup file <%s>"]\
|
|
$prog $::te(axis,filename) $::te(filename)]
|
|
}
|
|
}
|
|
check_for_reload {
|
|
# use same test as axis for disabling:
|
|
if [send axis {expr "$::task_state" == "$::STATE_ON"\
|
|
&& "$::interp_state" == "$::INTERP_IDLE"}] {
|
|
return 1 ;# ok
|
|
}
|
|
}
|
|
reload_tool_table {
|
|
if ![sendaxis check_for_reload] {
|
|
showerr [list "[_ "Must be On and Idle to reload tool table"]"]
|
|
return 0 ;# fail
|
|
}
|
|
::tooledit::writefile $::te(filename)
|
|
if [catch {send axis reload_tool_table} msg] {
|
|
return -code error "::tooledit::sendaxis reload_tool_table <$msg>"
|
|
}
|
|
return 1 ;# ok
|
|
}
|
|
default {return -code error "::tooledit::sendaxis: unknown cmd <$cmd>"}
|
|
}
|
|
|
|
return 0 ;# fail
|
|
} ;# sendaxis
|
|
|
|
proc ::tooledit::repack { {entryname tool} {mode increasing} } {
|
|
if ![info exist ::te(enable_column_sorting)] {
|
|
foreach name [array names ::te entry*frame] {
|
|
pack $::te($name) -side top -expand 1 -fill x -anchor n
|
|
}
|
|
return
|
|
}
|
|
|
|
set type $::te(type,$entryname)
|
|
|
|
foreach item $::te(items) {
|
|
set value $::te(parm,$item,$entryname)
|
|
if { ( ("$type" == "real") || ("$type" == "integer") )\
|
|
&& ( ("$value" == "" ) || ("$value" == "[_ "NEW"]") ) } {
|
|
set value 0
|
|
}
|
|
lappend parms $value
|
|
lappend parms_i $item
|
|
}
|
|
|
|
foreach i $::te(items) {
|
|
pack forget $::te(entry,$i,frame)
|
|
}
|
|
|
|
set indices [lsort -$type -$mode -indices $parms]
|
|
foreach idx $indices {
|
|
set i [lindex $parms_i $idx]
|
|
pack $::te(entry,$i,frame) -side top -expand 1 -fill x -anchor n
|
|
}
|
|
} ;# repack
|
|
|
|
proc ::tooledit::column_sort {e parm {initialize 0} } {
|
|
if {$initialize || ![info exists ::te(columnsortorder)]} {
|
|
set ::te(columnsortorder) increasing
|
|
catch {$::te(lastsort,entry) configure -disabledforeground black}
|
|
} else {
|
|
if [info exists ::te(lastsort,entry)] {
|
|
$::te(lastsort,entry) configure -disabledforeground black
|
|
if {"$::te(lastsort,entry)" != "$e"} {
|
|
set ::te(columnsortorder) decreasing
|
|
}
|
|
}
|
|
if {"$::te(columnsortorder)" == "increasing"} {
|
|
set ::te(columnsortorder) decreasing
|
|
} else {
|
|
set ::te(columnsortorder) increasing
|
|
}
|
|
}
|
|
::tooledit::repack $parm $::te(columnsortorder)
|
|
|
|
if ![info exists ::te(enable_column_sorting)] return
|
|
|
|
set ::te(lastsort,entry) $e
|
|
set ::te(lastsort) [string toupper $parm]
|
|
switch $::te(columnsortorder) {
|
|
increasing {
|
|
$e configure -disabledforeground blue
|
|
::tooledit::message isort
|
|
}
|
|
decreasing {
|
|
$e configure -disabledforeground violetred
|
|
::tooledit::message dsort
|
|
}
|
|
}
|
|
} ;# column_sort
|
|
|
|
#------------------------------------------------------------------------
|
|
set ::te(allcolumns) {x y z a b c u v w diam front back orien}
|
|
proc standalone_tooledit {args} {
|
|
# configure for standalone usage:
|
|
set ::te(standalone) 1
|
|
wm withdraw .
|
|
if {[lindex $::argv 0] == ""} {
|
|
set prog [file tail $::argv0]
|
|
puts stderr "\n[_ "Usage"]:"
|
|
puts stderr " $prog [_ "filename"]"
|
|
puts stderr " $prog \[column_1 ... column_n\] [_ "filename"]"
|
|
puts stderr "\n[format [_ "Allowed column_ names are: %s"] $::te(allcolumns)]"
|
|
exit 1
|
|
}
|
|
# start, unless already started (convenient for debug sourcing):
|
|
if ![info exists ::te(top)] {
|
|
# expect ::argv == [colname colname ...] filename
|
|
set columns "" ;# default use all columns
|
|
set argct [llength $::argv]
|
|
switch $argct {
|
|
0 {#notreached
|
|
puts stderr "$::argv0: [_ "Missing filename"]";exit 1}
|
|
1 {set filename $::argv}
|
|
default {set filename [lindex $::argv end]
|
|
set columns [lreplace $::argv end end]
|
|
}
|
|
}
|
|
::tooledit::tooledit $filename $columns
|
|
tkwait variable ::tooledit::finis
|
|
exit 0
|
|
}
|
|
} ;# standalone_tooledit
|
|
|
|
if {[info script] == $::argv0} standalone_tooledit
|
|
|