186 lines
7.2 KiB
Tcl
186 lines
7.2 KiB
Tcl
# This is a part of LinuxCNC
|
|
# Copyright 2006-2009 Jeff Epler <jepler@unpythonic.net>
|
|
#
|
|
# 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
|
|
namespace eval linuxcnc {
|
|
variable HOME @EMC2_HOME@
|
|
variable TMP_DIR @EMC2_TMP_DIR@
|
|
variable BIN_DIR @EMC2_BIN_DIR@
|
|
variable TCL_DIR @EMC2_TCL_DIR@
|
|
variable TCL_LIB_DIR @EMC2_TCL_LIB_DIR@
|
|
variable TCL_BIN_DIR @EMC2_TCL_DIR@/bin
|
|
variable TCL_SCRIPT_DIR @EMC2_TCL_DIR@/scripts
|
|
variable HELP_DIR @EMC2_HELP_DIR@
|
|
variable RTLIB_DIR @EMC2_RTLIB_DIR@
|
|
variable CONFIG_PATH [subst -nocommands -nobackslashes {@LINUXCNC_CONFIG_PATH_TCL@}]
|
|
variable NCFILES_DIR @EMC2_NCFILES_DIR@
|
|
variable LANG_DIR @EMC2_LANG_DIR@
|
|
variable IMAGEDIR @EMC2_IMAGE_DIR@
|
|
variable REALTIME @REALTIME@
|
|
variable RTS @RTS@
|
|
variable RUN_IN_PLACE @RUN_IN_PLACE@
|
|
variable CONFIG_DIR {}
|
|
variable _dir
|
|
foreach _dir [split $CONFIG_PATH :] {
|
|
lappend CONFIG_DIR [file normalize $_dir]
|
|
}
|
|
unset _dir
|
|
variable USER_CONFIG_DIR [lindex $CONFIG_DIR 0]
|
|
variable _langinit 1
|
|
variable LINUXCNC_AUX_GLADEVCP @LINUXCNC_AUX_GLADEVCP@
|
|
variable LINUXCNC_AUX_EXAMPLES @LINUXCNC_AUX_EXAMPLES@
|
|
}
|
|
|
|
if {[string first $::linuxcnc::BIN_DIR: $env(PATH)] != 0} {
|
|
set env(PATH) $::linuxcnc::BIN_DIR:$env(PATH)
|
|
}
|
|
|
|
proc linuxcnc::image_search i {
|
|
set paths "$::linuxcnc::IMAGEDIR $::linuxcnc::HOME $::linuxcnc::HOME/etc/linuxcnc /etc/linuxcnc ."
|
|
foreach f $paths {
|
|
if [file exists $f/$i] {
|
|
return [image create photo -file $f/$i]
|
|
}
|
|
if [file exists $f/$i.gif] {
|
|
return [image create photo -file $f/$i.gif]
|
|
}
|
|
}
|
|
error "image $i is not available"
|
|
}
|
|
|
|
load [file join [file dirname [info script]] linuxcnc[info sharedlibextension]]
|
|
|
|
# Arrange to load hal.so when the 'hal' command is requested
|
|
proc hal {args} {
|
|
load $::linuxcnc::TCL_LIB_DIR/hal.so
|
|
eval hal $args
|
|
}
|
|
|
|
# Internationalisation (i18n)
|
|
# in order to use i18n, all the strings will be called [msgcat::mc "string-foo"]
|
|
# instead of "string-foo".
|
|
# Thus msgcat searches for a translation of the string, and in case one isn't
|
|
# found, the original string is used.
|
|
# In order to properly use locale's the env variable LANG is queried.
|
|
# If LANG is defined, then the folder src/po is searched for files
|
|
# called *.msg, (e.g. en_US.msg).
|
|
package require msgcat
|
|
if {$linuxcnc::_langinit && [info exists env(LANG)]} {
|
|
msgcat::mclocale
|
|
msgcat::mcload $linuxcnc::LANG_DIR
|
|
set linuxcnc::_langinit 0
|
|
}
|
|
|
|
proc linuxcnc::standard_font_size {} {
|
|
if {[info exists ::linuxcnc::standard_font_size]} { return $::linuxcnc::standard_font_size }
|
|
set res1 [catch {exec gconftool -g /desktop/gnome/font_rendering/dpi} gnome_dpi]
|
|
set res2 [catch {exec xlsfonts -fn -adobe-helvetica-medium-r-normal--*-*-*-*-p-*-iso10646-1} fonts]
|
|
if {$res1 == 0 && $res2 == 0} {
|
|
set pixels [expr {$gnome_dpi / 8.}]
|
|
set min_diff [expr .2*$pixels]
|
|
set best_size [expr {int($pixels)}]
|
|
foreach f $fonts {
|
|
regexp -- {-.*?-.*?-.*?-.*?-.*?-.*?-(.*?)-.*} $f _ sz
|
|
set diff [expr {abs($pixels - $sz)}]
|
|
if {$diff < $min_diff} {
|
|
set min_diff $diff
|
|
set best_size $sz
|
|
}
|
|
}
|
|
return -$best_size
|
|
set ::linuxcnc::standard_font_size -$best_size
|
|
} else {
|
|
set ::linuxcnc::standard_font_size 12
|
|
}
|
|
}
|
|
|
|
proc linuxcnc::standard_font_family {} {
|
|
if {[lsearch [font names] TkDefaultFont] != -1} {
|
|
return [font configure TkDefaultFont -family]
|
|
}
|
|
return Helvetica
|
|
}
|
|
|
|
proc linuxcnc::standard_font {} {
|
|
if {[lsearch [font names] TkDefaultFont] != -1} { return TkDefaultFont }
|
|
list [standard_font_family] [standard_font_size]
|
|
}
|
|
|
|
proc linuxcnc::standard_fixed_font_family {} {
|
|
if {[lsearch [font names] TkFixedFont] != -1} {
|
|
return [font configure TkFixedFont -family]
|
|
}
|
|
return Courier
|
|
}
|
|
|
|
proc linuxcnc::standard_fixed_font {} {
|
|
if {[lsearch [font names] TkFixedFont] != -1} { return TkFixedFont }
|
|
set sz [standard_font_size]
|
|
if {$sz < 0 && $sz >= -12 && [lsearch [font families] fixed] != -1} {
|
|
return fixed
|
|
}
|
|
list [standard_fixed_font_family] [standard_font_size]
|
|
}
|
|
|
|
#
|
|
# FIXME:
|
|
# This parse_ini() code should be removed. It is inadequate for the new
|
|
# INI-file parser and has no sense of types. It is only here for compatibility
|
|
# with old code that expects global INI-file arrays in the Tcl namespace. This
|
|
# routine maps all section/variables to the sections, variables and values of
|
|
# the real INI-file using the new C++ parser.
|
|
# All Tcl code depending on global array INI-file entries needs to be ported to
|
|
# use the typed interface (using the emc_ini_* routines) or, better, the code
|
|
# should be rewritten in python.
|
|
#
|
|
# Create associative arrays for all ini file sections like: ::EMC(VERSION),
|
|
# ::KINS(JOINTS), ... etc
|
|
# The data is extracted from the INI-file parser and iterates all sections
|
|
# and variables to export the sections as global namespace array variables.
|
|
proc parse_ini {filename} {
|
|
# You can have a mismatch between the INI-file names when this gets called
|
|
# without other parts of LinuxCNC being initialized. Notably the twopass*
|
|
# tests have this problem.
|
|
# The LinuxCNC internals default to a statically set name "emc.ini" and,
|
|
# f.ex., the haltcl program does not set the underlying filename before
|
|
# calling here. This creates a problem because the emc_ini_* calls are all
|
|
# dependent on the static filename. Thus a mismatch here will read the
|
|
# wrong INI-file.
|
|
if {$filename != [emc_ini_filename]} {
|
|
# This guards against INI-file mismatches
|
|
if {[info exists ::env(INI_FILE_NAME)]} {
|
|
# If there is an environment var, then we need to use that
|
|
if {$filename != $::env(INI_FILE_NAME)} {
|
|
error "parse_ini: fatal: requested filename (${filename}) and env(INI_FILE_NAME) (${::env(INI_FILE_NAME)}) are not the same."
|
|
}
|
|
# The requested name matches the env variable, load it
|
|
if {![emc_ini_load $::env(INI_FILE_NAME)]} {
|
|
error "parse_ini: fatal: cannot parse (${::env(INI_FILE_NAME)})."
|
|
}
|
|
} else {
|
|
error "parse_ini: fatal: requested filename (${filename}) and underlying filename ([emc_ini_filename]) are not the same."
|
|
}
|
|
}
|
|
# Take all sections
|
|
foreach section [emc_ini_sections] {
|
|
upvar $section s
|
|
# and add each variable in that section to the section array
|
|
foreach varval [emc_ini_variables $section] {
|
|
lappend s([lindex $varval 0]) [lindex $varval 1]
|
|
}
|
|
}
|
|
}
|