summaryrefslogtreecommitdiffstats
path: root/ds9/library/error.tcl
blob: 906a9e4c0bf87ea6eca7e95bac9b7fc5732f049c (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
#  Copyright (C) 1999-2018
#  Smithsonian Astrophysical Observatory, Cambridge, MA, USA
#  For conditions of distribution and use, see copyright notice in "copyright"

package provide DS9 1.0

# capture general errors
# this only captures gui errors, not xpa errors
proc bgerror {err} {
    tk_messageBox -type ok -icon error \
	-message "[msgcat::mc {An internal error has been detected}] $err"
}

# force capture xpa/samp/hv/interactive errors
proc InitError {which} {
    global ds9
    set ds9(msg) {}
    set ds9(msg,level) info
    set ds9(msg,src) $which

    global errorInfo
    set errorInfo {}
}

proc Info {message} {
    ProcessMessage info $message
}

proc Warning {message} {
    ProcessMessage warning $message
}

# used by backup
proc Error {message} {
    ProcessMessage error $message
}

proc ProcessMessage {level message} {
    global ds9
    global pds9

    set ds9(msg,level) $level
    switch -- $ds9(msg,src) {
	xpa -
	hv -
	samp {set ds9(msg) $message}
	default {
	    if {$pds9(confirm)} {
		tk_messageBox -message $message -type ok -icon $level
	    }
	}
    }
}

proc ParserError {msg yycnt yy_current_buffer index_} {
    global ds9

    switch -- $ds9(msg,src) {
	xpa -
	hv -
	samp {
	    Error "$msg, found [lindex $yy_current_buffer [expr $yycnt-1]]"
	}
	default {
	    puts stderr "[string range $yy_current_buffer 0 60]"
	    puts stderr [format "%*s" $index_ ^]
	    puts stderr "$msg"
	    QuitDS9
	}
    }
}

# here is where errors from within the canvas widgets 
# will try to get our attention. 
# XPA, HV, and SAMP will have already seen any problems
proc ErrorTimer {} {
    global ds9
    global pds9

    if {$ds9(msg) != {}} {
	if {$pds9(confirm)} {
	    tk_messageBox -message $ds9(msg) -type ok -icon $ds9(msg,level)
	}
	InitError tcl
    }

    # set again
    after $ds9(msg,timeout) ErrorTimer
}