/usr/lib/grass64/etc/gm/gmlib.tcl is in grass-gui 6.4.3-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 | ##########################################################################
#
# gmlib.tcl
#
# Procedures library for GIS Manager: GUI for GRASS 6
# Author: Michael Barton (Arizona State University)
# with contributions by Glynn Clements, Markus Neteler, Lorenzo Moretti,
# Florian Goessmann, and others
#
# January 2008
#
# COPYRIGHT: (C) 1999 - 2008 by the GRASS Development Team
#
# This program is free software under the GNU General Public
# License (>=v2). Read the file COPYING that comes with GRASS
# for details.
#
##########################################################################
namespace eval GmLib {
global array filename ;# mon
}
###############################################################################
#read_moncap
proc GmLib::color { color } {
if {$color == "white"} {
set r 255
set g 255
set b 255
} else {
regexp -- {#(..)(..)(..)} $color x r g b
set r [expr 0x$r ]
set g [expr 0x$g ]
set b [expr 0x$b ]
}
return "$r:$g:$b"
}
###############################################################################
# Deprecated
# Use guarantee_xmon and any run command instead.
proc GmLib::xmon { type cmd } {
guarantee_xmon
if { $type == "term" } {
term_panel $cmd
} else {
run_panel $cmd
}
return
}
###############################################################################
# Determine if an element already exists
proc GmLib::element_exists {elem name} {
global devnull
set exists 1
set failure [catch {exec g.findfile element=$elem file=$name >& $devnull}]
return [expr {! $failure}]
}
###############################################################################
#open dialog box
proc GmLib::OpenFileBox { } {
global filename
global mon
# thanks for brace tip to suchenwi from #tcl@freenode
set types [list \
[list [G_msg "Map Resource File"] [list ".dm" ".dmrc" ".grc"]] \
[list [G_msg "All Files"] "*"] \
]
set filename_new [tk_getOpenFile -initialdir $Gm::last_directory -parent $Gm::mainwindow -filetypes $types \
-title [G_msg "Open File"] ]
if { $filename_new == "" } { return}
set filename($mon) $filename_new
GmTree::load $filename($mon)
};
###############################################################################
#save dialog box
proc GmLib::SaveFileBox { } {
global filename
global mon
catch {
if {[ regexp -- {^Untitled_} $filename($mon) r]} {
set filename($mon) ""
}
}
if { $filename($mon) != "" } {
GmTree::save $filename($mon)
} else {
set types [list \
[list [G_msg "Map Resource File"] {.grc}] \
[list [G_msg "DM Resource File"] [list {.dm} {.dmrc}]] \
[list [G_msg "All Files"] "*"] \
]
set filename($mon) [tk_getSaveFile -initialdir $Gm::last_directory -parent $Gm::mainwindow -filetypes $types \
-title [G_msg "Save File"] -defaultextension .grc]
if { $filename($mon) == "" } { return}
GmTree::save $filename($mon)
}
};
###############################################################################
proc GmLib::errmsg { error args } {
# send error report and optional message (args) to tk_messageBox
set message ""
if { [winfo exists .intro]} {
destroy .intro
}
if { $args != ""} {
set message [join $args]
append message ": "
}
tk_messageBox -type ok -icon error -title [G_msg "Error"] \
-message "$message[G_msg $error]"
uplevel 1 return
};
|