utils.tcl

   1
   2 # Copyright 2016,2020 Ian Jackson
   3 # SPDX-License-Identifier: GPL-3.0-or-later
   4 # There is NO WARRANTY.
   5
   6 proc manyset {list args} {
   7     foreach val $list var $args {
   8         upvar 1 $var my
   9         set my $val
  10     }
  11 }
  12
  13 namespace eval debug {
  14
  15 # Debug:
  16 #
  17 #    Caller may call
  18 #       debug::setup ON-DEBUG
  19 #    which will result in calls to [concat ON-DEBUG [list MESSAGE]]
  20 #    (or ON-DEBUG may be "" in which case messages are discarded)
  21 #
  22 #    And caller may call
  23 #       debug::debug MSG
  24
  25 variable debug {}
  26
  27 proc debug {m} {
  28     variable debug
  29     if {![llength $debug]} return
  30     set ns [uplevel 1 namespace current]
  31     uplevel #0 $debug [list "DEBUG $ns $m"]
  32 }
  33
  34 proc setup {d} {
  35     variable debug $d
  36 }
  37
  38 }