← Back to branch summary

~ubuntu-branches/ubuntu/vivid/grass/vivid-proposed

« back to all changes in this revision

Viewing changes to gui/tcltk/gis.m/gm.tcl

  • Committer: Package Import Robot
  • Author(s): Bas Couwenberg
  • Date: 2015-02-20 23:12:08 UTC
  • mfrom: (8.2.6 experimental)
  • Revision ID: package-import@ubuntu.com-20150220231208-1u6qvqm84v430b10
Tags: 7.0.0-1~exp1
* New upstream release.
* Update python-ctypes-ternary.patch to use if/else instead of and/or.
* Drop check4dev patch, rely on upstream check.
* Add build dependency on libpq-dev to grass-dev for libpq-fe.h.
* Drop patches applied upstream, refresh remaining patches.
* Update symlinks for images switched from jpg to png.

Show diffs side-by-side

added added

removed removed

Lines of Context:
gui/tcltk/gis.m/gm.tcl
1
 
##########################################################################
2
 
#
3
 
# gm.tcl
4
 
#
5
 
# Primary tcltk script for GIS Manager: GUI for GRASS 6
6
 
# Author: Michael Barton (Arizona State University)
7
 
# Based in part on Display Manager for GRASS 5.7 by Radim Blazek (ITC-IRST)
8
 
# and tcltkgrass for GRASS 5.7 by Michael Barton (Arizona State University)--
9
 
# with contributions by Glynn Clements, Markus Neteler, Lorenzo Moretti,
10
 
# Florian Goessmann, and others
11
 
#
12
 
# March 2006
13
 
#
14
 
# COPYRIGHT:    (C) 1999 - 2006 by the GRASS Development Team
15
 
#
16
 
#               This program is free software under the GNU General Public
17
 
#               License (>=v2). Read the file COPYING that comes with GRASS
18
 
#               for details.
19
 
#
20
 
##########################################################################
21
 
 
22
 
lappend auto_path [file join "$env(GISBASE)" "bwidget"]
23
 
 
24
 
package require -exact BWidget 1.2.1
25
 
 
26
 
# Load up all the gis.m layers and things.
27
 
# pkgIndex.tcl only loads the files when they are first called.
28
 
lappend auto_path [file join "$env(GISBASE)" "etc" "gm"]
29
 
package require -exact GisM 1.0
30
 
 
31
 
# path to GIS Manager files
32
 
set gmpath [file join "$env(GISBASE)" "etc" "gm"]
33
 
 
34
 
# Load GUI stuff required for error reporting etc.
35
 
source [file join "$env(GISBASE)" "etc" "gui.tcl"]
36
 
 
37
 
# Load common procedure library
38
 
source [file join "$gmpath" "gmlib.tcl"]
39
 
 
40
 
# gisenv errors are fatal. 
41
 
if {[catch {set env(GISDBASE) [exec g.gisenv get=GISDBASE]} error]} {
42
 
        GmLib::errmsg $error
43
 
        puts $error
44
 
        exit 1
45
 
}
46
 
if {[catch {set env(LOCATION_NAME) [exec g.gisenv get=LOCATION_NAME]} error]} {
47
 
        GmLib::errmsg $error
48
 
        puts $error
49
 
        exit 1
50
 
}
51
 
if {[catch {set env(MAPSET) [exec g.gisenv get=MAPSET]} error]} {
52
 
        GmLib::errmsg $error
53
 
        puts $error
54
 
        exit 1
55
 
}
56
 
 
57
 
if {[catch {set gisdbase [exec g.gisenv get=GISDBASE]} error]} {
58
 
        GmLib::errmsg $error
59
 
        puts $error
60
 
        exit 1
61
 
}
62
 
if {[catch {set location_name [exec g.gisenv get=LOCATION_NAME]} error]} {
63
 
        GmLib::errmsg $error
64
 
        puts $error
65
 
        exit 1
66
 
}
67
 
if {[catch {set mapset [exec g.gisenv get=MAPSET]} error]} {
68
 
        GmLib::errmsg $error
69
 
        puts $error
70
 
        exit 1
71
 
}
72
 
 
73
 
# if any of those is empty, there's no reason to continue. it's a failure.
74
 
if { $gisdbase=={} || $location_name=={} || $mapset=={} } {
75
 
        GmLib::errmsg [G_msg "GISDBASE or LOCATION_NAME or MAPSET is empty. \
76
 
        This is a fatal error. gis.m can not work without proper settings."]
77
 
        exit 1
78
 
}
79
 
 
80
 
# path to icons for GIS Manager
81
 
set iconpath [file join "$env(GISBASE)" "etc" "gui" "icons" "grass"]
82
 
 
83
 
global iconpath
84
 
global gmpath
85
 
 
86
 
set keycontrol "Control"
87
 
set tmenu "1"
88
 
set keyctrl "Ctrl"
89
 
set execom "execute"
90
 
set msg 0
91
 
set mon 1
92
 
 
93
 
 
94
 
 
95
 
if {![catch {set env(HOSTTYPE)}]} {
96
 
        set HOSTTYPE $env(HOSTTYPE)
97
 
} else {
98
 
        set HOSTTYPE ""
99
 
}
100
 
 
101
 
# add for OSX aqua
102
 
if {![catch {set env(osxaqua)}]} {
103
 
    set osxaqua $env(osxaqua)
104
 
} else {
105
 
    set osxaqua "0"
106
 
}
107
 
 
108
 
if { $osxaqua == "1"} {
109
 
    set keycontrol "Command"
110
 
    set tmenu "0"
111
 
    set keyctrl "Command"
112
 
    set execom "spawn"
113
 
}
114
 
 
115
 
if {![catch {set env(OS)}] && $env(OS) == "Windows_NT"} {
116
 
        set mingw "1"
117
 
        set devnull "NUL:"
118
 
} else {
119
 
        set mingw "0"
120
 
        set devnull "/dev/null"
121
 
}
122
 
 
123
 
 
124
 
#fetch GRASS Version number:
125
 
catch {set fp [open [file join "$env(GISBASE)" "etc" "VERSIONNUMBER"] r]}
126
 
set GRASSVERSION [read -nonewline $fp]
127
 
 
128
 
if {[catch {close $fp} error]} {
129
 
        GmLib::errmsg $error
130
 
}
131
 
 
132
 
 
133
 
#source $env(GISBASE)/etc/gui.tcl
134
 
# gui.tcl also sources these:
135
 
# $env(GISBASE)/etc/gtcltk/gmsg.tcl
136
 
# $env(GISBASE)/etc/gtcltk/options.tcl
137
 
# $env(GISBASE)/etc/gtcltk/select.tcl
138
 
# $env(GISBASE)/etc/gtcltk/gronsole.tcl
139
 
 
140
 
# Load a console user interface
141
 
source [file join "$gmpath" "runandoutput.tcl"]
142
 
 
143
 
namespace eval Gm {
144
 
        variable gm_mainframe
145
 
        variable status
146
 
        variable array tree ;# mon
147
 
        variable rcfile
148
 
        variable moncount
149
 
        variable prgtext
150
 
        variable mainwindow
151
 
        variable dfont 
152
 
        variable selectedfont
153
 
        variable encoding
154
 
        global array filename ;# mon
155
 
        variable last_directory ;# last save/load dir for reuse
156
 
}
157
 
 
158
 
 
159
 
set Gm::prgtext ""
160
 
global prgindic
161
 
global max_prgindic
162
 
 
163
 
set max_prgindic 20
164
 
 
165
 
if { $tcl_platform(platform) == "windows" } {
166
 
        append regexp .* $env(GISBASE) {[^;]*}
167
 
        regsub -- $regexp $env(PATH) "&;$env(GISBASE)/etc/gui/scripts" env(PATH)
168
 
} else {
169
 
        append regexp .* $env(GISBASE) {[^:]*}
170
 
        regsub -- $regexp $env(PATH) "&:$env(GISBASE)/etc/gui/scripts" env(PATH)
171
 
}
172
 
 
173
 
###############################################################################
174
 
# Deprecated
175
 
# Use guarantee_xmon and any run command instead.
176
 
 
177
 
proc Gm::xmon { type cmd } {
178
 
        guarantee_xmon
179
 
 
180
 
        if { $type == "term" } {
181
 
                term_panel $cmd
182
 
        } else {
183
 
                run_panel $cmd
184
 
        }
185
 
 
186
 
        return
187
 
}
188
 
 
189
 
###############################################################################
190
 
 
191
 
 
192
 
proc Gm::create { } {
193
 
        variable mainwindow
194
 
        variable prgtext
195
 
        variable gm_mainframe
196
 
        variable tree
197
 
        variable moncount
198
 
        variable dfont
199
 
        variable ecoding
200
 
        global gmpath
201
 
        global mon
202
 
        global tree_pane
203
 
        global options
204
 
        global pgs
205
 
        global prgindic
206
 
        global keycontrol
207
 
        global env
208
 
        
209
 
        # set display rendering environment for PNG/PPM output
210
 
        set env(GRASS_RENDER_IMMEDIATE) "TRUE"
211
 
        
212
 
        # set default font
213
 
        if {[catch {set env(GRASS_FONT)}]} {set env(GRASS_FONT) "romans"}
214
 
        set Gm::dfont ""
215
 
        set Gm::encoding "ISO-8859-1"
216
 
 
217
 
        set moncount 1
218
 
 
219
 
        set Gm::prgtext [G_msg "Loading GIS Manager"]
220
 
        set prgindic -1
221
 
        _create_intro
222
 
        update
223
 
 
224
 
        source $gmpath/gmmenu.tcl
225
 
 
226
 
        set Gm::prgtext [G_msg "Creating MainFrame..."]
227
 
    
228
 
        set gm_mainframe [MainFrame .mainframe \
229
 
                       -menu $descmenu \
230
 
                       -textvariable Gm::status \
231
 
                       -progressvar  Gm::prgindic ]
232
 
 
233
 
        set mainwindow [$gm_mainframe getframe]
234
 
    
235
 
        # toolbar 1 & 2 creation
236
 
        set tb1  [$gm_mainframe addtoolbar]
237
 
        GmToolBar1::create $tb1
238
 
        set tb2  [$gm_mainframe addtoolbar]
239
 
        GmToolBar2::create $tb2
240
 
        set pw1 [PanedWindow $mainwindow.pw1 -side left -pad 0 -width 10 ]
241
 
    
242
 
        # tree
243
 
        set treemon [expr {$mon + 1}]
244
 
        set tree_pane  [$pw1 add  -minsize 50 -weight 1]
245
 
            set pgs [PagesManager $tree_pane.pgs]
246
 
    
247
 
    
248
 
            pack $pgs -expand yes -fill both
249
 
    
250
 
    
251
 
        # options
252
 
        set options_pane  [$pw1 add -minsize 50 -weight 1]
253
 
        set options_sw [ScrolledWindow $options_pane.sw -relief flat -borderwidth 1]
254
 
        set options_sf [ScrollableFrame $options_sw.sf]
255
 
        $options_sf configure -height 145 -width 460
256
 
        $options_sw setwidget $options_sf
257
 
        set options [$options_sf getframe]
258
 
        pack $options_sw -fill both -expand yes
259
 
    
260
 
        # Scroll the options window with the mouse
261
 
        bind_scroll $options_sf
262
 
    
263
 
        pack $pw1 -side top -expand yes -fill both -anchor n
264
 
    
265
 
            # finish up
266
 
        set Gm::prgtext [G_msg "Done"]
267
 
    
268
 
        set Gm::status [G_msg "Welcome to GRASS GIS"]
269
 
        $gm_mainframe showstatusbar status
270
 
    
271
 
        pack $gm_mainframe -fill both -expand yes
272
 
 
273
 
        Gm::startmon
274
 
 
275
 
        bind .mainframe <Destroy> {
276
 
                if {"%W" == ".mainframe"} {
277
 
                        Gm::cleanup}
278
 
        }
279
 
 
280
 
        if { [info exists env(HOME)] } {
281
 
                set Gm::last_directory $env(HOME)
282
 
        } else {
283
 
                set Gm::last_directory [pwd]
284
 
        }
285
 
 
286
 
}
287
 
 
288
 
 
289
 
###############################################################################
290
 
 
291
 
# start new display monitor and increment canvas monitor number
292
 
proc Gm::startmon { } {
293
 
        variable mainwindow
294
 
        variable moncount
295
 
        variable tree
296
 
        global mon
297
 
 
298
 
        set mon $moncount
299
 
        incr moncount 1
300
 
 
301
 
        #create initial display canvas and layer tree
302
 
        MapCanvas::create
303
 
        GmTree::create $mon
304
 
 
305
 
        wm title .mapcan($mon) [format [G_msg "Map Display %d"] $mon]
306
 
        wm withdraw .mapcan($mon)
307
 
        wm deiconify .mapcan($mon)
308
 
}
309
 
 
310
 
 
311
 
###############################################################################
312
 
 
313
 
proc Gm::_create_intro { } {
314
 
        variable prgtext
315
 
    global gmpath
316
 
    global GRASSVERSION
317
 
    global location_name
318
 
    global max_prgindic
319
 
    global prg
320
 
 
321
 
    set top [toplevel .intro -relief raised -borderwidth 2]
322
 
 
323
 
    wm withdraw $top
324
 
    wm overrideredirect $top 1
325
 
 
326
 
    set ximg  [label $top.x -image [image create photo -file "$gmpath/intro.gif"] ]
327
 
 
328
 
    set frame [frame $ximg.f -background white]
329
 
    set lab1  [label $frame.lab1 \
330
 
                -text [format [G_msg "GRASS%s GIS Manager - %s"] $GRASSVERSION $location_name] \
331
 
                -background white -foreground black -font introfont]
332
 
    set lab2  [label $frame.lab2 -textvariable Gm::prgtext -background white]
333
 
    set prg   [ProgressBar $frame.prg -width 50 -height 15 -background white \
334
 
                   -variable Gm::prgindic -maximum $max_prgindic]
335
 
    pack $lab1 $prg -side left -fill both -expand yes
336
 
    pack $lab2 -side right -expand yes
337
 
    place $frame -x 0 -y 0 -anchor nw
338
 
    pack $ximg
339
 
    BWidget::place $top 0 0 center
340
 
    wm deiconify $top
341
 
}
342
 
 
343
 
###############################################################################
344
 
 
345
 
# nviz
346
 
proc Gm::nviz { } {
347
 
global osxaqua
348
 
global HOSTTYPE
349
 
 
350
 
    set cmd "nviz"
351
 
        if { $HOSTTYPE == "macintosh" || $HOSTTYPE == "powermac" || $HOSTTYPE == "powerpc" || $HOSTTYPE == "intel-pc"} {
352
 
                if { $osxaqua == "1"} {
353
 
                        spawn $cmd
354
 
                } else {
355
 
                        term $cmd
356
 
                }
357
 
        } else {
358
 
                spawn $cmd
359
 
        }
360
 
 
361
 
}
362
 
 
363
 
###############################################################################
364
 
 
365
 
# d.nviz: set up NVIZ flight path (not much use without a backdrop?)
366
 
proc Gm::fly { } {
367
 
 
368
 
    guarantee_xmon
369
 
    exec d.nviz -i --ui &
370
 
 
371
 
}
372
 
 
373
 
###############################################################################
374
 
 
375
 
# xganim
376
 
proc Gm::xganim { } {
377
 
 
378
 
    exec xganim --ui &
379
 
 
380
 
}
381
 
 
382
 
###############################################################################
383
 
 
384
 
# help
385
 
proc Gm::help { } {
386
 
 
387
 
    set cmd [list g.manual --ui]
388
 
    term $cmd
389
 
 
390
 
}
391
 
 
392
 
###############################################################################
393
 
# sets default display font
394
 
proc Gm::defaultfont { source } {
395
 
        global env iconpath
396
 
        global fontlist
397
 
        variable dfont
398
 
        variable selectedfont
399
 
        variable encoding
400
 
 
401
 
        # create a dialog with selector for stroke font and true type font, and
402
 
        # text entry for character encoding
403
 
 
404
 
    toplevel .dispfont
405
 
    wm title .dispfont [G_msg "Select GRASS display font"]
406
 
    
407
 
    if {[catch {set rawlist [exec d.font --q -L]} error]} {
408
 
            GmLib::errmsg $error "d.font error"
409
 
    }
410
 
    set rawlist [split $rawlist "\n"]
411
 
    foreach item $rawlist {
412
 
        set fontinfo [split $item "|"]
413
 
        lappend fontlist $fontinfo
414
 
    }
415
 
    # Case-insensitive search on font long name, removing duplicates
416
 
    set fontlist [lsort -dictionary -unique -index 1 $fontlist]
417
 
   
418
 
    set row [ frame .dispfont.fontlb ]
419
 
    Label $row.a -text [G_msg "Font: "] 
420
 
    set fontlb [ listbox $row.b -bg white -width 30 \
421
 
        -yscrollcommand "$row.vscrollbar set"]
422
 
 
423
 
    scrollbar $row.vscrollbar -width 12 \
424
 
        -command "$row.b yview" \
425
 
        -relief {sunken}
426
 
 
427
 
    foreach item $fontlist {
428
 
        $fontlb insert end [lindex $item 1]
429
 
    }
430
 
    # If $Gm::dfont is empty then it hasn't been set by a layer module
431
 
    # before calling this procedure, so we should read the current
432
 
    # default font from the GRASS_FONT environment variable
433
 
    if {$Gm::dfont == ""} {    
434
 
        if {![catch {set env(GRASS_FONT)}] && $env(GRASS_FONT) != ""} {
435
 
            set Gm::dfont $env(GRASS_FONT)
436
 
            }
437
 
    }
438
 
    set selectedfont $Gm::dfont
439
 
     
440
 
    if {$Gm::dfont != ""} {
441
 
        set fontindex 0
442
 
        foreach item $fontlist {
443
 
            if { $Gm::dfont eq [lindex $item 0] } {
444
 
                $fontlb selection set $fontindex
445
 
                $fontlb see $fontindex
446
 
                break
447
 
            }
448
 
            incr fontindex
449
 
        }
450
 
    }
451
 
 
452
 
    pack $row.vscrollbar -side right -fill y
453
 
    pack $row.b -side right
454
 
    pack $row.a -side right -anchor n
455
 
    pack $row -side top -fill both -expand yes -pady 3 -padx 5
456
 
    
457
 
        set row [ frame .dispfont.fontopt3 ]
458
 
    Label $row.a -text [G_msg "Character encoding: "] 
459
 
    Entry $row.b -width 20 -text "$Gm::encoding" \
460
 
            -textvariable Gm::encoding
461
 
    pack $row.b $row.a -side right -anchor e
462
 
    pack $row -side top -fill both -expand yes -pady 3 -padx 5
463
 
    
464
 
        set row [ frame .dispfont.buttons ]
465
 
        Button $row.ok -text [G_msg "OK"] -width 8 -bd 1 \
466
 
                        -command "Gm::setfont $source; destroy .dispfont"
467
 
    pack $row.ok -side left -fill x -expand 0
468
 
    button $row.cancel -text [G_msg "Cancel"] -width 8 -bd 1 \
469
 
        -command "destroy .dispfont"
470
 
    pack $row.cancel -side right -fill x -expand 0
471
 
    pack $row -side bottom -pady 3  -padx 5 -expand 0 -fill x 
472
 
    
473
 
    bind $fontlb <<ListboxSelect>> {
474
 
        set Gm::selectedfont [lindex [lindex $fontlist [%W curselection]] 0]
475
 
    }   
476
 
    
477
 
};
478
 
 
479
 
 
480
 
proc Gm::setfont { source } {
481
 
        global env
482
 
        variable dfont
483
 
        variable selectedfont
484
 
        variable encoding
485
 
 
486
 
        # Set GRASS environmental variables for default display font and
487
 
        # character encoding
488
 
        
489
 
        if { $encoding != "" && $encoding != "ISO-8859-1"} {
490
 
                set env(GRASS_ENCODING) $encoding
491
 
        }
492
 
 
493
 
        set dfont $selectedfont
494
 
    
495
 
        if { $source == "menu" && $dfont != "" } {
496
 
                set env(GRASS_FONT) $dfont
497
 
                set dfont ""
498
 
        }
499
 
 
500
 
};
501
 
 
502
 
###############################################################################
503
 
 
504
 
proc Gm::cleanup { } {
505
 
        global mon
506
 
        global tmpdir
507
 
        global legfile
508
 
        variable moncount
509
 
        
510
 
        set mappid $MapCanvas::mappid
511
 
        
512
 
        # delete all map display ppm files
513
 
        cd $tmpdir
514
 
        set deletefile $mappid
515
 
        append deletefile ".*"
516
 
        foreach file [glob -nocomplain $deletefile] {
517
 
                catch {file delete $file}
518
 
        }
519
 
 
520
 
        if {[info exists legfile] && [file exists $legfile]} {catch {file delete -force $legfile}}
521
 
 
522
 
        unset mon
523
 
 
524
 
};
525
 
 
526
 
# Provides remote exit call. Used by GRASS exit to close all session's gis.m instances.
527
 
# Argument session_id is exit caller's GIS_LOCK variable.
528
 
proc Gm::remoteExit { session_id } {
529
 
        global env
530
 
        if {$env(GIS_LOCK) == $session_id} Gm::quit
531
 
}
532
 
 
533
 
# Provides exit from gis.m. May also do some clean-up, save-settings et.al.
534
 
proc Gm::quit { {full_exit false} } {
535
 
        global env
536
 
        
537
 
        if { $full_exit } {
538
 
                if { [catch {set spid $env(GRASS_SHELL_PID)}] == 0 } {
539
 
                        set leave [tk_dialog .leave [G_msg "End current GRASS session"] \
540
 
                        [G_msg "Do you really want to terminate current\
541
 
GRASS session?\n\nThis action will close all sessions gis.m instances.\n\nIf You have running some \
542
 
GRASS module from comandline, GRASS will terminate after it\
543
 
finishes to run."] warning 1 [G_msg "Terminate current GRASS session"] [G_msg "Cancel"]]
544
 
                        if { $leave == 0 } { 
545
 
                                exec kill -SIGQUIT $env(GRASS_SHELL_PID)
546
 
                        } else { 
547
 
                                return
548
 
                        }
549
 
                } else {
550
 
                        tk_messageBox -type ok -title [G_msg "Not supported"] -message \
551
 
                        [G_msg "We sorry. Your shell does not support this feature. \n\
552
 
You have to type 'exit' in terminal manually."]
553
 
                }
554
 
        }
555
 
 
556
 
        # It's unsafe to call exit during Destroy event
557
 
        after idle [list destroy .]
558
 
}
559
 
 
560
 
###############################################################################
561
 
 
562
 
proc main {argc argv} {
563
 
    variable gm_mainframe
564
 
    global auto_path
565
 
    global GRASSVERSION
566
 
    global location_name
567
 
    global mapset
568
 
    global keycontrol
569
 
    global filename
570
 
    global mon
571
 
 
572
 
    wm withdraw .
573
 
    wm title . [format [G_msg "GRASS%s GIS Manager - %s %s"] $GRASSVERSION $location_name $mapset]
574
 
 
575
 
    bind . <$keycontrol-Key-o> {
576
 
                Gm::OpenFileBox
577
 
    }
578
 
    bind . <$keycontrol-Key-n> {
579
 
                GmTree::new
580
 
    }
581
 
    bind . <$keycontrol-Key-s> {
582
 
                Gm::SaveFileBox
583
 
    }
584
 
    bind . <$keycontrol-Key-q> {
585
 
                Gm::quit
586
 
        }
587
 
    bind . <$keycontrol-Key-w> {
588
 
                GmTree::FileClose {}
589
 
    }
590
 
 
591
 
    Gm::create
592
 
    BWidget::place . 0 0 at 400 100
593
 
 
594
 
    wm deiconify .
595
 
    raise .mainframe
596
 
    focus -force .
597
 
    destroy .intro
598
 
    
599
 
    if { $argc > 1 } {
600
 
        foreach i $argv {
601
 
                if { [regexp -- {\.grc$} $i] || [regexp -- {\.dmrc$} $i] || [regexp -- {\.dm$} $i] } { 
602
 
                        set filename($mon) [lindex $argv 0]
603
 
                        GmTree::load $filename($mon)
604
 
                }
605
 
        }
606
 
    }
607
 
}
608
 
 
609
 
wm protocol . WM_DELETE_WINDOW {
610
 
        Gm::quit
611
 
}
612
 
 
613
 
main $argc $argv
614
 
wm geom . [wm geom .]
615