Fossil Wrapper

Check-in [ee3ce6f243]
Login

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

Overview
Comment:moved interceptor related stuff to different position.
Timelines: family | ancestors | descendants | both | dresden
Files: files | file ages | folders
SHA1: ee3ce6f243b597bee9abb29dc2a9bdadbda6d06c
User & Date: j 2013-07-28 13:16:09
Context
2013-07-28
13:39
small compulsive tidy up. check-in: d1110cdace user: j tags: dresden
13:16
moved interceptor related stuff to different position. check-in: ee3ce6f243 user: j tags: dresden
12:49
move pre-parsing of argv to separate proc. check-in: c4c35bb825 user: j tags: dresden
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to fsl.

198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
...
349
350
351
352
353
354
355

356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
...
622
623
624
625
626
627
628













































































































































629
630
631
632
633
634
635
...
740
741
742
743
744
745
746

747
748
749
            set line [$filter $line]
        }
        # 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'.
#
#   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 `commands_spec (e.g., a, ali, alias etc.)
       # generates a further entry (with identical value).
       dict set config::commands $command $fn
    }
}

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
}

# --( Command triggers )------------------------------------------------

proc prefixes {xs {start 0}} {
    # Return the prefix list of string $xs.
    for {set right $start} {$right < [string length $xs]} {incr right} {
        lappend parts [string range $xs 0 $right]
    }
................................................................................
        yellow  33       blue   34        purple  35
        magenta 35       cyan   36        grey    37
    }
    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]]
}

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.
    set expansion [expand [lrange $params 1 end] 1]
    set command   [first $expansion]
    if {![prefix? $command "help"] && [interceptor? $command]} {
        puts "'$command' is an interceptor defined as follows:"
        puts [lindex [dict get $config::commands $command] 1]
    } else {
        concat help $expansion
    }
}

interceptor ali:aliases {
    puts "Currently defined expansions:"
    dict for {alias expansion} $config::aliases {
        puts [format "%10s -> %s" $alias $expansion]
    }
}

interceptor df|gdf {
   # ------------------------------------------------------------------------
   # drop-in replacement for `fsl (g)di' using hg/svn-style relative 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)diff'. actually, 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 rgx { \-r[[:blank:]]*}
   set rgxrevnum {[[:digit:]]+(:[[:digit:]]+)?}
   set rgx $rgx$rgxrevnum

   # without `-r' argument we can return already:
   if {![regexp $rgx $params revarg]} {return $params}

   set hash2num [computeRevnums {}]
   set dim [dict size $hash2num]

   # 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]{10}} $key sha1
      dict set num2hash [expr {$dim - $val}] $sha1
   }

   # translate rev. numbers to sha1 hashes and construct the 
   # required `diff' arguments:
   regexp $rgxrevnum $revarg numbers
   set revs [split $numbers :]
   set to {}
   set cnt 0
   set fromto [list from to]
   foreach rev $revs {
      set optarg [lindex $fromto $cnt] 
      # this evals in turn to define variables `from' and `to', respectively,
      # which contain the respective `diff' arguments:
      set $optarg " --$optarg [dict get $num2hash $rev]"
      incr cnt
   } 

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

# --( further procs )---------------------------------------------------

proc unwrapTimeline records {
#-----------------------------------------------------------------------
# unwrap `fossil timeline' output, putting each checkin on a single
# line. expected input: currently, a list of \n terminated lines.
# (maybe the \n should go away?). continuation lines belonging
# to the checkin message (including the trailing user/tags info)
................................................................................
  
   set dbgpat {\--debug[[:blank:]]+([[:digit:]]+[ ]*)}
   regexp $dbgpat $argv dum dbglvl
   regsub $dbgpat $argv "" argv

   return $argv
}














































































































































# --( Fossil )----------------------------------------------------------

proc fossil {args} {
    global dbglvl

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

    log_user $prior_log;              # revert Expect settings
    return [spawned_errno $spawn_id]; # return with fossil error code
}

# --( Entry )-----------------------------------------------------------

set argv [preparse $argv]
config::init ~/.fslrc
exit [fossil {*}$argv]







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







>

<

|

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







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







 







>



198
199
200
201
202
203
204























































205
206
207
208
209
210
211
...
294
295
296
297
298
299
300
301
302

303
304
305























































































306
307
308
309
310
311
312
...
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
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
...
739
740
741
742
743
744
745
746
747
748
749
            set line [$filter $line]
        }
        # Prevent broken pipe error from propagating:
        catch {puts -nonewline $line}
    }
}
























































# --( Command triggers )------------------------------------------------

proc prefixes {xs {start 0}} {
    # Return the prefix list of string $xs.
    for {set right $start} {$right < [string length $xs]} {incr right} {
        lappend parts [string range $xs 0 $right]
    }
................................................................................
        yellow  33       blue   34        purple  35
        magenta 35       cyan   36        grey    37
    }
    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 }

























































































proc unwrapTimeline records {
#-----------------------------------------------------------------------
# unwrap `fossil timeline' output, putting each checkin on a single
# line. expected input: currently, a list of \n terminated lines.
# (maybe the \n should go away?). continuation lines belonging
# to the checkin message (including the trailing user/tags info)
................................................................................
  
   set dbgpat {\--debug[[:blank:]]+([[:digit:]]+[ ]*)}
   regexp $dbgpat $argv dum dbglvl
   regsub $dbgpat $argv "" argv

   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 `commands_spec (e.g., a, ali, alias etc.)
       # generates a further entry (with identical value).
       dict set config::commands $command $fn
    }
}

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

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.
    set expansion [expand [lrange $params 1 end] 1]
    set command   [first $expansion]
    if {![prefix? $command "help"] && [interceptor? $command]} {
        puts "'$command' is an interceptor defined as follows:"
        puts [lindex [dict get $config::commands $command] 1]
    } else {
        concat help $expansion
    }
}

interceptor ali:aliases {
    puts "Currently defined expansions:"
    dict for {alias expansion} $config::aliases {
        puts [format "%10s -> %s" $alias $expansion]
    }
}

interceptor df|gdf {
   # ------------------------------------------------------------------------
   # drop-in replacement for `fsl (g)di' using hg/svn-style relative 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)diff'. actually, 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 rgx { \-r[[:blank:]]*}
   set rgxrevnum {[[:digit:]]+(:[[:digit:]]+)?}
   set rgx $rgx$rgxrevnum

   # without `-r' argument we can return already:
   if {![regexp $rgx $params revarg]} {return $params}

   set hash2num [computeRevnums {}]
   set dim [dict size $hash2num]

   # 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]{10}} $key sha1
      dict set num2hash [expr {$dim - $val}] $sha1
   }

   # translate rev. numbers to sha1 hashes and construct the 
   # required `diff' arguments:
   regexp $rgxrevnum $revarg numbers
   set revs [split $numbers :]
   set to {}
   set cnt 0
   set fromto [list from to]
   foreach rev $revs {
      set optarg [lindex $fromto $cnt] 
      # this evals in turn to define variables `from' and `to', respectively,
      # which contain the respective `diff' arguments:
      set $optarg " --$optarg [dict get $num2hash $rev]"
      incr cnt
   } 

   #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
................................................................................
    }

    log_user $prior_log;              # revert Expect settings
    return [spawned_errno $spawn_id]; # return with fossil error code
}

# --( Entry )-----------------------------------------------------------

set argv [preparse $argv]
config::init ~/.fslrc
exit [fossil {*}$argv]