[GRASS-SVN] r35195 - grass/trunk/lib/init
svn_grass at osgeo.org
svn_grass at osgeo.org
Sun Jan 4 09:41:17 EST 2009
Author: martinl
Date: 2009-01-04 09:41:16 -0500 (Sun, 04 Jan 2009)
New Revision: 35195
Removed:
grass/trunk/lib/init/epsg_option.tcl
grass/trunk/lib/init/file_option.tcl
grass/trunk/lib/init/gis_set.tcl
Modified:
grass/trunk/lib/init/Makefile
Log:
lib/init: tcl files removed
Modified: grass/trunk/lib/init/Makefile
===================================================================
--- grass/trunk/lib/init/Makefile 2009-01-04 14:40:12 UTC (rev 35194)
+++ grass/trunk/lib/init/Makefile 2009-01-04 14:41:16 UTC (rev 35195)
@@ -42,9 +42,6 @@
$(ETC)/license \
$(ETC)/welcome \
$(ETC)/VERSIONNUMBER \
- $(ETC)/gis_set.tcl \
- $(ETC)/epsg_option.tcl \
- $(ETC)/file_option.tcl \
$(HTMLDIR)/variables.html \
$(HTMLDIR)/grass7.html \
$(HTMLDIR)/helptext.html \
Deleted: grass/trunk/lib/init/epsg_option.tcl
===================================================================
--- grass/trunk/lib/init/epsg_option.tcl 2009-01-04 14:40:12 UTC (rev 35194)
+++ grass/trunk/lib/init/epsg_option.tcl 2009-01-04 14:41:16 UTC (rev 35195)
@@ -1,515 +0,0 @@
-#=====================================================================================
-#
-# FILE: epsg_option.tcl
-#
-# DESCRIPTION: adds the utility to execute Netelers script to create a location
-# using the epsg codes
-#
-# NOTES: ---
-# AUTHOR: Antonello Andrea
-# EMAIL: antonell ing.unitn.it
-# COMPANY: Engineering, University of Trento / CUDAM
-# COPYRIGHT: Copyright (C) 2004 University of Trento / CUDAM, ITALY, GPL
-# VERSION: 1.2
-# CREATED: 04/01/2004
-# REVISION: 22/04/2006 (Michael Barton, Arizona State University)
-# CHANGELOG: 20/12/2006 - EPSG code search and epsgOpt::create_loc. Michael Barton.
-# 08/12/2006 - Fixed directory choosing dialogs. Maris Nartiss.
-#
-#=====================================================================================
-#
-#
-#
-# This library is free software; you can redistribute it and/or
-# modify it under the terms of the GNU Library General Public
-# License as published by the Free Software Foundation; either
-# version 2 of the License, or (at your option) any later version.
-#
-# This library 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
-# Library General Public License for more details.
-#
-# You should have received a copy of the GNU Library General Public
-# License along with this library; if not, write to the Free
-# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-# USA
-#
-#1. Redistributions of source code must retain the above copyright
-# notice, this list of conditions and the following disclaimer.
-#2. Redistributions in binary form must reproduce the above copyright
-# notice, this list of conditions and the following disclaimer in the
-# documentation and/or other materials provided with the distribution.
-#
-#############################################################################
-#
-# part regarding to the creation of a new location using proj and
-# the EPSG codes (routines epsgLocCom and infoEpsg)
-#
-#############################################################################
-
-namespace eval epsgOpt {
- variable browsedepsg ;#path to EPSG code file
- variable epsgLocation ;#name of new location to be created
- variable epsg_code ;#EPSG code number
- variable searchterm ;#text string searched in EPSG file
- variable dir
- variable start ;#starting index for searching EPSG text widget
- variable epsgtxt ;#text widget with EPSG definitions and codes
- variable dtnum ;#datum transformation number
- global env
- global database
- global refresh
- global mingw ;#test to see if we are running a windows version in mingw
-
-
-}
-# G_msg.tcl should be sourced first for internationalized strings.
-
-# the frame used to set EPSG parameters
-proc epsgOpt::epsgLocCom args {
- #Create main panel for setting location with EPSG code
- variable epsgLocation
- variable epsg_code
- variable browsedepsg
- variable searchterm
- variable dir
- variable start
- variable searchterm
- global database
- global env
- global mingw
-
- #initialize some variables
- set searchterm ""
- set dir "f"
- set start 1.0
- #Mac framework location for EPSG file
- #set env(/Library/Frameworks/PROJ.framework/Resources/proj) "/Library/Frameworks/PROJ.framework/Resources/proj"
-
- # NOTE: the epsg file is generated in GDAL for PROJ4
- # with gdal/pymod/epsg_tr.py
- if { [ catch { set epsgOpt::browsedepsg "$env(GRASS_PROJSHARE)/epsg" } ] } {
- DialogGen .wrnDlg [G_msg "WARNING: cant get enviromental variable"] warning \
- [format [G_msg "Warning: Unable to get enviromental variable GRASS_PROJSHARE. \nThis is a GRASS installation error. \nSet enviromental variable GRASS_PROJSHARE to point to directory with Proj4 EPSG file. "]] \
- 0 OK;
- return 0
- }
- set epsgOpt::epsgLocation "newLocation"
- set epsgOpt::epsg_code ""
-
- # creation of the parameter window
- set epsg_win [toplevel .optPopup]
- wm title $epsg_win [ G_msg "Define location using EPSG projection codes" ]
- # put it in the middle of the screen
- update idletasks
- set winWidth [winfo reqwidth $epsg_win]
- set winHeight [winfo reqheight $epsg_win]
- set scrnWidth [winfo screenwidth $epsg_win]
- set scrnHeight [winfo screenheight $epsg_win]
- set x [expr ($scrnWidth - $winWidth) / 2-250]
- set y [expr ($scrnHeight - $winHeight) / 2]
- wm geometry $epsg_win +$x+$y
- wm deiconify $epsg_win
-
- #create the form and buttons
-
- set row1 [frame $epsg_win.row1]
- set row2 [frame $epsg_win.row2]
- set row3 [frame $epsg_win.row3]
- set row4 [frame $epsg_win.row4]
-
- LabelEntry $row1.newloc -label [G_msg "Name of new location"] \
- -labeljustify right -labelanchor e -labelwidth 30 -wraplength 200 \
- -textvariable epsgOpt::epsgLocation -width 35 \
- -helptext [G_msg "Enter name for location to be created"]
-
- pack $row1.newloc -side left -expand 0 -fill x -padx 2
-
- LabelEntry $row2.epsgpath -label [G_msg "Path to the EPSG-codes file"] \
- -labeljustify right -labelanchor e -labelwidth 30 -wraplength 200 \
- -textvariable epsgOpt::browsedepsg -width 35 \
- -helptext [G_msg "Path to the EPSG-codes file"]
-
- #browse for epsg file
- Button $row2.browseepsgfile -justify center -padx 10 -bd 1 -text [G_msg "Browse..."] \
- -helptext [G_msg "Browse to locate EPSG file"] \
- -command "set epsgOpt::browsedepsg \[tk_getOpenFile -initialdir epsgOpt::browsedepsg -initialfile epsg \
- -parent .optPopup -title \[ G_msg \"Choose EPSG file\" \] -multiple false\]"
-
- pack $row2.epsgpath $row2.browseepsgfile -side left -expand 0 -fill x -padx 2
-
- #browse epsg codes in file
- LabelEntry $row3.code_entry -label [G_msg "EPSG code number of projection"] \
- -labeljustify right -labelanchor e -labelwidth 30 -wraplength 200 \
- -textvariable epsgOpt::epsg_code -width 35 \
- -helptext [G_msg "Enter EPSG code for selected projection"]
-
- Button $row3.codebutton -justify center -padx 10 -bd 1 -text [G_msg "Browse..."] \
- -helptext [G_msg "View EPSG codes and projection information."] \
- -command {
- if {[file exists $epsgOpt::browsedepsg]} {
- set epsgOpt::epsg_code ""
- epsgOpt::codesEpsg
- } else {
- DialogGen .wrnDlg [G_msg "WARNING: epsg-codes file not found"] warning \
- [G_msg "WARNING: The epsg-codes file was not found!"] \
- 0 OK
- return 0
- }
- }
-
- pack $row3.code_entry $row3.codebutton -side left -fill x -expand 0 -padx 2
-
- Button $row4.submit -padx 10 -text [G_msg "Define location"] \
- -command "epsgOpt::def_loc" -bd 1
-
- Button $row4.cancel -padx 10 -text [G_msg "Cancel"] \
- -command {destroy .optPopup} -bd 1
-
- pack $row4.submit -side left -fill x -expand 0
- pack $row4.cancel -side right -fill x -expand 0
-
- pack $row1 $row2 $row3 $row4 -side top -fill both -expand 1 -padx 3 -pady 3
- return 1
-}
-
-proc epsgOpt::def_loc { } {
-# define new location using EPSG code
- global refresh
- global database
- variable epsg_code
- variable epsgLocation
-
- if {$epsg_code==""} {return}
-
- if {![string is integer $epsg_code]} {
- DialogGen .wrnDlg [G_msg "Invalid EPSG Code!"] error \
- [format [G_msg "ERROR: Invalid EPSG code %s: should be an integer."] \
- $epsg_code] \
- 0 OK
- set epsg_code ""
- return
- }
-
- set epsgLocation [ string trim $epsgLocation ]
-
- if {[file exists ${database}/$epsgLocation]} {
- DialogGen .wrnDlg [G_msg "Location Exists!"] warning \
- [format [G_msg "WARNING: Location '%s' already exists: please try another name."] \
- $epsgLocation] 0 OK
- set epsgLocation ""
- return
- }
-
- if {[file exists $epsgLocation ]==0} {
- destroy .optPopup
- epsgOpt::create_loc
- set refresh 1
- return 1
- }
-}
-
-proc epsgOpt::create_loc { } {
-# Create a new location using g.proj
-# original bash code by M. Neteler
-
- # create new location from EPSG code
- epsgOpt::runproj
-
- return
-
-}
-
-proc epsgOpt::runproj {} {
- # first run g.proj to see if there are more than the default
- # parameters to choose from
- global location
- global mapset
- variable epsgLocation
- variable epsg_code
-
- set dtrans ""
- catch {set dtrans [exec g.proj --q -c location=$epsgLocation epsg=$epsg_code datumtrans=-1]} errMsg
-
- if {[lindex $::errorCode 0] eq "CHILDSTATUS"} {
- DialogGen .wrnDlg [G_msg "Error creating location!"] error \
- [format [G_msg "g.proj returned the following message:\n%s"] $errMsg] \
- 0 OK
- } elseif {$dtrans eq ""} {
- # if nothing written to stdout, there was no choice of
- # datum parameters and we need not do anything more
-
- if {$errMsg ne ""} {
- DialogGen .wrnDlg [G_msg "Informational output from g.proj"] info \
- [format [G_msg "g.proj returned the following informational message:\n%s"] $errMsg] \
- 0 OK
- }
- set location $epsgLocation
- set mapset "PERMANENT"
- } else {
- # user selects datum transform
- #create dialog that lists datum transforms, asks user to enter a number and press OK
- set paramset [epsgOpt::sel_dtrans $dtrans]
-
- # operation canceled
- if {$paramset == -9} {return}
-
- # create new location from epsg code
- catch {exec g.proj --q -c epsg=$epsg_code location=$epsgLocation datumtrans=$paramset} errMsg
-
- #catch any other errors
- if {[lindex $::errorCode 0] eq "CHILDSTATUS"} {
- DialogGen .wrnDlg [G_msg "Error creating location!"] warning \
- [format [G_msg "g.proj returned the following message:\n%s"] $errMsg] \
- 0 OK
- } else {
- if {$errMsg ne ""} {
- DialogGen .wrnDlg [G_msg "Informational output from g.proj"] info \
- [format [G_msg "g.proj returned the following informational message:\n%s"] $errMsg] \
- 0 OK
- }
- set location $epsgLocation
- set mapset "PERMANENT"
- }
- }
-}
-
-proc epsgOpt::sel_dtrans {dtrans} {
-
-# Dialog for selecting optional datum transform parameters
-# Argument is stdout from g.proj
-
- # default is not to specify datum transformation
- set epsgOpt::dtnum 0
-
- # Create a popup search dialog
- toplevel .dtrans_sel
- wm title .dtrans_sel [G_msg "Select datum transformation parameters:"]
- set row1 [frame .dtrans_sel.frame1]
- set row3 [frame .dtrans_sel.frame3]
-
- radiobutton $row1.0 -value 0 -variable epsgOpt::dtnum -wraplength 640 -justify left -text [G_msg "Continue without specifying parameters - if used when creating a location, other GRASS modules will use the \"default\" (likely non-optimum) parameters for this datum if necessary in the future."]
- pack $row1.0 -anchor w
-
- set dtrans [split $dtrans "\n"]
- for {set i 0} { $i < [llength $dtrans] } {incr i} {
- set thisnum [lindex $dtrans $i]
- if {$thisnum == "---"} {
- continue
- }
- set thisdesc $thisnum.
- while { [incr i] < [llength $dtrans] && [lindex $dtrans $i] != "---"} {
- set thisdesc ${thisdesc}\n[lindex $dtrans $i]
- }
- radiobutton $row1.$thisnum -variable epsgOpt::dtnum -value $thisnum -wraplength 640 -justify left -text $thisdesc
- pack $row1.$thisnum -anchor w
- }
-
- pack $row1
-
- Button $row3.ok -text [G_msg "OK"] -padx 10 -bd 1 \
- -command "destroy .dtrans_sel"
- pack $row3.ok -side left -padx 3
- button $row3.cancel -text [G_msg "Cancel"] -padx 10 -bd 1 \
- -command "set epsgOpt::dtnum -9; destroy .dtrans_sel"
- pack $row3.cancel -side left -padx 3
- pack $row3 -anchor center -pady 3
-
- tkwait window .dtrans_sel
- return $epsgOpt::dtnum
-
-}
-
-
-proc epsgOpt::codesEpsg args {
-# text widget for listing EPSG codes
-
- variable browsedepsg
- variable epsgtxt
- variable epsg_code
-
- toplevel .infoPopup
- wm title .infoPopup {EPSG-codes}
- update idletasks
- wm geometry .infoPopup +250+10
- wm deiconify .infoPopup
-
- set epsgfr [frame .infoPopup.fr]
-
- set titlefr [frame $epsgfr.top -relief groove -bd 2 -bg white]
- label $titlefr.title1 -text [G_msg "EPSG CODES (from file: $epsgOpt::browsedepsg)"] \
- -fg mediumblue -bg white
- label $titlefr.title2 -bg white \
- -text [G_msg "You can select EPSG code (in <braces>) and copy it for later use." ]
- pack $titlefr.title1 $titlefr.title2 -side top
- pack $titlefr -side top -fill x -expand 0
-
- frame $epsgfr.mid
- set epsgtxt [text $epsgfr.mid.text \
- -wrap word -exportselection 1 \
- -relief flat -selectbackground lightgreen \
- -yscrollcommand "$epsgfr.mid.vscroll set"]
-
- scrollbar $epsgfr.mid.vscroll \
- -relief sunken \
- -command "$epsgtxt yview"
-
- # tag configuration
- $epsgtxt tag configure underline -underline 1
- $epsgtxt tag configure title -relief sunken -borderwidth 2 \
- -background white -foreground "mediumblue" -justify center
- #$epsgtxt tag configure lefttitle -relief flat -background beige
- # Do not set background color for subtitle. It will override selection background color!
- $epsgtxt tag configure subtitle -relief flat
-
- # open the file
- set f [open $epsgOpt::browsedepsg "r"]
- set found ""
- while { [eof $f] == 0 } {
- set line [gets $f]
- set firstdash [string first # $line]
- set firstminor [string first < $line]
- if {$firstdash == "0"} {
- $epsgtxt insert end "\n$line\n" lefttitle
- set found "yes"
- }
- if {$firstminor == "0"} {
- $epsgtxt insert end "\n$line\n\n" subtitle
- }
- if {$firstminor != "0" && $firstdash != "0" && $found != "yes"} {
- $epsgtxt insert end [format "\n\n%s\n\n" [G_msg "GUESS THAT IS NOT THE EPSG FILE"]] title;
- break;
- }
- }
-
- set controls [frame .infoPopup.buttons]
- button $controls.search -text [G_msg "Search"] -padx 10 -bd 1 -command "epsgOpt::search_epsg $epsgtxt"
-
- Button $controls.grab -text [G_msg "Grab code"] -padx 10 -bd 1 \
- -command "epsgOpt::grabcode"
-
- pack $controls.search $controls.grab -side left -fill x -expand 0
-
- button $controls.close -padx 10 -text [G_msg "Close"] \
- -command {destroy .infoPopup} -bd 1
- pack $controls.close -side right -fill x -expand 0
-
- pack $controls -side bottom -fill x -expand 0 -padx 5 -pady 4
- pack $epsgtxt -side left -fill both -expand 1
- pack $epsgfr.mid.vscroll -side right -fill both -expand 0
- pack $epsgfr.mid -side top -fill both -expand 1
- pack $epsgfr -fill both -expand 1
-
-}
-
-proc epsgOpt::search_epsg { epsgtxt } {
-# Widget for searching EPSG file. Selects EPSG code associated with found search term.
-# Argument is text widget
-
- variable searchterm
- variable dir
- variable start
-
- # Create a popup search dialog
- toplevel .search_epsg
- wm title .search_epsg [G_msg "Search"]
- set row1 [frame .search_epsg.frame1]
- set row2 [frame .search_epsg.frame2]
- set row3 [frame .search_epsg.frame3]
- set row4 [frame .search_epsg.frame4]
-
- Label $row1.label -text [G_msg "Search text: "] \
- -helptext [G_msg "Search for entered text in EPSG file"]
- set searchentry [entry $row1.enter -relief sunken -textvariable epsgOpt::searchterm]
- pack $row1.label $row1.enter -side left -fill x -expand 0 -anchor w
- pack $row1 -side top -padx 3 -pady 4 -expand 1 -fill both
-
- radiobutton $row2.forward -text [G_msg "forward search"] -variable epsgOpt::dir -value "f"
- radiobutton $row2.backward -text [G_msg "backward search"] -variable epsgOpt::dir -value "b"
- $row2.forward select
- pack $row2.forward $row2.backward -side left \
- -anchor w -fill x -expand 0
- pack $row2 -side top -padx 3 -expand 1 -fill both
-
- Button $row4.search -text [G_msg "Search"] -padx 10 -bd 1 \
- -command "epsgOpt::textsearch"
- pack $row4.search -side left -fill x -expand 0
- button $row4.cancel -text [G_msg "Close"] -padx 10 -bd 1 -command "destroy .search_epsg"
- pack $row4.cancel -side right -fill x -expand 0
- pack $row4 -side top -pady 3 -expand 1 -fill both
-
-}
-
-proc epsgOpt::textsearch { } {
-# Search for text in EPSG text widget and return the EPSG code
- variable epsgtxt
- variable searchterm
- variable dir
- variable start
- variable epsg_code
- set strlength 0
-
- catch {$epsgtxt tag remove sel [lindex [$epsgtxt tag ranges sel] 0] [lindex [$epsgtxt tag ranges sel] 1]}
-
- if {$dir == "f"} {
- catch {set start [$epsgtxt search -forwards -nocase -count strlength -- $epsgOpt::searchterm $start]}
- catch {set newstart [$epsgtxt index "$start +[expr 1+$strlength] c"]}
- } else {
- catch {set start [$epsgtxt search -backwards -nocase -count strlength -- $epsgOpt::searchterm $start]}
- catch {set newstart [$epsgtxt index "$start -1 c"]}
- }
-
- update idletasks
-
- if {$start != 0 && $strlength !=0} {
- $epsgtxt tag add sel "$start"
- $epsgtxt see $start
- catch {set start $newstart}
- set currpos [$epsgtxt index sel.first]
- if { [$epsgtxt get "$currpos linestart"] == "<" } {
- set codestart [$epsgtxt index "$currpos linestart +1c"]
- set codeend [$epsgtxt index [$epsgtxt search -forwards -- {>} $codestart]]
- } else {
- set codestart [$epsgtxt index "[$epsgtxt search -forwards -- {<} $currpos] +1c"]
- set codeend [$epsgtxt index [$epsgtxt search -forwards -- {>} $codestart]]
- }
-
- $epsgtxt tag remove sel [$epsgtxt index sel.first]
- $epsgtxt tag add sel "$codestart" "$codeend"
- set epsg_code [$epsgtxt get $codestart $codeend]
- } else {
- set start 1.0
- return
- }
-
-}
-
-proc epsgOpt::grabcode { } {
-# put the code in the EPSG code entry and activate the define location button
-# Will grab the code of the entry where the insertion cursor is located if nothing found search
-
- variable epsgtxt
- variable searchterm
- variable dir
- variable start
- variable epsg_code
-
- if { $epsg_code == "" } {
- set currpos [$epsgtxt index insert]
- if { [$epsgtxt get "$currpos linestart"] == "<" } {
- set codestart [$epsgtxt index "$currpos linestart +1c"]
- set codeend [$epsgtxt index [$epsgtxt search -forwards -- {>} $codestart]]
- } else {
- set codestart [$epsgtxt index "[$epsgtxt search -forwards -- {<} $currpos] +1c"]
- set codeend [$epsgtxt index [$epsgtxt search -forwards -- {>} $codestart]]
- }
-
- $epsgtxt tag remove sel [$epsgtxt index insert]
- $epsgtxt tag add sel "$codestart" "$codeend"
- set epsg_code [$epsgtxt get $codestart $codeend]
- }
-
- destroy .infoPopup
-}
-
Deleted: grass/trunk/lib/init/file_option.tcl
===================================================================
--- grass/trunk/lib/init/file_option.tcl 2009-01-04 14:40:12 UTC (rev 35194)
+++ grass/trunk/lib/init/file_option.tcl 2009-01-04 14:41:16 UTC (rev 35195)
@@ -1,274 +0,0 @@
-#=====================================================================================
-#
-# FILE: file_option.tcl
-#
-# DESCRIPTION: creates location from georeferenced file
-#
-# NOTES: ---
-# AUTHOR: Michael Barton
-# COMPANY: Arizona State University
-# COPYRIGHT: Copyright (C) 2007 Michael Barton and GRASS Development Team
-# VERSION: 1.2
-# CREATED: 23/04/2006
-# REVISION: ---
-# CHANGELOG: 1.0.1 08/12/2006 - Fixed directory choosing dialogs. Maris Nartiss.
-# : 1.2 - 6 Jan 2007 - Fixed file creation for windows and reformatted
-# dialog widgets (Michael Barton).
-# Added check for return status of g.proj to catch failed location
-# creation (by Maris Nartiss).
-#=====================================================================================
-#
-#
-#
-# This library is free software; you can redistribute it and/or
-# modify it under the terms of the GNU Library General Public
-# License as published by the Free Software Foundation; either
-# version 2 of the License, or (at your option) any later version.
-#
-# This library 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
-# Library General Public License for more details.
-#
-# You should have received a copy of the GNU Library General Public
-# License along with this library; if not, write to the Free
-# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-# USA
-#
-#1. Redistributions of source code must retain the above copyright
-# notice, this list of conditions and the following disclaimer.
-#2. Redistributions in binary form must reproduce the above copyright
-# notice, this list of conditions and the following disclaimer in the
-# documentation and/or other materials provided with the distribution.
-#
-#############################################################################
-namespace eval fileOpt {
- variable fileLocation ;#name of new location to be created
- variable filepath ;#path to georeferenced file
- global env
- global database
- global mingw ;#test to see if we are running a windows version in mingw
- global refresh
-}
-
-
-# G_msg.tcl should be sourced first for internationalized strings.
-
-# the frame used to set parameters
-proc fileOpt::fileLocCom args {
- #vars declaration
- variable filepath
- variable fileLocation
- global database
- global env
-
- set fileLocation "newLocation"
- set filepath ""
- set locpath $database
- set buttonstate "disabled"
-
- # creation of the parameter window
- set file_win [toplevel .fileloc]
- wm title $file_win [ G_msg "Define location using projection information in georeferenced file" ]
-
- # put it in the middle of the screen
- update idletasks
- set winWidth [winfo reqwidth $file_win]
- set winHeight [winfo reqheight $file_win]
- set scrnWidth [winfo screenwidth $file_win]
- set scrnHeight [winfo screenheight $file_win]
- set x [expr ($scrnWidth - $winWidth) / 2-250]
- set y [expr ($scrnHeight - $winHeight) / 2]
- wm geometry $file_win +$x+$y
- wm deiconify $file_win
-
- set row1 [frame $file_win.row1]
- set row2 [frame $file_win.row2]
- set row3 [frame $file_win.row3]
- set row4 [frame $file_win.row4]
-
-
- #create the form and buttons
- LabelEntry $row1.newloc -label [G_msg "Name of new location"] \
- -labeljustify right -labelanchor e -labelwidth 30 -wraplength 200 \
- -textvariable fileOpt::fileLocation -width 35 \
- -helptext [G_msg "Enter name of location to be created"]
-
- pack $row1.newloc -side left -expand 0 -fill x -padx 2
-
- LabelEntry $row2.filepath -label [G_msg "Path to georeferenced file"] \
- -labeljustify right -labelanchor e -labelwidth 30 -wraplength 200 \
- -textvariable fileOpt::filepath -width 35 \
- -helptext [G_msg "Path to georeferenced file (format must be readable by GDAL/OGR)"]
-
- #browse for georeferenced file
- Button $row2.browsefile -justify center -padx 10 -bd 1 -text [G_msg "Browse..."] \
- -helptext [G_msg "Browse to locate georeferenced file"] \
- -command "fileOpt::browse_file"
-
- pack $row2.filepath $row2.browsefile -side left -expand 0 -fill x -padx 2
-
- Button $row3.submit -justify center -padx 10 -text [G_msg "Define location"] \
- -command "fileOpt::def_loc" -bd 1
-
- Button $row3.cancel -justify center -padx 10 -text [G_msg "Cancel"] \
- -command {destroy .fileloc} -bd 1
-
- pack $row3.submit -side left -fill x -expand 0
- pack $row3.cancel -side right -fill x -expand 0
-
- pack $row1 $row2 $row3 -side top -fill both -expand 1 -padx 3 -pady 3
-
-}
-
-proc fileOpt::browse_file {} {
- global env
- variable filepath
-
- if { [info exists env(HOME)] } {
- set dir $env(HOME)
- set fileOpt::filepath [tk_getOpenFile -parent .fileloc -initialdir $dir \
- -title [ G_msg "Choose georeferenced file" ] -multiple false]
- } else {
- set fileOpt::filepath [tk_getOpenFile -parent .fileloc \
- -title [ G_msg "Choose georeferenced file" ] -multiple false]
- }
-
-}
-
-
-proc fileOpt::def_loc { } {
-# define new location using georeferenced file readable by GDAL/OGR
- #vars declaration
- variable filepath
- variable fileLocation
- global database
- global env
-
- if {$filepath==""} {return}
-
- if {$filepath==""} {
- tk_messageBox -type ok -icon error \
- -message [G_msg "WARNING: Please supply a\nvalid georeferenced file"]
- return
- }
-
- set fileLocation [ string trim $fileLocation ]
-
- if {[file exists $fileLocation ]== 1} {
- tk_messageBox -type ok -icon error \
- -message [G_msg "WARNING: The location '$fileLocation'\nalready exists, please try another name"]
- set fileLocation ""
- return
- }
-
- if {[file exists $fileLocation ]==0} {
- destroy .fileloc
- fileOpt::create_loc
- set refresh 1
- return
- }
-}
-
-proc fileOpt::create_loc { } {
-# Create a new location using g.proj
-# original bash code by M. Neteler
- variable filepath
- variable fileLocation
- global location
- global mapset
-
- set dtrans ""
- catch {set dtrans [exec g.proj --q -c location=$fileLocation georef=$filepath datumtrans=-1]} errMsg
-
- if {[lindex $::errorCode 0] eq "CHILDSTATUS"} {
- DialogGen .wrnDlg [G_msg "Error creating location!"] error \
- [format [G_msg "g.proj returned the following message:\n%s"] $errMsg] \
- 0 OK
- } elseif {$dtrans eq ""} {
- # if nothing written to stdout, there was no choice of
- # datum parameters and we need not do anything more
-
- if {$errMsg ne ""} {
- DialogGen .wrnDlg [G_msg "Informational output from g.proj"] info \
- [format [G_msg "g.proj returned the following informational message:\n%s"] $errMsg] \
- 0 OK
- }
- set location $fileLocation
- set mapset "PERMANENT"
- } else {
- # user selects datum transform
- #create dialog that lists datum transforms, asks user to enter a number and press OK
- set paramset [fileOpt::sel_dtrans $dtrans]
-
- # operation canceled
- if {$paramset == -9} {return}
-
- # create new location from georeferenced file
- catch {exec g.proj --q -c georef=$filepath location=$fileLocation datumtrans=$paramset} errMsg
-
- #catch any other errors
- if {[lindex $::errorCode 0] eq "CHILDSTATUS"} {
- DialogGen .wrnDlg [G_msg "Error creating location!"] warning \
- [format [G_msg "g.proj returned the following message:\n%s"] $errMsg] \
- 0 OK
- } else {
- if {$errMsg ne ""} {
- DialogGen .wrnDlg [G_msg "Informational output from g.proj"] info \
- [format [G_msg "g.proj returned the following informational message:\n%s"] $errMsg] \
- 0 OK
- }
- set location $fileLocation
- set mapset "PERMANENT"
- }
- }
-
- return
-
-}
-
-proc fileOpt::sel_dtrans {dtrans} {
-
-# Dialog for selecting optional datum transform parameters
-# Argument is stdout from g.proj
-
- # default is not to specify datum transformation
- set fileOpt::dtnum 0
-
- # Create a popup search dialog
- toplevel .dtrans_sel
- wm title .dtrans_sel [G_msg "Select datum transformation parameters:"]
- set row1 [frame .dtrans_sel.frame1]
- set row3 [frame .dtrans_sel.frame3]
-
- radiobutton $row1.0 -value 0 -variable fileOpt::dtnum -wraplength 640 -justify left -text [G_msg "Continue without specifying parameters - if used when creating a location, other GRASS modules will use the \"default\" (likely non-optimum) parameters for this datum if necessary in the future."]
- pack $row1.0 -anchor w
-
- set dtrans [split $dtrans "\n"]
- for {set i 0} { $i < [llength $dtrans] } {incr i} {
- set thisnum [lindex $dtrans $i]
- if {$thisnum == "---"} {
- continue
- }
- set thisdesc $thisnum.
- while { [incr i] < [llength $dtrans] && [lindex $dtrans $i] != "---"} {
- set thisdesc ${thisdesc}\n[lindex $dtrans $i]
- }
- radiobutton $row1.$thisnum -variable fileOpt::dtnum -value $thisnum -wraplength 640 -justify left -text $thisdesc
- pack $row1.$thisnum -anchor w
- }
-
- pack $row1
-
- Button $row3.ok -text [G_msg "OK"] -padx 10 -bd 1 \
- -command "destroy .dtrans_sel"
- pack $row3.ok -side left -padx 3
- button $row3.cancel -text [G_msg "Cancel"] -padx 10 -bd 1 \
- -command "set fileOpt::dtnum -9; destroy .dtrans_sel"
- pack $row3.cancel -side left -padx 3
- pack $row3 -anchor center -pady 3
-
- tkwait window .dtrans_sel
- return $fileOpt::dtnum
-
-}
Deleted: grass/trunk/lib/init/gis_set.tcl
===================================================================
--- grass/trunk/lib/init/gis_set.tcl 2009-01-04 14:40:12 UTC (rev 35194)
+++ grass/trunk/lib/init/gis_set.tcl 2009-01-04 14:41:16 UTC (rev 35195)
@@ -1,895 +0,0 @@
-#############################################################################
-#
-# MODULE: Grass Tcl/Tk Initialization
-# AUTHOR(S): Original author unknown - probably CERL
-# Justin Hickey - Thailand - jhickey hpcc.nectec.or.th
-# Markus Neteler - Germany - neteler geog.uni-hannover.de, itc.it
-# Michael Barton - USA - Arizona State University
-# Maris Nartiss - Latvia - maris.gis gmail.com
-# PURPOSE: The source file for this shell script is in
-# src/tcltkgrass/main/gis_set.tcl. It allows the user to choose
-# the database, location, and mapset to use with grass by
-# presenting a user interface window.
-# COPYRIGHT: (C) 2000,2006 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.
-#
-#############################################################################
-
-if {[info exists env(OS)] && $env(OS) == "Windows_NT"} {
- set mingw "1"
-} else {
- set mingw "0"
-}
-
-source $env(GISBASE)/etc/gtcltk/gmsg.tcl
-source $env(GISBASE)/etc/gtcltk/options.tcl
-source $env(GISBASE)/etc/epsg_option.tcl
-source $env(GISBASE)/etc/file_option.tcl
-
-#fetch GRASS Version number:
-set fp [open $env(GISBASE)/etc/VERSIONNUMBER r]
-set GRASSVERSION [read -nonewline $fp]
-close $fp
-
-#############################################################################
-
-proc searchGISRC { filename } {
-
- global database
- global location
- global mapset
- global oldDb
- global oldLoc
- global oldMap
- global grassrc_list
-
- set grassrc_list ""
-
- set flag 0
- if { [file exists $filename] } {
- set ifp [open $filename "r"]
- set thisline [gets $ifp]
- while { [eof $ifp] == 0 } {
-
- lappend grassrc_list "$thisline"
-
- if { [regexp -- {^GISDBASE: *(.*)$} $thisline dummy env_database] } {
- set database $env_database
- }
- if { [scan $thisline "LOCATION_NAME: %s" env_location] } {
- set location $env_location
- }
- if { [scan $thisline "MAPSET: %s" env_mapset] } {
- set mapset $env_mapset
- }
- set thisline [gets $ifp]
- }
-
- set oldDb $database
- set oldLoc $location
- set oldMap $mapset
-
- close $ifp
- if { $database != "" && $location != "" && $mapset != "" } {
- set flag 1
- }
- }
- return $flag
-}
-
-#############################################################################
-
-proc putGRASSRC { filename } {
- # create grassrc file with new values
- global database
- global location
- global mapset
- global grassrc_list
-
- set ofp [open $filename "w"]
-
- foreach i $grassrc_list {
- if { [regexp {^GISDBASE:} $i] } {
- puts $ofp "GISDBASE: $database"
- } elseif { [regexp {^LOCATION_NAME:} $i] } {
- puts $ofp "LOCATION_NAME: $location"
- } elseif { [regexp {^MAPSET:} $i] } {
- puts $ofp "MAPSET: $mapset"
- } else {
- puts $ofp $i
- }
- }
-
- if { [ catch { close $ofp } error ] } {
- DialogGen .wrnDlg [G_msg "WARNING: can not save"] warning \
- [format [G_msg "Warning: unable to save data to <%s> file.\nError message: %s"] \
- $filename $error] \
- 0 OK;
- }
-}
-
-
-#############################################################################
-
-proc CheckLocation {} {
- # Returns 0, if location is invalid, 1 othervise.
- global database location
-
- set found 0
- set dir $database
- append dir "/$location"
- set currDir [pwd]
-
- # Special case - wrong GISDBASE
- if {[file isdirectory $dir] == 0} {
- DialogGen .wrnDlg [G_msg "WARNING: invalid location"] warning \
- [format [G_msg "Warning: location <%s> at GISDBASE <%s> is not a directory or does not exist."] \
- $location $database] \
- 0 OK;
- .frame0.frameMS.listbox delete 0 end
- .frame0.frameNMS.second.entry configure -state disabled
- .frame0.frameBUTTONS.ok configure -state disabled
- } else {
- cdir $dir
- .frame0.frameNMS.second.entry configure -state disabled
- if {[file isdirectory "PERMANENT"] && [file exists "$dir/PERMANENT/DEFAULT_WIND"]} {
- set found 1
- .frame0.frameNMS.second.entry configure -state normal
- }
- }
-
- cdir $currDir
- return $found
-}
-
-proc CheckMapset {} {
- global database location mapset
-
- if { $mapset == "" } { return 0; }
-
- if { [file exists "$database/$location/$mapset/WIND"] } {
- return 1
- }
- return 0
-}
-
-#############################################################################
-proc gisSetWindow {} {
-# create main GRASS startup panel
- global GRASSVERSION
- global database
- global location
- global mymapset
- global mapset
- global oldDb oldLoc oldMap
- global env
- global grassrc_list
- global gisrc_name
- global refresh
-
- set refresh 0
-
- global mingw
-
- # Window manager configurations
-
- wm title . [format [G_msg "GRASS %s Startup"] $GRASSVERSION]
-
- # ---------------------------
- # build .frame0 with panel title
- # ---------------------------
- set mainfr [frame .frame0 \
- -borderwidth {2} \
- -relief {raised}]
-
- set titlefrm [frame .frame0.intro -borderwidth 2 ]
- set introimg [label $titlefrm.img -image [image create photo -file \
- "$env(GISBASE)/etc/gui/images/gintro.gif"]]
- set introtitle [text $titlefrm.msg -height 5 \
- -relief flat -fg darkgreen \
- -bg #dddddd \
- -font introfont \
- -width 50 ]
-
- pack $titlefrm -side top
- pack $introimg -side top
- pack $introtitle -side top
-
- .frame0.intro.msg tag configure all -justify center
- .frame0.intro.msg insert end [G_msg "Welcome to GRASS GIS Version"]
- .frame0.intro.msg insert end [G_msg " $GRASSVERSION\n"]
- .frame0.intro.msg insert end [G_msg "The world's leading open source GIS\n\n"]
- .frame0.intro.msg insert end [G_msg "Select an existing project location and mapset\n"]
- .frame0.intro.msg insert end [G_msg "or define a new location\n"]
- .frame0.intro.msg tag add all 1.0 end
- .frame0.intro.msg configure -state disabled
-
- # -----------------------------------
- # build .frame0.frameDB - panel top section for database selection
- # -----------------------------------
-
- frame .frame0.frameDB \
- -borderwidth {2}
-
- frame .frame0.frameDB.left \
- -borderwidth {2}
-
- frame .frame0.frameDB.mid \
- -borderwidth {2}
-
- frame .frame0.frameDB.right \
- -borderwidth {2}
-
- label .frame0.frameDB.left.label \
- -justify right \
- -wraplength 200 \
- -text [G_msg "GIS Data Directory: "]
-
- entry .frame0.frameDB.mid.entry \
- -relief {sunken} \
- -textvariable database \
- -width 40 \
- -xscrollcommand { .frame0.frameDB.mid.hscrollbar set}
-
- scrollbar .frame0.frameDB.mid.hscrollbar \
- -command { .frame0.frameDB.mid.entry xview} \
- -relief {sunken} \
- -orient {horizontal}
-
- button .frame0.frameDB.right.button \
- -text [G_msg "Browse..."] -padx 10 -bd 1 \
- -command { set tmp [tk_chooseDirectory -initialdir $database \
- -parent .frame0 -title [G_msg "New GIS data directory"] -mustexist true]
- if {$tmp != ""} {
- set database $tmp
- refresh_loc
- .frame0.frameBUTTONS.ok configure -state disabled }
- }
-
- pack .frame0.frameDB.left.label -side top
- pack .frame0.frameDB.mid.entry -side top
- pack .frame0.frameDB.mid.hscrollbar -side bottom -fill x
- pack .frame0.frameDB.right.button -side left
- pack .frame0.frameDB.left -side left -anchor n
- pack .frame0.frameDB.mid -side left -anchor n
- pack .frame0.frameDB.right -side left -anchor n -padx 10
-
- # -----------------------------------
- # build .frame0.frameLOC - middle, left section for location selection listbox
- # -----------------------------------
- frame .frame0.frameLOC \
- -borderwidth {2}
-
- label .frame0.frameLOC.label \
- -wraplength 170 \
- -text [G_msg "Project Location (projection/coordinate system)"]
-
- listbox .frame0.frameLOC.listbox \
- -relief {sunken} \
- -exportselection false \
- -yscrollcommand {.frame0.frameLOC.vscrollbar set} \
- -xscrollcommand {.frame0.frameLOC.hscrollbar set} \
- -selectmode single
-
- scrollbar .frame0.frameLOC.vscrollbar \
- -command {.frame0.frameLOC.listbox yview} \
- -relief {sunken}
-
- scrollbar .frame0.frameLOC.hscrollbar \
- -command {.frame0.frameLOC.listbox xview} \
- -orient {horizontal} \
- -relief {sunken}
-
- pack append .frame0.frameLOC \
- .frame0.frameLOC.label { top fill } \
- .frame0.frameLOC.vscrollbar { right filly } \
- .frame0.frameLOC.hscrollbar { bottom fillx } \
- .frame0.frameLOC.listbox { left expand fill }
-
-
- # -----------------------------------
- # build .frame0.frameMS - middle, right section for mapset selection listbox
- # -----------------------------------
- frame .frame0.frameMS \
- -borderwidth {2}
-
- label .frame0.frameMS.label \
- -wraplength 170 \
- -text [G_msg "Accessible Mapsets (directories of GIS files)"]
-
- listbox .frame0.frameMS.listbox \
- -relief {sunken} \
- -exportselection false \
- -yscrollcommand {.frame0.frameMS.vscrollbar set} \
- -xscrollcommand {.frame0.frameMS.hscrollbar set} \
- -selectmode single
-
- scrollbar .frame0.frameMS.vscrollbar \
- -command {.frame0.frameMS.listbox yview} \
- -relief {sunken}
-
- scrollbar .frame0.frameMS.hscrollbar \
- -command {.frame0.frameMS.listbox xview} \
- -orient {horizontal} \
- -relief {sunken}
-
- pack append .frame0.frameMS \
- .frame0.frameMS.label { top fill } \
- .frame0.frameMS.vscrollbar { right filly } \
- .frame0.frameMS.hscrollbar { bottom fillx } \
- .frame0.frameMS.listbox { left expand fill }
-
- # -----------------------------------
- # build .frame0.frameNMS - middle far right section with buttons for
- # creating new mapset and location
- # -----------------------------------
- frame .frame0.frameNMS \
- -borderwidth {2}
-
- frame .frame0.frameNMS.first \
- -borderwidth {2}
-
- frame .frame0.frameNMS.second \
- -borderwidth {2}
-
- frame .frame0.frameNMS.third \
- -borderwidth {2}
-
- frame .frame0.frameNMS.spacer \
- -borderwidth {2} -height {10}
-
- frame .frame0.frameNMS.fourth \
- -borderwidth {2}
-
- frame .frame0.frameNMS.fifth \
- -borderwidth {2}
-
- frame .frame0.frameNMS.sixth \
- -borderwidth {2}
-
- frame .frame0.frameNMS.seventh \
- -borderwidth {2}
-
- label .frame0.frameNMS.first.label \
- -wraplength 200 \
- -text [G_msg "Create new mapset in selected location"]
-
- entry .frame0.frameNMS.second.entry \
- -relief {sunken} \
- -textvariable mymapset \
- -width 22
-
- button .frame0.frameNMS.third.button \
- -text [G_msg "Create new mapset"] \
- -padx 10 -bd 1 -wraplength 150 \
- -command {
- set mymapset [ string trim $mymapset ]
- if { [file exists $mymapset] } {
- DialogGen .wrnDlg [G_msg "WARNING: invalid mapset name"] warning \
- [format [G_msg "Warning: Mapset with name <%s> already exists. \nNew mapset is NOT created. \nChoose different mapset name and try again."] $mymapset] \
- 0 OK;
- return
- }
- .frame0.frameNMS.third.button configure -state disabled
- if { $mymapset != "" } {
- if {[CheckLocation] == 0} {
- DialogGen .wrnDlg [G_msg "WARNING: invalid location"] warning \
- [format [G_msg "Warning: selected location <%s> is not valid. \n New mapset is NOT created. \n Select valid location and try again."] $location] \
- 0 OK;
- set mapset ""
- } else {
- cdir $database
- cdir $location
- if { [ catch { file mkdir $mymapset } error ] } {
- DialogGen .wrnDlg [G_msg "WARNING: unable to mkdir"] warning \
- [format [G_msg "Warning: Unable to create directory for new mapset. \nError message: %s"] $error] \
- 0 OK;
- } else {
- #generate default DB definition, create dbf subdirectory:
- set varfp [open $mymapset/VAR "w"]
- puts $varfp "DB_DRIVER: sqlite"
- puts $varfp "DB_DATABASE: \$GISDBASE/\$LOCATION_NAME/\$MAPSET/sqlite.db"
- close $varfp
- catch {file attributes $mymapset/VAR -permissions u+rw,go+r}
-# file mkdir $mymapset/dbf
- #copy over the WIND definition:
- catch {file copy $mymapset/../PERMANENT/DEFAULT_WIND $mymapset/WIND}
- catch {file attributes $mymapset/WIND -permissions u+rw,go+r}
- .frame0.frameMS.listbox insert end $mymapset
- selFromList .frame0.frameMS.listbox $mymapset
- set mapset $mymapset
- .frame0.frameNMS.second.entry delete 0 end
- .frame0.frameBUTTONS.ok configure -state normal
- }
- }
- }
- }
-
- label .frame0.frameNMS.fourth.label \
- -wraplength 200 \
- -text [G_msg "Define new location with..."]
-
-
- button .frame0.frameNMS.fifth.button \
- -text [G_msg "Georeferenced file"] \
- -width 22 -bd 1 -wraplength 150\
- -relief raised \
- -command {putGRASSRC $gisrc_name
- fileOpt::fileLocCom
- tkwait window .fileloc
- refresh_loc
- refresh_ms
- selFromList .frame0.frameLOC.listbox $location
- selFromList .frame0.frameMS.listbox $mapset
- .frame0.frameBUTTONS.ok configure -state normal}
-
- button .frame0.frameNMS.sixth.button \
- -text [G_msg "EPSG codes"] \
- -width 22 -bd 1 -wraplength 150\
- -relief raised \
- -command { putGRASSRC $gisrc_name
- if { [epsgOpt::epsgLocCom] } {
- tkwait window .optPopup
- refresh_loc
- refresh_ms
- selFromList .frame0.frameLOC.listbox $location
- selFromList .frame0.frameMS.listbox $mapset
- .frame0.frameBUTTONS.ok configure -state normal} }
-
- button .frame0.frameNMS.seventh.button \
- -text [G_msg "Projection values"] \
- -width 22 -bd 1 -wraplength 150\
- -relief raised \
- -command {
- if { $mingw == "1" } {
- exec -- cmd.exe /c start $env(GISBASE)/etc/set_data
- } else {
- exec -- $env(GISBASE)/etc/grass-xterm-wrapper -name xterm-grass -e $env(GISBASE)/etc/grass-run.sh $env(GISBASE)/etc/set_data
- }
- # Now we should refresh the list of locations!
- refresh_loc ;# Could it look like this? Maris.
- }
-
- pack append .frame0.frameNMS
- pack .frame0.frameNMS.first.label
- pack .frame0.frameNMS.second.entry
- pack .frame0.frameNMS.third.button
- pack .frame0.frameNMS.fourth.label
- pack .frame0.frameNMS.fifth.button
- pack .frame0.frameNMS.sixth.button
- pack .frame0.frameNMS.seventh.button
- pack .frame0.frameNMS.first
- pack .frame0.frameNMS.second
- pack .frame0.frameNMS.third
- pack .frame0.frameNMS.spacer
- pack .frame0.frameNMS.fourth
- pack .frame0.frameNMS.fifth
- pack .frame0.frameNMS.sixth
- pack .frame0.frameNMS.seventh
-
- # ----------------------------------
- # build .frame0.frameBUTTONS
- # ----------------------------------
- frame .frame0.frameBUTTONS \
- -borderwidth {2}
-
-
- button .frame0.frameBUTTONS.ok \
- -text [G_msg "Enter GRASS"] \
- -padx 10 -bd 1 -fg green4 -default active -wraplength 100 \
- -command {
- if {[CheckLocation] == 0} {
- DialogGen .wrnDlg [G_msg "WARNING: invalid location"] warning \
- [format [G_msg "Warning: selected location <%s> is not valid. \n Select valid location and try again."] $location] \
- 0 OK;
- set mapset ""
- } else {
- if {[CheckMapset] == 0} {
- DialogGen .wrnDlg [G_msg "WARNING: invalid mapset"] warning \
- [format [G_msg "Warning: <%s> is not a valid mapset"] $mapset] \
- 0 OK;
- } else {
- puts stdout "GISDBASE='$database';"
- puts stdout "LOCATION_NAME='$location';"
- puts stdout "MAPSET='$mapset';"
- putGRASSRC $gisrc_name
- exit 0
- }
- }
- }
-
- bind . <Return> {.frame0.frameBUTTONS.ok invoke}
-
- button .frame0.frameBUTTONS.help \
- -text [G_msg "Help"] \
- -padx 10 -bd 1 -wraplength 100 \
- -bg honeydew2 \
- -command {
- if { [winfo exists .help] } {
- puts [G_msg "Help already opened"]
- wm deiconify .help
- raise .help
- return
- }
- if { $mingw == "1" } {
- exec -- $env(GRASS_HTML_BROWSER) file://$env(GISBASE)/docs/html/helptext.html &;
- } else {
- exec -- $env(GRASS_HTML_BROWSER) file://$env(GISBASE)/docs/html/helptext.html >@stdout 2>@stderr &;
- }
- }
-
- button .frame0.frameBUTTONS.cancel \
- -text [G_msg "Exit"] \
- -padx 10 -bd 1 -wraplength 100 \
- -command { exit 2 }
-
-
- pack append .frame0.frameBUTTONS \
- .frame0.frameBUTTONS.ok { left } \
- .frame0.frameBUTTONS.cancel { left } \
- .frame0.frameBUTTONS.help { right }
-
-
-
- # ----------------------------------
- # packed it all
- # ----------------------------------
-
- frame .frame0.frameSpacer \
- -borderwidth {2} -height {5}
-
- # pack widget .frame0
- pack append .frame0 \
- .frame0.frameDB { top } \
- .frame0.frameBUTTONS { bottom expand fill } \
- .frame0.frameSpacer { bottom } \
- .frame0.frameLOC { left expand } \
- .frame0.frameMS { left expand } \
- .frame0.frameNMS { left expand fill }
-
- .frame0.frameNMS.third.button configure -state disabled
-
- pack append . \
- .frame0 { top frame center expand fill }
-
- .frame0.frameDB.mid.entry xview moveto 1
-
- if { ! [file exists $database] } {
- DialogGen .wrnDlg [G_msg "WARNING: Invalid Database"] warning \
- [G_msg "WARNING: Invalid database. Finding first valid directory in parent tree"] \
- 0 OK
-
- while { ! [file exists $database] } {
- set database [file dirname $database]
- }
- }
-
- # setting list of locations
- refresh_loc
- selFromList .frame0.frameLOC.listbox $location
- if { [CheckLocation] } {
- # setting list of mapsets
- refresh_ms
- selFromList .frame0.frameMS.listbox $mapset
- if { [.frame0.frameMS.listbox get [.frame0.frameMS.listbox curselection]] == $mapset } {
- .frame0.frameBUTTONS.ok configure -state normal
- }
- }
-
- bind .frame0.frameDB.mid.entry <Return> {
- set new_path [%W get]
- if { "$new_path" != "" \
- && [file exists $new_path] && [file isdirectory $new_path] } {
- %W delete 0 end
- %W insert 0 $new_path
- cdir $new_path
- set location ""
- set mapset ""
- refresh_loc
- set database [pwd]
- }
- .frame0.frameBUTTONS.ok configure -state disabled
- }
-
- bind .frame0.frameLOC.listbox <Double-ButtonPress-1> {
- # Do something only if there IS atleast one location
- if {[%W size] > 0} {
- %W selection clear 0 end
- %W select set [%W nearest %y]
- cdir $database
- set location [%W get [%W nearest %y]]
- .frame0.frameMS.listbox delete 0 end
- .frame0.frameBUTTONS.ok configure -state disabled
- set mapset ""
- if {[CheckLocation] == 0} {
- # Notice - %%s prevents %s capturing by bind
- DialogGen .wrnDlg [G_msg "WARNING: invalid location"] warning \
- [format [G_msg "Warning: selected location <%%s> is not valid. \n Select valid location and try again."] $location] \
- 0 OK;
- } else {
- refresh_ms
- }
- }
- }
-
- bind .frame0.frameLOC.listbox <ButtonPress-1> {
- # Do something only if there IS atleast one location
- if {[%W size] > 0} {
- %W selection clear 0 end
- %W select set [%W nearest %y]
- cdir $database
- set location [%W get [%W nearest %y]]
- .frame0.frameMS.listbox delete 0 end
- .frame0.frameBUTTONS.ok configure -state disabled
- set mapset ""
- if {[CheckLocation] == 0} {
- # Notice - %%s prevents %s capturing by bind
- DialogGen .wrnDlg [G_msg "WARNING: invalid location"] warning \
- [format [G_msg "Warning: selected location <%%s> is not valid. \n Select valid location and try again."] $location] \
- 0 OK;
- } else {
- refresh_ms
- }
- }
- }
-
- bind .frame0.frameMS.listbox <Double-ButtonPress-1> {
- # Do something only if there IS atleast one mapset
- if {[%W size] > 0} {
- %W selection clear 0 end
- %W select set [%W nearest %y]
- set mapset [%W get [%W nearest %y]]
- .frame0.frameBUTTONS.ok configure -state normal
- if {[CheckLocation] == 0} {
- # Notice - %%s prevents %s capturing by bind
- DialogGen .wrnDlg [G_msg "WARNING: invalid location"] warning \
- [format [G_msg "Warning: selected location <%%s> is not valid. \n Select valid location and try again."] $location] \
- 0 OK;
- set mapset ""
- } else {
- if {[CheckMapset] == 0} {
- DialogGen .wrnDlg [G_msg "WARNING: invalid mapset"] warning \
- [format [G_msg "Warning: <%%s> is not a valid mapset"] $mapset] \
- 0 OK;
- } else {
- puts stdout "GISDBASE='$database';"
- puts stdout "LOCATION_NAME='$location';"
- puts stdout "MAPSET='$mapset';"
- putGRASSRC $gisrc_name
- exit 0
- }
- }
- }
- }
-
- bind .frame0.frameMS.listbox <ButtonPress-1> {
- # Do something only if there IS atleast one mapset
- if {[%W size] > 0} {
- %W selection clear 0 end
- %W select set [%W nearest %y]
- set mapset [%W get [%W nearest %y]]
- .frame0.frameBUTTONS.ok configure -state normal
- if {[CheckLocation] == 0} {
- DialogGen .wrnDlg [G_msg "WARNING: invalid location"] warning \
- [format [G_msg "Warning: selected location <%%s> is not valid. \n Select valid location and try again."] $location] \
- 0 OK;
- set mapset ""
- }
- }
- }
-
- bind .frame0.frameNMS.second.entry <KeyRelease> {
- .frame0.frameNMS.third.button configure -state normal
- }
-
- # Exit GRASS, if window gets closed.
- wm protocol . WM_DELETE_WINDOW {
- exit 2
- }
-
- grab .
- tkwait window .
-
-}
-
-#############################################################################
-
-proc refresh_loc {} {
-# refresh location listbox entries
- global database
-
- set locList .frame0.frameLOC.listbox
- set mapList .frame0.frameMS.listbox
-
-
- if { "$database" != "" \
- && [file exists $database] && [file isdirectory $database] } {
- cdir $database
- $locList delete 0 end
- foreach i [lsort [glob -nocomplain -directory [pwd] *]] {
- if { [file isdirectory $i] } {
- $locList insert end [file tail $i]
- }
- }
- $mapList delete 0 end
- }
- .frame0.frameBUTTONS.ok configure -state disabled
- update idletasks
-}
-
-proc refresh_ms {} {
-# refresh location listbox entries
- global database
- global location
-
- set mapList .frame0.frameMS.listbox
- $mapList delete 0 end
- if { [CheckLocation] } {
- cdir $database
- cdir $location
- foreach i [lsort [glob -directory [pwd] *]] {
- if {[file isdirectory $i] && [file owned $i] } {
- $mapList insert end [file tail $i]
- }
- }
- }
- .frame0.frameBUTTONS.ok configure -state disabled
-}
-
-#############################################################################
-
-proc cdir { dir } {
-# cd wrapper
- if { [catch { cd $dir }] } {
- DialogGen .wrnDlg [G_msg "WARNING: change directory failed"] warning \
- [format [G_msg "Warning: could not change directory to <%s>.\nCheck directory permissions."] $dir ]\
- 0 OK;
- return 1
- } else {
- return 0
- }
-}
-
-proc selFromList { lis str } {
-# Selects list entry, if there is match
- set siz [$lis size]
- set curSelected 0
- for { set x 0 } { $x < $siz } { incr x } {
- if { $str == [$lis get $x] } {
- set curSelected $x
- break
- }
- }
- $lis yview $curSelected
- $lis selection clear 0 end
- $lis select set $curSelected
-}
-
-#############################################################################
-#
-# proc DialogGen {widget title bitmap text default buttons}
-#
-# PURPOSE: This function simply pops up a dialog box with a given message.
-# Note that it is similar to tk_dialog but has a slightly
-# different look to the dialog.
-# Example call:
-# set val [DialogGen .warnDlg "WARNING: List Changed" \
-# warning "WARNING: You have changed the current list.\
-# Do you want to discard the changes and open a new \
-# file?" 0 OK Cancel]
-# if { $val == 0 } { puts stderr "OK button pressed" }
-# if { $val == 1 } { puts stderr "Cancel button pressed" }
-# INPUT VARS: widget => name of the dialog box starting with . eg .errDlg
-# title => title to display in window border
-# bitmap => bitmap icon to display - must be one of
-# error gray12
-# gray50 hourglass
-# info questhead
-# question warning
-# text => text of the message to be displayed
-# default => index of default button (0, 1, 2...) must be less
-# than number of buttons
-# buttons => text to be used for each button eg OK Cancel
-# RETURN VAL: index of button that was clicked - can be ignored if only one
-# button is defined
-#
-#############################################################################
-
-# Procedure to generate the dialog box
-proc DialogGen {widget title bitmap text default buttons} \
-{
- global buttonNum
-
- # Create a popup window to warn the user
- toplevel $widget
- wm title $widget $title
- wm resizable $widget 0 0
- wm protocol $widget WM_DELETE_WINDOW "CancelDialog $widget"
-
- # Create a label for the bitmap and a message for the text
- frame $widget.dlgFrame
- pack $widget.dlgFrame -side top -fill both
- label $widget.dlgFrame.icon -bitmap $bitmap
- message $widget.dlgFrame.text -text $text -width 10c
- pack $widget.dlgFrame.icon $widget.dlgFrame.text -side left -fill x \
- -padx 10
-
- # Create a frame for the pushbuttons
- frame $widget.sepFrame -height 4 -bd 2 -relief raised
- frame $widget.buttonFrame
- pack $widget.buttonFrame $widget.sepFrame -side bottom -fill x
-
- # Create the pushbuttons
- set i 0
- foreach buttonLabel $buttons {
- button $widget.buttonFrame.$i -bd 1 -text $buttonLabel -command "set buttonNum $i"
- pack $widget.buttonFrame.$i -side left -expand 1 -padx 10 -pady 5
- incr i
- }
-
- # Position the top left corner of the window over the root window
- wm withdraw $widget
- update idletasks
- wm geometry $widget +[expr [winfo rootx .] + ([winfo width .] \
- -[winfo width $widget]) / 2]+[expr [winfo rooty .] + ([winfo \
- height .] - [winfo height $widget]) / 2]
- wm deiconify $widget
-
- # Grab the pointer to make sure this window is closed before continuing
- grab set $widget
-
- if {$default >= 0} {
- focus $widget.buttonFrame.$default
- }
-
- tkwait variable buttonNum
-
- # Destroy the popup window
- destroy $widget
-
- # Return the number of the button that was pushed
- return "$buttonNum"
-}
-
-# Procedure to cancel the dialog
-proc CancelDialog {widget} {
- global buttonNum
-
- # Set the wait variable so that the dialog box can cancel properly
- set buttonNum 999
-}
-
-
-#############################################################################
-
-global database
-global location
-global mapset
-global grassrc_list
-global gisrc_name
-
-set ver [info tclversion]
-
-if { [string compare $ver "8.0"] < 0} {
- puts stderr "Sorry your version of the Tcl/Tk libraries is $ver and is too"
- puts stderr "old for GRASS which requires a Tcl/Tk library version of 8.0 or later."
- puts stderr "Reverting default settings back to GRASS text mode interface."
- exit 1
-}
-
-set database ""
-set location ""
-set mapset ""
-set gisrc_name ""
-
-if { [info exists env(GISRC)] } {
- set gisrc_name $env(GISRC)
-}
-
-if { [searchGISRC $gisrc_name] } {
- gisSetWindow
-}
-
More information about the grass-commit
mailing list