Internet File Formats/InternetFileFormatsCD.bin/text/latex/mac/alpha60.hqx/Tcl/SystemCode/getVarValue.tcl

Text File | 1995-06-08 | 4.6 KB | 161 lines

#############################################################################
#  Report the current value of a global variable, chosen interactively
#  from a list of all active variables.
#
#  If the variable is an array, or its value is too big to fit in an
#  alertnote, then its contents are listed in a new window, otherwise
#  the variable's value is displayed in an alertnote.
#
proc getVarValue {} {
    set def [getText [getPos] [selEnd]]
    set var [listpick -p {Which var?} -L $def [lsort -ignore [info globals]]]
    if {![string length $var]} return
    showVarValue $var
}

proc showVarValue {var} {
    global $var
    if {![catch {set $var} value]} {
        if {![catch {alertnote "'$var' = $value"}]} {
            return
        } else {
            new -n "* $var *"
            insertText "'$var' = $value"
        }
    } else {
        new -n "* $var *"
        listArray $var
    }
    goto 0
# if 'shrinkWindow' is loaded, call it to trim the output window.
   catch {shrinkWindow 1}
   set win [lindex [winNames -f] 0]
   setWinInfo -w $win dirty 0
   setWinInfo -w $win read-only 1
}

#############################################################################
#  List the name and value of each element of the array $arrName.
#  (Convenient to use as a shell command.)
#
proc listArray {arrName} {
    global $arrName
    set lines {}
    if {![catch {info vars $arrName}]} {
        foreach nm [array names $arrName] {
            set val [expr \$$arrName\($nm\)]
            append lines "\r\"$nm\"\t\{$val\}"
        }
        insertText $lines
    } else {
        alertnote "\"$arrName\" doesn't exist in this context"
    }
}

#############################################################################
#  Write out the active definition of the proc $procName.
#  (Convenient to use as a shell command.)
#
proc listProc {procName} {
    set lines {}
    if {![catch {info procs "*$procName*"} procList]} {
        foreach p $procList {
            set pargs [info args $p]
            set arglist {}
            foreach a $pargs {
                if {[info default $p $a def]} {
                    append arglist " {$a $def}"
                } else {
                    append arglist " $a"
                }
            }
            append lines "\rproc $p {[string trim $arglist]} {"
            append lines [info body $p]
            append lines "}\r"
        }
        insertText $lines
    }
}

#############################################################################
# Adjust the dimensions of the current window to match the length (and
# optionally the width) of the text that it contains.  If shrinkWidth is
# omitted or set to zero, then only the height of the window is adjusted.
# (Finding the maximum number of characters per line can be annoyingly
# time-consuming for large files).

proc shrinkWindow {{shrinkWidth 0}} {
    global defHeight defWidth
    # These constants work for 9-pt Monaco type
    set lineht 11
    set htoff 22
    set chwd 6
    set choff 20

    set wd [lindex [getGeometry] 2]
    set ht [lindex [getGeometry] 3]
    set top [lindex [getGeometry] 1]
    set left [lindex [getGeometry] 0]

    set mxht [expr [lindex [getMainDevice] 3] - $top - 5 -15]
    set mxwd [expr [lindex [getMainDevice] 2] - $left - 5]
    set mnht 120
    set mnwd 200

    set htWd [fileHtWd $shrinkWidth]
    set lines [lindex $htWd 0]
    set chars [lindex $htWd 1]

    if {$lines <= 1} then {set lines 10}


    if {$lines > 0} {
        set ht [expr $htoff + ( $lineht * (1 + $lines)) ]
    } elseif {$ht > $defHeight} {
        set ht $defHeight
    }

    if {$chars > 0} {
        set wd [expr $choff + ( $chwd * (2 + $chars)) ]
    } elseif {$wd > $defWidth} {
        set wd $defWidth
    }

    if {$ht > $mxht} then {set ht $mxht}
    if {$wd > $mxwd} then {set wd $mxwd}
    if {$ht < $mnht} then {set ht $mnht}
    if {$wd < $mnwd} then {set wd $mnwd}
    sizeWin $wd $ht
}

#############################################################################
# Return the number of lines and the maximum number of characters in any
# line of a file.  It would be nice if there was a built-in command to
# do this (i.e., compiled C code) because this is a pretty slow way to
# get the maximum line width.

proc fileHtWd {{checkWidth 0}} {
    set text [getText 0 [maxPos]]

    set lines [split $text "\r"]
    set nlines [llength $lines]

    set llen 0
    if {$checkWidth} {
        foreach line $lines {
            regsub {                +░.*$} $line {} line
            regsub {    } $line {    } line
            set len [string length $line]
            if {[set ntab [llength [split $line "\t"]]] > 1} {
                set len [expr $len + 3*($ntab-1)]
            }
            if { $len > $llen} {
                set llen $len
            }
        }
    }
#    alertnote "Text Height : $nlines ; Text Width : $llen "
    return [list $nlines $llen]
}