gis_set.tcl 28 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898
  1. #############################################################################
  2. #
  3. # $Id$
  4. #
  5. # MODULE: Grass Tcl/Tk Initialization
  6. # AUTHOR(S): Original author unknown - probably CERL
  7. # Justin Hickey - Thailand - jhickey hpcc.nectec.or.th
  8. # Markus Neteler - Germany - neteler geog.uni-hannover.de, itc.it
  9. # Michael Barton - USA - Arizona State University
  10. # Maris Nartiss - Latvia - maris.gis gmail.com
  11. # PURPOSE: The source file for this shell script is in
  12. # src/tcltkgrass/main/gis_set.tcl. It allows the user to choose
  13. # the database, location, and mapset to use with grass by
  14. # presenting a user interface window.
  15. # COPYRIGHT: (C) 2000,2006 by the GRASS Development Team
  16. #
  17. # This program is free software under the GNU General Public
  18. # License (>=v2). Read the file COPYING that comes with GRASS
  19. # for details.
  20. #
  21. #############################################################################
  22. if {[info exists env(OS)] && $env(OS) == "Windows_NT"} {
  23. set mingw "1"
  24. } else {
  25. set mingw "0"
  26. }
  27. source $env(GISBASE)/etc/gtcltk/gmsg.tcl
  28. source $env(GISBASE)/etc/gtcltk/options.tcl
  29. source $env(GISBASE)/etc/epsg_option.tcl
  30. source $env(GISBASE)/etc/file_option.tcl
  31. #fetch GRASS Version number:
  32. set fp [open $env(GISBASE)/etc/VERSIONNUMBER r]
  33. set GRASSVERSION [read -nonewline $fp]
  34. close $fp
  35. #############################################################################
  36. proc searchGISRC { filename } {
  37. global database
  38. global location
  39. global mapset
  40. global oldDb
  41. global oldLoc
  42. global oldMap
  43. global grassrc_list
  44. set grassrc_list ""
  45. set flag 0
  46. if { [file exists $filename] } {
  47. set ifp [open $filename "r"]
  48. set thisline [gets $ifp]
  49. while { [eof $ifp] == 0 } {
  50. lappend grassrc_list "$thisline"
  51. if { [regexp -- {^GISDBASE: *(.*)$} $thisline dummy env_database] } {
  52. set database $env_database
  53. }
  54. if { [scan $thisline "LOCATION_NAME: %s" env_location] } {
  55. set location $env_location
  56. }
  57. if { [scan $thisline "MAPSET: %s" env_mapset] } {
  58. set mapset $env_mapset
  59. }
  60. set thisline [gets $ifp]
  61. }
  62. set oldDb $database
  63. set oldLoc $location
  64. set oldMap $mapset
  65. close $ifp
  66. if { $database != "" && $location != "" && $mapset != "" } {
  67. set flag 1
  68. }
  69. }
  70. return $flag
  71. }
  72. #############################################################################
  73. proc putGRASSRC { filename } {
  74. # create grassrc file with new values
  75. global database
  76. global location
  77. global mapset
  78. global grassrc_list
  79. set ofp [open $filename "w"]
  80. foreach i $grassrc_list {
  81. if { [regexp {^GISDBASE:} $i] } {
  82. puts $ofp "GISDBASE: $database"
  83. } elseif { [regexp {^LOCATION_NAME:} $i] } {
  84. puts $ofp "LOCATION_NAME: $location"
  85. } elseif { [regexp {^MAPSET:} $i] } {
  86. puts $ofp "MAPSET: $mapset"
  87. } else {
  88. puts $ofp $i
  89. }
  90. }
  91. if { [ catch { close $ofp } error ] } {
  92. DialogGen .wrnDlg [G_msg "WARNING: can not save"] warning \
  93. [format [G_msg "Warning: unable to save data to <%s> file.\nError message: %s"] \
  94. $filename $error] \
  95. 0 OK;
  96. }
  97. }
  98. #############################################################################
  99. proc CheckLocation {} {
  100. # Returns 0, if location is invalid, 1 othervise.
  101. global database location
  102. set found 0
  103. set dir $database
  104. append dir "/$location"
  105. set currDir [pwd]
  106. # Special case - wrong GISDBASE
  107. if {[file isdirectory $dir] == 0} {
  108. DialogGen .wrnDlg [G_msg "WARNING: invalid location"] warning \
  109. [format [G_msg "Warning: location <%s> at GISDBASE <%s> is not a directory or does not exist."] \
  110. $location $database] \
  111. 0 OK;
  112. .frame0.frameMS.listbox delete 0 end
  113. .frame0.frameNMS.second.entry configure -state disabled
  114. .frame0.frameBUTTONS.ok configure -state disabled
  115. } else {
  116. cdir $dir
  117. .frame0.frameNMS.second.entry configure -state disabled
  118. if {[file isdirectory "PERMANENT"] && [file exists "$dir/PERMANENT/DEFAULT_WIND"]} {
  119. set found 1
  120. .frame0.frameNMS.second.entry configure -state normal
  121. }
  122. }
  123. cdir $currDir
  124. return $found
  125. }
  126. proc CheckMapset {} {
  127. global database location mapset
  128. if { $mapset == "" } { return 0; }
  129. if { [file exists "$database/$location/$mapset/WIND"] } {
  130. return 1
  131. }
  132. return 0
  133. }
  134. #############################################################################
  135. proc gisSetWindow {} {
  136. # create main GRASS startup panel
  137. global GRASSVERSION
  138. global database
  139. global location
  140. global mymapset
  141. global mapset
  142. global oldDb oldLoc oldMap
  143. global env
  144. global grassrc_list
  145. global gisrc_name
  146. global refresh
  147. set refresh 0
  148. global mingw
  149. # Window manager configurations
  150. wm title . [format [G_msg "GRASS %s Startup"] $GRASSVERSION]
  151. # ---------------------------
  152. # build .frame0 with panel title
  153. # ---------------------------
  154. set mainfr [frame .frame0 \
  155. -borderwidth {2} \
  156. -relief {raised}]
  157. set titlefrm [frame .frame0.intro -borderwidth 2 ]
  158. set introimg [label $titlefrm.img -image [image create photo -file \
  159. "$env(GISBASE)/etc/gintro.gif"]]
  160. set introtitle [text $titlefrm.msg -height 5 \
  161. -relief flat -fg darkgreen \
  162. -bg #dddddd \
  163. -font introfont \
  164. -width 50 ]
  165. pack $titlefrm -side top
  166. pack $introimg -side top
  167. pack $introtitle -side top
  168. .frame0.intro.msg tag configure all -justify center
  169. .frame0.intro.msg insert end [G_msg "Welcome to GRASS GIS Version"]
  170. .frame0.intro.msg insert end [G_msg " $GRASSVERSION\n"]
  171. .frame0.intro.msg insert end [G_msg "The world's leading open source GIS\n\n"]
  172. .frame0.intro.msg insert end [G_msg "Select an existing project location and mapset\n"]
  173. .frame0.intro.msg insert end [G_msg "or define a new location\n"]
  174. .frame0.intro.msg tag add all 1.0 end
  175. .frame0.intro.msg configure -state disabled
  176. # -----------------------------------
  177. # build .frame0.frameDB - panel top section for database selection
  178. # -----------------------------------
  179. frame .frame0.frameDB \
  180. -borderwidth {2}
  181. frame .frame0.frameDB.left \
  182. -borderwidth {2}
  183. frame .frame0.frameDB.mid \
  184. -borderwidth {2}
  185. frame .frame0.frameDB.right \
  186. -borderwidth {2}
  187. label .frame0.frameDB.left.label \
  188. -justify right \
  189. -wraplength 200 \
  190. -text [G_msg "GIS Data Directory: "]
  191. entry .frame0.frameDB.mid.entry \
  192. -relief {sunken} \
  193. -textvariable database \
  194. -width 40 \
  195. -xscrollcommand { .frame0.frameDB.mid.hscrollbar set}
  196. scrollbar .frame0.frameDB.mid.hscrollbar \
  197. -command { .frame0.frameDB.mid.entry xview} \
  198. -relief {sunken} \
  199. -orient {horizontal}
  200. button .frame0.frameDB.right.button \
  201. -text [G_msg "Browse..."] -padx 10 -bd 1 \
  202. -command { set tmp [tk_chooseDirectory -initialdir $database \
  203. -parent .frame0 -title [G_msg "New GIS data directory"] -mustexist true]
  204. if {$tmp != ""} {
  205. set database $tmp
  206. refresh_loc
  207. .frame0.frameBUTTONS.ok configure -state disabled }
  208. }
  209. pack .frame0.frameDB.left.label -side top
  210. pack .frame0.frameDB.mid.entry -side top
  211. pack .frame0.frameDB.mid.hscrollbar -side bottom -fill x
  212. pack .frame0.frameDB.right.button -side left
  213. pack .frame0.frameDB.left -side left -anchor n
  214. pack .frame0.frameDB.mid -side left -anchor n
  215. pack .frame0.frameDB.right -side left -anchor n -padx 10
  216. # -----------------------------------
  217. # build .frame0.frameLOC - middle, left section for location selection listbox
  218. # -----------------------------------
  219. frame .frame0.frameLOC \
  220. -borderwidth {2}
  221. label .frame0.frameLOC.label \
  222. -wraplength 170 \
  223. -text [G_msg "Project Location (projection/coordinate system)"]
  224. listbox .frame0.frameLOC.listbox \
  225. -relief {sunken} \
  226. -exportselection false \
  227. -yscrollcommand {.frame0.frameLOC.vscrollbar set} \
  228. -xscrollcommand {.frame0.frameLOC.hscrollbar set} \
  229. -selectmode single
  230. scrollbar .frame0.frameLOC.vscrollbar \
  231. -command {.frame0.frameLOC.listbox yview} \
  232. -relief {sunken}
  233. scrollbar .frame0.frameLOC.hscrollbar \
  234. -command {.frame0.frameLOC.listbox xview} \
  235. -orient {horizontal} \
  236. -relief {sunken}
  237. pack append .frame0.frameLOC \
  238. .frame0.frameLOC.label { top fill } \
  239. .frame0.frameLOC.vscrollbar { right filly } \
  240. .frame0.frameLOC.hscrollbar { bottom fillx } \
  241. .frame0.frameLOC.listbox { left expand fill }
  242. # -----------------------------------
  243. # build .frame0.frameMS - middle, right section for mapset selection listbox
  244. # -----------------------------------
  245. frame .frame0.frameMS \
  246. -borderwidth {2}
  247. label .frame0.frameMS.label \
  248. -wraplength 170 \
  249. -text [G_msg "Accessible Mapsets (directories of GIS files)"]
  250. listbox .frame0.frameMS.listbox \
  251. -relief {sunken} \
  252. -exportselection false \
  253. -yscrollcommand {.frame0.frameMS.vscrollbar set} \
  254. -xscrollcommand {.frame0.frameMS.hscrollbar set} \
  255. -selectmode single
  256. scrollbar .frame0.frameMS.vscrollbar \
  257. -command {.frame0.frameMS.listbox yview} \
  258. -relief {sunken}
  259. scrollbar .frame0.frameMS.hscrollbar \
  260. -command {.frame0.frameMS.listbox xview} \
  261. -orient {horizontal} \
  262. -relief {sunken}
  263. pack append .frame0.frameMS \
  264. .frame0.frameMS.label { top fill } \
  265. .frame0.frameMS.vscrollbar { right filly } \
  266. .frame0.frameMS.hscrollbar { bottom fillx } \
  267. .frame0.frameMS.listbox { left expand fill }
  268. # -----------------------------------
  269. # build .frame0.frameNMS - middle far right section with buttons for
  270. # creating new mapset and location
  271. # -----------------------------------
  272. frame .frame0.frameNMS \
  273. -borderwidth {2}
  274. frame .frame0.frameNMS.first \
  275. -borderwidth {2}
  276. frame .frame0.frameNMS.second \
  277. -borderwidth {2}
  278. frame .frame0.frameNMS.third \
  279. -borderwidth {2}
  280. frame .frame0.frameNMS.spacer \
  281. -borderwidth {2} -height {10}
  282. frame .frame0.frameNMS.fourth \
  283. -borderwidth {2}
  284. frame .frame0.frameNMS.fifth \
  285. -borderwidth {2}
  286. frame .frame0.frameNMS.sixth \
  287. -borderwidth {2}
  288. frame .frame0.frameNMS.seventh \
  289. -borderwidth {2}
  290. label .frame0.frameNMS.first.label \
  291. -wraplength 200 \
  292. -text [G_msg "Create new mapset in selected location"]
  293. entry .frame0.frameNMS.second.entry \
  294. -relief {sunken} \
  295. -textvariable mymapset \
  296. -width 22
  297. button .frame0.frameNMS.third.button \
  298. -text [G_msg "Create new mapset"] \
  299. -padx 10 -bd 1 -wraplength 150 \
  300. -command {
  301. set mymapset [ string trim $mymapset ]
  302. if { [file exists $mymapset] } {
  303. DialogGen .wrnDlg [G_msg "WARNING: invalid mapset name"] warning \
  304. [format [G_msg "Warning: Mapset with name <%s> already exists. \nNew mapset is NOT created. \nChoose different mapset name and try again."] $mymapset] \
  305. 0 OK;
  306. return
  307. }
  308. .frame0.frameNMS.third.button configure -state disabled
  309. if { $mymapset != "" } {
  310. if {[CheckLocation] == 0} {
  311. DialogGen .wrnDlg [G_msg "WARNING: invalid location"] warning \
  312. [format [G_msg "Warning: selected location <%s> is not valid. \n New mapset is NOT created. \n Select valid location and try again."] $location] \
  313. 0 OK;
  314. set mapset ""
  315. } else {
  316. cdir $database
  317. cdir $location
  318. if { [ catch { file mkdir $mymapset } error ] } {
  319. DialogGen .wrnDlg [G_msg "WARNING: unable to mkdir"] warning \
  320. [format [G_msg "Warning: Unable to create directory for new mapset. \nError message: %s"] $error] \
  321. 0 OK;
  322. } else {
  323. #generate default DB definition, create dbf subdirectory:
  324. set varfp [open $mymapset/VAR "w"]
  325. puts $varfp "DB_DRIVER: dbf"
  326. puts $varfp "DB_DATABASE: \$GISDBASE/\$LOCATION_NAME/\$MAPSET/dbf/"
  327. close $varfp
  328. catch {file attributes $mymapset/VAR -permissions u+rw,go+r}
  329. file mkdir $mymapset/dbf
  330. #copy over the WIND definition:
  331. catch {file copy $mymapset/../PERMANENT/DEFAULT_WIND $mymapset/WIND}
  332. catch {file attributes $mymapset/WIND -permissions u+rw,go+r}
  333. .frame0.frameMS.listbox insert end $mymapset
  334. selFromList .frame0.frameMS.listbox $mymapset
  335. set mapset $mymapset
  336. .frame0.frameNMS.second.entry delete 0 end
  337. .frame0.frameBUTTONS.ok configure -state normal
  338. }
  339. }
  340. }
  341. }
  342. label .frame0.frameNMS.fourth.label \
  343. -wraplength 200 \
  344. -text [G_msg "Define new location with..."]
  345. button .frame0.frameNMS.fifth.button \
  346. -text [G_msg "Georeferenced file"] \
  347. -width 22 -bd 1 -wraplength 150\
  348. -relief raised \
  349. -command {putGRASSRC $gisrc_name
  350. fileOpt::fileLocCom
  351. tkwait window .fileloc
  352. refresh_loc
  353. refresh_ms
  354. selFromList .frame0.frameLOC.listbox $location
  355. selFromList .frame0.frameMS.listbox $mapset
  356. .frame0.frameBUTTONS.ok configure -state normal}
  357. button .frame0.frameNMS.sixth.button \
  358. -text [G_msg "EPSG codes"] \
  359. -width 22 -bd 1 -wraplength 150\
  360. -relief raised \
  361. -command { putGRASSRC $gisrc_name
  362. if { [epsgOpt::epsgLocCom] } {
  363. tkwait window .optPopup
  364. refresh_loc
  365. refresh_ms
  366. selFromList .frame0.frameLOC.listbox $location
  367. selFromList .frame0.frameMS.listbox $mapset
  368. .frame0.frameBUTTONS.ok configure -state normal} }
  369. button .frame0.frameNMS.seventh.button \
  370. -text [G_msg "Projection values"] \
  371. -width 22 -bd 1 -wraplength 150\
  372. -relief raised \
  373. -command {
  374. if { $mingw == "1" } {
  375. exec -- cmd.exe /c start $env(GISBASE)/etc/set_data
  376. } else {
  377. exec -- $env(GISBASE)/etc/grass-xterm-wrapper -name xterm-grass -e $env(GISBASE)/etc/grass-run.sh $env(GISBASE)/etc/set_data
  378. }
  379. # Now we should refresh the list of locations!
  380. refresh_loc ;# Could it look like this? Maris.
  381. }
  382. pack append .frame0.frameNMS
  383. pack .frame0.frameNMS.first.label
  384. pack .frame0.frameNMS.second.entry
  385. pack .frame0.frameNMS.third.button
  386. pack .frame0.frameNMS.fourth.label
  387. pack .frame0.frameNMS.fifth.button
  388. pack .frame0.frameNMS.sixth.button
  389. pack .frame0.frameNMS.seventh.button
  390. pack .frame0.frameNMS.first
  391. pack .frame0.frameNMS.second
  392. pack .frame0.frameNMS.third
  393. pack .frame0.frameNMS.spacer
  394. pack .frame0.frameNMS.fourth
  395. pack .frame0.frameNMS.fifth
  396. pack .frame0.frameNMS.sixth
  397. pack .frame0.frameNMS.seventh
  398. # ----------------------------------
  399. # build .frame0.frameBUTTONS
  400. # ----------------------------------
  401. frame .frame0.frameBUTTONS \
  402. -borderwidth {2}
  403. button .frame0.frameBUTTONS.ok \
  404. -text [G_msg "Enter GRASS"] \
  405. -padx 10 -bd 1 -fg green4 -default active -wraplength 100 \
  406. -command {
  407. if {[CheckLocation] == 0} {
  408. DialogGen .wrnDlg [G_msg "WARNING: invalid location"] warning \
  409. [format [G_msg "Warning: selected location <%s> is not valid. \n Select valid location and try again."] $location] \
  410. 0 OK;
  411. set mapset ""
  412. } else {
  413. if {[CheckMapset] == 0} {
  414. DialogGen .wrnDlg [G_msg "WARNING: invalid mapset"] warning \
  415. [format [G_msg "Warning: <%s> is not a valid mapset"] $mapset] \
  416. 0 OK;
  417. } else {
  418. puts stdout "GISDBASE='$database';"
  419. puts stdout "LOCATION_NAME='$location';"
  420. puts stdout "MAPSET='$mapset';"
  421. putGRASSRC $gisrc_name
  422. exit 0
  423. }
  424. }
  425. }
  426. bind . <Return> {.frame0.frameBUTTONS.ok invoke}
  427. button .frame0.frameBUTTONS.help \
  428. -text [G_msg "Help"] \
  429. -padx 10 -bd 1 -wraplength 100 \
  430. -bg honeydew2 \
  431. -command {
  432. if { [winfo exists .help] } {
  433. puts [G_msg "Help already opened"]
  434. wm deiconify .help
  435. raise .help
  436. return
  437. }
  438. if { $mingw == "1" } {
  439. exec -- $env(GRASS_HTML_BROWSER) file://$env(GISBASE)/docs/html/helptext.html &;
  440. } else {
  441. exec -- $env(GRASS_HTML_BROWSER) file://$env(GISBASE)/docs/html/helptext.html >@stdout 2>@stderr &;
  442. }
  443. }
  444. button .frame0.frameBUTTONS.cancel \
  445. -text [G_msg "Exit"] \
  446. -padx 10 -bd 1 -wraplength 100 \
  447. -command { exit 2 }
  448. pack append .frame0.frameBUTTONS \
  449. .frame0.frameBUTTONS.ok { left } \
  450. .frame0.frameBUTTONS.cancel { left } \
  451. .frame0.frameBUTTONS.help { right }
  452. # ----------------------------------
  453. # packed it all
  454. # ----------------------------------
  455. frame .frame0.frameSpacer \
  456. -borderwidth {2} -height {5}
  457. # pack widget .frame0
  458. pack append .frame0 \
  459. .frame0.frameDB { top } \
  460. .frame0.frameBUTTONS { bottom expand fill } \
  461. .frame0.frameSpacer { bottom } \
  462. .frame0.frameLOC { left expand } \
  463. .frame0.frameMS { left expand } \
  464. .frame0.frameNMS { left expand fill }
  465. .frame0.frameNMS.third.button configure -state disabled
  466. pack append . \
  467. .frame0 { top frame center expand fill }
  468. .frame0.frameDB.mid.entry xview moveto 1
  469. if { ! [file exists $database] } {
  470. DialogGen .wrnDlg [G_msg "WARNING: Invalid Database"] warning \
  471. [G_msg "WARNING: Invalid database. Finding first valid directory in parent tree"] \
  472. 0 OK
  473. while { ! [file exists $database] } {
  474. set database [file dirname $database]
  475. }
  476. }
  477. # setting list of locations
  478. refresh_loc
  479. selFromList .frame0.frameLOC.listbox $location
  480. if { [CheckLocation] } {
  481. # setting list of mapsets
  482. refresh_ms
  483. selFromList .frame0.frameMS.listbox $mapset
  484. if { [.frame0.frameMS.listbox get [.frame0.frameMS.listbox curselection]] == $mapset } {
  485. .frame0.frameBUTTONS.ok configure -state normal
  486. }
  487. }
  488. bind .frame0.frameDB.mid.entry <Return> {
  489. set new_path [%W get]
  490. if { "$new_path" != "" \
  491. && [file exists $new_path] && [file isdirectory $new_path] } {
  492. %W delete 0 end
  493. %W insert 0 $new_path
  494. cdir $new_path
  495. set location ""
  496. set mapset ""
  497. refresh_loc
  498. set database [pwd]
  499. }
  500. .frame0.frameBUTTONS.ok configure -state disabled
  501. }
  502. bind .frame0.frameLOC.listbox <Double-ButtonPress-1> {
  503. # Do something only if there IS atleast one location
  504. if {[%W size] > 0} {
  505. %W selection clear 0 end
  506. %W select set [%W nearest %y]
  507. cdir $database
  508. set location [%W get [%W nearest %y]]
  509. .frame0.frameMS.listbox delete 0 end
  510. .frame0.frameBUTTONS.ok configure -state disabled
  511. set mapset ""
  512. if {[CheckLocation] == 0} {
  513. # Notice - %%s prevents %s capturing by bind
  514. DialogGen .wrnDlg [G_msg "WARNING: invalid location"] warning \
  515. [format [G_msg "Warning: selected location <%%s> is not valid. \n Select valid location and try again."] $location] \
  516. 0 OK;
  517. } else {
  518. refresh_ms
  519. }
  520. }
  521. }
  522. bind .frame0.frameLOC.listbox <ButtonPress-1> {
  523. # Do something only if there IS atleast one location
  524. if {[%W size] > 0} {
  525. %W selection clear 0 end
  526. %W select set [%W nearest %y]
  527. cdir $database
  528. set location [%W get [%W nearest %y]]
  529. .frame0.frameMS.listbox delete 0 end
  530. .frame0.frameBUTTONS.ok configure -state disabled
  531. set mapset ""
  532. if {[CheckLocation] == 0} {
  533. # Notice - %%s prevents %s capturing by bind
  534. DialogGen .wrnDlg [G_msg "WARNING: invalid location"] warning \
  535. [format [G_msg "Warning: selected location <%%s> is not valid. \n Select valid location and try again."] $location] \
  536. 0 OK;
  537. } else {
  538. refresh_ms
  539. }
  540. }
  541. }
  542. bind .frame0.frameMS.listbox <Double-ButtonPress-1> {
  543. # Do something only if there IS atleast one mapset
  544. if {[%W size] > 0} {
  545. %W selection clear 0 end
  546. %W select set [%W nearest %y]
  547. set mapset [%W get [%W nearest %y]]
  548. .frame0.frameBUTTONS.ok configure -state normal
  549. if {[CheckLocation] == 0} {
  550. # Notice - %%s prevents %s capturing by bind
  551. DialogGen .wrnDlg [G_msg "WARNING: invalid location"] warning \
  552. [format [G_msg "Warning: selected location <%%s> is not valid. \n Select valid location and try again."] $location] \
  553. 0 OK;
  554. set mapset ""
  555. } else {
  556. if {[CheckMapset] == 0} {
  557. DialogGen .wrnDlg [G_msg "WARNING: invalid mapset"] warning \
  558. [format [G_msg "Warning: <%%s> is not a valid mapset"] $mapset] \
  559. 0 OK;
  560. } else {
  561. puts stdout "GISDBASE='$database';"
  562. puts stdout "LOCATION_NAME='$location';"
  563. puts stdout "MAPSET='$mapset';"
  564. putGRASSRC $gisrc_name
  565. exit 0
  566. }
  567. }
  568. }
  569. }
  570. bind .frame0.frameMS.listbox <ButtonPress-1> {
  571. # Do something only if there IS atleast one mapset
  572. if {[%W size] > 0} {
  573. %W selection clear 0 end
  574. %W select set [%W nearest %y]
  575. set mapset [%W get [%W nearest %y]]
  576. .frame0.frameBUTTONS.ok configure -state normal
  577. if {[CheckLocation] == 0} {
  578. DialogGen .wrnDlg [G_msg "WARNING: invalid location"] warning \
  579. [format [G_msg "Warning: selected location <%%s> is not valid. \n Select valid location and try again."] $location] \
  580. 0 OK;
  581. set mapset ""
  582. }
  583. }
  584. }
  585. bind .frame0.frameNMS.second.entry <KeyRelease> {
  586. .frame0.frameNMS.third.button configure -state normal
  587. }
  588. # Exit GRASS, if window gets closed.
  589. wm protocol . WM_DELETE_WINDOW {
  590. exit 2
  591. }
  592. grab .
  593. tkwait window .
  594. }
  595. #############################################################################
  596. proc refresh_loc {} {
  597. # refresh location listbox entries
  598. global database
  599. set locList .frame0.frameLOC.listbox
  600. set mapList .frame0.frameMS.listbox
  601. if { "$database" != "" \
  602. && [file exists $database] && [file isdirectory $database] } {
  603. cdir $database
  604. $locList delete 0 end
  605. foreach i [lsort [glob -nocomplain -directory [pwd] *]] {
  606. if { [file isdirectory $i] } {
  607. $locList insert end [file tail $i]
  608. }
  609. }
  610. $mapList delete 0 end
  611. }
  612. .frame0.frameBUTTONS.ok configure -state disabled
  613. update idletasks
  614. }
  615. proc refresh_ms {} {
  616. # refresh location listbox entries
  617. global database
  618. global location
  619. set mapList .frame0.frameMS.listbox
  620. $mapList delete 0 end
  621. if { [CheckLocation] } {
  622. cdir $database
  623. cdir $location
  624. foreach i [lsort [glob -directory [pwd] *]] {
  625. if {[file isdirectory $i] && [file owned $i] } {
  626. $mapList insert end [file tail $i]
  627. }
  628. }
  629. }
  630. .frame0.frameBUTTONS.ok configure -state disabled
  631. }
  632. #############################################################################
  633. proc cdir { dir } {
  634. # cd wrapper
  635. if { [catch { cd $dir }] } {
  636. DialogGen .wrnDlg [G_msg "WARNING: change directory failed"] warning \
  637. [format [G_msg "Warning: could not change directory to <%s>.\nCheck directory permissions."] $dir ]\
  638. 0 OK;
  639. return 1
  640. } else {
  641. return 0
  642. }
  643. }
  644. proc selFromList { lis str } {
  645. # Selects list entry, if there is match
  646. set siz [$lis size]
  647. set curSelected 0
  648. for { set x 0 } { $x < $siz } { incr x } {
  649. if { $str == [$lis get $x] } {
  650. set curSelected $x
  651. break
  652. }
  653. }
  654. $lis yview $curSelected
  655. $lis selection clear 0 end
  656. $lis select set $curSelected
  657. }
  658. #############################################################################
  659. #
  660. # proc DialogGen {widget title bitmap text default buttons}
  661. #
  662. # PURPOSE: This function simply pops up a dialog box with a given message.
  663. # Note that it is similar to tk_dialog but has a slightly
  664. # different look to the dialog.
  665. # Example call:
  666. # set val [DialogGen .warnDlg "WARNING: List Changed" \
  667. # warning "WARNING: You have changed the current list.\
  668. # Do you want to discard the changes and open a new \
  669. # file?" 0 OK Cancel]
  670. # if { $val == 0 } { puts stderr "OK button pressed" }
  671. # if { $val == 1 } { puts stderr "Cancel button pressed" }
  672. # INPUT VARS: widget => name of the dialog box starting with . eg .errDlg
  673. # title => title to display in window border
  674. # bitmap => bitmap icon to display - must be one of
  675. # error gray12
  676. # gray50 hourglass
  677. # info questhead
  678. # question warning
  679. # text => text of the message to be displayed
  680. # default => index of default button (0, 1, 2...) must be less
  681. # than number of buttons
  682. # buttons => text to be used for each button eg OK Cancel
  683. # RETURN VAL: index of button that was clicked - can be ignored if only one
  684. # button is defined
  685. #
  686. #############################################################################
  687. # Procedure to generate the dialog box
  688. proc DialogGen {widget title bitmap text default buttons} \
  689. {
  690. global buttonNum
  691. # Create a popup window to warn the user
  692. toplevel $widget
  693. wm title $widget $title
  694. wm resizable $widget 0 0
  695. wm protocol $widget WM_DELETE_WINDOW "CancelDialog $widget"
  696. # Create a label for the bitmap and a message for the text
  697. frame $widget.dlgFrame
  698. pack $widget.dlgFrame -side top -fill both
  699. label $widget.dlgFrame.icon -bitmap $bitmap
  700. message $widget.dlgFrame.text -text $text -width 10c
  701. pack $widget.dlgFrame.icon $widget.dlgFrame.text -side left -fill x \
  702. -padx 10
  703. # Create a frame for the pushbuttons
  704. frame $widget.sepFrame -height 4 -bd 2 -relief raised
  705. frame $widget.buttonFrame
  706. pack $widget.buttonFrame $widget.sepFrame -side bottom -fill x
  707. # Create the pushbuttons
  708. set i 0
  709. foreach buttonLabel $buttons {
  710. button $widget.buttonFrame.$i -bd 1 -text $buttonLabel -command "set buttonNum $i"
  711. pack $widget.buttonFrame.$i -side left -expand 1 -padx 10 -pady 5
  712. incr i
  713. }
  714. # Position the top left corner of the window over the root window
  715. wm withdraw $widget
  716. update idletasks
  717. wm geometry $widget +[expr [winfo rootx .] + ([winfo width .] \
  718. -[winfo width $widget]) / 2]+[expr [winfo rooty .] + ([winfo \
  719. height .] - [winfo height $widget]) / 2]
  720. wm deiconify $widget
  721. # Grab the pointer to make sure this window is closed before continuing
  722. grab set $widget
  723. if {$default >= 0} {
  724. focus $widget.buttonFrame.$default
  725. }
  726. tkwait variable buttonNum
  727. # Destroy the popup window
  728. destroy $widget
  729. # Return the number of the button that was pushed
  730. return "$buttonNum"
  731. }
  732. # Procedure to cancel the dialog
  733. proc CancelDialog {widget} {
  734. global buttonNum
  735. # Set the wait variable so that the dialog box can cancel properly
  736. set buttonNum 999
  737. }
  738. #############################################################################
  739. global database
  740. global location
  741. global mapset
  742. global grassrc_list
  743. global gisrc_name
  744. set ver [info tclversion]
  745. if { [string compare $ver "8.0"] < 0} {
  746. puts stderr "Sorry your version of the Tcl/Tk libraries is $ver and is too"
  747. puts stderr "old for GRASS which requires a Tcl/Tk library version of 8.0 or later."
  748. puts stderr "Reverting default settings back to GRASS text mode interface."
  749. exit 1
  750. }
  751. set database ""
  752. set location ""
  753. set mapset ""
  754. set gisrc_name ""
  755. if { [info exists env(GISRC)] } {
  756. set gisrc_name $env(GISRC)
  757. }
  758. if { [searchGISRC $gisrc_name] } {
  759. gisSetWindow
  760. }