File: debug.tcl

package info (click to toggle)
tkgate 2.1%2Brepack-7
  • links: PTS, VCS
  • area: main
  • in suites: trixie
  • size: 28,808 kB
  • sloc: ansic: 62,300; tcl: 20,345; xml: 2,731; yacc: 1,177; lex: 839; sh: 701; makefile: 187; perl: 39
file content (67 lines) | stat: -rw-r--r-- 1,778 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
#   Copyright (C) 1987-2015 by Jeffery P. Hansen
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License along
#   with this program; if not, write to the Free Software Foundation, Inc.,
#   51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
#
# Last edit by hansen on Wed Jun  8 08:49:57 2005

########################################################################
#
# Procedures in this file are only used for debugging purposes
#

namespace eval DebugModSym {
  variable dms_w .debug_modsym

  proc update {ms} {
    del $ms
    add $ms
  }

  proc add {ms} {
    variable dms_w

    puts "DebugModSym::add $ms"
    $dms_w.lb insert end $ms
  }

  proc del {ms} {
    variable dms_w

    set ms [lindex $ms 0]
    puts "DebugModSym::del $ms"
    set n [$dms_w.lb size]
    for { set i 0 } {$i < $n} {incr i} {
      if {[lindex [$dms_w.lb get $i] 0] == $ms} {
	$dms_w.lb delete $i
	break
      }
    }
  }


  proc post args {
    variable dms_w

    toplevel $dms_w

    listbox $dms_w.lb -width 40 -yscrollcommand "$dms_w.vb set"
    scrollbar $dms_w.vb -orient vertical -command "$dms_w.lb yview"

    pack $dms_w.lb -fill both -side left -padx 1 -pady 1
    pack $dms_w.vb -fill y -side left -padx 1 -pady 1
  }
}

#DebugModSym::post