Fossil Wrapper

Check-in [5b283d6948]
Login

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

Overview
Comment:move `dbglvl' to the `config' namespace.
Timelines: family | ancestors | descendants | both | dresden
Files: files | file ages | folders
SHA1: 5b283d6948f7530643c2f879bce94a18ae3998ed
User & Date: j 2013-07-28 14:17:36
Context
2013-07-28
16:09
fixed typo. minor cosmetics. check-in: 8958476da0 user: j tags: dresden
14:17
move `dbglvl' to the `config' namespace. check-in: 5b283d6948 user: j tags: dresden
13:39
small compulsive tidy up. check-in: d1110cdace user: j tags: dresden
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to fsl.

2
3
4
5
6
7
8


9
10
11
12
13
14
15
...
460
461
462
463
464
465
466

467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
...
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
...
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
# -*-tcl-*-
#
# Copyright (c) 2012, Marc Simpson <marc@0branch.com> (ISC, see LICENSE)

# --( Aliases and Filters )---------------------------------------------

namespace eval config {


    set aliases {}
    set filters {};             # registered filters
    set commands {};            # registered interceptors

    proc init {filename} {
        set myname $::argv0
        if {[file exists $filename] && [file mtime $filename] > [file mtime $myname]} {
................................................................................
}

proc preparse argv {
# -------------------------------------------------------------------
# purpose: preprocessing of provided argument string by looking
# for `fsl' specific option/value arguments, which are eliminated
# from the argv string after the corresponding actions are performed.

# currently understands the following options:
#
#    --debug n : set global variable `dbglvl' to value n
# -------------------------------------------------------------------
   global dbglvl
   set dbglvl 0
  
   # check for presence of a `--debug n' option, if present, it
   # defines the debug level which controls how much additional
   # output is generated. after extraction of the debug level the
   # option and its value are eliminated from the argument string
   # since it otherwise would be interpreted as an (unknown) command
   # during further processing.
  
   set dbgpat {\--debug[[:blank:]]+([[:digit:]]+[ ]*)}
   regexp $dbgpat $argv dum dbglvl
   regsub $dbgpat $argv "" argv

   return $argv
}

# --( Interceptors )----------------------------------------------------

................................................................................

   #replace `-r n:m' by the constructed `diff' arguments: 
   regsub $revarg $params $from$to params
   return $params
}

proc intercept {params} {
    global dbglvl
    set command [first $params]
    if {[interceptor? $command]} {

        if {$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} {
    global dbglvl

    set candidate [first $args]; # candidate for expansion

    if {$dbglvl > 0} { puts "*** provided argument list: $args" }

    # Alias expansion and command interception:
    set params [intercept [expand $args]]

    if {$dbglvl > 0} { 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:
................................................................................
          # if yes, don't unwrap (but it's still filtered 
          # through `fancy_timeline'. think ...)
          if {!$catmode} {
             set lines [unwrapTimeline $lines]
          }
       }

       if {$dbglvl == 1} {puts "*** filter chain: $chain"}

       foreach line $lines {
          if {$dbglvl > 2} {
             puts "IN: >$line<"
             puts -nonewline "OU: >"
             filter_with $chain "$line"
             puts "<"
          } else {
             filter_with $chain "$line"
          }







>
>







 







>


|

<
<









|







 







<



|











<



|




|







 







|


|







2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
...
462
463
464
465
466
467
468
469
470
471
472
473


474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
...
610
611
612
613
614
615
616

617
618
619
620
621
622
623
624
625
626
627
628
629
630
631

632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
...
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
# -*-tcl-*-
#
# Copyright (c) 2012, Marc Simpson <marc@0branch.com> (ISC, see LICENSE)

# --( Aliases and Filters )---------------------------------------------

namespace eval config {
    set dbglvl 0;               # debug level

    set aliases {}
    set filters {};             # registered filters
    set commands {};            # registered interceptors

    proc init {filename} {
        set myname $::argv0
        if {[file exists $filename] && [file mtime $filename] > [file mtime $myname]} {
................................................................................
}

proc preparse argv {
# -------------------------------------------------------------------
# purpose: preprocessing of provided argument string by looking
# for `fsl' specific option/value arguments, which are eliminated
# from the argv string after the corresponding actions are performed.
#
# currently understands the following options:
#
#    --debug n : set variable `config::dbglvl' to value n
# -------------------------------------------------------------------


  
   # check for presence of a `--debug n' option, if present, it
   # defines the debug level which controls how much additional
   # output is generated. after extraction of the debug level the
   # option and its value are eliminated from the argument string
   # since it otherwise would be interpreted as an (unknown) command
   # during further processing.
  
   set dbgpat {\--debug[[:blank:]]+([[:digit:]]+[ ]*)}
   regexp $dbgpat $argv dum config::dbglvl
   regsub $dbgpat $argv "" argv

   return $argv
}

# --( Interceptors )----------------------------------------------------

................................................................................

   #replace `-r n:m' by the constructed `diff' arguments: 
   regsub $revarg $params $from$to params
   return $params
}

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]]

    if {$config::dbglvl > 0} { 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:
................................................................................
          # if yes, don't unwrap (but it's still filtered 
          # through `fancy_timeline'. think ...)
          if {!$catmode} {
             set lines [unwrapTimeline $lines]
          }
       }

       if {$config::dbglvl == 1} {puts "*** filter chain: $chain"}

       foreach line $lines {
          if {$config::dbglvl > 2} {
             puts "IN: >$line<"
             puts -nonewline "OU: >"
             filter_with $chain "$line"
             puts "<"
          } else {
             filter_with $chain "$line"
          }