RoleCtrl

Source code:

<mind:reply xmlns:dsssl="http://www.askemos.org/2000/NameSpaceDSSSL" xmlns:mind="http://www.askemos.org/2000/CoreAPI" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
 <xsl:variable name="selected">
  <dsssl:copy-of select="#CONTENT">
(node-list
 (let ((id (data (form-field 'id (current-node)))))
  (node-list-filter
   (lambda (node) (and (match-element? 'role node)
                       (equal? (attribute-string 'id node) id)))
   (xsl-variable "roles")))
  (xsl-variable "role-schema"))
  </dsssl:copy-of>
 </xsl:variable>
 <xsl:variable name="new-value">
  <dsssl:copy-of select="#CONTENT">
(make element
  gi: 'role
  attributes: `((id ,(let* ((f (form-field 'id (current-node)))
                            (v (and f (data f))))
                       (if (member v '(#f "#f" "none" ""))
                           (error "no id specified")
                           v))))
  (node-list
   (let* ((f (form-field 'right (current-node)))
             (v (and f (data f))))
      (if (member v '(#f "#f" "none" ""))
          (select-elements
           (children (node-list-first (xsl-variable "selected"))) 'right)
          (right-&gt;node-list (map string-&gt;oid (parsed-locator v)))))
   (let* ((f (form-field 'description (current-node)))
             (v (and f (xml-parse (data f)))))
      (if (equal? "" (data v))
          (select-elements
           (children (node-list-first (xsl-variable "selected"))) 'description)
          (make element gi: 'description v)))))
  </dsssl:copy-of>
 </xsl:variable>
 <dsssl:copy-of select="#CONTENT">

(root
 (let ((this-root (document-element (grove-root (current-node)))))
   (make element
    gi: (gi this-root) ns: (ns this-root)
    attributes: (copy-attributes (current-node))
    (node-list-map
     (lambda (node)
      (cond
       ((match-element? 'roles node)
        (let ((id (attribute-string
                   'id (node-list-first (xsl-variable "selected")))))
          (make element
            gi: (gi node) ns: (ns node)
            (if (equal? id "none")
                (node-list (xsl-variable "new-value") (children node))
                (node-list-map
                 (lambda (node)
                   (if (and (match-element? 'role node)
                            (equal? (attribute-string 'id node) id))
                       (xsl-variable "new-value")
                       node))
                 (children node))))))
       (else node)))
     ;; The children of the root of the style sheet.
     (children this-root)))))

 </dsssl:copy-of>
<!--

 ;;; Local Variables: ***
 ;;; mode: dsssl ***
 ;;; End: ***

-->
</mind:reply>