d57b7b4a05 2007-10-02 aku: ## -*- tcl -*- d57b7b4a05 2007-10-02 aku: # # ## ### ##### ######## ############# ##################### d57b7b4a05 2007-10-02 aku: ## Copyright (c) 2007 Andreas Kupries. d57b7b4a05 2007-10-02 aku: # d57b7b4a05 2007-10-02 aku: # This software is licensed as described in the file LICENSE, which d57b7b4a05 2007-10-02 aku: # you should have received as part of this distribution. d57b7b4a05 2007-10-02 aku: # d57b7b4a05 2007-10-02 aku: # This software consists of voluntary contributions made by many d57b7b4a05 2007-10-02 aku: # individuals. For exact contribution history, see the revision d57b7b4a05 2007-10-02 aku: # history and logs, available at http://fossil-scm.hwaci.com/fossil d57b7b4a05 2007-10-02 aku: # # ## ### ##### ######## ############# ##################### d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: ## Utility package, error reporting on top of the log package. d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: # # ## ### ##### ######## ############# ##################### d57b7b4a05 2007-10-02 aku: ## Requirements d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: package require Tcl 8.4 ; # Required runtime. d57b7b4a05 2007-10-02 aku: package require vc::tools::log ; # Basic log generation. d57b7b4a05 2007-10-02 aku: package require snit ; # OO system. d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: # # ## ### ##### ######## ############# ##################### d57b7b4a05 2007-10-02 aku: ## d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: snit::type ::vc::tools::trouble { d57b7b4a05 2007-10-02 aku: # # ## ### ##### ######## ############# d57b7b4a05 2007-10-02 aku: ## Public API, Methods d57b7b4a05 2007-10-02 aku: 5911515322 2007-10-02 aku: typemethod internal {text} { 5911515322 2007-10-02 aku: foreach line [split $text \n] { $type fatal "INTERNAL ERROR! $line" } 5911515322 2007-10-02 aku: exit 1 5911515322 2007-10-02 aku: } 5911515322 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: typemethod fatal {text} { d57b7b4a05 2007-10-02 aku: lappend myfatal $text 5911515322 2007-10-02 aku: return d57b7b4a05 2007-10-02 aku: } d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: typemethod warn {text} { d57b7b4a05 2007-10-02 aku: lappend mywarn $text d57b7b4a05 2007-10-02 aku: log write 0 trouble $text d57b7b4a05 2007-10-02 aku: return d57b7b4a05 2007-10-02 aku: } d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: typemethod info {text} { d57b7b4a05 2007-10-02 aku: lappend myinfo $text d57b7b4a05 2007-10-02 aku: return d57b7b4a05 2007-10-02 aku: } d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: typemethod show {} { d57b7b4a05 2007-10-02 aku: foreach m $myinfo { log write 0 "" $m } d57b7b4a05 2007-10-02 aku: foreach m $mywarn { log write 0 warning $m } d57b7b4a05 2007-10-02 aku: foreach m $myfatal { log write 0 fatal $m } d57b7b4a05 2007-10-02 aku: return 5911515322 2007-10-02 aku: } 5911515322 2007-10-02 aku: 5911515322 2007-10-02 aku: typemethod abort? {} { 5911515322 2007-10-02 aku: if { 5911515322 2007-10-02 aku: ![llength $myinfo] && 5911515322 2007-10-02 aku: ![llength $mywarn] && 5911515322 2007-10-02 aku: ![llength $myfatal] 5911515322 2007-10-02 aku: } return 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: # Frame the pending messages to make them more clear as the 52f2254007 2007-10-04 aku: # cause of the abort. 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: set myinfo [linsert $myinfo 0 "" "Encountered problems." ""] 52f2254007 2007-10-04 aku: lappend myfatal "Stopped due to problems." 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: # We have error messages to print, so stop now. 5911515322 2007-10-02 aku: exit 1 d57b7b4a05 2007-10-02 aku: } d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: # # ## ### ##### ######## ############# d57b7b4a05 2007-10-02 aku: ## Internal, state d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: typevariable myinfo {} d57b7b4a05 2007-10-02 aku: typevariable mywarn {} d57b7b4a05 2007-10-02 aku: typevariable myfatal {} d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: # # ## ### ##### ######## ############# d57b7b4a05 2007-10-02 aku: ## Configuration d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: pragma -hasinstances no ; # singleton d57b7b4a05 2007-10-02 aku: pragma -hastypeinfo no ; # no introspection d57b7b4a05 2007-10-02 aku: pragma -hastypedestroy no ; # immortal d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: # # ## ### ##### ######## ############# d57b7b4a05 2007-10-02 aku: } d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: # # ## ### ##### ######## ############# ##################### d57b7b4a05 2007-10-02 aku: ## Internal. Special. Set up a hook into the application exit, to show d57b7b4a05 2007-10-02 aku: ## the remembered messages, before passing through the regular command. d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: rename ::exit ::vc::tools::trouble::EXIT d57b7b4a05 2007-10-02 aku: proc ::exit {{status 0}} { d57b7b4a05 2007-10-02 aku: ::vc::tools::trouble show d57b7b4a05 2007-10-02 aku: ::vc::tools::trouble::EXIT $status d57b7b4a05 2007-10-02 aku: # Not reached. d57b7b4a05 2007-10-02 aku: return d57b7b4a05 2007-10-02 aku: } d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: namespace eval ::vc::tools { d57b7b4a05 2007-10-02 aku: namespace eval trouble {namespace import ::vc::tools::log } d57b7b4a05 2007-10-02 aku: trouble::log register "" d57b7b4a05 2007-10-02 aku: trouble::log register fatal d57b7b4a05 2007-10-02 aku: trouble::log register trouble d57b7b4a05 2007-10-02 aku: trouble::log register warning d57b7b4a05 2007-10-02 aku: namespace export trouble d57b7b4a05 2007-10-02 aku: } d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: # # ## ### ##### ######## ############# ##################### d57b7b4a05 2007-10-02 aku: ## Ready d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: package provide vc::tools::trouble 1.0 d57b7b4a05 2007-10-02 aku: return
File Annotation