tcl-websh-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From dav...@dedasys.com (David N. Welton)
Subject Re: "cleanups": 4726
Date Thu, 13 Dec 2001 10:04:05 GMT

I was thinking of something that just does a more simplistic cleanup:

namespace eval sentry {
    array set beginvars {}
    array set beginfiles {}
    array set beginprocs {}
    set varpattern {}
    set filepattern {}
    set procpattern {}
}

proc sentry::Entry { {varpat ""} {filepat ""} {procpat ""} } {
    variable beginvars
    variable beginfiles
    variable varpattern $varpat
    variable filepattern $filepat
    variable procpattern $procpat

    if { $varpattern == "" } {
	set vars [uplevel [list info vars]]
    } else {
	set vars [uplevel [list info vars $varpattern]]
    }
    foreach vr $vars {
	set beginvars($vr) 1
    }

    if { $filepattern == "" } {
	set files [file channels]
    } else {
	set files [file channels $filepattern]
    }
    foreach fl $files {
	set beginfiles($fl) 1
    }

    if { $procpattern == "" } {
	set procs [uplevel [list info procs]]
    } else {
	set procs [uplevel [list info procs $procpattern]]
    }
    foreach pr $procs {
	set beginprocs($pr) 1
    }

    return [list [llength $vars] [llength $files] [llength $procs]] 
}

proc sentry::Exit { } {
    variable beginvars
    variable beginfiles
    variable beginprocs
    variable varpattern 
    variable filepattern
    variable procpattern

    if { $varpattern == "" } {
	set vars [uplevel [list info vars]]
    } else {
	set vars [uplevel [list info vars $varpattern]]
    }

    if { $filepattern == "" } {
	set files [file channels]
    } else {
	set files [file channels $filepattern]
    }

    if { $procpattern == "" } {
	set procs [uplevel [list info procs]]
    } else {
	set procs [uplevel [list info procs $procpattern]]
    }
    foreach vr $vars {
	if { ! [info exists beginvars($vr)] } {
	    uplevel [list unset $vr]
	}
    }
    
    foreach fl $files {
	if { ! [info exists beginfiles($fl)] } {
	    close $fl
	}
    }

    foreach pr $procs {
	if { ! [info exists beginprocs($pr)] } {
	    uplevel [list rename $pr {}]
	}
    }
}

Although the idea of saving the interpreter state is intriguing, I
think that it might be more of a long term project to add something to
Tcl itself.

-- 
David N. Welton
   Consulting: http://www.dedasys.com/
Free Software: http://people.debian.org/~davidw/
   Apache Tcl: http://tcl.apache.org/
     Personal: http://www.efn.org/~davidw/

Mime
View raw message