如何把看跌期权的输出作为输入？

Question

我有一个proc，可以将列表打印为格式化表格。像 print_table $ temp

这样的用例

我如何在使用“ puts”命令作为该proc print_table 的输入来打印输出的情况下给出其他proc的输出？

set list1 {{abc 1} {defg 2} {hijlk 3} {lmn 4}}
proc abc { list1 } {
foreach lst $list1 {
   puts "$lst"
}
}

> abc $list1 
abc 1
defg 2
hijlk 3
lmn 4

> print_table $list1
 ==============
 | abc    | 1 |
 | defg   | 2 |
 | hijlk  | 3 |
 | lmn    | 4 |
 ==============

我想让下面的工作

> print_table [abc $list1]
 ==============
 | abc    | 1 |
 | defg   | 2 |
 | hijlk  | 3 |
 | lmn    | 4 |
 ==============

Answer 1

如Donal所指出的，最好使打印代码使用通道作为参数。另外，如果您无法控制所有打印过程，或者不想触摸它们，则可以使用通道拦截器（在capturing Tcl test suite output中已发现）：

通道拦截器被实现为通道转换；并且之前已被here覆盖。

第1步：定义通道拦截器

oo::class create ChannelSink {
    variable buffer
    method initialize {handle mode} {
        if {$mode ne "write"} {error "can't handle reading"}
        return {finalize initialize write}
    }
    method finalize {handle} {
        # NOOP
    }

    method write {handle bytes} {
        append buffer $bytes
        return $bytes
    }

    method getCapture {} {
         set r $buffer
         unset buffer
         return $r
    }
}

上面的摘录是从Donal偷偷获得的。

步骤2：在您的打印代码周围向stdout注册拦截器

set cs [ChannelSink new]
chan push stdout $cs

abc $list1

chan pop stdout
print_table [$cs getCapture]

您可以将拦截样板打包到print_table中，使其看起来像：print_table {abc $list1}。

proc print_table {script} {
    # set up interception
    uplevel 1 $script
    # remove interception
}

Answer 2

最简单的方法之一是临时替换puts。

# Partial emulation of [puts] API; assumes we don't write to other files
proc capturing_puts {args} {
    global capturedStdout
    set value [lindex $args end]
    set args [lrange $args 0 end-1]
    if {"-nonewline" ni $args} {
        append value "\n"
    }
    append capturedStdout $value
}

# A helper procedure to install and restore the replacement [puts] implementation
proc capture {script} {
    global capturedStdout
    rename puts original_puts
    rename capturing_puts puts
    set capturedStdout ""

    try {
        uplevel 1 $script
    } finally {
        # Restore the original, even on error!
        rename puts capturing_puts
        rename original_puts puts
    }
    return $capturedStdout
}

# Now we can use it like this
set output [capture {
    abc $list1
}]
print_table $output

如果您可以使打印代码采用一个（可选）参数来指定要写入的通道，则会更容易。然后，您完全不需要弄乱输出捕获。

---

我认为可以使用通道变换来进行捕获，这比用稍微棘手的API（puts）替换命令要脆弱得多，但是编写它们要复杂得多。 / p>

Answer 3

@ Donal，@ mrcalivin，您的两种解决方案都接近我的期望。但是它将所有数据打印在一个列中。

建议的代码给出如下输出：

> print_table  [capture {abc $list1}]                    
 ========
 | abc   
 | 1     
 | defg  
 | 2     
 | hijlk 
 | 3     
 | lmn   
 | 4     
 ========

我已经输入了print_table的代码，也许我可以添加proc print_table的详细信息，如果可以进行任何更改的话，我目前正在输入列表名称 table 。可能会有更好的方法来编码此proc。

proc print_table { table } {
    set col_len [llength [lindex $table 0]]
    for {set i 0} {$i < $col_len} { incr i } { set col_wid($i) 0 }
    foreach line $table {
        for {set i 0} {$i < $col_len} { incr i } { 
            set temp_col_width($i) [string length [lindex $line $i]];
            if { $col_wid($i) > $temp_col_width($i) } { set col_wid($i) $col_wid($i) } else { set col_wid($i) $temp_col_width($i) }
        }
    }
    set total_col 0; for {set i 0} {$i < $col_len} { incr i } { set total_col [expr $total_col +  $col_wid($i) ] } ; set total_col [expr $total_col + (($col_len-2) * 2) + 9 ];
    set table_length [llength $table]; set j 0 ; 
    foreach line $table {
      set line1 ""; set line2 "";
      for {set i 0} {$i < $col_len} { incr i } {
        if { $i == 0 } {
          append line1 " | [format "%-$col_wid($i)s" [lindex $line $i]] " 
        } elseif { $i == [expr $col_len -1] } {
          append line1 " | [format "%-$col_wid($i)s" [lindex $line $i]] |" 
        } else  {
          append line1 "| [format "%-$col_wid($i)s" [lindex $line $i]] "
        }
      }

      if { $j == 0 } {
        puts " [string repeat = [expr [string length $line1]-1]]"; 
        puts "$line1";
        #puts " [string repeat = [expr [string length $line1]-1]]"; 
      } elseif { $j == 1 && $j == [expr $table_length - 1] } {
        puts "$line1" ;puts " [string repeat = [expr [string length $line1]-1]]"
      } elseif { $j == [expr $table_length - 1] } {
        puts "$line1" ; puts " [string repeat = [expr [string length $line1]-1]]";
      } else { puts "$line1" }
       incr j;
    }
}