Как передать вывод puts в proc в качестве ввода?

Как указывает Донал, предпочтительнее, чтобы код печати использовал канал в качестве аргумента. В качестве альтернативы, если у вас нет контроля над всеми процессами печати или вы не хотите их трогать, используйте перехватчик канала (рассмотренный ранее, для захват вывода набора тестов Tcl):

Перехватчик канала реализован как преобразование канала; и уже обсуждалось здесь.

Шаг 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
}

Один из самых простых способов — временно заменить 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), но написать их гораздо сложнее.

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