如何将puts的输出作为输入提供给proc？

Question

我有一个将列表打印为格式化表格的过程。有像 print_table $temp

这样的用例

如何提供不同 proc 的输出，其中我使用“puts”命令打印输出作为此 proc print_table 的输入？

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

上面的sn-p直接来源于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) 替换命令要脆弱得多，但编写它们要复杂得多。

Answer 3

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

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

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

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

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