Updated 2015-08-02 19:08:33 by AMG

Synopsis  edit

An implementation by Cris Fugate of the frames paradigm in Tcl.

Attributes  edit

name
framesets
location
https://github.com/crisafugate/framesets
Updated
03/2013
Contact
mailto:[email protected] (Cris A Fugate)

Description  edit

Frames based OO implemention for Tcl.

Framesets is based on Marvin Minsky's concept of frames and basic set operations. It can currently be found at [1]. An older archive can be found through the Internet Wayback Machine at [2], and appended below for posterity. In particular, Marvin Minsky's seminal paper "A Framework for Representing Knowledge" can be found at http://www.bitsavers.org/pdf/mit/ai/aim/AIM-306.pdf

Also see this comp.lang.tcl discussion: [3]

frameagents.README
    frameagents.tcl is an extension to the tcl scripting language.  It provides
 basic frame and frame set mechanisms which can be used to dynamically organize
 and perform operations on values and procedures.  It also provides mechanisms
 which allow frames and frame sets to act as mobile agents.  Below is a list of
 commands, how to call them, and the result of calling them.

 fcomparef (compare two frames)

 invoke: fcomparef <frame> <frame>
 result: return 1 if frames have the same slots
         return 0 otherwise

 fcompares (compare slot of two frames)

 invoke: fcompares <frame> <slot> <frame>
 result: return 1 if slot is the same in both frames
         return 0 otherwise

 fcopyf (copy a frame)

 invoke: fcopyf <frame> <frame>
 result: second frame is a copy of the first frame
         return 1 if successful, return 0 otherwise

 fcopys (copy a slot)

 invoke: fcopys <frame> <slot> <frame>
 result: second frame has a copy of the slot in the first frame
         return 1 if successful, return 0 otherwise

 fcreated (create a demon facet)

 invoke: fcreated <frame> <slot> <demon>
 result: a new demon facet is created in the slot of the frame
         return 1 if successful, return 0 otherwise

 fcreatef (create a frame)

 invoke: fcreatef <frame>
 result: a new frame is created
         return 1 if successful, return 0 otherwise

 fcreatefs (create a frame set)

 invoke: fcreatefs <set>
 result: a new frame set is created
         return 1 if successful, return 0 otherwise

 fcreatem (create a method facet)

 invoke: fcreatem <frame> <slot>
 result: a new method facet is created in the slot of the frame
         return 1 if successful, return 0 otherwise

 fcreater (create a reference facet)

 invoke: fcreater <frame> <slot>
 result: a new reference facet is created in the slot of the frame
         return 1 if successful, return 0 otherwise

 fcreates (create a slot)

 invoke: fcreates <frame> <slot>
 result: a new slot is created in the frame
         return 1 if successful, return 0 otherwise

 fcreatev (create a value facet)

 invoke: fcreatev <frame> <slot>
 result: a new value facet is created in the slot of the frame
         return 1 if successful, return 0 otherwise

 fdo (remote execution)

 invoke: fdo <message> <socket>
 result: send code to be executed to server

 fexecd (execute a demon)

 invoke: fexecd <frame> <slot> <demon>
 result: execute the demon in slot of the frame
         return 1 if successful, return 0 otherwise

 fexecm (execute a method)

 invoke: fexecm <frame> <slot>
 result: execute the method in the slot of the frame
         return 1 if successful, return 0 otherwise

 fexecx (execute agent code)

 invoke: fexecx <frame>
 result: execute agent code of a frame
         return 1 if successful, return 0 otherwise

 fexistd (determine if a demon facet exists)

 invoke: fexistd <frame> <slot> <demon>
 result: return 1 if the demon in the slot of the frame exists
         return 0 otherwise

 fexistf (determine if a frame exists)

 invoke: fexistf <frame>
 result: return 1 if the frame exists, return 0 otherwise

 fexistm (determine if a method facet exists)

 invoke: fexistm <frame> <slot>
 result: return 1 if the method facet in the slot of the frame exists
         return 0 otherwise

 fexistr (determine if a reference facet exists)

 invoke: fexistr <frame> <slot>
 result: return 1 if the reference facet in the slot of the frame exists
         return 0 otherwise

 fexists (determine if a slot exists)

 invoke: fexists <frame> <slot>
 result: return 1 if the slot in the frame exists
         return 0 otherwise

 fexistv (determine if a value facet exists)

 invoke: fexistv <frame> <slot>
 result: return 1 if the value facet in the slot of the frame exists
         return 0 otherwise

 ffetchf (fetch a frame)

 invoke: ffetchf <frame> <socket>
 result: move a frame here from a server
         return 1 if successful, 0 otherwise

 ffetchfs (fetch a frame set)

 invoke: ffetchfs <set> <socket>
 result: move a frame set here from a server
         return 1 if successful, 0 otherwise

 ffilterf (filter a frame)

 invoke: ffilterf <frame> <frame>
 result: remove common slots of first frame from second frame
         return 1 if successful, 0 otherwise

 fgetd (get demon code)

 invoke: fgetd <frame> <slot> <demon>
 result: return the demon code in the slot of the frame
         return nothing if this fails

 fgetm (get method code)

 invoke: fgetm <frame> <slot>
 result: return the method code in the slot of the frame
         return nothing if this fails

 fgetr (get reference)

 invoke: fgetr <frame> <slot>
 result: return the frame name for the reference in the slot of the frame
         return nothing if this fails

 fgets (get a frame status)

 invoke: fgets <frame>
 result: return the agent state of a frame
         return nothing if this fails

 fgetv (get a value)

 invoke: fgetv <frame> <slot>
 result: return the value for the value facet in the slot of the frame
         return nothing if this fails

 fgetx (get agent code)

 invoke: fgetx <frame>
 result: return the agent code of a frame
         return nothing if this fails

 flistf (list frames)

 invoke: flistf
 result: return the frames which exist

 flistr (list references)

 invoke: flistr <frame>
 result: return the slots of the frame which contain references
         return empty list if this fails

 flists (list slots)

 invoke: flists <frame>
 result: return the slots of the frame
         return empty list if this fails

 flistt (list facets)

 invoke: flistt <frame> <slot>
 result: return the facet types for the slot of the frame
         return empty list if this fails

 floadf (load a frame)

 invoke: floadf <frame>
 result: frame is loaded from disk into memory
         return 1 if successful, return 0 otherwise

 floadfs (load a frame set)

 invoke: floadfs <set>
 result: set is loaded from disk into memory
         return 1 if successful, return 0 otherwise

 flockf (lock a frame)

 invoke: flockf <frame>
 result: lock a frame so it cannot be modified
         return 1 if successful, 0 otherwise

 flockfs (lock a frame set)

 invoke: flockfs <set>
 result: lock a frame set so it cannot be modified
         return 1 if successful, 0 otherwise

 fmergef (merge frames)

 invoke: fmergef <frame> <frame>
 result: copy non-common slots of first frame into second frame
         return 1 if successful, 0 otherwise

 fpack (pack a frame)

 invoke: fpack <frame>
 result: remove a frame and return a packed list of the frame if successful
         return an empty list if this fails

 fpathr (get path of references)

 invoke: fpathr <frame> <slot>
 result: return a list of frame names for each frame in the reference chain

 fputd (assign demon code)

 invoke: fputd <frame> <slot> <demon> <procedure>
 result: assign code to the demon facet of the slot of the frame
         return 1 if successful, return 0 otherwise

 fputm (assign method code)

 invoke: fputm <frame> <slot> <procedure>
 result: assign code to the method facet of the slot of the frame
         return 1 if successful, return 0 otherwise

 fputr (assign a reference)

 invoke: fputr <frame> <slot> <procedure>
 result: assign frame name to the reference facet of the slot of the frame
         return 1 if successful, return 0 otherwise

 fputs (assign a state)

 invoke: fputs <frame> <value>
 result: assign a state to a frame
         return 1 if successful, return 0 otherwise

 fputv (assign a value)

 invoke: fputv <frame> <slot> <value>
 result: assign value to the value facet of the slot of the frame
         return 1 if successful, return 0 otherwise

 fputx (assign agent code)

 invoke: fputx <frame> <procedure>
 result: assign agent code to a frame
         return 1 if successful, 0 otherwise

 fremoved (remove a demon facet)

 invoke: fremoved <frame> <slot> <demon>
 result: destroy demon facet in slot of the frame
         return 1 if successful, return 0 otherwise

 fremovef (remove a frame)

 invoke: fremovef <frame>
 result: destroy frame
         return 1 if successful, return 0 otherwise

 fremovem (remove a method facet)

 invoke: fremovem <frame> <slot>
 result: destory method facet in slot of the frame
         return 1 if successful, return 0 otherwise

 fremover (remove a reference)

 invoke: fremover <frame> <slot>
 result: destroy reference facet in slot of the frame
         return 1 if successful, return 0 otherwise

 fremoves (remove a slot)

 invoke: fremoves <frame> <slot>
 result: destory slot of the frame
         return 1 if successful, return 0 otherwise

 fremovev (remove a value facet)

 invoke: fremovev <frame> <slot>
 result: destroy value facet in slot of the frame
         return 1 if successful, return 0 otherwise

 frpc (remote procedure call)

 invoke: frpc <message> <socket>
 result: send code to be executed to server
         return results of that execution

 fscreated (create a demon facet for a frame set)

 invoke: fscreated <set> <slot> <demon>
 result: a new demon facet is created in the slot of the frame set
         return 1 if successful, return 0 otherwise

 fscreatem (create a method facet for a frame set)

 invoke: fscreatem <set> <slot>
 result: a new method facet is created in the slot of the frame set
         return 1 if successful, return 0 otherwise

 fscreater (create a reference for a frame set)

 invoke: fscreater <set> <slot>
 result: a new reference facet is created in the slot of the frame set
         return 1 if successful, return 0 otherwise

 fscreates (create a slot for a frame set)

 invoke: fscreates <set> <slot>
 result: a new slot is created in the frame set
         return 1 if successful, return 0 otherwise

 fscreatev (create a value facet for a frame set)

 invoke: fscreatev <set> <slot>
 result: a new value facet is created in the slot of the frame set
         return 1 if successful, return 0 otherwise

 fsendf (send a frame)

 invoke: fsendf <frame> <socket>
 result: send a frame to a server
         return 1 if successful, 0 otherwise

 fsendfs (send a frame set)

 invoke: fsendfs <set> <socket>
 result: send a frame set to a server
         return 1 if successful, 0 otherwise

 fsexcludef (exclude a frame from a frame set)

 invoke: fsexcludef <set> <frame>
 result: frame is excluded from the frame set
         return 1 if successful, return 0 otherwise

 fsgetr (get a reference from a frame set)

 invoke: fsgetr <set> <slot>
 result: return a reference from a slot if successful, return "" otherwise

 fsincludef (include a frame in a frame set)

 invoke: fsincludef <set> <frame>
 result: frame is included in the frame set
         return 1 if successful, return 0 otherwise

 fsleepf (put a frame to sleep)

 invoke: fsleepf <frame>
 result: put a frame to sleep so that methods cannot be invoked
         return 1 if successful, 0 otherwise

 fsleepfs (put a frame set to sleep)

 invoke: fsleepfs <set>
 result: put a frame set to sleep so that methods of associated frames
         cannot be invoked
         return 1 if successful, 0 otherwise

 fslistf (get a list of frames in a frame set)

 invoke: fslistf <set>
 result: return the frames which are part of the frame set
         return empty list if this fails

 fsmemberf (get a list of frame sets of which a frame is a member)

 invoke: fsmemberf <frame>
 result: return a list of frame sets of which a frame is a member
         return empty list if this fails

 fsputr (assign a reference to a frame set)

 invoke: fsputr <set> <slot> <frame>
 result: put a reference into a slot of the frame set
         return 1 if successful, return 0 otherwise

 fsremoved (remove a demon facet from a frame set)

 invoke: fsremoved <set> <slot> <demon>
 result: destroy demon facet in slot of the frame set
         return 1 if successful, return 0 otherwise

 fsremovem (remove method demon from a frame set)

 invoke: fsremovem <set> <slot>
 result: destory method facet in slot of the frame set
         return 1 if successful, return 0 otherwise

 fsremover (remove a reference from a frame set)

 invoke: fsremover <set> <slot>
 result: destroy reference facet in slot of the frame set
         return 1 if successful, return 0 otherwise

 fsremoves (remove a slot from a frame set)

 invoke: fsremoves <set> <slot>
 result: destory slot of the frame set
         return 1 if successful, return 0 otherwise

 fsremovev (remove a value facet from a frame set)

 invoke: fsremovev <set> <slot>
 result: destroy value facet in slot of the frame set
         return 1 if successful, return 0 otherwise

 fstoref (store a frame)

 invoke: fstoref <frame>
 result: store the representation of a frame on disk
         return 1 if successful, return 0 otherwise

 fstorefs (store a frame set)

 invoke: fstorefs <set>
 result: store the representation of a frame set on disk
         return 1 if successful, return 0 otherwise

 funlockf (unlock a frame)

 invoke: funlockf <frame>
 result: unlocks a frame so that it can be modified
         return 1 if successful, 0 otherwise

 funlockfs (unlock a frame set)
 invoke: funlockfs <set>
 result: unlocks a frame set so that it can be modified
         return 1 if successful, 0 otherwise

 funpack (unpack a frame)

 invoke: funpack <frame> <packed list>
 result: unpacks and restores a frame from a packed list

 fupdatef (synchronize a frame)

 invoke: fupdate <frame> <frame>
 result: synchronize frame structure of first frame on second frame
         return 1 if successful, return 0 otherwise

 fwakef (wake up a frame)

 invoke: fwakef <frame>
 result: wake up a frame so that methods can be invoked
         return 1 if successful, 0 otherwise

 fwakefs (wake up a frame set)

 invoke: fwakefs <set>
 result: wake up a frame set so that methods of associated frames can be invoked
         return 1 if successful, 0 otherwise

 Internal Structure

    The internal structure of the frame system begins with a root variable
 containing the names of all the frames.  In turn the frames consist of
 associative arrays.  The elements of an associative array contain agent code,
 an agent state, a list of slots, a list of facets, procedure names, frame
 names, and values.

 fframes = {frame name ..}
 frame(frame,start) = code
 frame(frame,state) = active | asleep | locked | inactive
 frame(frame,slots) = {slot name ..}
 frame(slot,facets) = {facet name ..}
 frame(slot,method) = code
 frame(slot,value) = {value ..}
 frame(slot,ref) = frame name
 frame(slot,demon) = code

    Frame sets also consist of associative arrays.  The elements of an
 associative array contain agent code, an agent state, a list of frames
 included in the frame set, a list of slots, a list of facets, and frame names.

 frame(frame,start) = code
 frame(frame,state) = active | asleep | locked | inactive
 frame(frame,set) = {frame name ..}
 frame(frame,slots) = {slot name ..}
 frame(slot,facets) = {facet name ..}
 frame(slot,method) = {}
 frame(slot,value) = {}
 frame(slot,ref) = frame name
 frame(slot,demon) = {}

 Agents

    Agents are supposed to be autonomous, so when an agent moves its main
 code in frame(frame,start) is automatically started (unless the agent is
 asleep).  This variable is universal so it cannot be created or removed.
    The state of an agent is used for timing.  Am active state allows
 both invocations and modifications.  Asleep prevents invocations.  Locked
 prevents modifications.  An inactive state prevents both invocations and
 modifications.  This variable is also universal so it cannot be created
 or removed either.

 References

    References are used by method and value operations to locate
 method and value facets to operate on.  There can only be one reference
 in a reference facet.  However, there can be an unlimited chain of
 references.  The only requirements are that a method or value facet must
 terminate the chain of references, and all references must be in slots
 of the same name.

 Demons

    Demons (like methods) point to procedures.  However, unlike methods,
 demons are automatically called when operations are performed on methods,
 values, or references.
    Demon operations do not directly use references.  However, the location
 of demons to execute directly depends on the location where method, value,
 and reference operations are performed.
    The demons which can be defined are ifcreatem, ifcreater, ifcreatev,
 ifexecm, ifexistm, ifexistr, ifexistv, ifgetm, ifgetr, ifgetv, ifputm,
 ifputr, ifputv, ifref, ifremovem, ifremover, and ifremovev.

 List Extension

    The list extension provides some service to the frame system.  However,
 its potential use should be in procedures pointed to by methods and
 demons which operate on values stored in the frames.

 Frame Set Operations

    Commands involving the structure of frames are repeated for every
 frame included in the frame set.  This does not mean that all frames
 included in the frame set have exactly the same structure and values.
 It only means that there is a core structure which all the frames
 in the frame set pocess.

 Frame Storage

    Frames are stored by using the frame name as the file name, and saving
 each pair of element name and value of the associated array.  Loading
 a frame then consists of appending the frame name to fframes, and a series
 of set statements to restore the structure of the associated array.

 file name=frame name
 file contents:
 frame,start code
 frame,state <state>
 frame,slots {slot name ..}
 slot,facets {facet name ..}
 slot,method <code>
 slot,value  {value ..}
 slot,ref    <frame>
 slot,demon  <code>

 Frame Set Storage

    Frame sets are stored by using the frame name as the file name, and saving
 each pair of element name and value of the associated array.  Loading
 a frame set then consists of appending the frame set name to fframes, a series
 of set statements to restore the structure of the associated array, and then
 using the list of frames stored in the frame set to repeat the process for
 the frames included in the frame set.

 file name=frame set name
 file contents:
 frame,start <code>
 frame,state <state>
 frame,set   {frame name ..}
 frame,slots {slot name ..}
 slot,facets {facet name ..}
 slot,method {}
 slot,value  {}
 slot,ref    <frame>
 slot,demon  {}

 This software is OSI Certified Open Source Software.
 OSI Certified is a certification mark of the Open Source Initiative.

frameagents.tcl
 ######################################################################
 #
 # program name: frameagents.tcl
 #   programmer: Cris A. Fugate
 # date written: September 2, 1998 (wrote frames.tcl)
 #      changed: September 28, 1998 (added floadf and fstoref to frames)
 #      changed: November 25, 1998 (wrote framesets.tcl)
 #      changed: February 10, 1999 (added fupdatef to frames,
 #               added fsgetr, fsputr and fsmemberf to framesets)         
 #      changed: April 16, 1999 (merged frames and framesets)
 #      changed: November 8, 1999 (added args to fputv,fputm,fputd)
 #      changed: February 15, 2000 (added agent technology)
 #
 #  description: This program is an extension to the tcl scripting
 #               language.  It provides a frame and frameset
 #               mechanism which can be used to dynamically organize
 #               and perform operations on values and procedures.
 #
 # Copyright (c) 2000 Cris A. Fugate
 #
 # Permission is hereby granted, free of charge, to any person obtaining 
 # a copy of this software and associated documentation files (the 
 # "Software"), to deal in the Software without restriction, including 
 # without limitation the rights to use, copy, modify, merge, publish, 
 # distribute, sublicense, and/or sell copies of the Software, and to 
 # permit persons to whom the Software is furnished to do so, subject to 
 # the following conditions:
 #
 # The above copyright notice and this permission notice shall be included 
 # in all copies or substantial portions of the Software.
 #
 # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
 # OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
 # THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
 # OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, 
 # ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 
 # OTHER DEALINGS IN THE SOFTWARE. 
 #
 ######################################################################       
 #
 #                              Variables
 # 
 # aname                        array name
 # args                         list of arguments
 # avalue                       array value
 # cmp                          comparison flag
 # created                      create flag
 # dname                        demon type
 # elcnt                        count of list elements
 # elema                        element of a list
 # executed                     execute flag
 # exist                        flag for frame exists
 # fframes                      list of frames
 # fh                           file handle
 # fhbuf                        file handle buffer
 # flist                        list of references in a frame 
 # fname                        frame name
 # fname1                       frame name
 # fname2                       frame name
 # found                        exist flag
 # ftype                        facet type
 # i                            loop variable
 # lista                        first list to be processed 
 # listb                        second list to be processed
 # listx                        first temporary list
 # listy                        second temporary list
 # mlist                        list of framesets of which a frame 
 #                              is a member
 # msg                          message to send/receive 
 # name                         frameset name
 # plist                        list of frames in a reference chain
 # pname                        procedure name
 # put                          put flag
 # r                            reference
 # removed                      remove flag
 # result                       result returned from server
 # s                            list of frames in the frameset
 # sid                          server socket id
 # sname                        slot name
 # sname2                       slot name
 # status                       status of a frame
 # x                            variable used in place of expression
 # y                            variable used in place of expression
 # <fname>(<ename>)             used in operations involving many elements
 # <fname>(<fname>,set)         frames in a frameset
 # <fname>(<fname>,slots)       slots in a frame
 # <fname>(<fname>,start)       code to execute after frame is sent
 # <fname>(<fname>,state)       state of a frame
 # <fname>(<sname>,<ftype>)     demon facet
 # <fname>(<sname>,facets)      facets in a slot
 # <fname>(<sname>,ifcreatem)   ifcreatem demon
 # <fname>(<sname>,ifcreater)   ifcreater demon
 # <fname>(<sname>,ifcreatev)   ifcreatev demon 
 # <fname>(<sname>,ifexecm)     ifexecm demon
 # <fname>(<sname>,ifexistm)    ifexistm demon
 # <fname>(<sname>,ifexistr)    ifexistr demon
 # <fname>(<sname>,ifexistv)    ifexistv demon
 # <fname>(<sname>,ifgetm)      ifgetm demon
 # <fname>(<sname>,ifgetr)      ifgetr demon
 # <fname>(<sname>,ifgetv)      ifgetv demon
 # <fname>(<sname>,ifputm)      ifputm demon
 # <fname>(<sname>,ifputr)      ifputr demon
 # <fname>(<sname>,ifputv)      ifputv demon
 # <fname>(<sname>,ifref)       ifref demon
 # <fname>(<sname>,ifremovem)   ifremovem demon
 # <fname>(<sname>,ifremover)   ifremover demon
 # <fname>(<sname>,ifremovev)   ifremovev demon
 # <fname>(<sname>,method)      method facet
 # <fname>(<sname>,ref)         reference facet
 # <fname>(<sname>,value)       value facet
 #
 ######################################################################   
 #
 #                              Procedures
 #
 # compress                     order and remove duplicates from a list
 # equivalence                  determine is two lists are equivalent
 # fcomparef                    compare slots of two frames
 # fcompares                    compare two slots
 # fcopyf                       make a copy of a frame
 # fcopys                       make a copy of a slot in another frame
 # fcreated                     create a demon facet 
 # fcreatef                     create a frame
 # fcreatefs                    create a frameset 
 # fcreatem                     create a method facet
 # fcreater                     create a reference facet
 # fcreates                     create a slot
 # fcreatev                     create a value facet
 # fdo                          do something
 # fdos                         do something service
 # fexecd                       directly execution a demon
 # fexecm                       execute a method
 # fexecx                       execute a frame start method
 # fexistd                      determine if a demon facet exists
 # fexistf                      determine if a frame exists
 # fexistm                      determine if a method facet exists
 # fexistr                      determine if a reference facet exists
 # fexistrx                     (same as fexistr without a demon call)
 # fexists                      determine if a slot exists
 # fexistv                      determine if a value facet exists
 # ffetchf                      fetch a frame
 # ffetchfs                     fetch a frameset
 # ffilterf                     filter a frame based on another frame
 # fgetd                        get the value of a demon facet
 # fgetm                        get the value of a method facet
 # fgetr                        get the value of a reference facet
 # fgets                        get the state of a frame
 # fgetv                        get the value of a value facet
 # fgetx                        get the start code of a frame
 # flistf                       get a list of existing frames
 # flistr                       get a list of references in a frame
 # flists                       get a list of slots for a frame
 # flistt                       get a list of facet types for a slot
 # floadf                       load a frame into memory
 # floadfs                      load a frameset into memory
 # flockf                       lock a frame
 # flockfs                      lock a frameset
 # fmergef                      merge slots of a frame into another frame
 # fpack                        pack a frame
 # fpathr                       get a list of frames in a reference chain
 # fputd                        put a value into a demon facet
 # fputm                        put a value into a method facet
 # fputr                        put a value into a reference facet
 # fputs                        assign a state to a frame
 # fputv                        put a value into a value facet
 # fputx                        assign start code to a frame
 # fremoved                     destroy a demon facet
 # fremovef                     destroy a frame
 # fremovefs                    destroy a frameset
 # fremovem                     destroy a method facet
 # fremover                     destroy a reference facet
 # fremoves                     destroy a slot
 # fremovev                     destroy a value facet
 # frpc                         remote procedure call
 # frpcs                        remote procedure call service
 # fscreated                    create a demon facet in a frameset
 # fscreatem                    create a method facet in a frameset
 # fscreater                    create a reference facet in a frameset
 # fscreates                    create a slot in a frameset
 # fscreatev                    create a value facet in a frameset
 # fsendf                       send a frame
 # fsendfs                      send a frameset
 # fsexcludef                   exclude a frame from a frameset
 # fsgetr                       get a value from a reference facet 
 #                              in a frameset
 # fsincludef                   include a frame in a frameset 
 # fsleepf                      put a frame to sleep
 # fsleepfs                     put a frameset to sleep
 # fslistf                      get a list of frames in a frameset
 # fsmemberf                    get list of framesets in which 
 #                              a frame is a member
 # fsputr                       put a value in a reference facet
 #                              in a frameset
 # fsremoved                    remove a demon facet from a frameset
 # fsremovem                    remove a method facet from a frameset
 # fsremover                    remove a reference facet from a frameset
 # fsremoves                    remove a slot from a frameset
 # fsremovev                    remove a value facet from a frameset
 # fstoref                      store a frame on disk
 # fstorefs                     store a frameset on disk
 # funlockf                     unlock a frame
 # funlockfs                    unlock a frameset
 # funpack                      unpack a frame
 # fupdatef                     synchronize a frame based on another frame
 # fwakef                       wake up a frame
 # fwakefs                      wake up a frameset
 # member                       determine if a value is a member of a list
 # remove                       remove a value from a list
 #
 
 #
 # compress - order and remove duplicates from a list
 # modifies lista
 #
 proc compress lista {
     upvar $lista listx
     set listx [lsort $listx]
     set listy [lindex $listx 0]
     set elema $listy
     foreach i $listx {
         if {$elema != $i} {
             lappend listy $i
         }
         set elema $i
     }
     set listx $listy
 }
 
 #
 # equivalence - determine if two lists are equivalent
 #
 proc equivalence {lista listb} {
     set listx $lista
     set listy $listb
     compress listx
     compress listy
     if {$listx == $listy} {
         return 1
     } else {
         return 0
     }
 }
 
 #
 # member - determine if an element is a member of a list
 #
 proc member {lista elema} {
     set elcnt 0
     foreach i $lista {
         if {$elema == $i} {
             incr elcnt
         }
     }
     return $elcnt
 }
 
 #
 # remove - remove all occurances of an element from a list
 # modifies lista
 #
 proc remove {lista elema} {
     upvar $lista listx
     set listy {}
     foreach i $listx {
         if {$elema != $i} {
             lappend listy $i
         }
     }
     set listx $listy
 }
 
 # initialize frames
 set fframes {}
 
 #
 # fexistf - determine if a frame exists
 # calls member
 #
 proc fexistf fname {
     global fframes
     return [member $fframes $fname]
 } 
 
 #
 # fcreatef - create a frame
 # requires that fname() does not exist
 # modifies fframes, fname(fname,slots)
 # calls fexistf
 #
 proc fcreatef fname {
     global fframes
     if {![fexistf $fname]} {
         lappend fframes $fname
         uplevel \#0 "set $fname\($fname,start) {}"
         uplevel \#0 "set $fname\($fname,state) {active}"
         uplevel \#0 "set $fname\($fname,slots) {}"
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fremovef - remove a frame
 # requires that fname() exists and is not locked
 # modifies fframes,fname()
 # calls fexistf, fgets
 #
 proc fremovef fname {
     global fframes
     if {[fexistf $fname] && [fgets $fname] != "locked" && [fgets $fname] != "inactive"} {
         foreach i [uplevel \#0 "array names $fname"] {
             uplevel \#0 "unset $fname\($i)"
         }
         remove fframes $fname
         return 1
     } else {
         return 0
     }
 
 }
 
 #
 # flistf - return list of frames
 #
 proc flistf {} {
     global fframes
     return $fframes
 }
 
 #
 # fcopyf - create a new frame based on another frame
 # requires that fname1() exists and fname2() is not locked
 # modifies fname2()
 # calls fexistf, fremovef
 #
 proc fcopyf {fname1 fname2} {
     if {[fexistf $fname1] && [fgets $fname2] != "locked" && [fgets $fname2] != "inactive"} {
         fremovef $fname2
         fcreatef $fname2
         uplevel \#0 "set $fname2\($fname2,slots) $$fname1\($fname1,slots)"
         foreach i [uplevel \#0 "array names $fname1"] {
             if {$i != "$fname1,start" && $i != "$fname1,state" && $i != "$fname1,set" && $i != "$fname1,slots"} {
                 uplevel \#0 "set $fname2\($i) $$fname1\($i)"
             }
         }
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fcomparef - determine if two frames are equivalent
 # requires that fname1() and fname2() exist
 # calls fexistf
 #
 proc fcomparef {fname1 fname2} {
     if {[fexistf $fname1] && [fexistf $fname2]} {
         set x [uplevel \#0 "set $fname1\($fname1,slots)"]
         set y [uplevel \#0 "set $fname2\($fname2,slots)"]
         if {[equivalence $x $y]} {
             return 1
         } else {
             return 0
         }
     } else {
         return 0
     }
 
 }
 
 #
 # fmergef - merge slots of one frame into another other
 # requires that fname1() and fname2() exist and fname2() is not locked
 # modifies fname2()
 # calls fexistf, fgets
 #
 proc fmergef {fname1 fname2} {
     if {[fexistf $fname1] && [fexistf $fname2] && [fgets $fname2] != "locked" && [fgets $fname2] != "inactive"} {
         set y [uplevel \#0 "set $fname2\($fname2,slots)"]
         foreach i [uplevel \#0 "array names $fname1"] {
             if {$i != "$fname1,start" && $i != "$fname1,state" && $i != "$fname1,set" && $i != "$fname1,slots"} {
                 scan $i "%\[^,]" sname
                 if {![member $y $sname]} {
                     uplevel \#0 "set $fname2\($i) $$fname1\($i)"
                     uplevel \#0 "lappend $fname2\($fname2,slots) $sname"
                 }
             }
         }
         return 1
     } else {
         return 0
     }
 }
 
 #
 # floadf - load a frame into memory
 # requires that fname() exists on disk, but not in memory
 # calls fexistf, remove
 #
 proc floadf fname {
     global fframes
     if {[file exists $fname] && ![fexistf $fname]} {
         lappend fframes $fname
         set fh [open $fname r]
         while {![eof $fh]} {
             gets $fh fhbuf
             set aname [lindex $fhbuf 0]
             set avalue [remove fhbuf $aname]
             uplevel \#0 "set $fname\($aname) {$avalue}"
         }
         close $fh
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fstoref - store a frame on disk
 # requires that fname() exists
 # calls fexistf
 #
 proc fstoref fname {
     if {[fexistf $fname]} {
         set fh [open $fname w]
         foreach i [uplevel \#0 "array names $fname"] {
             set avalue [uplevel \#0 "set $fname\($i)"]
             puts $fh "$i $avalue"
         }
         close $fh
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fupdatef - update structure of a frame from another frame
 # requires that both frames exist and fname2() is not locked
 # modifies frame2()
 # calls fexistf, fgets
 #
 proc fupdatef {fname1 fname2} {
     if {[fexistf $fname1] && [fexistf $fname2] && [fgets $fname2] != "locked" && [fgets $fname2] != "inactive"} {
         uplevel \#0 "set $fname2\($fname2,slots) $$fname1\($fname1,slots)"
         foreach i [uplevel \#0 "array names $fname2"] {
             if {$i != "$fname2,start" && $i != "$fname2,state" && $i != "$fname2,set" && $i != "$fname2,slots"} {
                 if {![uplevel \#0 "info exists $fname1\($i)"]} {
                     uplevel \#0 "unset $fname2\($i)"
                 }
             }
         }
         foreach i [uplevel \#0 "array names $fname1"] {
             if {$i != "$fname1,start" && $i != "$fname1,state" && $i != "$fname1,set" && $i != "$fname1,slots"} {
                 if {![uplevel \#0 "info exists $fname2\($i)"]} {
                     uplevel \#0 "set $fname2\($i) $$fname1\($i)"
                 }
             } 
         }
         return 1
     } else {
         return 0
     }
 }
 
 #
 # ffilterf - filter slots of a frame based on another frame
 # requires that both frames exist and fname2() is not locked
 # modifies frame2()
 # calls fexistf, fgets
 # 
 proc ffilterf {fname1 fname2} {
     if {[fexistf $fname1] && [fexistf $fname2] && [fgets $fname2] != "locked" && [fgets $fname2] != "inactive"} {
         foreach i [uplevel \#0 "array names $fname2"] {
             if {$i != "$fname2,start" && $i != "$fname2,state" && $i != "$fname2,set" && $i != "$fname2,slots"} {
                 if {![uplevel \#0 "info exists $fname1\($i)"]} {
                     uplevel \#0 "unset $fname2\($i)"
                 }
             }
         }
         return 1
     } else {
         return 0
     } 
 }
 
 #
 # fexists - determine if a slot exists
 # requires that fname() exists
 # fexistf
 #
 proc fexists {fname sname} {
     if {[fexistf $fname]} {
         if {[uplevel \#0 "member $$fname\($fname,slots) $sname"]} {
             return 1
         } else {
             return 0
         }
     } else {
         return 0
     }
 }
 
 #
 # fcreates - create a slot
 # requires that fname() exists and is not locked
 # modifies fname(fname,slot),fname(sname,facets)
 # calls fexistf, fgets
 #
 proc fcreates {fname sname} {
     if {[fexistf $fname] && [fgets $fname] != "locked" && [fgets $fname] != "inactive"} {
         if {[uplevel \#0 "member $$fname\($fname,slots) $sname"] == 0} {
             uplevel \#0 "lappend $fname\($fname,slots) $sname"
             uplevel \#0 "set $fname\($sname,facets) {}"
             return 1
         } else {
             return 0
         }
     } else {
         return 0
     }
 }
 
 #
 # fremoves - remove a slot
 # requires that fname(sname,facets) exists and fname() is not locked
 # modifies fname(fname,slots),fname(sname,)
 # calls fexists, fgets, remove
 #
 proc fremoves {fname sname} {
     if {[fexists $fname $sname] && [fgets $fname] != "locked" && [fgets $fname] != "inactive"} {
         foreach i [uplevel \#0 "array names $fname"] {
             scan $i "%\[^,]" sname2
             if {$sname == $sname2} {
                 uplevel \#0 "unset $fname\($i)"
             }
         }
         uplevel \#0 "remove $fname\($fname,slots) $sname"
         return 1
     } else {
         return 0
     }
 }
 
 #
 # flists - list slots of a frame
 # requires that fname() exists
 # calls fexistf
 #
 proc flists fname {
     if {[fexistf $fname]} {
         return [uplevel \#0 "set $fname\($fname,slots)"]
     } else {
         return {}
     }
 }
 
 #
 # fcopys - copy a slot into another frame
 # requires that fname1() and fname2() exist
 # modifies fname2(sname,)
 # calls fexists, fexistf, fgets, member
 #
 proc fcopys {fname1 sname fname2} {
     if {[fexists $fname1 $sname] && [fexistf $fname2] && [fgets $fname2] != "locked" && [fgets $fname2] != "inactive"} {
         if {[uplevel \#0 "member $$fname2\($fname2,slots) $sname"] == 0} {
             uplevel \#0 "lappend $fname2\($fname2,slots) $sname"
          }
         foreach i [uplevel \#0 "array names $fname1"] {
             scan $i "%\[^,]" sname2
             if {$sname == $sname2} {
                 uplevel \#0 "set $fname2\($i) $$fname1\($i)"
             }
         }
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fcompares - compare a slot in two frames
 # requires that fname1(sname,facets) and fname2(sname,facets) exist
 # calls fexists, equivalence
 #
 proc fcompares {fname1 sname fname2} {
     set cmp 1
     if {[fexists $fname1 $sname] && [fexists $fname2 $sname]} {
         set x [uplevel \#0 "set $fname1\($sname,facets)"]
         set y [uplevel \#0 "set $fname2\($sname,facets)"]
         if {[equivalence $x $y]} {
             foreach i [uplevel \#0 "array names $fname1"] {
                 scan $i "%\[^,]" sname2
                 if {$sname == $sname2} {
                     set x [uplevel \#0 "set $fname1\($i)"]
                     set y [uplevel \#0 "set $fname2\($i)"]
                     if {$x != $y} {
                         set cmp 0
                     }
                 }                       
             }
             return $cmp                    
         } else {
             return 0
         }
     } else {
         return 0
     }
 }
 
 #
 # flistt - list of facet types in a slot
 # requires that fname(sname,facets) exists
 # calls fexists
 #
 proc flistt {fname sname} {
     if {[fexists $fname $sname]} {
         return [uplevel \#0 "set $fname\($sname,facets)"]
     } else {
         return {}
     }
 }
 
 #
 # fexistrx - determine if a reference facet exists (internal)
 # requires that fname(sname,facets) exists
 # fexists, member
 # 
 proc fexistrx {fname sname} {
     if {[fexists $fname $sname]} {
         if {[uplevel \#0 "member $$fname\($sname,facets) ref"]} {
             return 1
         } else {
             return 0
         }
     } else {
         return 0
     }
 }
 
 # 
 # fexistr - determine if a reference facet exists
 # requires that fname(sname,facets) exists
 # calls fexistrx, member, ifexistr demon
 #
 proc fexistr {fname sname} {
     if {[fexistrx $fname $sname]} {
         if {[uplevel \#0 "member $$fname\($sname,facets) ifexistr"]} {
             uplevel \#0 "eval $$fname\($sname,ifexistr)"
         }
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fcreater - create a reference facet
 # requires that fname(sname,facets) exists and fname() is not locked
 # modifies fname(sname,facets),fname(sname,ref)
 # calls fexists, fgets, member, ifcreater demon
 #
 proc fcreater {fname sname} {
     if {[fexists $fname $sname] && [fgets $fname] != "locked" && [fgets $fname] != "inactive"} {
         if {[uplevel \#0 "member $$fname\($sname,facets) ref"] == 0} { 
             set x [uplevel \#0 "member $$fname\($sname,facets) method"]
             set y [uplevel \#0 "member $$fname\($sname,facets) value"]
             if {!($x || $y)} {
                 uplevel \#0 "lappend $fname\($sname,facets) ref"
                 uplevel \#0 "set $fname\($sname,ref) {}"
                 if {[uplevel \#0 "member $$fname\($sname,facets) ifcreater"]} {
                     uplevel \#0 "eval $$fname\($sname,ifcreater)"
                 }
                 return 1
             } else {
                 return 0
             }
         } else {
             return 0
         }
     } else {
         return 0
     }
 }
 
 #
 # fremover - remove a reference facet
 # requires that fname(sname,ref) exists and fname() is not locked
 # modifies fname(sname,facets),fname(sname,ref)
 # calls fexistrx, fgets, member, remove, ifremover demon
 #
 proc fremover {fname sname} {
     if {[fexistrx $fname $sname] && [fgets $fname] != "locked" && [fgets $fname] != "inactive"} {
         if {[uplevel \#0 "member $$fname\($sname,facets) ifremover"]} {
             uplevel \#0 "eval $$fname\($sname,ifremover)"
         }
         uplevel \#0 "unset $fname\($sname,ref)"
         uplevel \#0 "remove $fname\($sname,facets) ref"
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fgetr - get a value from a reference facet
 # requires that fname(sname,ref) exists
 # calls fexistrx, member, ifgetr demon
 #
 proc fgetr {fname sname} {
     if {[fexistrx $fname $sname]} {
         if {[uplevel \#0 "member $$fname\($sname,facets) ifgetr"]} {
             uplevel \#0 "eval $$fname\($sname,ifgetr)"
         }
         return [uplevel \#0 "set $fname\($sname,ref)"]
     } else {
         return {}
     }
 }
 
 #
 # fputr - put a value in a reference facet
 # requires that fname1(sname,ref) exists and fname1() is not locked
 # modifies fname(sname,ref)
 # calls fexistrx, fgets, member, ifputr demon
 #
 proc fputr {fname1 sname fname2} {
     if {[fexistrx $fname1 $sname] && [fgets $fname1] != "locked" && [fgets $fname1] != "inactive"} {
         uplevel \#0 "set $fname1\($sname,ref) $fname2"
         if {[uplevel \#0 "member $$fname1\($sname,facets) ifputr"]} {
             uplevel \#0 "eval $$fname1\($sname,ifputr)"
         }
         return 1
     } else {
         return 0
     }
 }
 
 #
 # flistr - list of references in a frame
 # requires that fname() exists
 # calls fexistf
 #
 proc flistr fname {
     set flist {}
     if {[fexistf $fname]} {
         foreach i [uplevel \#0 "array names $fname"] {
             scan $i "%\[^,],%s" sname ftype
             if {$ftype == "ref"} {
                 lappend flist $sname
             }
         }
     }
     return $flist
 }
 
 #
 # fpathr - return chain of references
 # requires that fname(sname,facets) exists
 # calls fexists, member, fpathr
 #
 proc fpathr {fname sname {plist {}}} {
     if {[fexists $fname $sname]} {
         if {[member $plist $fname] == 0} {
             lappend plist $fname
             if {[uplevel \#0 "member $$fname\($sname,facets) ref"]} {
                 set fname2 [uplevel \#0 "set $fname\($sname,ref)"]
                 fpathr $fname2 $sname $plist
             } else {
                 return $plist
             }
         } else {
             return $plist
         }
     } else {
         return $plist
     }
 }
 
 # 
 # fexistm - determine if a method facet exists
 # requires that fname(sname,facets) exists
 # calls fexists, fexistrx, member, fexistm, ifref and ifexistm demons
 #
 proc fexistm {fname sname} {
     set found 0
     if {[fexists $fname $sname]} {
         if {[fexistrx $fname $sname]} {
             set fname2 [uplevel \#0 "set $fname\($sname,ref)"]
             if {[uplevel \#0 "member $$fname\($sname,facets) ifref"]} {
                 uplevel \#0 "eval $$fname\($sname,ifref)"
             }
             set found [fexistm $fname2 $sname]
         }
         if {[uplevel \#0 "member $$fname\($sname,facets) method"]} {
             if {[uplevel \#0 "member $$fname\($sname,facets) ifexistm"]} {
                 uplevel \#0 "eval $$fname\($sname,ifexistm)"
             }
             set found 1
         }
     }
     return $found
 }
     
 #
 # fcreatem - create a method facet
 # requires that fname(sname,facets) exists and fname() is not locked
 # modifies fname(sname,facets),fname(sname,method) where fname is
 #          the original or referenced frame
 # calls fexists, fgets, member, fcreatem, ifref and ifcreatem demons
 #
 proc fcreatem {fname sname} {
     set created 0
     if {[fexists $fname $sname] && [fgets $fname] != "locked" && [fgets $fname] != "inactive"} {
         if {[uplevel \#0 "member $$fname\($sname,facets) method"] ||
             [uplevel \#0 "member $$fname\($sname,facets) value"]} {
             set created 0
         } else {
             if {[uplevel \#0 "member $$fname\($sname,facets) ref"]} {
                 set fname2 [uplevel \#0 "set $fname\($sname,ref)"] 
                 if {[uplevel \#0 "member $$fname\($sname,facets) ifref"]} {
                     uplevel \#0 "eval $$fname\($sname,ifref)"
                 }
                 set created [fcreatem $fname2 $sname]
             } else {
                 uplevel \#0 "set $fname\($sname,method) {}"
                 uplevel \#0 "lappend $fname\($sname,facets) method"
                 if {[uplevel \#0 "member $$fname\($sname,facets) ifcreatem"]} {
                     uplevel \#0 "eval $$fname\($sname,ifcreatem)"
                 }
                 set created 1
             }
         }
     }
     return $created
 }
 
 # 
 # fremovem - remove a method facet
 # requires sthat fname(sname,facets) exists and fname() is not locked
 # modifies fname(sname,facets),fname(sname,method) where fname is
 #          the original or referenced frame
 # calls fexists, fgets, member, fremovem, remove, ifref and ifremovem demons
 #
 proc fremovem {fname sname} {
     set removed 0
     if {[fexists $fname $sname] && [fgets $fname] != "locked" && [fgets $fname] != "inactive"} {
         if {[uplevel \#0 "member $$fname\($sname,facets) ref"]} {
             set fname2 [uplevel \#0 "set $fname\($sname,ref)"]
             if {[uplevel \#0 "member $$fname\($sname,facets) ifref"]} {
                 uplevel \#0 "eval $$fname\($sname,ifref)"
             }
             set removed [fremovem $fname2 $sname]
         } else {
             if {[uplevel \#0 "member $$fname\($sname,facets) method"]} {
                 if {[uplevel \#0 "member $$fname\($sname,facets) ifremovem"]} {
                     uplevel \#0 "eval $$fname\($sname,ifremovem)"
                 }
                 uplevel \#0 "unset $fname\($sname,method)"
                 uplevel \#0 "remove $fname\($sname,facets) method"
                 set removed 1
             } 
         }
     }
     return $removed
 }
 
 #
 # fexecm - execute a method
 # requires that fname(sname,facets) exists and fname() is not asleep
 # calls fexists, fgets, member, fexecm, ifref and ifexecm demons
 #
 proc fexecm {fname sname} {
     set executed 0
     if {[fexists $fname $sname] && [fgets $fname] != "asleep" && [fgets $fname] != "inactive"} {
         if {[uplevel \#0 "member $$fname\($sname,facets) ref"]} {
             set fname2 [uplevel \#0 "set $fname\($sname,ref)"] 
             if {[uplevel \#0 "member $fname\($sname,facets) ifref"]} {
                 uplevel \#0 "eval $$fname\($sname,ifref)"
             }
             set executed [fexecm $fname2 $sname]
         } else {
             if {[uplevel \#0 "member $$fname\($sname,facets) method"]} {
                 if {[uplevel \#0 "member $$fname\($sname,facets) ifexecm"]} {
                     uplevel \#0 "eval $$fname\($sname,ifexecm)"
                 }
                 uplevel \#0 "eval $$fname\($sname,method)"
                 set executed 1
             }
         }
     }
     return $executed
 }
 
 # 
 # fgetm - get a value from a method facet
 # requires that fname(sname,facets) exists
 # calls fexists, member, fgetm, ifref and ifgetm demons
 #
 proc fgetm {fname sname} {
     set pname {}
     if {[fexists $fname $sname]} {
         if {[uplevel \#0 "member $$fname\($sname,facets) ref"]} {
             set fname2 [uplevel \#0 "set $fname\($sname,ref)"]
             if {[uplevel \#0 "member $$fname\($sname,facets) ifref"]} {
                 uplevel \#0 "eval $$fname\($sname,ifref)"
             }
             set pname [fgetm $fname2 $sname]
         } else {
             if {[uplevel \#0 "member $$fname\($sname,facets) method"]} {
                 if {[uplevel \#0 "member $$fname\($sname,facets) ifgetm"]} {
                     uplevel \#0 "eval $$fname\($sname,ifgetm)"
                 }
                 set pname [uplevel \#0 "set $fname\($sname,method)"]
             }
         }
     }
     return $pname
 }
 
 #
 # fputm - put a value in a method facet
 # requires that fname(sname,facets) exists and fname() is not locked
 # modifies fname(sname,method) where fname is the original or
 #          referenced frame
 # calls fexists, fgets, member, fputm, ifref and ifputm demons
 #
 proc fputm {fname sname args} {
     set put 0
     if {[fexists $fname $sname] && [fgets $fname] != "locked" && [fgets $fname] != "inactive"} {
         if {[uplevel \#0 "member $$fname\($sname,facets) ref"]} {
             set fname2 [uplevel \#0 "set $fname\($sname,ref)"] 
             if {[uplevel \#0 "member $$fname\($sname,facets) ifref"]} {
                 uplevel \#0 "eval $$fname\($sname,ifref)"
             }
             set put [fputm $fname2 $sname $args]
         } else {
             if {[uplevel \#0 "member $$fname\($sname,facets) method"]} {
                 if {[uplevel \#0 "member $$fname\($sname,facets) ifputm"]} {
                     uplevel \#0 "eval $$fname\($sname,ifputm)"
                 }
                 uplevel \#0 "set $fname\($sname,method) $args"
                 set put 1
             }
         }
     }
     return $put
 }
 
 #
 # fexistv - determine if a value facet exists
 # requires that fname(sname,facets) exists
 # calls fexists, fexistrx, member, fexistv, ifref and ifexistv demons
 #
 proc fexistv {fname sname} {
     set found 0
     if {[fexists $fname $sname]} {
         if {[fexistrx $fname $sname]} {
             set fname2 [uplevel \#0 "set $fname\($sname,ref)"]
             if {[uplevel \#0 "member $$fname\($sname,facets) ifref"]} {
                 uplevel \#0 "eval $$fname\($sname,ifref)"
             }
             set found [fexistv $fname2 $sname]
         }
         if {[uplevel \#0 "member $$fname\($sname,facets) value"]} {
             if {[uplevel \#0 "member $$fname\($sname,facets) ifexistv"]} {
                 uplevel \#0 "eval $$fname\($sname,ifexistv)"
             }
             set found 1
         }
     }
     return $found
 }
 
 # 
 # fcreatev - create a value facet
 # requires that fname(sname,facets) exists and fname() is not locked
 # modifies fname(sname,facets),fname(sname,value) where fname is
 #          the original or referenced frame
 # calls fexists, fgets, member, fcreatev, ifref and ifcreatev demons
 # 
 proc fcreatev {fname sname} {
     set created 0
     if {[fexists $fname $sname] && [fgets $fname] != "locked" && [fgets $fname] != "inactive"} {
         if {[uplevel \#0 "member $$fname\($sname,facets) method"] ||
             [uplevel \#0 "member $$fname\($sname,facets) value"]} {
             set created 0
         } else {
             if {[uplevel \#0 "member $$fname\($sname,facets) ref"]} {
                 set fname2 [uplevel \#0 "set $fname\($sname,ref)"] 
                 if {[uplevel \#0 "member $$fname\($sname,facets) ifref"]} {
                     uplevel \#0 "eval $$fname\($sname,ifref)"
                 }
                 set created [fcreatev $fname2 $sname]
             } else {
                 uplevel \#0 "set $fname\($sname,value) {}"
                 uplevel \#0 "lappend $fname\($sname,facets) value"
                 if {[uplevel \#0 "member $$fname\($sname,facets) ifcreatev"]} {
                     uplevel \#0 "eval $$fname\($sname,ifcreatev)"
                 }
                 set created 1
             }
         }
     }
     return $created
 }
 
 #
 # fremovev - remove a value facet
 # requires that fname(sname,facets) exists and fname() is not locked
 # modifies fname(sname,facets),fname(sname,value) where fname is
 #          the original or referenced frame
 # calls fexists, fgets, member, fremovev, remove, ifref and ifremovev demons
 #
 proc fremovev {fname sname} {
     set removed 0
     if {[fexists $fname $sname] && [fgets $fname] != "locked" && [fgets $fname] != "inactive"} {
         if {[uplevel \#0 "member $$fname\($sname,facets) ref"]} {
             set fname2 [uplevel \#0 "set $fname\($sname,ref)"]
             if {[uplevel \#0 "member $$fname\($sname,facets) ifref"]} {
                 uplevel \#0 "eval $$fname\($sname,ifref)"
             }
             set removed [fremovev $fname2 $sname]
         } else {
             if {[uplevel \#0 "member $$fname\($sname,facets) value"]} {
                 if {[uplevel \#0 "member $$fname\($sname,facets) ifremovev"]} {
                     uplevel \#0 "eval $$fname\($sname,ifremovev)"
                 }
                 uplevel \#0 "unset $fname\($sname,value)"
                 uplevel \#0 "remove $fname\($sname,facets) value"
                 set removed 1
             } 
         }
     }
     return $removed
 }
 
 #
 # fgetv - get a value from a value facet
 # requires that fname(sname,facets) exists
 # calls fexists, member, fgetv, ifref and ifgetv demons
 #
 proc fgetv {fname sname} {
     set pname {}
     if {[fexists $fname $sname]} {
         if {[uplevel \#0 "member $$fname\($sname,facets) ref"]} {
             set fname2 [uplevel \#0 "set $fname\($sname,ref)"]
             if {[uplevel \#0 "member $$fname\($sname,facets) ifref"]} {
                 uplevel \#0 "eval $$fname\($sname,ifref)"
             }
             set pname [fgetv $fname2 $sname]
         } else {
             if {[uplevel \#0 "member $$fname\($sname,facets) value"]} {
                 if {[uplevel \#0 "member $$fname\($sname,facets) ifgetv"]} {
                     uplevel \#0 "eval $$fname\($sname,ifgetv)"
                 }
                 set pname [uplevel \#0 "set $fname\($sname,value)"]
             }
         }
     }
     return $pname
 }
 
 #
 # fputv - put a value in a value facet
 # requires that fname(sname,facets) exists and fname() is not locked
 # modifies fname(sname,value) where fname is the original or
 #          referenced frame
 # calls fexists, fgets, member, fputv, ifref and ifputv demons
 #
 proc fputv {fname sname args} {
     set put 0
     if {[fexists $fname $sname] && [fgets $fname] != "locked" && [fgets $fname] != "inactive"} {
         if {[uplevel \#0 "member $$fname\($sname,facets) ref"]} {
             set fname2 [uplevel \#0 "set $fname\($sname,ref)"] 
             if {[uplevel \#0 "member $$fname\($sname,facets) ifref"]} {
                 uplevel \#0 "eval $$fname\($sname,ifref)"
             }
             set put [fputv $fname2 $sname $args]
         } else {
             if {[uplevel \#0 "member $$fname\($sname,facets) value"]} {
                 uplevel \#0 "set $fname\($sname,value) $args"
                 if {[uplevel \#0 "member $$fname\($sname,facets) ifputv"]} {
                     uplevel \#0 "eval $$fname\($sname,ifputv)"
                 }
                 set put 1
             }
         }
     }
     return $put
 }
 
 #
 # fexistd - determine if a demon facet exists
 # requires that fname(sname,facets) exists
 # calls fexists, member
 # 
 proc fexistd {fname sname dname} {
     if {[fexists $fname $sname]} {
         if {[uplevel \#0 "member $$fname\($sname,facets) $dname"]} {
             return 1
         } else {
             return 0
         }
     } else {
         return 0
     }
 }
 
 # 
 # fcreated - create a demon facet
 # requires that fname(sname,facets) exists and fname() is not locked
 # modifies fname(sname,facets),fname(sname,dname)
 # calls fexists, fgets, member
 # 
 proc fcreated {fname sname dname} {
     if {[fexists $fname $sname] && [fgets $fname] != "locked" && [fgets $fname] != "inactive"} {
         if {[uplevel \#0 "member $$fname\($sname,facets) $dname"] == 0} {
             uplevel \#0 "set $fname\($sname,$dname) {}"
             uplevel \#0 "lappend $fname\($sname,facets) $dname"
             return 1
         } else {
             return 0
         }
     } else {
         return 0
     }
 }
 
 # 
 # fremoved - remove a demon facet
 # requires that fname(sname,dname) exists and fname() is not locked
 # modifies fname(sname,facets),fname(sname,dname)
 # calls fexistd, fgets, remove
 #
 proc fremoved {fname sname dname} {
     if {[fexistd $fname $sname $dname] && [fgets $fname] != "locked" && [fgets $fname] != "inactive"} {
         uplevel \#0 "unset $fname\($sname,$dname)"
         uplevel \#0 "remove $fname\($sname,facets) $dname"
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fgetd - get a value from a demon facet
 # requires that fname(sname,dname) exists
 # calls fexistd
 #
 proc fgetd {fname sname dname} {
     if {[fexistd $fname $sname $dname]} {
         return [uplevel \#0 "set $fname\($sname,$dname)"]
     } else {
         return {}
     }
 }
 
 #
 # fputd - put a value in a demon facet
 # requires that fname(sname,dname) exists and fname() is not locked
 # modifies fname(sname,dname)
 # calls fexistd, fgets
 #
 proc fputd {fname sname dname args} {
     if {[fexistd $fname $sname $dname] && [fgets $fname] != "locked" && [fgets $fname] != "inactive"} {
         uplevel \#0 "set $fname\($sname,$dname) $args"
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fexecd - directly execute a demon
 # requires that fname(sname,dname) exists and fname() is not asleep
 # calls fexistd, fgets
 #
 proc fexecd {fname sname dname} {
     if {[fexistd $fname $sname $dname] && [fgets $fname] != "asleep" && [fgets $fname] != "inactive"} {
         uplevel \#0 "eval $$fname\($sname,$dname)"
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fcreatefs - create a frameset
 # requires that name() does not exist and is not locked
 # modifies fframes, name(name,set), name(name,slots)
 # calls fexistf
 #
 proc fcreatefs {name} {
     global fframes
     if {![fexistf $name]} {
         lappend fframes $name
         uplevel \#0 "set $name\($name,start) {}"
         uplevel \#0 "set $name\($name,state) {active}"
         uplevel \#0 "set $name\($name,set) {}"
         uplevel \#0 "set $name\($name,slots) {}"
         return 1
     } else {
         return 0
     }
 }
 
 # 
 # fremovefs - remove a frameset
 # requires that name() exists and is not locked
 # modifies fframes, name()
 # calls fremovef
 #
 proc fremovefs {name} {
     if {[fremovef $name]} {
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fslistf - return a list of frames in a frameset
 # requires that name() exists
 # calls fexistf
 #
 proc fslistf {name} {
     if {[fexistf $name]} {
         return [uplevel \#0 "set $name\($name,set)"]
     } else {
         return {}
     }
 }
 
 #
 # floadfs - load a frameset into memory
 # requires that name() exist on disk, but not in memory
 # calls floadf, fslistf
 #
 proc floadfs {name} {
     if {[floadf $name]} {
         set s [fslistf $name]
         foreach i $s {
             floadf $i 
         }
         return 1
     } else {
         return 0
     }
 }
 
 # 
 # fstorefs - store a frameset on disk
 # requires that name() exists
 # calls fstoref, fslistf
 #
 proc fstorefs {name} {
     if {[fstoref $name]} {
         set s [fslistf $name]
         foreach i $s {
             fstoref $i
         }
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fsincludef - include a frame in a frameset
 # requires that name() and fname() exist and name() is not locked
 # modifies name(name,set)
 # calls fexistf, fgets
 #
 proc fsincludef {name fname} {
     if {[fexistf $name] && [fexistf $fname] && [fgets $name] != "locked" && [fgets $name] != "inactive"} {
         uplevel \#0 "lappend $name\($name,set) $fname"
         return 1
     } else {
         return 0
     }
 }
 
 # 
 # fsexcludef - exclude a frame from a frameset
 # requires that name() exists and is not locked
 # modifies name(name,set)
 # calls fexistf, fgets, member, remove
 #
 proc fsexcludef {name fname} {
     if {[fexistf $name] && [fgets $name] != "locked" && [fgets $name] != "inactive"} {
         if {[uplevel \#0 "member $$name\($name,set) $fname"]} {
             uplevel \#0 "remove $name\($name,set) $fname"
             return 1
         } else {
             return 0
         }
     } else {
         return 0
     }
 }
 
 # 
 # fscreates - create a slot in a frameset
 # requires that name() exists and is not locked
 # modifies name(name,slots), name(sname,facets), associated frames
 # calls fcreates, fslistf
 #
 proc fscreates {name sname} {
     if {[fcreates $name $sname]} {
         set s [fslistf $name]
         foreach i $s {
             fcreates $i $sname
         }
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fsremoves - remove a slot from a frameset
 # requires that name(sname,facets) exists and name() is not locked
 # modifies name(name,slots), name(sname,), associated frames
 # calls fremoves, fslistf
 #
 proc sremoves {name sname} {
     if {[fremoves $name $sname]} {
         set s [fslistf $name]
         foreach i $s {
             fremoves $i $sname
         }
         return 1
     } else {
         return 0
     }
 }
 
 # 
 # fscreated - create a demon facet in a frameset
 # requires that name(sname,facets) exists and name() is not locked
 # modifies name(sname,facets), name(sname,dname), associated frames
 # calls fcreated, fslistf
 #
 proc fscreated {name sname dname} {
     if {[fcreated $name $sname $dname]} {
         set s [fslistf $name]
         foreach i $s {
             fcreated $i $sname $dname
         }
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fsremoved - remove a demon facet from a frameset
 # requires that name(sname,dname) exists and name() is not locked
 # modifies name(name,slots), name(sname,dname), associated frames
 # calls fremoved, fslistf
 #
 proc sremoved {name sname dname} {
     if {[fremoved $name $sname $dname]} {
         set s [fslistf $name]
         foreach i $s {
             fremoved $i $sname $dname
         }
         return 1
     } else {
         return 0
     }
 }
 
 # 
 # fscreatem - create a method facet in a frameset
 # requires that name(sname,facets) exists and name() is not locked
 # modifies name(sname,facets), name(sname,method), associated frames
 # calls fcreatem, fslistf
 #
 proc fscreatem {name sname} {
     if {[fcreatem $name $sname]} {
         set s [fslistf $name]
         foreach i $s {
             fcreatem $i $sname
         }
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fsremovem - remove a method facet from a frameset
 # requires that name(sname,facets) exists and name() is not locked
 # modifies name(sname,facets), name(sname,method), associated frames
 # calls fremovem, fslistf
 #
 proc fsremovem {name sname} {
     if {[fremovem $name $sname]} {
         set s [fslistf $name]
         foreach i $s {
             fremovem $i $sname
         }
         return 1
     } else {
         return 0
     }
 }
 
 # 
 # fscreater - create a reference facet in a frameset
 # requires that name(sname,facets) exists and name() is not locked
 # modifies name(sname,facets), name(sname,ref), associated frames
 # calls fcreater, fslistf
 #
 proc fscreater {name sname} {
     if {[fcreater $name $sname]} {
         set s [fslistf $name]
         foreach i $s {
             fcreater $i $sname
         }
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fsremover - remove a reference facet from a frameset
 # requires that name(sname,facets) exists and name() is not locked
 # modifies name(sname,facets), name(sname,ref), associated frames
 # calls fremover, fslistf
 #
 proc fsremover {name sname} {
     if {[fremover $name $sname]} {
         set s [fslistf $name]
         foreach i $s {
             fremover $i $sname
         }
         return 1
     } else {
         return 0
     }
 }
 
 # 
 # fscreatev - create a value facet in a frameset
 # requires that name(sname,facets) exists and name() is not locked
 # modifies name(sname,facets), name(sname,value), associated frames
 # calls fcreatev, fslistf
 #
 proc fscreatev {name sname} {
     if {[fcreatev $name $sname]} {
         set s [fslistf $name]
         foreach i $s {
             fcreatev $i $sname
         }
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fsremovev - remove a value facet from of a frameset
 # requires that name(sname,facets) exists and name() is not locked
 # modifies name(sname,facets), name(sname,value), associated frames
 # calls fremovev, fslistf
 #
 proc fsremovev {name sname} {
     if {[fremovev $name $sname]} {
         set s [fslistf $name]
         foreach i $s {
             fremovev $i $sname
         }
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fsputr - put a value in reference facet in a frameset
 # requires that name(sname,facets) exists and name() is not locked
 # modifies the name(sname,ref)
 # calls fexistr, fputr, fslistf
 #
 proc fsputr {name sname fname} {
     if {[fexistr $name $sname] && [fgets $name] != "locked" && [fgets $name] != "inactive"} {
         fputr $name $sname $fname
         set s [fslistf $name]
         foreach i $s {
             fputr $i $sname $fname
         }
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fsgetr - get a value from a reference facet in a frameset
 # requires that name(sname,ref) exists
 # modifies nothing
 # calls fexistr, fgetr
 #
 proc fsgetr {name sname} {
     if {[fexistr $name $sname]} {
         set r [fgetr $name $sname]
         return $r
     } else {
         return ""
     }
 }
     
 #
 # fsmemberf - get list of framesets in which a frame is a member
 # requires that the frame exists
 # modifies nothing
 # calls fexistf, flistf, member
 #
 proc fsmemberf {name} {
     if {[fexistf $name]} {
         foreach i [flistf] {
             if {[uplevel \#0 "info exists $i\($i,set)"]} {
                 if {[member [uplevel \#0 "fslistf $i"] $name]} {
                     lappend mlist $i
                 }
             }
         }
         return $mlist
     } else {
         return {}
     }
 }
 
 #
 # fsendf - send a frame
 # requires open socket, fname() exists and is not locked
 # modifies location of fname()
 # calls fexistf, fgets, fpack
 #
 proc fsendf {fname sid} {
     if {[fexistf $fname] && [fgets $fname] != "locked" && [fgets $fname] != "inactive"} {
         set plist [fpack $fname]
         puts $sid "funpack $fname {$plist}"
         flush $sid
         puts $sid "fexecx $fname"
         flush $sid
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fsendfs - send a frameset
 # requires open socket, fname() exists and is not locked
 # modifies location of frames in frameset
 # calls fexistf, fgets, fslistf, fpack
 #
 proc fsendfs {fname sid} {
     if {[fexistf $fname] && [fgets $fname] != "locked" && [fgets $fname] != "inactive"} {
         set s [fslistf $fname]
         set plist [fpack $fname]
         puts $sid "funpack $fname {$plist}"
         flush $sid
         foreach i $s {
             fsendf $i $sid
         }
         puts $sid "fexecx $fname"
         flush $sid
         return 1
     } else {
         return 0
     }
 }
 
 #
 # ffetchf - fetch a frame
 # requires open socket, fname() exists and is not locked
 # modifies location of fname()
 # calls frpc, funpack
 #
 proc ffetchf {fname sid} {
     set exist [frpc "fexistf $fname" $sid]
     set status [frpc "fgets $fname" $sid]
     if {$exist && $status != "locked" && $status != "inactive"} {
         set plist [frpc "fpack $fname" $sid]
         funpack $fname $plist
         fexecx $fname
         return 1
     } else {
         return 0
     }
 }
 
 #
 # ffetchfs - fetch a frameset
 # requires open socket, fname() exists and is not locked
 # modifies location of frames in frameset
 # calls frpc, funpack
 #
 proc ffetchfs {fname sid} {
     set exist [frpc "fexistf $fname" $sid]
     set status [frpc "fgets $fname" $sid]
     if {$exist && $status != "locked" && $status != "inactive"} {
         set s [frpc "fslistf $fname" $sid]
         set plist [frpc "fpack $fname" $sid]
         funpack $fname $plist
         foreach i $s {
             set plist [frpc "fpack $i" $sid]
             funpack $i $plist
             fexecx $i
         }
         fexecx $fname
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fsleepf - put a frame to sleep
 # requires fname() exists and is not locked or asleep
 # modifies frame state
 # calls fexistf, fgets, fputs
 #
 proc fsleepf {fname} {
     if {[fexistf $fname]} {
         if {[fgets $fname] == "active"} {
             uplevel \#0 "set $fname\($fname,state) asleep"
             return 1
         } else {
             return 0
         }
     } else {
         return 0
     }
 }
 
 #
 # fsleepfs - put a frameset to sleep
 # requires fname() exists and is not locked or asleep
 # modifies state of frames in frameset
 # calls fexistf, fgets, fsleepf, fslistf
 #
 proc fsleepfs {fname} {
     if {[fexistf $fname]} {
         if {[fgets $fname] == "active"} {
             fsleepf $fname
             set s [fslistf $fname]
             foreach i $s {
                 fsleepf $i
             }
             return 1
         } else {
             return 0
         }
     } else {
         return 0
     }
 }
 
 #
 # fwakef - wake up a frame
 # requires fname() exists and is asleep but not locked
 # modifies frame state
 # calls fexistf, fgets, fputs
 #
 proc fwakef {fname} {
     if {[fexistf $fname]} {
         if {[fgets $fname] == "asleep"} {
             uplevel \#0 "set $fname\($fname,state) active"
             return 1
         } else {
             return 0
         }
     } else {
         return 0
     }
 }
 
 # 
 # fwakefs - wake up a frameset
 # requires fname() exists and is asleep but not locked
 # modifies state of frames in frameset
 # calls fexistf, fgets, fwakef
 #
 proc fwakefs {fname} {
     if {[fexistf $fname]} {
         if {[fgets $fname] == "asleep"} {
             fwakef $fname
             set s [fslistf $fname]
             foreach i $s {
                 fwakef $i
             }
             return 1
         } else {
             return 0
         }
     } else {
         return 0
     }
 }
 
 #
 # flockf - lock a frame
 # requires fname() exists and is not locked
 # modifies frame state
 # calls fexistf, fgets, fputs
 #
 proc flockf {fname} {
     if {[fexistf $fname]} {
         if {[fgets $fname] == "active"} {
             uplevel \#0 "set $fname\($fname,state) locked"
             return 1
         }
         if {[fgets $fname] == "asleep"} {
             uplevel \#0 "set $fname\($fname,state) inactive"
             return 1
         }
         return 0
     } else {
         return 0
     }
 }
 
 #
 # flockfs - lock a frameset
 # requires fname() exists and is not locked
 # modifies state of all frames in frameset
 # calls fexistf, fslistf, flockf
 # 
 proc flockfs {fname} {
     if {[fexistf $fname]} {
         if {[fgets $fname] == "active" || [fgets $fname] == "asleep"} {
             flockf $fname
             set s [fslistf $fname]
             foreach i $s {
                 flockf $i
             }
             return 1
         } else {
             return 0
         }
     } else {
         return 0
     }
 }
 
 #
 # funlockf - unlock a frame
 # requires fname() exists and is locked
 # modifies frame state
 # calls fexistf, fgets, fputs
 #
 proc funlockf {fname} {
     if {[fexistf $fname]} {
         if {[fgets $fname] == "locked"} {
             uplevel \#0 "set $fname\($fname,state) active"
             return 1
         }
         if {[fgets $fname] == "inactive"} {
             uplevel \#0 "set $fname\($fname,state) asleep"
             return 1
         }
         return 0
     } else {
         return 0
     }
 }
 
 #
 # funlockfs - unlock a frameset
 # requires fname() exists and is locked
 # modifies state of all frames in frameset
 # calls fexistf, funlockf, fslistf
 #
 proc funlockfs {fname} {
     if {[fexistf $fname]} {
         if {[fgets $fname] == "locked" || [fgets $fname] == "inactive"} {
             funlockf $fname
             set s [fslistf $fname]
             foreach i $s {
                 funlockf $i
             }
             return 1
         } else {
             return 0
         }
     } else {
         return 0
     }
 }
 
 #
 # fdo - do something
 # requires application or open socket
 # modifies nothing
 #
 proc fdo {msg sid} {
     puts $sid "fdos {$msg}"
     flush $sid
 }
 
 #
 # fdos - do something service
 # requires nothing
 # modifies nothing
 #
 proc fdos {msg} {
     uplevel \#0 "eval $msg"
 }
 
 #
 # frpc - remote procedure call
 # requires application or open socket
 # modifies nothing
 #
 proc frpc {msg sid} {
     puts $sid "frpcs {$msg}"
     flush $sid
     gets $sid result
     return $result
 }
 
 #
 # frpcs - remote procedure call service
 # requires open socket to client
 # modifies nothing
 #
 proc frpcs {msg cid} {
     set result [uplevel \#0 "eval $msg"]
     if {[llength $result] > 1} {
         puts $cid "$result"
     } else {
         puts $cid $result
     }
     flush $cid
 }
 
 #
 # fpack - pack a frame
 # requires fname() exists
 # modifies fname() and fframes
 # calls fremovef
 #
 proc fpack {fname} {
     set plist {}
     foreach i [uplevel \#0 "array names $fname"] {
         set avalue [uplevel \#0 "set $fname\($i)"]
         lappend plist "$fname\($i) {$avalue}"
     }
     fremovef $fname
     return $plist
 }
 
 #
 # funpack - unpack a frame
 # requires nothing
 # modifies ffframes
 # calls fexistf, fremovef, fcreatef
 #
 proc funpack {fname plist} {
     funlockf $fname
     fremovef $fname
     fcreatef $fname
     for {set i 0} {$i < [llength $plist]} {incr i} {
         uplevel \#0 "set [lindex $plist $i]"
     }
 }
 
 #
 # fexecx - execute a frame start method
 # requires fname() exists and is not asleep
 # modifies nothing
 # calls fexistf, fgets
 #
 proc fexecx {fname} {
     if {[fexistf $fname] && [fgets $fname] != "asleep" && [fgets $fname] != "inactive"} {
         uplevel \#0 "eval $$fname\($fname,start)"
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fgetx - get the start code of a frame
 # requires that fname() exists
 # modifies nothing
 # calls fexistf
 #
 proc fgetx {fname} {
     if {[fexistf $fname]} {
         return [uplevel \#0 "set $fname\($fname,start)"]
     } else {
         return ""
     }
 }
 
 #
 # fputx - assign start code to a frame
 # requires that fname() exists and is not locked
 # modifies the frame start code
 # calls fexistf, fgets
 #
 proc fputx {fname args} {
     if {[fexistf $fname] && [fgets $fname] != "locked" && [fgets $fname] != "inactive"} {
         uplevel \#0 "set $fname\($fname,start) $args"
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fgets - get the state of a frame
 # requires that fname() exists
 # modifies nothing
 # calls fexistf
 #
 proc fgets {fname} {
     if {[fexistf $fname]} {
         return [uplevel \#0 "set $fname\($fname,state)"]
     } else {
         return ""
     }
 }
 
 #
 # fputs - assign a state to a frame
 # requires that fname() exists and is not locked
 # modifies the frame state
 # calls fexistf, fgets
 #
 proc fputs {fname state} {
     if {[fexistf $fname] && [fgets $fname] != "locked" && [fgets $fname] != "inactive"} {
         uplevel \#0 "set $fname\($fname,state) $state"
         return 1
     } else {
         return 0
     }
 }
----
'''framesets.tcl'''
 ######################################################################
 #
 # program name: framesets.tcl 1.1
 #   programmer: Cris A. Fugate
 # date written: September 2, 1998 (wrote frames.tcl)
 #      changed: September 28, 1998 (added floadf and fstoref to frames)
 #      changed: November 25, 1998 (wrote framesets.tcl)
 #      changed: February 10, 1999 (added fupdatef to frames,
 #               added fsgetr, fsputr and fsmemberf to framesets)         
 #      changed: April 16, 1999 (merged frames and framesets)
 #      changed: November 8, 1999 (added args to fputv,fputm,fputd)
 #
 #  description: This program is an extension to the tcl scripting
 #               language.  It provides a frame and frameset
 #               mechanism which can be used to dynamically organize
 #               and perform operations on values and procedures.
 #
 # Copyright (c) 1999 Cris A. Fugate
 #
 # Permission is hereby granted, free of charge, to any person obtaining 
 # a copy of this software and associated documentation files (the 
 # "Software"), to deal in the Software without restriction, including 
 # without limitation the rights to use, copy, modify, merge, publish, 
 # distribute, sublicense, and/or sell copies of the Software, and to 
 # permit persons to whom the Software is furnished to do so, subject to 
 # the following conditions:
 #
 # The above copyright notice and this permission notice shall be included 
 # in all copies or substantial portions of the Software.
 #
 # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
 # OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
 # THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
 # OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, 
 # ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 
 # OTHER DEALINGS IN THE SOFTWARE. 
 #
 ######################################################################       
 #
 #                              Variables
 # 
 # aname                        array name
 # args                         list of arguments
 # avalue                       array value
 # cmp                          comparison flag
 # created                      create flag
 # elema                        element of a list
 # dname                        demon type
 # elcnt                        count of list elements
 # executed                     execute flag
 # fframes                      list of frames
 # fh                           file handle
 # fhbuf                        file handle buffer
 # flist                        list of references in a frame 
 # fname                        frame name
 # fname1                       frame name
 # fname2                       frame name
 # found                        exist flag
 # ftype                        facet type
 # i                            loop variable
 # lista                        first list to be processed 
 # listb                        second list to be processed
 # listx                        first temporary list
 # listy                        second temporary list
 # mlist                        list of framesets of which a frame 
 #                              is a member
 # name                         frameset name
 # plist                        list of frames in a reference chain
 # pname                        procedure name
 # put                          put flag
 # r                            reference
 # removed                      remove flag
 # s                            list of frames in the frameset
 # sname                        slot name
 # sname2                       slot name
 # x                            variable used in place of expression
 # y                            variable used in place of expression
 # <fname>(<ename>)             used in operations involving many elements
 # <fname>(<fname>,set)         frames in a frameset
 # <fname>(<fname>,slots)       slots in a frame
 # <fname>(<sname>,<ftype>)     demon facet
 # <fname>(<sname>,facets)      facets in a slot
 # <fname>(<sname>,ifcreatem)   ifcreatem demon
 # <fname>(<sname>,ifcreater)   ifcreater demon
 # <fname>(<sname>,ifcreatev)   ifcreatev demon 
 # <fname>(<sname>,ifexecm)     ifexecm demon
 # <fname>(<sname>,ifexistm)    ifexistm demon
 # <fname>(<sname>,ifexistr)    ifexistr demon
 # <fname>(<sname>,ifexistv)    ifexistv demon
 # <fname>(<sname>,ifgetm)      ifgetm demon
 # <fname>(<sname>,ifgetr)      ifgetr demon
 # <fname>(<sname>,ifgetv)      ifgetv demon
 # <fname>(<sname>,ifputm)      ifputm demon
 # <fname>(<sname>,ifputr)      ifputr demon
 # <fname>(<sname>,ifputv)      ifputv demon
 # <fname>(<sname>,ifref)       ifref demon
 # <fname>(<sname>,ifremovem)   ifremovem demon
 # <fname>(<sname>,ifremover)   ifremover demon
 # <fname>(<sname>,ifremovev)   ifremovev demon
 # <fname>(<sname>,method)      method facet
 # <fname>(<sname>,ref)         reference facet
 # <fname>(<sname>,value)       value facet
 #
 ######################################################################   
 #
 #                              Procedures
 #
 # compress                     order and remove duplicates from a list
 # equivalence                  determine is two lists are equivalent
 # fcomparef                    compare slots of two frames
 # fcompares                    compare two slots
 # fcopyf                       make a copy of a frame
 # fcopys                       make a copy of a slot in another frame
 # fcreated                     create a demon facet 
 # fcreatef                     create a frame
 # fcreatefs                    create a frameset 
 # fcreatem                     create a method facet
 # fcreater                     create a reference facet
 # fcreates                     create a slot
 # fcreatev                     create a value facet
 # fexecd                       directly execution a demon
 # fexecm                       execute a method
 # fexistd                      determine if a demon facet exists
 # fexistf                      determine if a frame exists
 # fexistm                      determine if a method facet exists
 # fexistr                      determine if a reference facet exists
 # fexistrx                     (same as fexistr without a demon call)
 # fexists                      determine if a slot exists
 # fexistv                      determine if a value facet exists
 # ffilterf                     filter a frame based on another frame
 # fgetd                        get the value of a demon facet
 # fgetm                        get the value of a method facet
 # fgetr                        get the value of a reference facet
 # fgetv                        get the value of a value facet
 # flistf                       get a list of existing frames
 # flistr                       get a list of references in a frame
 # flists                       get a list of slots for a frame
 # flistt                       get a list of facet types for a slot
 # floadf                       load a frame into memory
 # floadfs                      load a frameset into memory
 # fmergef                      merge slots of a frame into another frame
 # fpathr                       get a list of frames in a reference chain
 # fputd                        put a value into a demon facet
 # fputm                        put a value into a method facet
 # fputr                        put a value into a reference facet
 # fputv                        put a value into a value facet
 # fremoved                     destroy a demon facet
 # fremovef                     destroy a frame
 # fremovefs                    destroy a frameset
 # fremovem                     destroy a method facet
 # fremover                     destroy a reference facet
 # fremoves                     destroy a slot
 # fremovev                     destroy a value facet
 # fscreated                    create a demon facet in a frameset
 # fscreatem                    create a method facet in a frameset
 # fscreater                    create a reference facet in a frameset
 # fscreates                    create a slot in a frameset
 # fscreatev                    create a value facet in a frameset
 # fsexcludef                   exclude a frame from a frameset
 # fsgetr                       get a value from a reference facet 
 #                              in a frameset
 # fsincludef                   include a frame in a frameset 
 # fslistf                      get a list of frames in a frameset
 # fsmemberf                    get list of framesets in which 
 #                              a frame is a member
 # fsputr                       put a value in a reference facet
 #                              in a frameset
 # fsremoved                    remove a demon facet from a frameset
 # fsremovem                    remove a method facet from a frameset
 # fsremover                    remove a reference facet from a frameset
 # fsremoves                    remove a slot from a frameset
 # fsremovev                    remove a value facet from a frameset
 # fstoref                      store a frame on disk
 # fstorefs                     store a frameset on disk
 # fupdatef                     synchronize a frame based on another frame
 # member                       determine if a value is a member of a list
 # remove                       remove a value from a list
 #
 
 #
 # compress - order and remove duplicates from a list
 # modifies lista
 #
 proc compress lista {
     upvar $lista listx
     set listx [lsort $listx]
     set listy [lindex $listx 0]
     set elema $listy
     foreach i $listx {
         if {$elema != $i} {
             lappend listy $i
         }
         set elema $i
     }
     set listx $listy
 }
 
 #
 # equivalence - determine if two lists are equivalent
 #
 proc equivalence {lista listb} {
     set listx $lista
     set listy $listb
     compress listx
     compress listy
     if {$listx == $listy} {
         return 1
     } else {
         return 0
     }
 }
 
 #
 # member - determine if an element is a member of a list
 #
 proc member {lista elema} {
     set elcnt 0
     foreach i $lista {
         if {$elema == $i} {
             incr elcnt
         }
     }
     return $elcnt
 }
 
 #
 # remove - remove all occurances of an element from a list
 # modifies lista
 #
 proc remove {lista elema} {
     upvar $lista listx
     set listy {}
     foreach i $listx {
         if {$elema != $i} {
             lappend listy $i
         }
     }
     set listx $listy
 }
 
 # initialize frames
 set fframes {}
 
 #
 # fexistf - determine if a frame exists
 #
 proc fexistf fname {
     global fframes
     return [member $fframes $fname]
 } 
 
 #
 # fcreatef - create a frame
 # requires that fname() does not exist
 # modifies fframes, fname(fname,slots)
 #
 proc fcreatef fname {
     global fframes
     if {![fexistf $fname]} {
         lappend fframes $fname
         uplevel \#0 "set $fname\($fname,slots) {}"
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fremovef - remove a frame
 # requires that fname() exists
 # modifies fframes,fname()
 #
 proc fremovef fname {
     global fframes
     if {[fexistf $fname]} {
         foreach i [uplevel \#0 "array names $fname"] {
             uplevel \#0 "unset $fname\($i)"
         }
         remove fframes $fname
         return 1
     } else {
         return 0
     }
 
 }
 
 #
 # flistf - return list of frames
 #
 proc flistf {} {
     global fframes
     return $fframes
 }
 
 #
 # fcopyf - create a new frame based on another frame
 # requires that frame1() exists
 # modifies fframes,fname2()
 #
 proc fcopyf {fname1 fname2} {
     global fframes
     if {[fexistf $fname1]} {
         fremovef $fname2
         lappend fframes $fname2
         foreach i [uplevel \#0 "array names $fname1"] {
             uplevel \#0 "set $fname2\($i) $$fname1\($i)"
         }
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fcomparef - determine if two frames are equivalent
 # requires that fname1() and fname2() exist
 #
 proc fcomparef {fname1 fname2} {
     if {[fexistf $fname1] && [fexistf $fname2]} {
         set x [uplevel \#0 "set $fname1\($fname1,slots)"]
         set y [uplevel \#0 "set $fname2\($fname2,slots)"]
         if {[equivalence $x $y]} {
             return 1
         } else {
             return 0
         }
     } else {
         return 0
     }
 
 }
 
 #
 # fmergef - merge slots of one frame into another other
 # requires that fname1() and fname2() exist
 # modifies fname2()
 #
 proc fmergef {fname1 fname2} {
     if {[fexistf $fname1] && [fexistf $fname2]} {
         set y [uplevel \#0 "set $fname2\($fname2,slots)"]
         foreach i [uplevel \#0 "array names $fname1"] {
             if {$i != "$fname1,set" && $i != "$fname1,slots"} {
                 scan $i "%\[^,]" sname
                 if {![member $y $sname]} {
                     uplevel \#0 "set $fname2\($i) $$fname1\($i)"
                     uplevel \#0 "lappend $fname2\($fname2,slots) $sname"
                 }
             }
         }
         return 1
     } else {
         return 0
     }
 }
 
 #
 # floadf - load a frame into memory
 # requires that fname() exists on disk, but not in memory
 #
 proc floadf fname {
     global fframes
     if {[file exists $fname] && ![fexistf $fname]} {
         lappend fframes $fname
         set fh [open $fname r]
         while {![eof $fh]} {
             gets $fh fhbuf
             set aname [lindex $fhbuf 0]
             set avalue [remove fhbuf $aname]
             uplevel \#0 "set $fname\($aname) {$avalue}"
         }
         close $fh
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fstoref - store a frame on disk
 # requires that fname() exists
 #
 proc fstoref fname {
     if {[fexistf $fname]} {
         set fh [open $fname w]
         foreach i [uplevel \#0 "array names $fname"] {
             set avalue [uplevel \#0 "set $fname\($i)"]
             puts $fh "$i $avalue"
         }
         close $fh
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fupdatef - update structure of a frame from another frame
 # requires that both frames exist
 # modifies frame2()
 #
 proc fupdatef {fname1 fname2} {
     if {[fexistf $fname1] && [fexistf $fname2]} {
         uplevel \#0 "set $fname2\($fname2,slots) $$fname1\($fname1,slots)"
         foreach i [uplevel \#0 "array names $fname2"] {
             if {$i != "$fname2,set" && $i != "$fname2,slots"} {
                 if {![uplevel \#0 "info exists $fname1\($i)"]} {
                     uplevel \#0 "unset $fname2\($i)"
                 }
             }
         }
         foreach i [uplevel \#0 "array names $fname1"] {
             if {$i != "$fname1,set" && $i != "$fname1,slots"} {
                 if {![uplevel \#0 "info exists $fname2\($i)"]} {
                     uplevel \#0 "set $fname2\($i) $$fname1\($i)"
                 }
             } 
         }
         return 1
     } else {
         return 0
     }
 }
 
 #
 # ffilterf - filter slots of a frame based on another frame
 # requires that both frames exist
 # modifies frame2()
 # 
 proc ffilterf {fname1 fname2} {
     if {[fexistf $fname1] && [fexistf $fname2]} {
         foreach i [uplevel \#0 "array names $fname2"] {
             if {$i != "$fname2,set" && $i != "$fname2,slots"} {
                 if {![uplevel \#0 "info exists $fname1\($i)"]} {
                     uplevel \#0 "unset $fname2\($i)"
                 }
             }
         }
         return 1
     } else {
         return 0
     } 
 }
 
 #
 # fexists - determine if a slot exists
 # requires that fname() exists
 #
 proc fexists {fname sname} {
     if {[fexistf $fname]} {
         if {[uplevel \#0 "member $$fname\($fname,slots) $sname"]} {
             return 1
         } else {
             return 0
         }
     } else {
         return 0
     }
 }
 
 #
 # fcreates - create a slot
 # requires that fname() exists
 # modifies fname(fname,slot),fname(sname,facets)
 #
 proc fcreates {fname sname} {
     if {[fexistf $fname]} {
         if {[uplevel \#0 "member $$fname\($fname,slots) $sname"] == 0} {
             uplevel \#0 "lappend $fname\($fname,slots) $sname"
             uplevel \#0 "set $fname\($sname,facets) {}"
             return 1
         } else {
             return 0
         }
     } else {
         return 0
     }
 }
 
 #
 # fremoves - remove a slot
 # requires that fname(sname,facets) exists
 # modifies fname(fname,slots),fname(sname,)
 #
 proc fremoves {fname sname} {
     if {[fexists $fname $sname]} {
         foreach i [uplevel \#0 "array names $fname"] {
             scan $i "%\[^,]" sname2
             if {$sname == $sname2} {
                 uplevel \#0 "unset $fname\($i)"
             }
         }
         uplevel \#0 "remove $fname\($fname,slots) $sname"
         return 1
     } else {
         return 0
     }
 }
 
 #
 # flists - list slots of a frame
 # requires that fname() exists
 #
 proc flists fname {
     if {[fexistf $fname]} {
         return [uplevel \#0 "set $fname\($fname,slots)"]
     } else {
         return {}
     }
 }
 
 #
 # fcopys - copy a slot into another frame
 # requires that fname1() and fname2() exist
 # modifies fname2(sname,)
 #
 proc fcopys {fname1 sname fname2} {
     if {[fexists $fname1 $sname] && [fexistf $fname2]} {
         if {[uplevel \#0 "member $$fname2\($fname2,slots) $sname"] == 0} {
             uplevel \#0 "lappend $fname2\($fname2,slots) $sname"
          }
         foreach i [uplevel \#0 "array names $fname1"] {
             scan $i "%\[^,]" sname2
             if {$sname == $sname2} {
                 uplevel \#0 "set $fname2\($i) $$fname1\($i)"
             }
         }
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fcompares - compare a slot in two frames
 # requires that fname1(sname,facets) and fname2(sname,facets) exist
 #
 proc fcompares {fname1 sname fname2} {
     set cmp 1
     if {[fexists $fname1 $sname] && [fexists $fname2 $sname]} {
         set x [uplevel \#0 "set $fname1\($sname,facets)"]
         set y [uplevel \#0 "set $fname2\($sname,facets)"]
         if {[equivalence $x $y]} {
             foreach i [uplevel \#0 "array names $fname1"] {
                 scan $i "%\[^,]" sname2
                 if {$sname == $sname2} {
                     set x [uplevel \#0 "set $fname1\($i)"]
                     set y [uplevel \#0 "set $fname2\($i)"]
                     if {$x != $y} {
                         set cmp 0
                     }
                 }                       
             }
             return $cmp                    
         } else {
             return 0
         }
     } else {
         return 0
     }
 }
 
 #
 # flistt - list of facet types in a slot
 # requires that fname(sname,facets) exists
 #
 proc flistt {fname sname} {
     if {[fexists $fname $sname]} {
         return [uplevel \#0 "set $fname\($sname,facets)"]
     } else {
         return {}
     }
 }
 
 #
 # fexistrx - determine if a reference facet exists (internal)
 # requires that fname(sname,facets) exists
 # 
 proc fexistrx {fname sname} {
     if {[fexists $fname $sname]} {
         if {[uplevel \#0 "member $$fname\($sname,facets) ref"]} {
             return 1
         } else {
             return 0
         }
     } else {
         return 0
     }
 }
 
 # 
 # fexistr - determine if a reference facet exists
 # requires that fname(sname,facets) exists
 # calls ifexistr demon
 #
 proc fexistr {fname sname} {
     if {[fexistrx $fname $sname]} {
         if {[uplevel \#0 "member $$fname\($sname,facets) ifexistr"]} {
             uplevel \#0 "eval $$fname\($sname,ifexistr)"
         }
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fcreater - create a reference facet
 # requires that fname(sname,facets) exists
 # modifies fname(sname,facets),fname(sname,ref)
 # calls ifcreater demon
 #
 proc fcreater {fname sname} {
     if {[fexists $fname $sname]} {
         if {[uplevel \#0 "member $$fname\($sname,facets) ref"] == 0} { 
             set x [uplevel \#0 "member $$fname\($sname,facets) method"]
             set y [uplevel \#0 "member $$fname\($sname,facets) value"]
             if {!($x || $y)} {
                 uplevel \#0 "lappend $fname\($sname,facets) ref"
                 uplevel \#0 "set $fname\($sname,ref) {}"
                 if {[uplevel \#0 "member $$fname\($sname,facets) ifcreater"]} {
                     uplevel \#0 "eval $$fname\($sname,ifcreater)"
                 }
                 return 1
             } else {
                 return 0
             }
         } else {
             return 0
         }
     } else {
         return 0
     }
 }
 
 #
 # fremover - remove a reference facet
 # requires that fname(sname,ref) exists
 # modifies fname(sname,facets),fname(sname,ref)
 # calls ifremover demon
 #
 proc fremover {fname sname} {
     if {[fexistrx $fname $sname]} {
         if {[uplevel \#0 "member $$fname\($sname,facets) ifremover"]} {
             uplevel \#0 "eval $$fname\($sname,ifremover)"
         }
         uplevel \#0 "unset $fname\($sname,ref)"
         uplevel \#0 "remove $fname\($sname,facets) ref"
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fgetr - get a value from a reference facet
 # requires that fname(sname,ref) exists
 # calls ifgetr demon
 #
 proc fgetr {fname sname} {
     if {[fexistrx $fname $sname]} {
         if {[uplevel \#0 "member $$fname\($sname,facets) ifgetr"]} {
             uplevel \#0 "eval $$fname\($sname,ifgetr)"
         }
         return [uplevel \#0 "set $fname\($sname,ref)"]
     } else {
         return {}
     }
 }
 
 #
 # fputr - put a value in a reference facet
 # requires that fname(sname,ref) exists
 # modifies fname(sname,ref)
 # calls ifputr demon
 #
 proc fputr {fname1 sname fname2} {
     if {[fexistrx $fname1 $sname]} {
         uplevel \#0 "set $fname1\($sname,ref) $fname2"
         if {[uplevel \#0 "member $$fname1\($sname,facets) ifputr"]} {
             uplevel \#0 "eval $$fname1\($sname,ifputr)"
         }
         return 1
     } else {
         return 0
     }
 }
 
 #
 # flistr - list of references in a frame
 # requires that fname() exists
 # 
 proc flistr fname {
     set flist {}
     if {[fexistf $fname]} {
         foreach i [uplevel \#0 "array names $fname"] {
             scan $i "%\[^,],%s" sname ftype
             if {$ftype == "ref"} {
                 lappend flist $sname
             }
         }
     }
     return $flist
 }
 
 #
 # fpathr - return chain of references
 # requires that fname(sname,facets) exists
 #
 proc fpathr {fname sname {plist {}}} {
     if {[fexists $fname $sname]} {
         if {[member $plist $fname] == 0} {
             lappend plist $fname
             if {[uplevel \#0 "member $$fname\($sname,facets) ref"]} {
                 set fname2 [uplevel \#0 "set $fname\($sname,ref)"]
                 fpathr $fname2 $sname $plist
             } else {
                 return $plist
             }
         } else {
             return $plist
         }
     } else {
         return $plist
     }
 }
 
 # 
 # fexistm - determine if a method facet exists
 # requires that fname(sname,facets) exists
 # calls ifref and ifexistm demons
 #
 proc fexistm {fname sname} {
     set found 0
     if {[fexists $fname $sname]} {
         if {[fexistrx $fname $sname]} {
             set fname2 [uplevel \#0 "set $fname\($sname,ref)"]
             if {[uplevel \#0 "member $$fname\($sname,facets) ifref"]} {
                 uplevel \#0 "eval $$fname\($sname,ifref)"
             }
             set found [fexistm $fname2 $sname]
         }
         if {[uplevel \#0 "member $$fname\($sname,facets) method"]} {
             if {[uplevel \#0 "member $$fname\($sname,facets) ifexistm"]} {
                 uplevel \#0 "eval $$fname\($sname,ifexistm)"
             }
             set found 1
         }
     }
     return $found
 }
     
 #
 # fcreatem - create a method facet
 # requires that fname(sname,facets) exists
 # modifies fname(sname,facets),fname(sname,method) where fname is
 #          the original or referenced frame
 # calls ifref and ifcreatem demons
 #
 proc fcreatem {fname sname} {
     set created 0
     if {[fexists $fname $sname]} {
         if {[uplevel \#0 "member $$fname\($sname,facets) method"] ||
             [uplevel \#0 "member $$fname\($sname,facets) value"]} {
             set created 0
         } else {
             if {[uplevel \#0 "member $$fname\($sname,facets) ref"]} {
                 set fname2 [uplevel \#0 "set $fname\($sname,ref)"] 
                 if {[uplevel \#0 "member $$fname\($sname,facets) ifref"]} {
                     uplevel \#0 "eval $$fname\($sname,ifref)"
                 }
                 set created [fcreatem $fname2 $sname]
             } else {
                 uplevel \#0 "set $fname\($sname,method) {}"
                 uplevel \#0 "lappend $fname\($sname,facets) method"
                 if {[uplevel \#0 "member $$fname\($sname,facets) ifcreatem"]} {
                     uplevel \#0 "eval $$fname\($sname,ifcreatem)"
                 }
                 set created 1
             }
         }
     }
     return $created
 }
 
 # 
 # fremovem - remove a method facet
 # requires sthat fname(sname,facets) exists
 # modifies fname(sname,facets),fname(sname,method) where fname is
 #          the original or referenced frame
 # calls ifref and ifremovem demons
 #
 proc fremovem {fname sname} {
     set removed 0
     if {[fexists $fname $sname]} {
         if {[uplevel \#0 "member $$fname\($sname,facets) ref"]} {
             set fname2 [uplevel \#0 "set $fname\($sname,ref)"]
             if {[uplevel \#0 "member $$fname\($sname,facets) ifref"]} {
                 uplevel \#0 "eval $$fname\($sname,ifref)"
             }
             set removed [fremovem $fname2 $sname]
         } else {
             if {[uplevel \#0 "member $$fname\($sname,facets) method"]} {
                 if {[uplevel \#0 "member $$fname\($sname,facets) ifremovem"]} {
                     uplevel \#0 "eval $$fname\($sname,ifremovem)"
                 }
                 uplevel \#0 "unset $fname\($sname,method)"
                 uplevel \#0 "remove $fname\($sname,facets) method"
                 set removed 1
             } 
         }
     }
     return $removed
 }
 
 #
 # fexecm - execute a method
 # requires that fname(sname,facets) exists
 # calls ifref and ifexecm demons
 #
 proc fexecm {fname sname} {
     set executed 0
     if {[fexists $fname $sname]} {
         if {[uplevel \#0 "member $$fname\($sname,facets) ref"]} {
             set fname2 [uplevel \#0 "set $fname\($sname,ref)"] 
             if {[uplevel \#0 "member $fname\($sname,facets) ifref"]} {
                 uplevel \#0 "eval $$fname\($sname,ifref)"
             }
             set executed [fexecm $fname2 $sname]
         } else {
             if {[uplevel \#0 "member $$fname\($sname,facets) method"]} {
                 if {[uplevel \#0 "member $$fname\($sname,facets) ifexecm"]} {
                     uplevel \#0 "eval $$fname\($sname,ifexecm)"
                 }
                 uplevel \#0 "eval $$fname\($sname,method)"
                 set executed 1
             }
         }
     }
     return $executed
 }
 
 # 
 # fgetm - get a value from a method facet
 # requires that fname(sname,facets) exists
 # calls ifref and ifgetm demons
 #
 proc fgetm {fname sname} {
     set pname {}
     if {[fexists $fname $sname]} {
         if {[uplevel \#0 "member $$fname\($sname,facets) ref"]} {
             set fname2 [uplevel \#0 "set $fname\($sname,ref)"]
             if {[uplevel \#0 "member $$fname\($sname,facets) ifref"]} {
                 uplevel \#0 "eval $$fname\($sname,ifref)"
             }
             set pname [fgetm $fname2 $sname]
         } else {
             if {[uplevel \#0 "member $$fname\($sname,facets) method"]} {
                 if {[uplevel \#0 "member $$fname\($sname,facets) ifgetm"]} {
                     uplevel \#0 "eval $$fname\($sname,ifgetm)"
                 }
                 set pname [uplevel \#0 "set $fname\($sname,method)"]
             }
         }
     }
     return $pname
 }
 
 #
 # fputm - put a value in a method facet
 # requires that fname(sname,facets) exists
 # modifies fname(sname,method) where fname is the original or
 #          referenced frame
 # calls ifref and ifputm demons
 #
 proc fputm {fname sname args} {
     set put 0
     if {[fexists $fname $sname]} {
         if {[uplevel \#0 "member $$fname\($sname,facets) ref"]} {
             set fname2 [uplevel \#0 "set $fname\($sname,ref)"] 
             if {[uplevel \#0 "member $$fname\($sname,facets) ifref"]} {
                 uplevel \#0 "eval $$fname\($sname,ifref)"
             }
             set put [fputm $fname2 $sname $args]
         } else {
             if {[uplevel \#0 "member $$fname\($sname,facets) method"]} {
                 if {[uplevel \#0 "member $$fname\($sname,facets) ifputm"]} {
                     uplevel \#0 "eval $$fname\($sname,ifputm)"
                 }
                 uplevel \#0 "set $fname\($sname,method) $args"
                 set put 1
             }
         }
     }
     return $put
 }
 
 #
 # fexistv - determine if a value facet exists
 # requires that fname(sname,facets) exists
 # calls ifref and ifexistv demons
 #
 proc fexistv {fname sname} {
     set found 0
     if {[fexists $fname $sname]} {
         if {[fexistrx $fname $sname]} {
             set fname2 [uplevel \#0 "set $fname\($sname,ref)"]
             if {[uplevel \#0 "member $$fname\($sname,facets) ifref"]} {
                 uplevel \#0 "eval $$fname\($sname,ifref)"
             }
             set found [fexistv $fname2 $sname]
         }
         if {[uplevel \#0 "member $$fname\($sname,facets) value"]} {
             if {[uplevel \#0 "member $$fname\($sname,facets) ifexistv"]} {
                 uplevel \#0 "eval $$fname\($sname,ifexistv)"
             }
             set found 1
         }
     }
     return $found
 }
 
 # 
 # fcreatev - create a value facet
 # requires that fname(sname,facets) exists
 # modifies fname(sname,facets),fname(sname,value) where fname is
 #          the original or referenced frame
 # calls ifref and ifcreatev demons
 # 
 proc fcreatev {fname sname} {
     set created 0
     if {[fexists $fname $sname]} {
         if {[uplevel \#0 "member $$fname\($sname,facets) method"] ||
             [uplevel \#0 "member $$fname\($sname,facets) value"]} {
             set created 0
         } else {
             if {[uplevel \#0 "member $$fname\($sname,facets) ref"]} {
                 set fname2 [uplevel \#0 "set $fname\($sname,ref)"] 
                 if {[uplevel \#0 "member $$fname\($sname,facets) ifref"]} {
                     uplevel \#0 "eval $$fname\($sname,ifref)"
                 }
                 set created [fcreatev $fname2 $sname]
             } else {
                 uplevel \#0 "set $fname\($sname,value) {}"
                 uplevel \#0 "lappend $fname\($sname,facets) value"
                 if {[uplevel \#0 "member $$fname\($sname,facets) ifcreatev"]} {
                     uplevel \#0 "eval $$fname\($sname,ifcreatev)"
                 }
                 set created 1
             }
         }
     }
     return $created
 }
 
 #
 # fremovev - remove a value facet
 # requires that fname(sname,facets) exists
 # modifies fname(sname,facets),fname(sname,value) where fname is
 #          the original or referenced frame
 # calls ifref and ifremovev demons
 #
 proc fremovev {fname sname} {
     set removed 0
     if {[fexists $fname $sname]} {
         if {[uplevel \#0 "member $$fname\($sname,facets) ref"]} {
             set fname2 [uplevel \#0 "set $fname\($sname,ref)"]
             if {[uplevel \#0 "member $$fname\($sname,facets) ifref"]} {
                 uplevel \#0 "eval $$fname\($sname,ifref)"
             }
             set removed [fremovev $fname2 $sname]
         } else {
             if {[uplevel \#0 "member $$fname\($sname,facets) value"]} {
                 if {[uplevel \#0 "member $$fname\($sname,facets) ifremovev"]} {
                     uplevel \#0 "eval $$fname\($sname,ifremovev)"
                 }
                 uplevel \#0 "unset $fname\($sname,value)"
                 uplevel \#0 "remove $fname\($sname,facets) value"
                 set removed 1
             } 
         }
     }
     return $removed
 }
 
 #
 # fgetv - get a value from a value facet
 # requires that fname(sname,facets) exists
 # calls ifref and ifgetv demons
 #
 proc fgetv {fname sname} {
     set pname {}
     if {[fexists $fname $sname]} {
         if {[uplevel \#0 "member $$fname\($sname,facets) ref"]} {
             set fname2 [uplevel \#0 "set $fname\($sname,ref)"]
             if {[uplevel \#0 "member $$fname\($sname,facets) ifref"]} {
                 uplevel \#0 "eval $$fname\($sname,ifref)"
             }
             set pname [fgetv $fname2 $sname]
         } else {
             if {[uplevel \#0 "member $$fname\($sname,facets) value"]} {
                 if {[uplevel \#0 "member $$fname\($sname,facets) ifgetv"]} {
                     uplevel \#0 "eval $$fname\($sname,ifgetv)"
                 }
                 set pname [uplevel \#0 "set $fname\($sname,value)"]
             }
         }
     }
     return $pname
 }
 
 #
 # fputv - put a value in a value facet
 # requires that fname(sname,facets) exists
 # modifies fname(sname,value) where fname is the original or
 #          referenced frame
 # calls ifref and ifputv demons
 #
 proc fputv {fname sname args} {
     set put 0
     if {[fexists $fname $sname]} {
         if {[uplevel \#0 "member $$fname\($sname,facets) ref"]} {
             set fname2 [uplevel \#0 "set $fname\($sname,ref)"] 
             if {[uplevel \#0 "member $$fname\($sname,facets) ifref"]} {
                 uplevel \#0 "eval $$fname\($sname,ifref)"
             }
             set put [fputv $fname2 $sname $args]
         } else {
             if {[uplevel \#0 "member $$fname\($sname,facets) value"]} {
                 uplevel \#0 "set $fname\($sname,value) $args"
                 if {[uplevel \#0 "member $$fname\($sname,facets) ifputv"]} {
                     uplevel \#0 "eval $$fname\($sname,ifputv)"
                 }
                 set put 1
             }
         }
     }
     return $put
 }
 
 #
 # fexistd - determine if a demon facet exists
 # requires that fname(sname,facets) exists
 # 
 proc fexistd {fname sname dname} {
     if {[fexists $fname $sname]} {
         if {[uplevel \#0 "member $$fname\($sname,facets) $dname"]} {
             return 1
         } else {
             return 0
         }
     } else {
         return 0
     }
 }
 
 # 
 # fcreated - create a demon facet
 # requires that fname(sname,facets) exists
 # modifies fname(sname,facets),fname(sname,dname)
 # 
 proc fcreated {fname sname dname} {
     if {[fexists $fname $sname]} {
         if {[uplevel \#0 "member $$fname\($sname,facets) $dname"] == 0} {
             uplevel \#0 "set $fname\($sname,$dname) {}"
             uplevel \#0 "lappend $fname\($sname,facets) $dname"
             return 1
         } else {
             return 0
         }
     } else {
         return 0
     }
 }
 
 # 
 # fremoved - remove a demon facet
 # requires that fname(sname,dname) exists
 # modifies fname(sname,facets),fname(sname,dname)
 #
 proc fremoved {fname sname dname} {
     if {[fexistd $fname $sname $dname]} {
         uplevel \#0 "unset $fname\($sname,$dname)"
         uplevel \#0 "remove $fname\($sname,facets) $dname"
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fgetd - get a value from a demon facet
 # requires that fname(sname,dname) exists
 #
 proc fgetd {fname sname dname} {
     if {[fexistd $fname $sname $dname]} {
         return [uplevel \#0 "set $fname\($sname,$dname)"]
     } else {
         return {}
     }
 }
 
 #
 # fputd - put a value in a demon facet
 # requires that fname(sname,dname) exists
 # modifies fname(sname,dname)
 #
 proc fputd {fname sname dname args} {
     if {[fexistd $fname $sname $dname]} {
         uplevel \#0 "set $fname\($sname,$dname) $args"
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fexecd - directly execute a demon
 # requires that fname(sname,dname) exists
 #
 proc fexecd {fname sname dname} {
     if {[fexistd $fname $sname $dname]} {
         uplevel \#0 "eval $$fname\($sname,$dname)"
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fcreatefs - create a frameset
 # requires that name() does not exist
 # modifies fframes, name(name,set), name(name,slots)
 #
 proc fcreatefs {name} {
     global fframes
     if {![fexistf $name]} {
         lappend fframes $name
         uplevel \#0 "set $name\($name,set) {}"
         uplevel \#0 "set $name\($name,slots) {}"
         return 1
     } else {
         return 0
     }
 }
 
 # 
 # fremovefs - remove a frameset
 # requires that name() exists
 # modifies fframes, name()
 #
 proc fremovefs {name} {
     if {[fremovef $name]} {
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fslistf - return a list of frames in a frameset
 # requires that name() exists
 #
 proc fslistf {name} {
     if {[fexistf $name]} {
         return [uplevel \#0 "set $name\($name,set)"]
     } else {
         return {}
     }
 }
 
 #
 # floadfs - load a frameset into memory
 # requires that name() exist on disk, but not in memory
 #
 proc floadfs {name} {
     if {[floadf $name]} {
         set s [fslistf $name]
         foreach i $s {
             floadf $i 
         }
         return 1
     } else {
         return 0
     }
 }
 
 # 
 # fstorefs - store a frameset on disk
 # requires that name() exists
 #
 proc fstorefs {name} {
     if {[fstoref $name]} {
         set s [fslistf $name]
         foreach i $s {
             fstoref $i
         }
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fsincludef - include a frame in a frameset
 # requires that name() and fname() exist
 # modifies name(name,set)
 #
 proc fsincludef {name fname} {
     if {[fexistf $name] && [fexistf $fname]} {
         uplevel \#0 "lappend $name\($name,set) $fname"
         return 1
     } else {
         return 0
     }
 }
 
 # 
 # fsexcludef - exclude a frame from a frameset
 # requires that name() exists
 # modifies name(name,set)
 #
 proc fsexcludef {name fname} {
     if {[fexistf $name]} {
         if {[uplevel \#0 "member $$name\($name,set) $fname"]} {
             uplevel \#0 "remove $name\($name,set) $fname"
             return 1
         } else {
             return 0
         }
     } else {
         return 0
     }
 }
 
 # 
 # fscreates - create a slot in a frameset
 # requires that name() exists
 # modifies name(name,slots), name(sname,facets), associated frames
 #
 proc fscreates {name sname} {
     if {[fcreates $name $sname]} {
         set s [fslistf $name]
         foreach i $s {
             fcreates $i $sname
         }
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fsremoves - remove a slot from a frameset
 # requires that name(sname,facets) exists
 # modifies name(name,slots), name(sname,), associated frames
 #
 proc sremoves {name sname} {
     if {[fremoves $name $sname]} {
         set s [fslistf $name]
         foreach i $s {
             fremoves $i $sname
         }
         return 1
     } else {
         return 0
     }
 }
 
 # 
 # fscreated - create a demon facet in a frameset
 # requires that name(sname,facets) exists
 # modifies name(sname,facets), name(sname,dname), associated frames
 #
 proc fscreated {name sname dname} {
     if {[fcreated $name $sname $dname]} {
         set s [fslistf $name]
         foreach i $s {
             fcreated $i $sname $dname
         }
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fsremoved - remove a demon facet from a frameset
 # requires that name(sname,dname) exists
 # modifies name(name,slots), name(sname,dname), associated frames
 #
 proc sremoved {name sname dname} {
     if {[fremoved $name $sname $dname]} {
         set s [fslistf $name]
         foreach i $s {
             fremoved $i $sname $dname
         }
         return 1
     } else {
         return 0
     }
 }
 
 # 
 # fscreatem - create a method facet in a frameset
 # requires that name(sname,facets) exists
 # modifies name(sname,facets), name(sname,method), associated frames
 #
 proc fscreatem {name sname} {
     if {[fcreatem $name $sname]} {
         set s [fslistf $name]
         foreach i $s {
             fcreatem $i $sname
         }
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fsremovem - remove a method facet from a frameset
 # requires that name(sname,facets) exists
 # modifies name(sname,facets), name(sname,method), associated frames
 #
 proc fsremovem {name sname} {
     if {[fremovem $name $sname]} {
         set s [fslistf $name]
         foreach i $s {
             fremovem $i $sname
         }
         return 1
     } else {
         return 0
     }
 }
 
 # 
 # fscreater - create a reference facet in a frameset
 # requires that name(sname,facets) exists
 # modifies name(sname,facets), name(sname,ref), associated frames
 #
 proc fscreater {name sname} {
     if {[fcreater $name $sname]} {
         set s [fslistf $name]
         foreach i $s {
             fcreater $i $sname
         }
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fsremover - remove a reference facet from a frameset
 # requires that name(sname,facets) exists
 # modifies name(sname,facets), name(sname,ref), associated frames
 #
 proc fsremover {name sname} {
     if {[fremover $name $sname]} {
         set s [fslistf $name]
         foreach i $s {
             fremover $i $sname
         }
         return 1
     } else {
         return 0
     }
 }
 
 # 
 # fscreatev - create a value facet in a frameset
 # requires that name(sname,facets) exists
 # modifies name(sname,facets), name(sname,value), associated frames
 #
 proc fscreatev {name sname} {
     if {[fcreatev $name $sname]} {
         set s [fslistf $name]
         foreach i $s {
             fcreatev $i $sname
         }
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fsremovev - remove a value facet from of a frameset
 # requires that name(sname,facets) exists
 # modifies name(sname,facets), name(sname,value), associated frames
 #
 proc fsremovev {name sname} {
     if {[fremovev $name $sname]} {
         set s [fslistf $name]
         foreach i $s {
             fremovev $i $sname
         }
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fsputr - put a value in reference facet in a frameset
 # requires that name(sname,facets) exists
 # modifies the name(sname,ref)
 #
 proc fsputr {name sname fname} {
     if {[fexistr $name $sname]} {
         fputr $name $sname $fname
         set s [fslistf $name]
         foreach i $s {
             fputr $i $sname $fname
         }
         return 1
     } else {
         return 0
     }
 }
 
 #
 # fsgetr - get a value from a reference facet in a frameset
 # requires that name(sname,ref) exists
 # modifies nothing
 #
 proc fsgetr {name sname} {
     if {[fexistr $name $sname]} {
         set r [fgetr $name $sname]
         return $r
     } else {
         return ""
     }
 }
     
 #
 # fsmemberf - get list of framesets in which a frame is a member
 # requires that the frame exists
 # modifies nothing
 #
 proc fsmemberf {name} {
     if {[fexistf $name]} {
         foreach i [flistf] {
             if {[uplevel \#0 "info exists $i\($i,set)"]} {
                 if {[member [uplevel \#0 "fslistf $i"] $name]} {
                     lappend mlist $i
                 }
             }
         }
         return $mlist
     } else {
         return {}
     }
 }