blob: dcc2af9d03e8d8563593c232e2b93cebe91a5bb9 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## Copyright (c) 2007 Andreas Kupries.
#
# This software is licensed as described in the file LICENSE, which
# you should have received as part of this distribution.
#
# This software consists of voluntary contributions made by many
# individuals. For exact contribution history, see the revision
# history and logs, available at http://fossil-scm.hwaci.com/fossil
# # ## ### ##### ######## ############# #####################
## Utility package, error reporting on top of the log package.
# # ## ### ##### ######## ############# #####################
## Requirements
package require Tcl 8.4 ; # Required runtime.
package require vc::tools::log ; # Basic log generation.
package require snit ; # OO system.
# # ## ### ##### ######## ############# #####################
##
snit::type ::vc::tools::trouble {
# # ## ### ##### ######## #############
## Public API, Methods
typemethod internal {text} {
foreach line [split $text \n] { $type fatal "INTERNAL ERROR! $line" }
exit 1
}
typemethod fatal {text} {
lappend myfatal $text
return
}
typemethod warn {text} {
lappend mywarn $text
log write 0 trouble $text
return
}
typemethod info {text} {
lappend myinfo $text
return
}
typemethod show {} {
foreach m $myinfo { log write 0 "" $m }
foreach m $mywarn { log write 0 warning $m }
foreach m $myfatal { log write 0 fatal $m }
return
}
typemethod ? {} {
return [expr {
[llength $myinfo] ||
[llength $mywarn] ||
[llength $myfatal]
}]
}
typemethod abort? {} {
if {
![llength $myinfo] &&
![llength $mywarn] &&
![llength $myfatal]
} return
# Frame the pending messages to make them more clear as the
# cause of the abort.
set myinfo [linsert $myinfo 0 "" "Encountered problems." ""]
lappend myfatal "Stopped due to problems."
# We have error messages to print, so stop now.
exit 1
}
# # ## ### ##### ######## #############
## Internal, state
typevariable myinfo {}
typevariable mywarn {}
typevariable myfatal {}
# # ## ### ##### ######## #############
## Configuration
pragma -hasinstances no ; # singleton
pragma -hastypeinfo no ; # no introspection
pragma -hastypedestroy no ; # immortal
# # ## ### ##### ######## #############
}
# # ## ### ##### ######## ############# #####################
## Internal. Special. Set up a hook into the application exit, to show
## the remembered messages, before passing through the regular command.
rename ::exit ::vc::tools::trouble::EXIT
proc ::exit {{status 0}} {
::vc::tools::trouble show
::vc::tools::trouble::EXIT $status
# Not reached.
return
}
namespace eval ::vc::tools {
namespace eval trouble {namespace import ::vc::tools::log }
trouble::log register ""
trouble::log register fatal
trouble::log register trouble
trouble::log register warning
namespace export trouble
}
# # ## ### ##### ######## ############# #####################
## Ready
package provide vc::tools::trouble 1.0
return
|
