]> git.zerfleddert.de Git - micropolis/blame - src/tclx/tclsrc/showproc.tcl
XINCLUDE: use /usr/X11R6/include everywhere
[micropolis] / src / tclx / tclsrc / showproc.tcl
CommitLineData
6a5fa4e0
MG
1#
2# showprocs.tcl --
3#
4# Display procedure headers and bodies.
5#------------------------------------------------------------------------------
6# Copyright 1992 Karl Lehenbauer and Mark Diekhans.
7#
8# Permission to use, copy, modify, and distribute this software and its
9# documentation for any purpose and without fee is hereby granted, provided
10# that the above copyright notice appear in all copies. Karl Lehenbauer and
11# Mark Diekhans make no representations about the suitability of this
12# software for any purpose. It is provided "as is" without express or
13# implied warranty.
14#------------------------------------------------------------------------------
15# $Id: showprocs.tcl,v 2.0 1992/10/16 04:52:11 markd Rel $
16#------------------------------------------------------------------------------
17#
18
19#@package: TclX-show_procedures showproc showprocs
20
21proc showproc {procname} {
22 if [lempty [info procs $procname]] {demand_load $procname}
23 set arglist [info args $procname]
24 set nargs {}
25 while {[llength $arglist] > 0} {
26 set varg [lvarpop arglist 0]
27 if [info default $procname $varg defarg] {
28 lappend nargs [list $varg $defarg]
29 } else {
30 lappend nargs $varg
31 }
32 }
33 format "proc %s \{%s\} \{%s\}\n" $procname $nargs [info body $procname]
34}
35
36proc showprocs {args} {
37 if [lempty $args] { set args [info procs] }
38 set out ""
39
40 foreach i $args {
41 foreach j $i { append out [showproc $j] "\n"}
42 }
43 return $out
44}
45
Impressum, Datenschutz