Fossil Wrapper

Check-in [38deb932f7]
Login

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

Overview
Comment:merged from trunk.
Timelines: family | ancestors | descendants | both | dresden
Files: files | file ages | folders
SHA1: 38deb932f77f60603ee08f6f131e6ae96c72218c
User & Date: j 2013-01-01 23:48:34
Context
2013-01-01
23:54
small fix. check-in: ba3a1b7d98 user: j tags: dresden
23:48
merged from trunk. check-in: 38deb932f7 user: j tags: dresden
2012-12-29
13:37
Reference the caller's namespace when defining interceptors (close [caeb6df696]). check-in: 6839e8de1e user: marc tags: trunk
2012-12-27
17:33
merged from trunk. check-in: e3d00d91c1 user: j tags: dresden
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to fsl.

133
134
135
136
137
138
139


140
141
142
143
144
145
146
...
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
...
246
247
248
249
250
251
252

253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
...
295
296
297
298
299
300
301

302
303

304
305
306
307
308
309
310
...
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
...
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

           default    {             set  line }
        }
    }

    filter highlight_branch {branch} {
        expr {[regexp {^\* } $line] ? [coloured yellow $line] : $line}
    }


}

# --( Alias expansion )-------------------------------------------------

proc expand {params {explain 0}} {
    set candidate [first $params]
    if {[alias? $candidate]} {
................................................................................
# - 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]
    foreach command [triggers_for $command_spec] {
        dict set config::commands $command $fn
    }
}

proc intercept {params} {
    set command [first $params]
................................................................................
    lindex $xs 0
}

proc interactive? {command} {
    # Check whether the supplied command requires user interaction
    # from the outset:
    switch -re $command {

        ^(ci|com|comm|commi|commit)$         { return true  }
        ^(sq|sql|sqli|sqlit|sqlite|sqlite3)$ { return true  }
        default                              { return false }
    }
}

proc spawned_errno {} {
    catch wait result_list
    lindex $result_list 3
}

proc unindent_script {script} {
    regexp "^ *" [set trimmed [string trim $script \n]] indent
    regsub -line -all "^$indent" $trimmed ""
}
................................................................................
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 {

    puts [concat "Aliases:  " [dict keys $config::aliases]]
    puts [concat "Filters:  " [dict keys $config::filters]]

}

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

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


proc unwrapTimeline records {
#-----------------------------------------------------------------------
# unwrap `fossil timeline' output, putting each comment on a single
# line. expected input: currently, a list of \n terminated lines.
# (maybe the \n should go away?)
#
................................................................................
      regsub -all {([[:alnum:]])- ([[:alnum:]])} $record \\1-\\2 record

      lappend out "$record"
   }
   return $out
}

# --( Entry )-----------------------------------------------------------
#here we go, finally:


#if `true' generate some noise:
set debug false

set rcfile ~/.fslrc

#1. read resource file (or create if not yet there) 
config::init $rcfile

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

# Alias expansion and command interception:
set params [intercept [expand $argv]]
if {[empty? $params]} {
    exit 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}]

# Expect settings:

if {![empty? $chain]} {
    log_user 0;                 # disable logging to stdout
}
if {![interactive? $command]} {
    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]} {
        interact; break
    }
    expect {
        eof { break }
        \n {
           #collect everything and postpone filtering
           lappend lines $expect_out(buffer)
        }
        # Transfer control to user following prompt:
        -re {[\?:] $} {
            if {![log_user]} {
                send_user $expect_out(buffer)
            }
            interact -o \n { send_user \r\n }
            break
        }
    }
}

if {[interactive? $command] == false} {
   if {$command == "timeline"} { 
      set lines [unwrapTimeline $lines]
   }
   foreach line $lines {
      if {$debug == true} {
         puts -nonewline "IN: $line"
         puts -nonewline "OU: "
      }
      filter_with $chain "$line"
   }
}







exit [spawned_errno]








>
>







 







|







 







>






|
|







 







>
|
|
>







 







<







 







|
<

>
|
|

<
<
<
<
<
|

|
|
|
|
|
|

|
|
|

|
>
|
|
|
|
|
|

|
|
<
|
|
|
|
|
|
|
|
|
|
|
<
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|

>
>
>
>
>
>
|
>
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
...
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
...
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
...
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
...
324
325
326
327
328
329
330

331
332
333
334
335
336
337
...
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
           default    {             set  line }
        }
    }

    filter highlight_branch {branch} {
        expr {[regexp {^\* } $line] ? [coloured yellow $line] : $line}
    }

    # vim: ft=tcl
}

# --( Alias expansion )-------------------------------------------------

proc expand {params {explain 0}} {
    set candidate [first $params]
    if {[alias? $candidate]} {
................................................................................
# - 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]
................................................................................
    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 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 ""
}
................................................................................
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]
................................................................................

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


proc unwrapTimeline records {
#-----------------------------------------------------------------------
# unwrap `fossil timeline' output, putting each comment on a single
# line. expected input: currently, a list of \n terminated lines.
# (maybe the \n should go away?)
#
................................................................................
      regsub -all {([[:alnum:]])- ([[:alnum:]])} $record \\1-\\2 record

      lappend out "$record"
   }
   return $out
}

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


proc fossil {args} {
    #if `true' generate some noise:
    set debug false






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

    # Alias expansion and command interception:
    set params [intercept [expand $args]]
    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}]

    # Expect settings:
    set prior_log [log_user];   # to be reverted before returning
    if {![empty? $chain]} {
        log_user 0;             # disable logging to stdout
    }
    if {![interactive? $command]} {
        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]} {
            interact; break
        }
        expect {
            eof { break }
            \n {
            #collect everything and postpone filtering
            lappend lines $expect_out(buffer)

        }            # Transfer control to user following prompt:
            -re {[\?:] $} {
                if {![log_user]} {
                    send_user $expect_out(buffer)
                }
                interact -o \n { send_user \r\n }
                break
            }
        }
    }

    if {[interactive? $command] == false} {
       if {$command == "timeline"} { 
          set lines [unwrapTimeline $lines]
       }
       foreach line $lines {
          if {$debug == true} {
             puts -nonewline "IN: $line"
             puts -nonewline "OU: "
          }
          filter_with $chain "$line"
       }
    }

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

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

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