Changeset 22 for trunk/tcl/scripts

Timestamp:

Jul 16, 2005, 2:31:32 PM (19 years ago)

Author:

mmc

Message:

Lots of changes to support Huckel-IV:

• Support for embedded <tool> declarations
• New <integer> entry
• Support for numbers and structures as output elements
• Atom numbers/symbols in MoleculeViewer?

File:

• trunk/tcl/scripts/library.tcl (modified) (4 diffs)

trunk/tcl/scripts/library.tcl

@@ -127 +127 @@
                 }
                 structure {
+                    # add this to the return list with the right flavor
+                    if {$params(-as) == "component"} {
+                        lappend rlist $cpath
+                    } else {
+                        lappend rlist [$xmlobj element -as $params(-as) $cpath]
+                    }
+
                     if {[$xmlobj element $cpath.current.parameters] != ""} {
                         lappend queue $cpath.current.parameters
@@ -163 +170 @@
     public method get {{path ""}}
     public method put {args}
+    public method copy {path from args}
     public method remove {{path ""}}
     public method xml {}
@@ -169 +177 @@
     public proc value {libobj path}
 
+    public proc path2list {path}
     protected method find {path}
-    protected method path2list {path}
     protected method node2name {node}
     protected method node2comp {node}
@@ -515 +523 @@
     }
     return ""
+}
+
+# ----------------------------------------------------------------------
+# USAGE: copy <path> from ?<xmlobj>? <path>
+#
+# Clients use this to copy the value from one xmlobj/path to another.
+# If the <xmlobj> is not specified, it is assumed to be the same as
+# the current object.
+# ----------------------------------------------------------------------
+itcl::body Rappture::LibraryObj::copy {path from args} {
+    if {[llength $args] == 1} {
+        set xmlobj $this
+        set fpath [lindex $args 0]
+    } elseif {[llength $args] == 2} {
+        set xmlobj [lindex $args 0]
+        set fpath [lindex $args 1]
+    } else {
+        error "wrong # args: should be \"copy path from ?xmlobj? path\""
+    }
+    if {$from != "from"} {
+        error "bad syntax: should be \"copy path from ?xmlobj? path\""
+    }
+
+    if {[llength [$xmlobj children $fpath]] == 0} {
+        set val [$xmlobj get $fpath]
+        put $path $val
+    } else {
+        set obj [$xmlobj element -as object $fpath]
+        put $path $obj
+        itcl::delete object $obj
+    }
 }