Index: fsl ================================================================== --- fsl +++ fsl @@ -4,21 +4,61 @@ # Copyright (c) 2012, Marc Simpson (ISC, see LICENSE) # --( Aliases and Filters )--------------------------------------------- namespace eval config { + variable dbglvl 0; # debug level + variable reset 0; # 1/0: do/don't recreate config file + variable grepflags ;# needed to pass around info needed by `fixGrep' + set aliases {} set filters {}; # registered filters set commands {}; # registered interceptors + + proc manpage {} { + set mantext { + ---------------------------------------------------------- + fsl -- a wrapper for the `fossil' revision control system. + ---------------------------------------------------------- + + This manpage is work in progress. Currently, only some usage hints + and explanation of pitfalls are given. + + 1. The `fsl' resource file: + `fsl' uses the resource file `~/.fslrc' in the user's home directory + which contains the recognized alias and filter definitions. The + file is auto-generated if not yet existing using the defaults as + defined in the `fsl' source code. Note that `.fslrc' does thus not + change automatically if `fsl' is updated (and might include + desirable changes to the default version of `.fslrc'). Regeneration + of `.fslrc' can be enforced by calling `fsl -reset'. + + 2. Getting help: + Issuing `fsl help COMMAND' works for all `fossil' commands as well + as for the command interceptors defined by `fsl' (see the wiki + for further information). Currently these are: + - alias + - wrapper + - df + + Issuing `fsl -help' provides a short help text for the `fsl' specific + options. + } + return $mantext + } proc init {filename} { - if {[file exists $filename]} { + set myname $::argv0 + if { [file exists $filename] && ${::config::reset} == 0 } { + # an existing config file is used only if the `-reset' + # option is not used. otherwise it's recreated set conf [read [open $filename]] } else { set conf [unindent_script $config::defaults] puts "(Creating $filename)" puts [open $filename w] $conf + if { ${::config::reset} == 1 } {exit 0} } uplevel #0 [list namespace eval config::fslrc $conf] } } @@ -27,11 +67,11 @@ set caller_ns [uplevel 1 {namespace current}] set namespaced "${caller_ns}::$name" uplevel 1 [list proc $name line $body] foreach command_spec $commands { foreach command [triggers_for $command_spec] { - dict append config::filters $command " $namespaced" + dict append config::filters $command "$namespaced " } } } proc alias {spec target} { @@ -38,64 +78,157 @@ foreach name [triggers_for $spec] { dict set config::aliases $name $target } } +# config::defaults defines the default content of `$rcfile' via +# a long string. +# # Utility function usage: # # alias ? help # # filter indent help { # return "\t$line" # } set config::defaults { - # -*-tcl-*- + # configuration file for the `Fossil SCM' wrapper script `fsl'. + # this file might be modified but changes are not guaranteed + # to be permanent: the file is regenerated if it is older + # than the script file for `fsl' (which will happen + # each time the script file itself is edited). # -- Aliases: alias . changes - alias d diff + alias .. {changes --differ} alias , ui - alias log timeline + alias ahelp {test-all-help} + alias alog {timeline -t ci -n 0} + alias b branch + alias d diff + alias dd {df -tk} + alias de descendants + alias desc descendants + alias di diff + alias elog {timeline -t ci -n 0 -v} + alias f {finfo} + alias fb {finfo -b} + alias fi {finfo} + alias flog {finfo} alias heads leaves; # for hg refugees + alias log {timeline -t ci} + alias not {extras --dotfiles --ignore {}} + alias s {changes --differ} ;# instead of redundant `show' interceptor... + alias t {timeline -t ci} + alias ticks {ticket show 1} + alias time {timeline} # -- Filters: - filter status {changes status timeline add rm addremove} { + filter status { + add + addremove + changes + info + redo + rm + search + status + undo + up + } { lassign [split [string trim $line]] status - switch $status { - MERGED_WITH { coloured purple $line } - ADDED { coloured green $line } - EDITED { coloured cyan $line } - DELETED { coloured red $line } - default { set line } - } - } - - filter log_entry {leaves timeline} { - if {[regexp "^=== .* ===" $line]} { - coloured blue $line - } else { - regsub -all {\[[A-Fa-f0-9]+\]} $line [coloured yellow &] + switch -regexp $status { + MERGED_WITH { coloured purple $line } + UPDATED_BY_MERGE { coloured blue $line } + ADDED { coloured green $line } + EDITED { coloured blue $line } + EXTRA { coloured magenta $line } + DELETED { coloured red $line } + IGNORED { coloured yellow $line } + MISSING { coloured cyan $line } + UPDATE { coloured red $line } + REMOVE { coloured blue $line } + UNDO { coloured blue $line } + REDO { coloured red $line } + NEW { coloured magenta $line } + RENAMED { coloured green $line } + ^(checkout|parent|merged-(from|into)): { + set date_rx {([a-f\d]{40} )(\d{4}-\d{2}-\d{2})} + set artifact_rx {[a-f\d]{4}} + regsub $date_rx $line \\1[coloured blue \\2] line + regsub $artifact_rx $line [coloured red &] + } + tags: { + regsub {(^tags:[ ]+)(.*)} $line [coloured yellow \\1][coloured cyan \\2] + } + comment: { + append colorized "[coloured blue \\1\\2]\\3" + append colorized "[coloured yellow \\4]" + append colorized "[coloured green \\5]\\6" + regsub {(^comment:[ ]+)(.*)(\()(user:)(.*)(\))} $line $colorized line + # if it is a multi-line comment (and previous regsub is a no-op) we + # at least colorize the `comment' keyword: + regsub {(^comment:[ ]+)} $line [coloured blue \\1] + } + changes: { + if {[regexp {^changes:[ ]+None. Already up-to-date} $line]} then { + regsub {(^changes:[ ]+)(.*)} $line [coloured green &] + } else { + regsub {(^changes:[ ]+)(.*)} $line [coloured red &] + } + } + default { set line } } } - # Filter on alias `d' instead of `diff' so that output can be - # redirected to create patch files. - filter diff {d} { + filter colorizeOutput {finfo leaves status} { + # this used to be `fancy_timeline'. but is now used much less + # since most of the work is relocated to `reformTimeline' + # the regex/regsubs below could be tidied up, accordingly... + # + # Expressions to match: + set revnum_rx {(\]:)(\d+)} + set artifact_rx {\[([a-f\d]{4})([a-f\d]{2,}\]*)\]} + set date_rx {(^|\n|([ ]*\(\d+\) ))((=== )?\d{4}-\d\d-\d\d( ===)?)} + set time_rx {\d\d:\d\d:\d\d (UTC)?} + set current_rx {\*CURRENT\*} + set frkmrg_rx {\*(FORK|MERGE|BRANCH)\*} + # Colour the output (repeated substitutions on $line): + set line [regsub $date_rx $line \\2[coloured blue \\3\\6]] + set line [regsub $time_rx $line [coloured yellow &]] + set line [regsub $revnum_rx $line \\1[coloured magenta \\2]] + set line [regsub $artifact_rx $line [format {[%s%s]} [coloured red {\1}] {\2}]] + set line [regsub $current_rx $line [display reversed &]] + set line [regsub $frkmrg_rx $line [display underscored &]] + set line [regsub {(user: )([A-Za-z][-_.A-Za-z0-9]*)} $line [coloured yellow \\1][coloured green \\2]] + set line [regsub {((tags|branch):)(( [A-Za-z][-_,.A-Za-z0-9 ]*)|(\n))} $line [coloured yellow \\1][coloured cyan \\4\\5]] + regsub {(artifact: )} $line [coloured yellow &] + } + + # Filter only on aliases of `diff' but not the original command so that + # the latter's output can be redirected to create patch files. + filter diff {d di} { switch -regexp $line { - {^-} { coloured red $line } - {^\+} { coloured green $line } - {^@@} { coloured yellow $line } - default { set line } + {^-} { coloured red $line } + {^\+} { coloured green $line } + {^@@} { coloured yellow $line } + {^ADDED} { coloured blue $line } + {^DELETED} { coloured red $line } + default { set line } } } filter highlight_branch {branch} { - expr {[regexp {^\* } $line] ? [coloured yellow $line] : $line} + expr {[regexp {^\* } $line] ? [coloured red $line] : $line} } + + # ensure that (otherwise preprocessed) output reaches stdout even + # if no other filter is processing these commands. + filter passthrough {descendants timeline} {set line} # vim: ft=tcl } # --( Alias expansion )------------------------------------------------- @@ -128,37 +261,10 @@ # Prevent broken pipe error from propagating: catch {puts -nonewline $line} } } -# --( Interceptors )---------------------------------------------------- - -# - Interceptors can refer to the current parameter list via an -# implicitly defined $params variable in their bodies. (See `Builtin -# interceptors' below for usage.) -# -# - If an interceptor returns an empty list, the wrapper is expected -# to exit without calling Fossil, thereby fully intercepting the -# query. Otherwise, it acts as a pre-processor: the returned list is -# treated as a revised parameter list and will be supplied to -# `fossil'. - -proc interceptor {command_spec body} { - set fn [list {params} $body [uplevel 1 {namespace current}]] - foreach command [triggers_for $command_spec] { - dict set config::commands $command $fn - } -} - -proc intercept {params} { - set command [first $params] - if {[interceptor? $command]} { - return [apply [dict get $config::commands $command] $params] - } - return $params -} - # --( Command triggers )------------------------------------------------ proc prefixes {xs {start 0}} { # Return the prefix list of string $xs. for {set right $start} {$right < [string length $xs]} {incr right} { @@ -203,29 +309,48 @@ proc first {xs} { lindex $xs 0 } -proc interactive? {command} { - # Check whether the supplied command requires user interaction - # from the outset: - switch -re $command { - ^(stas|stash)$ { return true } - ^(ci|com|comm|commi|commit)$ { return true } - ^(sq|sql|sqli|sqlit|sqlite|sqlite3)$ { return true } - default { return false } - } +proc last {xs} { + lindex $xs end +} + +proc interactive? {params} { + # Check whether the supplied command requires user interaction from + # the outset. some commands only need interaction for special + # options so it is not sufficient to just test for command name in + # this case (currently the only example I'm aware of is + # "amend -e"). + + # define a regexp pattern identifying the option bearing + # commands (and their valid abbreviations) that need interaction. + # append further commands to the pattern via alteration (logical + # OR)): + append needInteraction {^(am(e(nd?)?)?.* (-e|--edit-comment)( |$))} + + if {[regexp $needInteraction $params]} { + return true + } else { + set command [first $params] + switch -re $command { + ^(stas|stash)$ { return true } + ^(ci|com|comm|commi|commit)$ { return true } + ^(sq|sql|sqli|sqlit|sqlite|sqlite3)$ { return true } + default { return false } + } + } } proc spawned_errno {{spawn_id -1}} { catch {wait -i $spawn_id} result_list lindex $result_list 3 } proc unindent_script {script} { regexp "^ *" [set trimmed [string trim $script \n]] indent - regsub -line -all "^$indent" $trimmed "" + regsub -line -all "^$indent" $trimmed {} } proc ansi {mode table text} { if {[dict exists $table $mode]} { set code [dict get $table $mode] @@ -243,99 +368,1183 @@ ansi $mode $modes $text } proc coloured {colour text} { set colours { - black 30 red 31 green 32 - yellow 33 blue 34 purple 35 - magenta 35 cyan 36 grey 37 + black 0;30 + blue 0;34 + bluebold 1;34 + cyan 0;36 + green 0;32 + grey 0;37 + magenta 0;35 + magentabold 1;35 + purple 0;35 + red 0;31 + redbold 1;31 + yellow 0;33 + } ansi $colour $colours $text } proc alias? {name} { dict exists $config::aliases $name } + proc filter? {name} { dict exists $config::filters $name } + proc interceptor? {name} { dict exists $config::commands $name } -# --( Builtin interceptors )-------------------------------------------- - -interceptor wr:wrapper { - set fmt "=> %s:\n %s" - puts [format $fmt "Aliases" [dict keys $config::aliases]] - puts [format $fmt "Filters" [dict keys $config::filters]] - puts [format $fmt "Interceptors" [dict keys $config::commands]] +proc reformTimeline {lines revnums command} { + #----------------------------------------- + proc map {lambda list} { + set result {} + foreach item $list { + lappend result [apply $lambda $item] + } + return $result + } + #----------------------------------------- + if {$::config::dbglvl > 98} then {set origlines $lines} + + # join all lines to enable matching patterns across line boundaries: + set timeline [join $lines ""] + + set rgxdate {(\d{4}-\d\d-\d\d)} + set rgxtime {(\d\d:\d\d:\d\d)} + set rgxsha1 {(\[[a-f\d]{6,}\])} + + set rgxtimd {} + set rgxdatehead {} + set rgxrev {} + append rgxtimd {(^|\n)} "\($rgxtime|$rgxdate\)" + append rgxdatehead {(^|\n)(=== )} $rgxdate {( ===)(\n)} + set rgxarti {(\[)([a-f\d]{4})([a-f\d]{2,}\])(:)([0-9-]+)} + append rgxrev $rgxtimd { } $rgxsha1 + set rgxuser {( \()(user:( |(\n\s+)))([^\s]+)} + set rgxtags {( (tags|branch):)([^)]+)(\))} + set rgxcurr {\*CURRENT\*} + set rgxfmbr {\*(FORK|MERGE|BRANCH)\*} + + set p1 {(--- (line|entry) limit \([0-9]+\) reached ---)} + set p2 {(\+\+\+ (end of timeline|no more data) \([0-9]+\) \+\+\+)} + set rgxlast (\n)($p1|$p2) + + set cinum [dict size $revnums] + set ciwid [string length $cinum] + set na [string repeat - $ciwid] + + # note to self: remember that `regexp -all -inline' returns a flat list of + # full matches plus all submatches to captured patterns (five in + # the present case). since we are interested only in the last submatch we + # have to pick every sixth element from this list: + # + set matches [regexp -all -inline $rgxrev $timeline] + foreach {0 1 2 3 4 sha1} $matches {lappend revs $sha1} + + foreach rev $revs { + # determine chronological revision number: + if {[catch {dict get $revnums $rev} numrev]} { + set numrev $na + } else { + set na [string repeat - [string length $numrev]] + } + dict set numrevs $rev :$numrev + } + + # append chronological revision numbers to sha1 hashes. in order + # to keep this reasonably fast on large repos, we do *not* use + # thousands of `regsub' calls on the whole timeline but rather + # perform those only on a per-line basis and join everything + # afterwards. + + set timeline {} + foreach line $lines { + if {[regexp $rgxrev $line {} {} {} {} {} sha1rev]} { + set val [dict get $numrevs $sha1rev] + regsub $rgxrev $line &$val line + } + append timeline $line + } + + array set colors { + descendants yellow + finfo blue + search yellow + timeline yellow + + } + set timdcol $colors($command) + + # colorize + regsub -all $rgxdatehead $timeline \\1[coloured blue {\2\3\4}]\\5 timeline + regsub -all $rgxtimd $timeline \\1[coloured $timdcol \\2] timeline + regsub -all $rgxarti $timeline \\1[coloured red \\2]\\3\\4[coloured magenta \\5] timeline + regsub -all $rgxuser $timeline \\1[coloured yellow \\2][coloured green \\5] timeline + regsub -all $rgxtags $timeline [coloured yellow \\1][coloured cyan \\3]\\4 timeline + regsub $rgxcurr $timeline [display bright &] timeline + regsub -all $rgxfmbr $timeline [display underscored &] timeline + regsub $rgxlast $timeline [display reversed &] timeline + + set timeline [string trimright $timeline "\n"] + set lines [split $timeline "\n" ] + set lines [map {x {set x "$x\n"}} $lines] + + if {$::config::dbglvl > 98} then { + for {set i 0} {$i < [llength $lines]} {incr i} { + catch {puts "IN: >[lindex $origlines $i]<"} + catch {puts "OU: >[lindex $lines $i]<"} + } + } + + return $lines +} + +proc reformFinfo-b {lines revnums} { +#-------------------------------------------------- +# `finfo -b' needs some special treatment prior to +# further filtering/colorizing +#-------------------------------------------------- + set out {} + set rgxrev {^([a-f\d]{6,})} + set cinum [dict size $revnums] + set ciwid [string length $cinum] + + foreach line $lines { + set words [split $line] + + set rev [lindex $words 0] + set date [lindex $words 1] + set user [lindex $words 2] + set branch [lindex $words 3] + + if { [regexp $rgxrev $rev] } { + set rev "\[$rev\]" + # hopefully, all these are still on the same line ...: + set date [coloured blue $date] + set user [coloured green $user] + set branch [coloured cyan $branch] + } + if {![catch {set numrev [dict get $revnums $rev]}]} { + set rev "$rev:$numrev" + } + set words [lreplace $words 0 3 $rev $date $user $branch] + set line [join $words] + lappend out $line\n + } + return $out +} + +proc computeRevnums {params} { +#----------------------------------------------------------------------- +# generate a dictionary of SHA1 keys vs. revision numbers +#----------------------------------------------------------------------- + set revcnt 0 + set numrev 0 + set rgxtime {^\d\d:\d\d:\d\d} + set rgxrev {\[([a-f\d]{6,})([^\]]*)\]} + set rgxrepo {\-R\s+.+} + set repo {} + + regexp $rgxrepo $params repo + if { [catch {exec fossil timeline -t ci -n 0 -W 0 {*}$repo} timeline] } { + puts $timeline + exit 1 + } + set lines [split $timeline \n] + + foreach line $lines { + if {[regexp $rgxtime $line]} { incr numrev } + } + foreach line $lines { + if {[regexp $rgxtime $line]} { + incr revcnt + regexp $rgxrev $line rev + dict set revnums $rev [expr {$numrev - $revcnt}] + } + } + return $revnums +} + +proc fixGrep {lines params grepflags} { + set fname [last $params] + set finfo [lrange [split [exec fossil finfo -W 0 $fname] \n] 1 end] + set rgxdate {^\d{4}-\d\d-\d\d} + set rgxhash {\[([a-f\d]{6,})\]} + foreach line $finfo { + regexp "$rgxdate $rgxhash" $line _ cihash + regexp ", artifact: $rgxhash, branch: .*\\)" $line _ fhash + # an artifact 'fhash' can be part of multiple checkins. so we + # have to collect all of them via `dict lappend' + dict lappend cihashes $fhash \[$cihash\] + } + # a hack to account for fossil grep not honouring hash-digits setting, start + # presuming that hash-digits <= 10 (as used by grep output) + set hashlen [string length [lindex $cihashes 0]] + # a hack to account for fossil grep not honouring hash-digits setting, end + + set revnums [computeRevnums {}] + set f1 [last $grepflags] + set f2 [first $grepflags] + if {$f1 + $f2 > 0} { + set buf $lines + set lines {} + if {$f1} { lappend lines [first $buf] } + if {$f2} { lappend lines [last $buf] } + } + set greppat [lindex $params end-1] + set checkincols {blue green} + set idx 0 + set lastrev 0 + foreach line $lines { + # need to separate file hash and line number to match `greppat' + # against the real line content (so that anchoring of the + # pattern works and spurious coloring of hash or line number + # is prevented). + set field [split $line :] + set fhash [string trimright [first $field]] + set lino [lindex $field 1] + set line [join [lrange $field 2 end]] + set cihash [dict get $cihashes [string range $fhash 0 $hashlen-1]] + set revnum {} + foreach hash $cihash { + append revnum [dict get $revnums $hash] " " + } + set revnum [join $revnum ,] + regsub -all "$greppat" $line [coloured redbold &] line + # for now, we just preprend the chronological revision numbers + # and add a bit of colour + if {[lindex $revnum end] != $lastrev} { set idx [expr {1 - $idx}] } + set col [lindex $checkincols $idx] + set buf [coloured magenta $revnum]:[coloured $col $fhash] + if {[llength $field] > 1} { + append buf :[coloured cyan $lino]:$line + } else { append buf \n } + lappend out $buf + set lastrev [lindex $revnum end] + } + return $out +} + +proc adjustWidth params { + set widopt {} + regexp -- {(timeline|finfo|search|descendants).*(-W)} $params widopt + if {$widopt == ""} then { + # determine total number of checkins for computation of required + # additional space. the following works for the current format of + # `fossil info' output... + + set rgxrepo {\-R\s+.+} + set repo {} + regexp $rgxrepo $params repo + if {[catch {set fslinfo [exec fossil info {*}$repo]}]} { + return $params + } + + # we need to ensure that the `fslinfo' string is a valid Tcl list. + # this is not guaranteed a priori (e.g. `this is my "string"definition' + # would fail. so we first explicitly split it: + set fslinfo [split $fslinfo] + + set numrev [lindex $fslinfo end]; #tot. no. of checkins + set numrev [expr $numrev - 1]; #ordinal no. of last checkin + + if {[regexp {finfo.*-b} $params]} then { + set more 3; #added two brackets plus colon + } else { + set more 1; #added only one colon + } + + set size [exec stty size] + set cols [lindex $size end] + set need [expr [string length $numrev] + $more] + set width [expr $cols - $need] + + regsub {timeline|finfo|search|descendants} $params "& -W $width" params + # we need do undo the -W insertion in case we are dealing with + # `finfo -p' + regsub {(finfo)( -W .*)( -p)(.*)} $params "\\1\\3\\4" params + } + return $params +} + +proc processoptions argv { + # a `package require cmdline' sometimes can take ages for the lookup + # of the location if not yet cached (problem encountered under OSX + # at some point). we try to avoid this by assuming `tcllib' is + # located in its canonical location (i.e. has the same parent dir + # as `tcl_library') and use the explicit path for trying to source + # `cmdline.tcl' directly before resorting to `package require'. + # whether this workaround continues to make sense is not quite + # sure but it does no harm either ... + + set status [catch { + set dname [file dirname $::tcl_library] + set dir [lindex [lsort -dictionary [glob -directory $dname "*tcllib*"]] 0] + source [file join $dir cmdline cmdline.tcl] + }] + if {$status != 0} { package require cmdline } + + set progid [::cmdline::getArgv0] + + set knownoptions { + { reset "Recreate the default `~/.fslrc' config file by overwriting the existing one." } + { man "Some day this might show a comprehensive manpage. Currently only some usage hints."} + { debug.arg 0 "Set debug level. The default is:" } + } + + set usage "-- a `fossil' wrapper script. + + Calling syntax: + + `$progid' {options} command {command_options} {file(s)} + + where `command' is either one of the `$progid'-specific alias definitions + or command interceptors or a native `fossil' command. + + Options recognized by `$progid': + + " + + # `getoptions' raises error even when called with `-help'. this is + # irritating, so we work around it ... + if { [catch {::cmdline::getoptions argv $knownoptions $usage} optlist] } { + if { [string length $argv] } { + puts "[lindex $argv 0]: invalid option, see `fsl -help'. Giving up" + exit 1 + } else { + # this should be `fsl -help' + puts $optlist + exit + } + } + + ## puts $optlist + ## set optdict [dict create {*}$optlist] + ## array set optar $optlist + + # remember: `getoptions returns the options list unordered. + # the ordering used during the call is not maintained. + foreach {opt val} $optlist { + switch $opt { + debug { set ::config::dbglvl $val } + reset { set ::config::reset $val } + man { if {$val == 1} { puts [config::manpage] } } + } + } + + # needs separate loop due to ordering problem + if { $::config::dbglvl > 2 } { + foreach {opt val} $optlist { puts "*** option `-$opt' has value: $val" } + } + + return $argv +} + +# --( Interceptors )---------------------------------------------------- + +# - Interceptors can refer to the current parameter list via an +# implicitly defined $params variable in their bodies. (See `Builtin +# interceptors' below for usage.) +# +# - If an interceptor returns an empty list, the wrapper is expected +# to exit without calling Fossil, thereby fully intercepting the +# query. Otherwise, it acts as a pre-processor: the returned list is +# treated as a revised parameter list and will be supplied to +# `fossil'. +# +# rephrased: +# interceptor modifies `params' (the current command line arguments +# of the `fsl' call) and returns the modified list which is then +# used in further processing and the final call to `fossil'. if +# the interceptor returns nothing, `fsl' exits immediately. +# in this case the only performed actions are those executed +# by the interceptor itself. +# + +proc interceptor {command_spec body} { + # cf. `apply' documentation: the anonymous function for `apply' + # has to be specified in the form {args body namespace} where + # `args' spefifies the formal arguments of the function. in the + # present case `args' is identical to `params'. in the current setup + # the `namespace' argument is apparently redundant and could be + # ommitted: + + set fn [list {params} $body [uplevel 1 {namespace current}]] + + foreach command [triggers_for $command_spec] { + # this loop sets up the dictionary `config::commands' whose + # keys are the known interceptor commands and whose values are + # the corresponding anonymous function definitions. note that each + # alternate name in `command_spec' (e.g., a, ali, alias etc.) + # generates a further entry (with identical value). + dict set config::commands $command $fn + } +} + +interceptor ig:ignore { +# ------------------------------------------------------------------------ +# report the list of files in the checkout currently ignored by `fossil' +# ------------------------------------------------------------------------ + set afilter ::config::fslrc::status + + if { [catch {exec fossil extras} pattern] } { + puts $pattern + exit 1 + } + regsub -all {\n} $pattern {|} pattern + if {$pattern != ""} { + set pattern "($pattern)"; #the required OR pattern + } + + catch {exec fossil extras --dotfiles --ignore ""} full + set full [split $full \n] + + set ignored {} + foreach line $full { + if {$pattern == "" | ![regexp $pattern $line]} { + set ignored "${ignored}IGNORED $line\n" + } + } + set ignored [string trimright $ignored] + + set ignored [split $ignored \n] + foreach line $ignored { + filter_with $afilter "$line\n" + } +} + +interceptor uvex { +# ------------------------------------------------------------------------ +# a wrapper around `fossil uv export' that stores all unversioned +# files under their canonical names relative to the local-root of the +# checkout. +# before using this command, a look at the `fossil uv ls' output might +# be helpful in order to avoid surprises (`fossil uv export' +# overwrites existing files without asking questions...). +# ------------------------------------------------------------------------ + if { [catch {exec fossil uv ls} uvfiles] } { + puts $uvfiles + exit 1 + } elseif {$uvfiles == ""} { + exit 0 + } else { + # as of now (2018-08-03), `fossil' enforces that the names of + # unversioned files do not contain blanks. but just in case + # this changes in the future, we explicitly split the list at + # newline characters to get a list of the names: + set uvfiles [split $uvfiles \n] + } + + # we need to construct absolute pathnames for the output files + # since it is not guaranteed that this command is issued only when + # being in the local root of the repo: + if { [catch {exec fossil status} report] } { + puts $report + exit 1 + } + regexp -line {^local-root:[ ]*(.*)$} $report {} localroot + + foreach name $uvfiles { + if { [catch {exec fossil uv export $name $localroot$name} msg] } { + puts $msg + exit 1 + } else { puts $localroot$name } + } +} + +interceptor ll { +# ------------------------------------------------------------------------ +# Provide `ls -v' output plus some eye candy +# ------------------------------------------------------------------------ + set afilter ::config::fslrc::status + + catch {exec fossil ls -v} lsrep + + set lsrep [split $lsrep \n] + foreach line $lsrep { + filter_with $afilter "$line" + puts "" + } +} + +interceptor st:status { + return [lreplace $params 0 0 status] +} + +interceptor clon:clone { +# ------------------------------------------------------------------------ +# Catch the case where `clone' is issued without the mandatory +# trailing FILENAME argument. If this happens a default name for the +# repo and checkout directory is constructed, a checkout directory is +# created (if not yet existing), and the repo is cloned and opened in +# this checkout directory. the name generation strategy is roughly as +# follows (for details, see the source code): +# +# * determine basename of URI +# * strip leading `.' and trailing `.'-separated extender from the basename +# * trim leading and trailing blanks, if any +# * replace remaining blanks by underscore +# * append "-fsl" +# * use resulting name as checkout directory and create it +# * clone repo into this directory under the invariant name `.fslrepo' +# +# Otherwise (if FILENAME is provided) just pass the call unmodified to +# fossil. +# ------------------------------------------------------------------------ + set defaultName .fslrepo + set params [lreplace $params 0 0 clone] + set hasOpts [regexp {^-} [lindex $params 1]] + if {!$hasOpts && [llength $params] == 3} { + # we do not want to parse all possible `clone' options properly, + # but this case (a call without options but two arguments...) + # clearly should be passed through to `fossil' unchanged. + return $params + } elseif {[catch {exec fossil {*}$params} msg]} { + # there might be other reasons for failure (e.g. a typo in + # URI specification in a call using options (that thus + # reaches this block) ...), but we confidentally assume that + # an error signals omission of the FILENAME argument expected + # by `clone' and thus the intention to automaticlly + # "clone+open" the repo using the described naming strategy. + set uri [lindex $params end] + set remoteName [lindex [file split $uri] end] + set checkout [split [string trimleft $remoteName .] .] + if {[llength $checkout] > 1} { + set checkout [lreplace $checkout end end] + } + set checkout [string trim [join $checkout]] + regsub {(.*)-fsl$} $checkout {\1} checkout + regsub -all { } $checkout {_} checkout + append checkout -fsl + if {[file exists $checkout]} { + puts "$checkout: file exists" + exit 1 + } + if {[catch {file mkdir $checkout} msg]} { + puts $msg + exit 1 + } else { + lappend params $checkout/$defaultName + puts "cloning to ./$checkout ..." + if {[catch {exec fossil {*}$params} msg]} { + puts $msg + exit 1 + } else { + if {[catch {exec fossil open $defaultName} msg]} { + puts $msg + exit 1 + } + } + } + } else { return $params } +} + +interceptor w:wrapper { +# ------------------------------------------------------------------------ +# This interceptor provides a compilation of the current aliases, filters, +# and interceptors. +# ------------------------------------------------------------------------ + # undo `span' expansion of the interceptors for this report + # (admittedly, this is a bit stupid...). first, pad the list with + # a trailing dummy so that the loop below processes correctly + append interceptors [lsort -dictionary [dict keys $config::commands]] " \034" + set start [lindex $interceptors 0] + set stop $start + set hit 0 + set out {} + foreach name [lrange $interceptors 1 end] { + if {[regexp \^$stop $name]} { + set stop $name + incr hit + } else { + if {$hit > 0} { + lappend out $start:$stop + } else { lappend out $start } + set start $name + set stop $start + set hit 0 + } + } + set fmt "=> %s:\n %s" + puts [format $fmt "Aliases" [lsort -dictionary [dict keys $config::aliases]]] + puts [format $fmt "Filters" [lsort -dictionary [dict keys $config::filters]]] + puts [format $fmt "Interceptors" $out] +} + +interceptor up { +# ---------------------------------------------------------------------------- +# The provided VERSION is tentatively interpreted as a chronological +# revision number for which a lookup of the corresponding SHA1 hash is tried. +# If such a hash exists it is used instead of VERSION in the call to +# `fossil up', if not, the provided VERSION is used (which in this case +# should itself be a SHA1 hash). +# Note: tentative interpretation of VERSION as chronological revison number +# takes precedence. If you actually mean the SHA1 hash you might need to +# provide a longer initial segment to disambiguate it (e.g. 1234 might not +# suffice if there are already so many checkins). +# ---------------------------------------------------------------------------- + set knownoptions { + { case-sensitive.arg "" "(BOOL) override case-sensitive setting" } + { debug "print debug information on stdout" } + { latest "acceptable in place of VERSION, update to latest version" } + { force-missing "force update if missing content after sync"} + { n "If given, display instead of run actions" } + { dry-run "If given, display instead of run actions" } + { v "print status information about all files" } + { verbose "print status information about all files" } + { W.arg "" " Width of lines (default is to + auto-detect). Must be >20 or 0 (= no limit, + resulting in a single line per entry)." } + + { width.arg "" " Width of lines (default is to + auto-detect). Must be >20 or 0 (= no limit, + resulting in a single line per entry)." } + {setmtime "Set timestamps of all files to match their SCM-side + times (the timestamp of the last checkin which modified + them)."} + } + set usage { + Use `fossil help up' to get real help for the `up' command. + The options accepted by `up' follow. + } + # `getoptions' raises error even when called with `-help'. this is + # irritating, so we work around it ... + set args0 [lreplace $params 0 0] + set cmd [first $params] + set args $args0 + if { [catch {::cmdline::getoptions args $knownoptions $usage} optlist] } { + if { [string length $args] } { + puts "[lindex $args 0]: invalid option, see `fossil help up'. Giving up" + exit 1 + } else { + # in case `fsl up -help' is issued ... + puts $optlist + exit + } + } + regsub $args $args0 {} opts + + set version [lindex $args 0] + if { $version != "" } then { + set hash2num [computeRevnums {}] + dict for {key val} $hash2num { + regexp {[a-f\d]{6,}} $key sha1 + dict set num2hash $val $sha1 + } + if {[dict exists $num2hash $version]} { + set version [dict get $num2hash $version] + set args [lreplace $args 0 0 $version] + } + } + set params "$cmd --setmtime $opts$args" + return $params +} + +interceptor am:amend { +# ---------------------------------------------------------------------------- +# The provided UUID is tentatively interpreted as a chronological +# revision number for which a lookup of the corresponding SHA1 hash is tried. +# If such a hash exists it is used instead of UUID in the call to +# `fossil amend', if not, the provided UUID is used (which in this case +# should itself be a SHA1 hash). +# Note: tentative interpretation of UUID as chronological revison number +# takes precedence. If you actually mean the SHA1 hash you might need to +# provide a longer initial segment to disambiguate it (e.g. 1234 might not +# suffice if there are already so many checkins). +# ---------------------------------------------------------------------------- + set hash2num [computeRevnums {}] + dict for {key val} $hash2num { + regexp {[a-f\d]{6,}} $key sha1 + dict set num2hash $val $sha1 + } + # we assume canonical use of `amend' as described in its manpage: + # uuid can be expected to be the first argument. + set uuid [lindex $params 1] + if {[dict exists $num2hash $uuid]} { + set version [dict get $num2hash $uuid] + set params [lreplace $params 1 1 $version] + } + return $params +} + +interceptor cat { +# ---------------------------------------------------------------------------- +# The provided VERSION is tentatively interpreted as a chronological +# revision number for which a lookup of the corresponding SHA1 hash is tried. +# If such a hash exists it is used instead of VERSION in the call to +# `fossil cat', if not, the provided VERSION is used (which in this case +# should itself be a SHA1 hash). +# Note: tentative interpretation of VERSION as chronological revison number +# takes precedence. If you actually mean the SHA1 hash you might need to +# provide a longer initial segment to disambiguate it (e.g. 1234 might not +# suffice if there are already so many checkins). +# ---------------------------------------------------------------------------- + set hash2num [computeRevnums {}] + dict for {key val} $hash2num { + regexp {[a-f\d]{6,}} $key sha1 + dict set num2hash $val $sha1 + } + + set rflagpos [lsearch $params {-r}] + set revnumpos [expr $rflagpos + 1] + set version [lindex $params $revnumpos] + + if {[dict exists $num2hash $version]} { + set version [dict get $num2hash $version] + set params [lreplace $params $revnumpos $revnumpos $version] + } + return $params +} + +interceptor ci|com:commit { +# ----------------------------------------------------------------------------- +# Adds a non-standard option `--exclude' to the `commit' command. The +# option might also be abbreviated down to `--ex' or specified as +# `-e'. The option takes as argument a comma-separated list of regexp +# patterns for selection of file names that should be excluded from +# the checkin (quote patterns as required to protect them from the +# shell). the patterns are matched against the list +# +# `fossil changes --changed --added --deleted --renamed -no-classify' +# +# and matching names are eliminated from the list. the remaining file +# names are appended to the end of the `fossil commit' call (after +# deleting the `--exclude' option and its argument). in case the +# append list is empty the checkin is aborted (since all changed files +# are explicitly excluded from the checkin). therefore, +# +# fsl commit -e foo foo +# +# might or might not procede, depending on whether there are further +# modified files around (and `fsl commit -e . foo' never succeeds...). +# generally, just don't use --exclude and explicit file names at the +# same time. +# ----------------------------------------------------------------------------- + set pos [lsearch -regexp $params {^-(e|-ex(c(l(u(de?)?)?)?)?)$}] + + if {$pos >= 0} { + if {[catch {exec fossil changes --changed --added --deleted --renamed --no-classify} chlist]} { + puts $chlist + exit 1 + } + set chlist [split $chlist \n] + set exlist [split [lindex $params [expr {$pos + 1}]] ,] + if {$exlist == {}} { puts "`--exclude' option needs an argument."; exit 1 } + foreach name $exlist { + lappend hits [lsearch -all -regexp $chlist $name] + } + set hits [lsort -unique [join $hits]] + set dellist [lmap hit $hits {lindex $chlist $hit}] + foreach name $dellist { + set idx [lsearch -exact $chlist $name] + set chlist [lreplace $chlist $idx $idx] + } + if {$chlist == {}} { + puts "nothing to commit." + exit + } + set params [lreplace $params $pos [expr {$pos + 1}]] + lappend params {*}$chlist + } + return $params +} + +interceptor me:merge { +# ---------------------------------------------------------------------------- +# The provided VERSION is tentatively interpreted as a chronological +# revision number for which a lookup of the corresponding SHA1 hash is tried. +# If such a hash exists it is used instead of VERSION in the call to +# `fossil merge', if not, the provided VERSION is used (which in this case +# should itself be a SHA1 hash). +# Note: tentative interpretation of VERSION as chronological revison number +# takes precedence. If you actually mean the SHA1 hash you might need to +# provide a longer initial segment to disambiguate it (e.g. 1234 might not +# suffice if there are already so many checkins). +# ---------------------------------------------------------------------------- + set hash2num [computeRevnums {}] + dict for {key val} $hash2num { + regexp {[a-f\d]{6,}} $key sha1 + dict set num2hash $val $sha1 + } + + set version [last $params] + if {[dict exists $num2hash $version]} { + set version [dict get $num2hash $version] + set params [lreplace $params end end $version] + } + #puts $params + return $params +} + +interceptor di:diff|gdi:gdiff { +# ---------------------------------------------------------------------------- +# Each provided VERSION is tentatively interpreted as a chronological +# revision number for which a lookup of the corresponding SHA1 hash is tried. +# If such a hash exists it is used instead of VERSION in the call to +# `fossil diff', if not, the provided VERSION is used (which in this case +# should itself be a SHA1 hash). +# Note: tentative interpretation of VERSION as chronological revison number +# takes precedence. If you actually mean the SHA1 hash you might need to +# provide a longer initial segment to disambiguate it (e.g. 1234 might not +# suffice if there are already so many checkins). +# ---------------------------------------------------------------------------- + set hash2num [computeRevnums {}] + + # exchange keys and values in the above dictonary. at the same time, + # strip the square brackets around the hash value: + dict for {key val} $hash2num { + regexp {[a-f\d]{6,}} $key sha1 + dict set num2hash $val $sha1 + } + + set tversion {} + set fversion {} + set fidx 0 + set tidx 0 + set idx -1 + foreach word $params { + incr idx + if {$word == {-r} || $word == {--from}} { + set fidx [expr $idx + 1] + continue + } + if {$word == {--to}} { + set tidx [expr $idx + 1] + continue + } + } + if {$fidx > 0} {set fversion [lindex $params $fidx]} + if {$tidx > 0} {set tversion [lindex $params $tidx]} + + if {[dict exists $num2hash $fversion]} { + set fversion [dict get $num2hash $fversion] + } + if {[dict exists $num2hash $tversion]} { + set tversion [dict get $num2hash $tversion] + } + + if {$fversion != {}} { + set params [lreplace $params $fidx $fidx $fversion] + } + if {$tversion != {}} { + set params [lreplace $params $tidx $tidx $tversion] + } + #puts $params + return $params } interceptor he:help { - # Wrap builtin help command by expanding its argument list. This - # allows us provide help on aliased commands transparently. When - # the expanded command is an interceptor, simply print its body. +# ------------------------------------------------------------------------ +# Wrap builtin help command by expanding its argument list. This +# allows us to provide help on aliased commands transparently. When +# the expanded command is an interceptor: if it is _not_ corresponding to a +# `fossil' command, simply print its body, otherwise only print any leading +# comment block found in the interceptor's definition and append the +# help output for the corresponding `fossil' command. +# ------------------------------------------------------------------------ set expansion [expand [lrange $params 1 end] 1] set command [first $expansion] + + catch {exec fossil help --all} foscom + + # regularize foscom: bracket all commands with _single_ blanks + # (including first and last one ...) in order to facilitate further + # processing: + regsub -all {^|\n|$} $foscom { } foscom + regsub -all {[ ]+} $foscom { } foscom + + # now let's see whether `command' is a `fossil' command: + #append abbrev " $command" {[-a-z]*[ ]} + append abbrev $command {[-a-z]*} + set hit [regexp -all " ($abbrev) " $foscom {} thematch] + if {![prefix? $command "help"] && [interceptor? $command]} { - puts "'$command' is an interceptor defined as follows:" - puts [lindex [dict get $config::commands $command] 1] + if {$hit == 1} { + # we only deal with unique matches and presume that + # all interceptor names yield such a match (or none at all). + # non-unique (hit > 1) matches (e.g. `fossil a') should not + # trigger this block at all. + # NO LONGER QUITE RIGHT (st:stat ...), NEEDS RECONSIDERATION. + # + if {$command != $thematch} { + set insert "an abbreviation of `$thematch' and " + } else { set insert "" } + puts "Fossil's `$command' command is ${insert}intercepted by `fsl'." + puts "The interceptor does the following:" + # extract leading comment block from the interceptor source + set src [lindex [dict get $config::commands $command] 1] + set lines [split $src \n] + foreach line $lines { + if {![regexp {^#} $line]} { continue } ;#skip the first line... + if {[regexp {^#[ ]?(.*)} $line {} line]} { + puts $line + } else {break} + } + concat help $expansion + } elseif {$hit == 0} { + puts "\n'$command' is an interceptor with the following definition:" + puts [lindex [dict get $config::commands $command] 1] + } else { + puts "`$command' is a non-unique abbrevation of a `fossil' command." + puts "Please use unique abbrevation (or full name) to see the help text." + exit + } } else { - concat help $expansion + concat help $expansion } } + +interceptor a:alias { +# ------------------------------------------------------------------------ +# This interceptor lists the currently defined aliases. +# ------------------------------------------------------------------------ + set aliases [lsort -dictionary [dict keys $config::aliases]] + foreach alias $aliases { + lappend report [format "%10s -> %s" $alias [dict get $config::aliases $alias ]] + } + + puts "Alias definitions:" + puts "------------------" + puts [join $report \n] +} + +interceptor gr:grep { +# ------------------------------------------------------------------------ +# Extend `grep' by options +# -F +# -L +# to report only _f_irst (oldest) and _l_ast (newest) checkin matching +# the pattern. This is frequently what one is interested in. +# ------------------------------------------------------------------------ + # THINK: one might consider to convert this to a complete + # interceptor, moving all processing from the expect/filter block + # here. The benefit would be the added capability to make 'grep' + # work on multiple input files (or the whole '[fsl] ls' output). + + # we set up a 2-element list `grepflags' with 0/1 entries + # indicating whether F and L are set. this list is put into the + # `config' namespace to make it accessible elsewhere. + + set grepopts [lrange $params 1 end-2] + set grepflags [regexp -- -F $grepopts] + lappend grepflags [regexp -- -L $grepopts] + set config::grepflags $grepflags + + # strip the non-standard options since `fossil grep' does not + # understand them + regsub -all { -(F|L)} $params {} params + return $params +} + + +interceptor df|gd:gdf { +# ------------------------------------------------------------------------ +# drop-in replacement for `fsl (g)di' using hg/svn-style chronological +# revision numbers. call as +# +# fsl (g)df ... -r n(:m) ... +# +# where n, m are counting from 0 (initial checkin) and `...' denotes +# further `diff' arguments. +# This call is mapped to +# +# fsl (g)di ... -r sha1_n (--to sha1_m) ... +# +# where `sha1_n, sha1_m' are the sha1 hashes of the respective checkins. +# ------------------------------------------------------------------------ + # map this interceptor command to `fossil (g)di'. we use `di' instead of + # `diff' since only the former will trigger the `diff' filter: + regsub {^(g?d)f} $params {\1i} params + + # extract the revison number information from `params'. contrary to + # `fossil' it is acceptable to omit blanks between `-r' and `n:m': + set rgxopt { \-r\s*} + set rgxrevnum {\d+(:\d+)?} + append rgxopt $rgxrevnum + + # without `-r' argument we can return already: + if {![regexp $rgxopt $params revarg]} {return $params} + + set hash2num [computeRevnums {}] + + # exchange keys and values in the above dictonary. at the same time, + # strip the square brackets around the hash value: + dict for {key val} $hash2num { + regexp {[a-f\d]{6,}} $key sha1 + dict set num2hash $val $sha1 + } + + # translate rev. numbers to sha1 hashes and construct the + # required `diff' arguments: + regexp $rgxrevnum $revarg numbers + set revs [split $numbers :] + set cnt 0 + set fromto [list --from --to] + set ftopt {} + foreach rev $revs { + append ftopt " [lindex $fromto $cnt] [dict get $num2hash $rev]" + incr cnt + } + + #replace `-r n:m' by the constructed `diff' arguments: + regsub $revarg $params $ftopt params + return $params +} -interceptor ali:aliases { - puts "Currently defined expansions:" - dict for {alias expansion} $config::aliases { - puts [format "%10s -> %s" $alias $expansion] +proc intercept {params} { + set command [first $params] + if {[interceptor? $command]} { + + if {$::config::dbglvl > 0} { puts "*** `$command' interceptor triggered" } + # here, the interceptor definition is retrieved from the + # `commands' dictionary and used as the anonymous function + # argument for `apply' (and `params' as its concrete argument). + set params [apply [dict get $config::commands $command] $params] } + return $params } # --( Fossil )---------------------------------------------------------- proc fossil {args} { + set candidate [first $args]; # candidate for expansion + + if {$::config::dbglvl > 0} { puts "*** provided argument list: $args" } # Alias expansion and command interception: set params [intercept [expand $args]] + + # auto-adjust timeline to current terminal width (if not specified explicitely) + set params [adjustWidth $params] + + if {$::config::dbglvl > 0 && $params != ""} { puts "*** expanded argument list: $params" } + if {[empty? $params]} { return 0; # params cleared, no need to run fossil } set command [first $params]; # expanded candidate # Prepare filters: set chain [chain_for $candidate] set chain [expr {[empty? $chain] ? [chain_for $command] : $chain}] + set chain [string trimright $chain] # Expect settings: set prior_log [log_user]; # to be reverted before returning - if {![empty? $chain]} { - log_user 0; # disable logging to stdout + + # FIXME: reconcider the overall logic of how to handle log_user + # on/off. it is slowly becoming a mess. previously 'log_user 0' + # had to be called only if filter chain is non-empty (indicating + # that the usual fossil output is going to be processed prior to + # display). redefining this filter chain further down to + # `passthrough' then is not a problem (as is done for 'timeline' + # etc. where the output modifcation is not done by any filter but + # in a proc prior to final filtering) but it _is_ a problem for + # commands that lead to an empty filter chain (which usually + # indicates that one wants just to see the raw fossil output) + # while something is still done to their output as is the case for + # `grep' now. maybe we can put everything in a grep filter + # instead so that this explicit test for 'grep' becomes obsolete: + if {![empty? $chain] || $command == "grep"} { + log_user 0; # disable logging to stdout } - if {![interactive? $command]} { + + if {![interactive? $params]} { set stty_init -onlcr; # do not map LF to CRLF on output } + #ensure that `lines' always exists: + set lines {} # Call to `fossil' binary: spawn -noecho fossil {*}$params while 1 { - if {[interactive? $command]} { + if {[interactive? $params]} { interact; break } expect { eof { break } - \n { filter_with $chain $expect_out(buffer) } - # Transfer control to user following prompt: - -re {[\?:] $} { - if {![log_user]} { - send_user $expect_out(buffer) + \n { + #collect everything and postpone filtering + lappend lines $expect_out(buffer) + } + -notransfer -re {[?:] $} { + # [*] Under certain conditions, an incomplete output + # fragment will match this pattern; check whether + # there's a pending newline character: + set timeout 0 + #after 1 + expect -notransfer \n { + # Let the standard {\n} pattern match this line: + unset timeout + continue + } + unset timeout + # Transfer control to user following prompt: + expect -re {[?:] $} { + if {![log_user]} { + send_user $expect_out(buffer) + } + interact -o \n { send_user \r\n } + break } - interact -o \n { send_user \r\n } - break } + #-re {[\?:] $} { + # Transfer control to user following prompt: + #if {![log_user]} { + #send_user $expect_out(buffer) + #} + #interact -o \n { send_user \r\n } + #break + #} } } + + if {![interactive? $params]} { + if {( + $command == "timeline" || + $command == "search" || + $command == "descendants" + ) && [llength $lines] > 1} { + set revnums [computeRevnums $params] + set lines [reformTimeline $lines $revnums $command] + } elseif {$command == "finfo" && [llength $lines] > 1} { + if {[regexp {finfo \s*-p} $params]} { + # this is `finfo -p' (a.k.a. `cat'). prevent further + # filtering and pass through as is by (re)setting filter + # chain to `passthrough' filter: + set chain ::config::fslrc::passthrough + } elseif {[regexp {finfo.*-b} $params]} { + set revnums [computeRevnums $params] + set lines [reformFinfo-b $lines $revnums] + } else { + set revnums [computeRevnums $params] + set lines [reformTimeline $lines $revnums $command] + } + } elseif {$command == "grep" && [llength $lines] > 1} { + set lines [fixGrep $lines $params $config::grepflags] + set chain ::config::fslrc::passthrough + } + + if {$::config::dbglvl > 1} {puts "*** filter chain: [join $chain ", "]"} + + foreach line $lines { + if {$::config::dbglvl > 98} { + catch {puts "IN: >$line<"} + catch {puts -nonewline "OU: >"} + filter_with $chain "$line" + catch {puts "<"} + } else { + filter_with $chain "$line" + } + } + } log_user $prior_log; # revert Expect settings return [spawned_errno $spawn_id]; # return with fossil error code } # --( Entry )----------------------------------------------------------- +set argv [processoptions $argv] config::init ~/.fslrc exit [fossil {*}$argv]