Fossil

Check-in [d57b7b4a05]
Login

Check-in [d57b7b4a05]

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Re-added the user feedback and error reporting utilities, with modifications, and completed the handling of the informational options.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: d57b7b4a05e30c09737c989fb3c5772a5842bd3e
User & Date: aku 2007-10-02 05:33:09.000
Context
2007-10-02
06:48
Added the pass management, integrated with application and option processor. ... (check-in: 5911515322 user: aku tags: trunk)
05:33
Re-added the user feedback and error reporting utilities, with modifications, and completed the handling of the informational options. ... (check-in: d57b7b4a05 user: aku tags: trunk)
03:05
Third attempt at getting a cvs importer which can handle branches. Using cvs2svn code and design notes as a guide. ... (check-in: 2a98ac44bd user: aku tags: trunk)
Changes
Unified Diff Ignore Whitespace Patch
Changes to tools/cvs2fossil/lib/c2f_option.tcl.
︙︙
15
16
17
18
19
20
21
22

23
24
25
26
27
28
29

## other pieces of the system and handled there, via option
## delegation

# # ## ### ##### ######## ############# #####################
## Requirements

package require Tcl 8.4                         ; # Required runtime.
package require snit                            ; # OO system


# # ## ### ##### ######## ############# #####################
## 

snit::type ::vc::fossil::import::cvs::option {
    # # ## ### ##### ######## #############
    ## Public API, Options.








|
>








15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30

## other pieces of the system and handled there, via option
## delegation

# # ## ### ##### ######## ############# #####################
## Requirements

package require Tcl 8.4                         ; # Required runtime.
package require snit                            ; # OO system.
package require vc::tools::trouble              ; # Error reporting.

# # ## ### ##### ######## ############# #####################
## 

snit::type ::vc::fossil::import::cvs::option {
    # # ## ### ##### ######## #############
    ## Public API, Options.
︙︙
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
125
126
127
128

	#cvs::repository setbase [lindex $arguments 0]

	Validate
	return
    }

    # # ## ### ##### ######## #############
    ## Internal methods and state
















































    typevariable nocvs     "       The cvs-repository-path is missing."
    typevariable badoption "       Bad option "
    typevariable gethelp   "       Use --help to get help."

    proc IsOption {av _ ov} {
	upvar 1 $av arguments $ov option
	set candidate [lindex $arguments 0]
	if {![string match -* $candidate]} {return 0}
	set option    $candidate
	set arguments [lrange $arguments 1 end]
	return 1
    }

    proc Value {av} {
	upvar 1 $av arguments
	set v         [lindex $arguments 0]
	set arguments [lrange $arguments 1 end]
	return $v
    }




    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

    pragma -hasinstances   no ; # singleton
    pragma -hastypeinfo    no ; # no introspection
    pragma -hastypedestroy no ; # immortal

    # # ## ### ##### ######## #############
}





# # ## ### ##### ######## ############# #####################
## Ready

package provide vc::fossil::import::cvs::option 1.0
return








|

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>




















>
>
>




<
<
<
<
<
<
<
<









>
>
>
>







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
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156








157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175

	#cvs::repository setbase [lindex $arguments 0]

	Validate
	return
    }

    # # ## ### ##### ######## #############
    ## 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} {
	upvar 1 $av arguments $ov option
	set candidate [lindex $arguments 0]
	if {![string match -* $candidate]} {return 0}
	set option    $candidate
	set arguments [lrange $arguments 1 end]
	return 1
    }

    proc Value {av} {
	upvar 1 $av arguments
	set v         [lindex $arguments 0]
	set arguments [lrange $arguments 1 end]
	return $v
    }

    # # ## ### ##### ######## #############
    ## Internal methods, state validation

    proc Validate {} {
	return
    }









    # # ## ### ##### ######## #############
    ## Configuration

    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. 










































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

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
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
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
Changes to tools/cvs2fossil/lib/pkgIndex.tcl. 
1
2
3
4
5
6
7



# # ## ### ##### ######## ############# #####################
## Package management.
## 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]]










>
>

1
2
3
4
5
6
7
8
9

# # ## ### ##### ######## ############# #####################
## Package management.
## 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. 






























































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

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

## -*- 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