Overview
| SHA1 Hash: | d57b7b4a05e30c09737c989fb3c5772a5842bd3e |
|---|---|
| Date: | 2007-10-02 05:33:09 |
| User: | aku |
| Comment: | Re-added the user feedback and error reporting utilities, with modifications, and completed the handling of the informational options. |
| Timelines: | ancestors | descendants | both | trunk |
| Other Links: | files | ZIP archive | manifest |
Tags And Properties
- branch=trunk inherited from [a28c83647d]
- sym-trunk inherited from [a28c83647d]
Changes
[hide diffs]Modified tools/cvs2fossil/lib/c2f_option.tcl from [db1981ab35] to [fc9f62797d].
@@ -17,11 +17,12 @@
# # ## ### ##### ######## ############# #####################
## Requirements
package require Tcl 8.4 ; # Required runtime.
-package require snit ; # OO system
+package require snit ; # OO system.
+package require vc::tools::trouble ; # Error reporting.
# # ## ### ##### ######## ############# #####################
##
snit::type ::vc::fossil::import::cvs::option {
@@ -75,12 +76,59 @@
Validate
return
}
# # ## ### ##### ######## #############
- ## Internal methods and state
+ ## Internal methods, printing information.
+
+ proc PrintHelp {} {
+ global argv0
+ trouble info "Usage: $argv0 $usage"
+ trouble info ""
+ trouble info " Information options"
+ trouble info ""
+ trouble info " -h, --help Print this message and exit with success"
+ trouble info " --help-passes Print list of passes and exit with success"
+ trouble info " --version Print version number of $argv0"
+ trouble info ""
+ # --project, --cache
+ # ...
+ exit 0
+ }
+
+ proc PrintHelpPasses {} {
+ trouble info ""
+ trouble info "Conversion passes:"
+ trouble info ""
+ set n 0
+ foreach {p desc} {
+ CollectAr {Collect archives}
+ CollectRev {Collect revisions}
+ } { trouble info " [format %2d $n]: $p $desc" ; incr n }
+ trouble info ""
+ exit 0
+ }
+
+ proc PrintVersion {} {
+ global argv0
+ set v [package require vc::fossil::import::cvs]
+ trouble info "$argv0 v$v"
+ exit 0
+ }
+
+ proc Usage {{text {}}} {
+ global argv0
+ if {$text ne ""} {set text \n$text}
+ trouble fatal "Usage: $argv0 $usage$text"
+ # Not reached
+ return
+ }
+
+ # # ## ### ##### ######## #############
+ ## Internal methods, command line processing
+ typevariable usage "?option ?value?...? cvs-repository-path"
typevariable nocvs " The cvs-repository-path is missing."
typevariable badoption " Bad option "
typevariable gethelp " Use --help to get help."
proc IsOption {av _ ov} {
@@ -97,20 +145,15 @@
set v [lindex $arguments 0]
set arguments [lrange $arguments 1 end]
return $v
}
+ # # ## ### ##### ######## #############
+ ## Internal methods, state validation
+
proc Validate {} {
return
- }
-
- proc Usage {{text {}}} {
- global argv0
- if {$text ne ""} {set text \n$text}
- #trouble fatal "Usage: $argv0 ?option ?value?...? cvs-repository-path$text"
- puts "Usage: $argv0 ?option ?value?...? cvs-repository-path$text"
- exit 1
}
# # ## ### ##### ######## #############
## Configuration
@@ -117,12 +160,16 @@
pragma -hasinstances no ; # singleton
pragma -hastypeinfo no ; # no introspection
pragma -hastypedestroy no ; # immortal
# # ## ### ##### ######## #############
+}
+
+namespace eval ::vc::fossil::import::cvs::option {
+ namespace import ::vc::tools::trouble
}
# # ## ### ##### ######## ############# #####################
## Ready
package provide vc::fossil::import::cvs::option 1.0
return
Added tools/cvs2fossil/lib/log.tcl version [dd3a2d5171]
@@ -1,1 +1,164 @@
+## -*- 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, basic user feedback
+
+# # ## ### ##### ######## ############# #####################
+## Requirements
+
+package require Tcl 8.4 ; # Required runtime
+package require snit ; # OO system.
+
+# # ## ### ##### ######## ############# #####################
+##
+
+snit::type ::vc::tools::log {
+ # # ## ### ##### ######## #############
+ ## Public API, Methods
+
+ # Write the message 'text' to log, for the named 'system'. The
+ # message is written if and only if the message verbosity is less
+ # or equal the chosen verbosity. A message of verbosity 0 cannot
+ # be blocked.
+
+ typemethod write {verbosity system text} {
+ if {$verbosity > $myloglevel} return
+ uplevel #0 [linsert $mylogcmd end write [System $system] $text]
+ return
+ }
+
+ # Similar to write, especially in the handling of the verbosity,
+ # to drive progress displays. It signals that for some long
+ # running operation we are at tick 'n' of at most 'max' ticks. An
+ # empty 'max' indicates an infinite progress display.
+
+ typemethod progress {verbosity system n max} {
+ if {$verbosity > $myloglevel} return
+ uplevel #0 [linsert $mylogcmd end progress [System $system] $n $max]
+ return
+ }
+
+ # # ## ### ##### ######## #############
+ # Public API, Administrative methods
+
+ # Set verbosity to the chosen 'level'. Only messages with a level
+ # less or equal to this one will be shown.
+
+ typemethod verbosity {level} {
+ if {$level < 1} {set level 0}
+ set myloglevel $level
+ return
+ }
+
+ typemethod verbose {} {
+ incr myloglevel
+ return
+ }
+
+ typemethod quiet {} {
+ if {$myloglevel < 1} return
+ incr myloglevel -1
+ return
+ }
+
+ # Query the currently set verbosity.
+
+ typemethod verbosity? {} {
+ return $myloglevel
+ }
+
+ # Set the log callback handling the actual output of messages going
+ # through the package.
+
+ typemethod command {cmdprefix} {
+ variable mylogcmd $cmdprefix
+ return
+ }
+
+ # Register a system name, to enable tabular formatting. This is
+ # done by setting up a format specifier with a proper width. This
+ # is handled in the generation command, before the output callback
+ # is invoked.
+
+ typemethod register {name} {
+ set nlen [string length $name]
+ if {$nlen < $mysyslen} return
+ set mysyslen $nlen
+ set mysysfmt %-${mysyslen}s
+ return
+ }
+
+ # # ## ### ##### ######## #############
+ ## Internal, state
+
+ typevariable myloglevel 2 ; # Some verbosity, not too much
+ typevariable mylogcmd ::vc::tools::log::OUT ; # Standard output to stdout.
+ typevariable mysysfmt %s ; # Non-tabular formatting.
+ typevariable mysyslen 0 ; # Ditto.
+
+ # # ## ### ##### ######## #############
+ ## Internal, helper methods (formatting, dispatch)
+
+ proc System {s} {
+ upvar 1 mysysfmt mysysfmt
+ return [format $mysysfmt $s]
+ }
+
+ # # ## ### ##### ######## #############
+ ## Standard output callback, module internal
+
+ # Dispatch to the handlers of the possible operations.
+
+ proc OUT {op args} {
+ eval [linsert $args 0 ::vc::tools::log::OUT/$op]
+ return
+ }
+
+ # Write handler. Each message is a line.
+
+ proc OUT/write {system text} {
+ puts "$system $text"
+ return
+ }
+
+ # Progress handler. Uses \r to return to the beginning of the
+ # current line without advancing.
+
+ proc OUT/progress {system n max} {
+ if {$max eq {}} {
+ puts -nonewline "$system $n\r"
+ } else {
+ puts -nonewline "$system [format %[string length $max]s $n]/$max\r"
+ }
+ flush stdout
+ return
+ }
+
+ # # ## ### ##### ######## #############
+ ## Configuration
+
+ pragma -hasinstances no ; # singleton
+ pragma -hastypeinfo no ; # no introspection
+ pragma -hastypedestroy no ; # immortal
+
+ # # ## ### ##### ######## #############
+}
+
+namespace eval ::vc::tools {
+ namespace export log
+}
+
+# -----------------------------------------------------------------------------
+# Ready
+package provide vc::tools::log 1.0
+return
Modified tools/cvs2fossil/lib/pkgIndex.tcl from [5b7b443336] to [6725ddc053].
@@ -3,5 +3,7 @@
## Index of the local packages required by cvs2fossil
# # ## ### ##### ######## ############# #####################
if {![package vsatisfies [package require Tcl] 8.4]} return
package ifneeded vc::fossil::import::cvs 1.0 [list source [file join $dir cvs2fossil.tcl]]
package ifneeded vc::fossil::import::cvs::option 1.0 [list source [file join $dir c2f_option.tcl]]
+package ifneeded vc::tools::trouble 1.0 [list source [file join $dir trouble.tcl]]
+package ifneeded vc::tools::log 1.0 [list source [file join $dir log.tcl]]
Added tools/cvs2fossil/lib/trouble.tcl version [fdf622fa20]
@@ -1,1 +1,94 @@
+## -*- 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 fatal {text} {
+ lappend myfatal $text
+ exit 1
+ }
+
+ 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
+ }
+
+ # # ## ### ##### ######## #############
+ ## 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