;; -*- Mode: lisp; Syntax: ansi-common-lisp; Package: cgp; Base: 10 -*-
;;
;; Copyright (C) Paul Meurer 2000. All rights reserved.
;; paul.meurer@hit.uib.no
;; HIT-centre, University of Bergen
;;
;; Version 0.9
;;
;; Simple Web-interface to the CommonLisp-reimplementation of the CG parser/tagger system
;; (Oslo-tagger) developed at UiO (Dokumentasjonsprosjektet; Tekstlaboratoriet)
;;

;;-------------------------------------------------------------------------------------
;; TO DO:
;;-------------------------------------------------------------------------------------
;; PROBLEMS:
;;
;; Does not work in IE 5.00.2920.0000 (problem with persistent connections)
;;
;;-------------------------------------------------------------------------------------

(in-package :cgp)

(progn
  (define-java-script-writer js/edit-rule (language stream)
    #j(
       (defvar undoList (new (Object)))
       
       (defvar newRuleId 0)
       
       (defun restoreField (new-status)
         (let* (inputText
                (textInputField (document.getElementById "textInputField")))
           ;; set textarea element back to text
           (when textInputField
             (setf inputText textInputField.value)
             (let* ((restoredElement (document.createElement "pre"))
                    (rule-field-id (textInputField.name.substr 5))
                    (hiddenElement (document.createElement "<input type=hidden name=hidden>")))
               (setf restoredElement.innerText inputText
                     restoredElement.id rule-field-id
                     restoredElement.className textInputField.className
                     restoredElement.onclick textInputField.onclickMasqued)

               (textInputField.replaceNode restoredElement)
               
               (if (= new-status "deleted") 
                 (setf hiddenElement.value "deleted")
                 (setf hiddenElement.value inputText))
               (setf hiddenElement.name (+ "hidden_value_" rule-field-id)
                     hiddenElement.id (+ "hidden_value_" rule-field-id)
                     hiddenElement.className textInputField.className)
               (restoredElement.appendChild hiddenElement)
               ;; show status
               (unless (or (= (car (aref undoList rule-field-id)) inputText)
                           (not textInputField.ruleId))
                 (SetRuleStatus textInputField.ruleId new-status))))))
       
       #+old
       (defun EditRule (id type)
         (restoreField "endret")
         ;; delete hidden field with this id
         (let ((hidden (document.getElementById (+ "hidden_value_" id))))
           (when hidden
             (hidden.removeNode)))
         ;; put text of current field into textarea
         (let* ((doc (document.getElementById id))
                (textInput (document.createElement "<textarea name=text>"))
                (cr-array (doc.innerHTML.match (regexp "/<BR>/g")))
                cr-count)
           (if cr-array
             (setf cr-count (+ cr-array.length 2))
             (setf cr-count 2))
           (setf textInput.name (+ "rule_" id)
                 textInput.id "textInputField" ; id
                 textInput.rows cr-count
                 textInput.cols 70
                 textInput.value (doc.innerHTML.replace (regexp "/<BR>/g") "'\\r\\n'")
                 textInput.value (textInput.value.replace (regexp "/&nbsp;/g") " ")
                 textInput.value (textInput.value.replace (regexp "/&amp;/g") "&")
                 textInput.value (textInput.value.replace (regexp "/&gt;/g") ">")
                 textInput.value (textInput.value.replace (regexp "/&lt;/g") "<")
                 textInput.className doc.className
                 textInput.onclickMasqued doc.onclick)
           ;; push text of current field into undo list
           (if (aref undoList id)
             (unless (= textInput.value (car (aref undoList id)))
               (setf (aref undoList id) (cons textInput.value (aref undoList id))))
             (setf (aref undoList id) (list textInput.value)))
           ;; display text in textarea
           (doc.replaceNode textInput)))

       (defun EditRule (id type)
         (restoreField "endret")
         ;; delete hidden field with this id
         (let ((hidden (document.getElementById (+ "hidden_value_" id))))
           (when hidden
             (hidden.removeNode)))
         ;; put text of current field into textarea
         (let* ((doc (document.getElementById id))
                (textInput (document.createElement "<textarea name=text>")))
           (if doc
             (let* ((cr-array (doc.innerHTML.match (regexp "/<BR>/g")))
                    cr-count)
               (if cr-array
                 (setf cr-count (+ cr-array.length 2))
                 (setf cr-count 2))
               (setf textInput.name (+ "rule_" id)
                     textInput.id "textInputField"
                     textInput.rows cr-count
                     textInput.cols 70
                     textInput.value (doc.innerHTML.replace (regexp "/<BR>/g") "'\\r\\n'")
                     textInput.value (textInput.value.replace (regexp "/&nbsp;/g") " ")
                     textInput.value (textInput.value.replace (regexp "/&amp;/g") "&")
                     textInput.value (textInput.value.replace (regexp "/&gt;/g") ">")
                     textInput.value (textInput.value.replace (regexp "/&lt;/g") "<")
                     textInput.className doc.className
                     ;;textInput.ruleId id 
                     textInput.onclickMasqued doc.onclick)
               (cond ((= type "comment")
                      (setf textInput.ruleId (id.substr 11)))
                     ((= type "group-comment")
                      (setf textInput.ruleId nil))
                     (t
                      (setf textInput.ruleId id)))
               ;; push text of current field into undo list
               (if (aref undoList id)
                 (unless (= textInput.value (car (aref undoList id)))
                   (setf (aref undoList id) (cons textInput.value (aref undoList id))))
                 (setf (aref undoList id) (list textInput.value)))
               ;; display text in textarea
               (doc.replaceNode textInput))
             ;; new field (comment field)
             (let* ((rule-id (id.substr 11))
                    (ruleRow (document.getElementById (+ "RuleDefRow" rule-id)))
                    (ruleCommentLabelCell (document.createElement "<td class='clsRuleCommentLabel' valign='top'>"))
                    (ruleCommentCell (document.createElement "<td class='clsRuleComment'>"))
                    (ruleCommentRow (document.createElement "<tr>")))
               (setf ruleCommentLabelCell.innerHTML "Kommentar&nbsp;"
                     textInput.name (+ "rule_" id)
                     textInput.id "textInputField"
                     textInput.rows 4
                     textInput.cols 70
                     textInput.value ""
                     textInput.ruleId rule-id
                     ;;textInput.className doc.className
                     textInput.onclickMasqued (new (Function (+ "EditRule('" id "', '" type "');"))))
               ;; push text of current field into undo list
               (setf (aref undoList id) (list textInput.value))
               ;; display text in textarea
               (ruleRow.insertAdjacentElement "afterEnd" ruleCommentRow)
               (ruleCommentRow.appendChild ruleCommentLabelCell)
               (ruleCommentRow.appendChild ruleCommentCell)
               (ruleCommentCell.insertAdjacentElement "afterBegin" textInput)))))

       (defun InsertNewRule (lang)
         (restoreField "endret")
         (let* ((rulesTable (document.getElementById "tblRulesTable"))
                (ruleNameRow (rulesTable.insertRow 0))
                (ruleNameLabelCell (document.createElement "<td class='clsRuleNameLabel'>"))
                (ruleNameCell (document.createElement "<td class='clsRuleName' expitemnum='1'>"))
                (statusRow (rulesTable.insertRow 1))
                (statusLabelCell (document.createElement "<td class='clsRuleLabel'>"))
                (statusCell (document.createElement "<td class='clsRuleStatus'>"))
                (ruleBodyLabelCell (document.createElement "<td class='clsRuleLabel' valign='top'>"))
                (ruleBodyCell (document.createElement "<td class='clsRuleBody'>"))
                (textInput (document.createElement "<textarea name=text>"))
                (ruleBodyRow (rulesTable.insertRow 2)))
           (statusRow.appendChild statusLabelCell)
           (statusRow.appendChild statusCell)
           (ruleNameRow.appendChild ruleNameLabelCell)
           (ruleNameRow.appendChild ruleNameCell)
           (ruleBodyRow.appendChild ruleBodyLabelCell)
           (ruleBodyRow.appendChild ruleBodyCell)
           (ruleBodyCell.insertAdjacentElement "afterBegin" textInput) 
           (setf ruleNameLabelCell.innerHTML "Regel&nbsp;"
                 ruleNameLabelCell.align "right"
                 ruleNameCell.innerHTML (+ "rule <b>" lang "</b> (" newRuleId ")")
                 ruleNameCell.id (+ "RuleNameNew" lang newRuleId)
                 statusRow.id (+ "RuleStatusRowNew" lang newRuleId)
                 statusLabelCell.innerHTML "Status&nbsp;"
                 statusLabelCell.align "right"
                 statusCell.innerText "ny"    
                 statusCell.id (+ "RuleStatusNew" lang newRuleId)
                 ruleBodyLabelCell.innerHTML "Definisjon&nbsp;"
                 ruleBodyLabelCell.align "right"
                 textInput.name (+ "rule_New" lang newRuleId)
                 textInput.id "textInputField"
                 textInput.rows 5
                 textInput.cols 70
                 textInput.value ""
                 ;;textInput.className 
                 textInput.onclickMasqued (new (Function (+ "EditRule('New" lang newRuleId "', 'body');"))) 
                 (aref undoList (+ "New" lang newRuleId)) (list ""))
           (incf newRuleId)))

       (defun CloneRule (id)
         (let* ((rulesTable (document.getElementById "tblRulesTable"))
                (ruleRow (document.getElementById (+ "RuleRow" id)))
                (ruleNameRow (document.createElement "<tr class='clsRuleNameRow'>"))
                (ruleNameLabelCell (document.createElement "<td class='clsRuleNameLabel'>"))
                (ruleNameCell (document.createElement "<td class='clsRuleName' expitemnum='1'>"))
                (statusRow (document.createElement "<tr class='clsRuleStatusRow'>"))
                (statusLabelCell (document.createElement "<td class='clsRuleLabel'>"))
                (statusCell (document.createElement "<td class='clsRuleStatus'>"))
                (ruleBodyLabelCell (document.createElement "<td class='clsRuleLabel' valign='top'>"))
                (ruleBodyCell (document.createElement "<td class='clsRuleBody'>"))
                (textInput (document.createElement "<textarea name=text>"))
                (ruleBodyRow (document.createElement "<tr>"))
                (origRuleCell (document.getElementById id))
                (cr-array (origRuleCell.innerHTML.match (regexp "/<BR>/g")))
                (cr-count 5))
           (when cr-array (setf cr-count (+ cr-array.length 2)))
           (ruleRow.insertAdjacentElement "beforeBegin" ruleNameRow)
           (ruleRow.insertAdjacentElement "beforeBegin" statusRow)
           (ruleRow.insertAdjacentElement "beforeBegin" ruleBodyRow)
           (statusRow.appendChild statusLabelCell)
           (statusRow.appendChild statusCell)
           (ruleNameRow.appendChild ruleNameLabelCell)
           (ruleNameRow.appendChild ruleNameCell)
           (ruleBodyRow.appendChild ruleBodyLabelCell)
           (ruleBodyRow.appendChild ruleBodyCell)
           (ruleBodyCell.insertAdjacentElement "afterBegin" textInput) 
           (setf ruleNameLabelCell.innerHTML "Regel&nbsp;"
                 ruleNameLabelCell.align "right"
                 ruleNameCell.innerHTML (+ "rule <b>" #L language "</b> (" newRuleId ")")
                 ruleNameCell.id (+ "RuleNameNew" #L language newRuleId)
                 statusRow.id (+ "RuleStatusRowNew" #L language newRuleId)
                 statusLabelCell.innerHTML "Status&nbsp;"
                 statusLabelCell.align "right"
                 statusCell.innerText "ny"    
                 statusCell.id (+ "RuleStatusNew" #L language newRuleId)
                 ruleBodyLabelCell.innerHTML "Definisjon&nbsp;"
                 ruleBodyLabelCell.align "right"
                 textInput.name (+ "rule_New" id "_" #|#L language|# newRuleId)
                 textInput.id "textInputField"
                 textInput.rows cr-count
                 textInput.cols 70
                 textInput.value (origRuleCell.innerHTML.replace (regexp "/<BR>/g") "'\\r\\n'")
                 textInput.value (textInput.value.replace (regexp "/&nbsp;/g") " ")
                 textInput.value (textInput.value.replace (regexp "/&amp;/g") "&")
                 textInput.value (textInput.value.replace (regexp "/&gt;/g") ">")
                 textInput.value (textInput.value.replace (regexp "/&lt;/g") "<")
                 textInput.onclickMasqued (new (Function (+ "EditRule('New" #L language newRuleId "', 'body');"))) 
                 (aref undoList (+ "New" #L language newRuleId)) (list ""))
           (incf newRuleId)))
      
       ;; still does not work for comments since id refers only to rule
       (defun UndoRuleChanges (id)
         (when (aref undoList id)
           (let* ((doc (document.getElementById id))
                  (undo-text (car (aref undoList id))))
             (when (= undo-text "deleted")
               (when (cdr (aref undoList id))
                 (setf (aref undoList id) (cdr (aref undoList id))
                       undo-text (car (aref undoList id)))))
             (if (cdr (aref undoList id))
               (SetRuleStatus id "endret")
               (SetRuleStatus id "uendret"))
             (unless (= undo-text "deleted")
               (if doc
                 (let ((hiddenElement (document.createElement "<input type=hidden name=hidden>")))
                   (setf hiddenElement.value undo-text
                         hiddenElement.name (+ "hidden_value_" id)
                         hiddenElement.id (+ "hidden_value_" id)
                         hiddenElement.className doc.className)
                   (setf doc.innerText undo-text)
                   (doc.appendChild hiddenElement))
                 (let ((doc (document.getElementById "textInputField")))
                   (setf doc.value (car (aref undoList id)))))))
           (when (cdr (aref undoList id))
             (setf (aref undoList id) (cdr (aref undoList id))))))
       
       (defun DeleteRule (id type)
         (cond ((not (aref undoList id))
                (let* ((doc (document.getElementById id))
                       (value (doc.innerHTML.replace (regexp "/<BR>/g") "'\\r\\n'")))
                  (setf (aref undoList id) (list "deleted" (value.replace (regexp "/&nbsp;/g") " ")))))
               ((= (aref undoList id) "deleted")
                nil)
               (t
                (setf (aref undoList id) (cons "deleted" (aref undoList id)))))
         (let* ((doc (document.getElementById id))
                (textInputField (document.getElementById "textInputField"))
                (hiddenElement (document.getElementById (+ "hidden_value_" id))))
           (cond (doc
                  (let ((hiddenElement (document.createElement "<input type=hidden name=hidden>")))
                    (setf hiddenElement.value "deleted"
                          hiddenElement.name (+ "hidden_value_" id)
                          hiddenElement.id (+ "hidden_value_" id)
                          hiddenElement.className doc.className)
                    (doc.appendChild hiddenElement))) 
                 (textInputField
                  (restoreField "deleted"))
                 (t
                  (alert "error"))))
         (SetRuleStatus id "slettet"))

       (defun SetRuleStatus (id status)
         (let* ((statusRow (document.getElementById (+ "RuleStatusRow" id)))
                (statusCell (document.getElementById (+ "RuleStatus" id))))
           (unless statusRow
             (let* ((statusLabelCell (document.createElement "<td class='clsRuleStatus'>"))
                    (ruleNameCell (document.getElementById (+ "RuleName" id))))
               (setf statusRow (document.createElement "<tr class='clsRuleStatusRow'>")
                     statusRow.id (+ "RuleStatusRow" id)
                     statusLabelCell (document.createElement "<td class='clsRuleStatusLabel'>")
                     statusLabelCell.innerHTML "Status&nbsp;"
                     statusLabelCell.align "right"
                     statusCell (document.createElement "<td class='clsRuleStatus'>")
                     statusCell.id (+ "RuleStatus" id))
               (statusRow.appendChild statusLabelCell)
               (statusRow.appendChild statusCell)
               (ruleNameCell.parentElement.insertAdjacentElement "afterEnd" statusRow)))
           (setf statusCell.innerText status)))
       
       (defun SaveChanges ()
         (let* ((e (new (Enumerator (document.getElementsByTagName "form"))))
                (form (e.item)))
           (form.submit)))

       #+ignore
       (defun RedoRuleChanges (id type)
         (let ((doc (document.getElementById id)))
           (when (aref undoList id)
             (setf doc.innerHTML (car (aref undoList id))
                   (aref undoList id) (cdr (aref undoList id))))))))
  
  #+ignore
  (ns4.0:define-script
    edit-rule
    (:Java-Script)
    ;; :caller ((script stream text) (http::fast-format stream "EditRule('~a')" text))
    :script ((script stream language) (js/edit-rule language stream))))

(progn
  (define-java-script-writer js/edit-declaration (declaration-id stream)
    #j(

       (defvar declarationId #L declaration-id)

       (defun EditDeclaration (id type) ; *** remove EditDeclaration where type is "Name"! 
         (when (= type "Set")
           (restoreField "textInputNameField")
           (restoreField "textInputSetField")
           ;; delete hidden field with this id
           (let* ((hidden-set (document.getElementById (+ "hidden_value_DeclarationSet" id)))
                 (hidden-name (document.getElementById (+ "hidden_value_DeclarationName" id)))
                 (name-elt (document.getElementById (+ "DeclarationName" id)))
                 (doc (document.getElementById (+ "Declaration" type id)))
                 (textInput (document.createElement "<textarea name=text>"))
                 (cols 40))
             (when hidden-set (hidden-set.removeNode))
             (unless hidden-name 
               (let ((hiddenNameElement (document.createElement "<input type=hidden>")))
                 (setf hiddenNameElement.value name-elt.innerHTML)
                 (setf hiddenNameElement.name (+ "hidden_value_DeclarationName" id) ; ?? twice?
                       hiddenNameElement.id (+ "hidden_value_DeclarationName" id)))
               (name-elt.appendChild hiddenNameElement))
             ;; put text of current field into textarea
             (when (= type "Set") (setf cols 70)) ; very elegant ;-)
             (setf textInput.name (+ "Declaration" type id)
                   textInput.id (+ "textInput" type "Field")
                   textInput.rows 2
                   textInput.cols cols
                   textInput.value (doc.innerHTML.replace (regexp "/<BR>/g") "'\\r\\n'")
                   textInput.value (textInput.value.replace (regexp "/&nbsp;/g") " ")
                   textInput.value (textInput.value.replace (regexp "/&amp;/g") "&")
                   textInput.value (textInput.value.replace (regexp "/&gt;/g") ">")
                   textInput.value (textInput.value.replace (regexp "/&lt;/g") "<")
                   textInput.onclickMasqued doc.onclick)
             ;; display text in textarea
             (doc.replaceNode textInput))))
       
       #+old
       (defun EditDeclaration (id type)
         (restoreField "textInputNameField")
         (restoreField "textInputSetField")
         ;; delete hidden field with this id
         (let ((hidden (document.getElementById (+ "hidden_value_Declaration" type id))))
           (when hidden (hidden.removeNode)))
         ;; put text of current field into textarea
         (let* ((doc (document.getElementById (+ "Declaration" type id)))
                (textInput (document.createElement "<textarea name=text>"))
                (cols 40))
           (when (= type "Set") (setf cols 70)) ; very elegant ;-)
           (setf textInput.name (+ "Declaration" type id)
                 textInput.id (+ "textInput" type "Field")
                 textInput.rows 2
                 textInput.cols cols
                 textInput.value (doc.innerHTML.replace (regexp "/<BR>/g") "'\\r\\n'")
                 textInput.value (textInput.value.replace (regexp "/&nbsp;/g") " ")
                 textInput.value (textInput.value.replace (regexp "/&amp;/g") "&")
                 textInput.value (textInput.value.replace (regexp "/&gt;/g") ">")
                 textInput.value (textInput.value.replace (regexp "/&lt;/g") "<")
                 textInput.onclickMasqued doc.onclick)
           ;; display text in textarea
           (doc.replaceNode textInput)))
       
       (defun InsertNewDeclaration ()
         (restoreField "textInputNameField")
         (restoreField "textInputSetField")
         (let* ((declarationsTable (document.getElementById "tblDeclarationsTable"))
                (declarationNameCell (document.createElement "<td class='clsDeclarationName' valign='top'>"))
                (declarationSetCell (document.createElement "<td class='clsDeclarationSet'>"))
                (textInputName (document.createElement "<textarea name=text>"))
                (textInputSet (document.createElement "<textarea name=text>"))
                (declarationRow (declarationsTable.insertRow 1)))
           (declarationRow.appendChild declarationNameCell)
           (declarationRow.appendChild declarationSetCell)
           (declarationNameCell.insertAdjacentElement "afterBegin" textInputName) 
           (declarationSetCell.insertAdjacentElement "afterBegin" textInputSet)
           (setf declarationNameCell.align "left"
                 declarationSetCell.align "left"
                 declarationNameCell.id (+ "DeclarationName" declarationId)
                 declarationSetCell.id (+ "DeclarationSet" declarationId)
                 textInputName.name (+ "DeclarationName" declarationId) ; "new..."
                 textInputSet.name (+ "DeclarationSet" declarationId)
                 textInputName.id "textInputNameField"
                 textInputSet.id "textInputSetField"
                 textInputName.rows 2
                 textInputName.cols 40
                 textInputName.value ""
                 textInputSet.rows 2
                 textInputSet.cols 70
                 textInputSet.value ""
                 textInputName.onclickMasqued (new (Function (+ "EditDeclaration(" declarationId ", 'Name');"))) 
                 textInputSet.onclickMasqued (new (Function (+ "EditDeclaration(" declarationId ", 'Set');"))))
           (incf declarationId)))

       (defun DeleteDeclaration (id type)
         (cond ((not (aref undoList id))
                (let* ((doc (document.getElementById id))
                       (value (doc.innerHTML.replace (regexp "/<BR>/g") "'\\r\\n'")))
                  (setf (aref undoList id) (list "deleted" (value.replace (regexp "/&nbsp;/g") " ")))))
               ((= (aref undoList id) "deleted")
                nil)
               (t
                (setf (aref undoList id) (cons "deleted" (aref undoList id)))))
         (let* ((doc (document.getElementById id))
                (textInputField (document.getElementById "textInputField"))
                (hiddenElement (document.getElementById (+ "hidden_value_" id))))
           (cond (doc
                  (let ((hiddenElement (document.createElement "<input type=hidden name=hidden>")))
                    (setf hiddenElement.value "deleted"
                          hiddenElement.name (+ "hidden_value_" id)
                          hiddenElement.id (+ "hidden_value_" id)
                          hiddenElement.className doc.className)
                    (doc.appendChild hiddenElement))) 
                 (textInputField
                  (restoreField "deleted"))
                 (t
                  (alert "error"))))
         (SetRuleStatus id "slettet"))

       (defun restoreField (elt-name)
         (let* (inputText 
                (textInputField (document.getElementById elt-name)))
           ;; set textarea element back to text
           (when textInputField
             (setf inputText textInputField.value)
             (let* ((restoredElement (document.createElement "pre")) 
                    (hiddenElement (document.createElement "<input type=hidden name=hidden>")))
               ;;(alert (+ "hidden_value_" textInputField.name))
               (setf restoredElement.innerText inputText
                     restoredElement.id textInputField.name
                     restoredElement.className textInputField.className
                     restoredElement.onclick textInputField.onclickMasqued)

               (textInputField.replaceNode restoredElement)
               
               (setf hiddenElement.value inputText)
               (setf hiddenElement.name (+ "hidden_value_" textInputField.name) ; ?? twice?
                     hiddenElement.id (+ "hidden_value_" textInputField.name)
                     hiddenElement.className textInputField.className)
               (restoredElement.appendChild hiddenElement)))))

       (defun SaveChanges ()
         (let* ((e (new (Enumerator (document.getElementsByTagName "form"))))
                (form (e.item)))
           (form.submit)))

       #+ignore
       (defun RedoRuleChanges (id type)
         (let ((doc (document.getElementById id)))
           (when (aref undoList id)
             (setf doc.innerHTML (car (aref undoList id))
                   (aref undoList id) (cdr (aref undoList id))))))))

  #+ignore
  (ns4.0:define-script
   edit-declaration
   (:Java-Script)
   ;; :caller ((script stream text) (http::fast-format stream "EditDeclaration('~a')" text))
   :script ((script stream declaration-id) (js/edit-declaration declaration-id stream))))

;; -----------------------------------------------------------------------
;; 	NAVIGATION FOR MENUBAR AND MENUITEMS
;; -----------------------------------------------------------------------

;; -----------------------------------------------------------------------
;; 	Global variables to track menu state
;; -----------------------------------------------------------------------

(define-java-script-writer js/edit-rule-popup-menu (stream)
  #j(let ((eRulesTableItemShown null)
	  (eMenuShown null))
             
      ;; -----------------------------------------------------------------------
      ;; 	Conditional global event-handlers
      ;; -----------------------------------------------------------------------

      (defun document_click ()
	(when (and #+ignore(neq window.event.srcElement.className "clsRuleNameShown")
		   eMenuShown)
	  (HideMenu)))
    
      (defun document_keypress ()
	(when (and (= window.event.keyCode "27")
		   eMenuShown)
	  (HideMenu)))


      (defun window_blur ()
	(when eMenuShown
	  (HideMenu)))    
    
      ;; -----------------------------------------------------------------------
      ;; 	Cache/Uncache functions to store and bind if menu shown
      ;; -----------------------------------------------------------------------
    
      (defun CacheAndBind ()
	(setf window.CachedClick document.onclick
	      window.CachedKeypress document.onkeypress
	      window.CachedBlur window.onblur
	      document.onclick document_click
	      ;;document.oncontextmenu document_click
	      document.onkeypress document_keypress
	      window.onblur window_blur))
    
      (defun UncacheAndRebind ()
	(setf document.onclick window.CachedClick
	      ;;document.oncontextmenu window.CachedClick
	      document.onkeypress window.CachedKeypress
	      window.onblur window.CachedBlur))
    
      ;; -----------------------------------------------------------------------
      ;; 	HideMenu and ShowMenu functions
      ;; -----------------------------------------------------------------------

      (defun HideMenu ()
	(setf eMenuShown.style.visibility "hidden"
	      eMenuShown null
	      eRulesTableItemShown.className "clsRuleName"
	      eRulesTableItemShown null)
	(UncacheAndRebind))

      (defun ShowMenu (eSrc)
	(setf eMenuShown (aref document.all (+ "divMenu" eSrc.expitemnum))
	      eRulesTableItemShown eSrc
	      eRulesTableItemShown.className "clsRuleNameShown")
	(when eMenuShown
	  (setf eMenuShown.style.left (+ window.event.x document.body.scrollLeft)
		eMenuShown.style.top (+ window.event.y document.body.scrollTop)
		eMenuShown.style.width "120"
		eMenuShown.typeId eSrc.typeId
		eMenuShown.fieldId (+ "field" eSrc.id))
	  ;;(update-menu eMenuShown)
	  (setf eMenuShown.style.visibility "visible")
	  (CacheAndBind)))
    
      ;; -----------------------------------------------------------------------
      ;; 	FindTD function used in RulesTable event-handlers to determine TD ancestor
      ;; -----------------------------------------------------------------------
    
      (defun FindTD (eSrc eContainer)
	(for ((eContainer.contains eSrc))
	     (if (= eSrc.tagName "TD")
		 (return eSrc)
	       (setf eSrc eSrc.parentElement)))
	false)

      ;; -----------------------------------------------------------------------
      ;; 	RulesTable event-handlers (bound below)
      ;; -----------------------------------------------------------------------
    
      (defun RulesTable_mouseover (eContainer)
	(let ((eSrc (FindTD window.event.srcElement eContainer)))
	  (when (neq (FindTD window.event.fromElement eContainer) eSrc)
	    (when (= eSrc.className "clsRuleName")
	      (setf eSrc.className "clsRuleNameOver")))))

      (defun RulesTable_mouseout (eContainer)
	(let ((eSrc (FindTD window.event.srcElement eContainer)))
	  (when (neq (FindTD window.event.toElement eContainer) eSrc)
	    (when (= eSrc.className "clsRuleNameOver")
	      (setf eSrc.className "clsRuleName")))))
    
      (defun RulesTable_click (eContainer)
	(setf window.event.cancelBubble true)
	(let ((eSrc (FindTD window.event.srcElement eContainer)))
	  (if (= eSrc.className "clsRuleNameOver")
	      (progn
		(when (neq eMenuShown null)
		  (HideMenu))
		(ShowMenu eSrc))
	    (when (= eSrc.className "clsRuleNameShown")
	      (when (neq eMenuShown null)
		(HideMenu))
	      (setf eSrc.className "clsRuleNameOver")))))
    
      ;; -----------------------------------------------------------------------
      ;; 	Menu event-handlers I (bound inline at time of menu creation)
      ;; -----------------------------------------------------------------------
    
      (defun Menu_hover ()
	(let ((eSrc window.event.srcElement))
	  (when (neq eSrc.className "clsMenu")
	    (if (= eSrc.className "")
		(setf eSrc.className "clsMenuItemOver")
	      (setf eSrc.className "")))))


      ;; -----------------------------------------------------------------------
      ;; 	RulesTable event binding
      ;; -----------------------------------------------------------------------
        
      (when (= (typeof tblRulesTable) "object")
	(setf tblRulesTable.onmouseover (new (Function "RulesTable_mouseover(this);"))
	      tblRulesTable.onmouseout (new (Function "RulesTable_mouseout(this);"))
	      ;;tblRulesTable.onselectstart (new (Function "return false;"))
	      tblRulesTable.onclick (new (Function "RulesTable_click(this);"))
	      ;;tblRulesTable.oncontextmenu (new (Function "RulesTable_click(this);"))
	      ))
        
        
      ;; --------------------------------------------------------------
      ;;      needed to get boolean value of the number 0 right
      ;; --------------------------------------------------------------
        
      (defun bool (exp)
	(IF (= (typeof exp) "number")
	    (OR exp (= exp 0))
	    exp))

      ;; --------------------------------------------------------------
      ;;      list implementation etc.
      ;; --------------------------------------------------------------

      (defun cons-cell (car cdr)
	(setf (car this) car
	      (cdr this) cdr))       
       
      (defun cons (car cdr)
	(new (cons-cell car cdr)))

      (defun list (&rest elements)
	(let ((i 0) 
	      (p null)
	      res)
	  (for ((< i elements.length) (incf i))
	       (let ((cons-cell (cons (aref elements i) null)))
		 (if (= i 0)
		     (setf res cons-cell)
		   (setf (cdr p) cons-cell))
		 (setf p cons-cell)))
	  res))
       
      (defun print-list (a-list)
	(if a-list
	    (if (car aList)
		(let ((str "(") (start 1))
		  (for (aList (setf aList (cdr aList)))
		       (let ((listCar (car aList)))
			 (if listCar
			     (if start
				 (setf str (+ str (printList (car aList)))
				       start (not start))
			       (setf str (+ str " " (printList (car aList)))))
			   (setf str (+ str " . " aList)))))
		  (setf str (+ str ")"))
		  str)
	      aList)
	  nil))

      (defun mapcar (fun list)
	(when list
	  (let* ((res-list (cons nil nil))
		 (p res-list))
	    (for (list (setf list (cdr list)))
		 (setf (car p) (fun (car list)))
		 (when (cdr list)
		   (setf (cdr p) (cons nil nil)
			 p (cdr p))))
	    res-list)))

      #+ignore
      (defun update-menu (context-menu)
	(let ((node-e (new (Enumerator (document.getElementsByName "changeType")))))
	  (for ((not (node-e.atEnd)) (node-e.moveNext))
	       (context-menu.removeChild (node-e.item)))
	  (let* ((type (aref current-collection.types
			     context-menu.typeId))
		 (subtypes (mapcar type-id-name type.subtypes))
		 (id 1))
	    (for (subtypes (setf subtypes (cdr subtypes)))
		 (let ((new-item (document.createElement "div")))
		   (setf new-item.id (incf id)
			 new-item.name "changeType"
			 new-item.innerText (car subtypes))
		   (context-menu.appendChild new-item)))
	    #+ignore
	    (alert (print-list subtypes))))
	#+ignore
	(alert context-menu.fieldId))
             
      ;; -----------------------------------------------------------------------
      ;; 	Menu event-handlers II (bound inline at time of menu creation)
      ;; -----------------------------------------------------------------------
    
      (defun Menu_click ()
	(HideMenu)
	(let* ((menuNode window.event.srcElement.parentNode)
	       (rule-id (menuNode.fieldId.substr 13)))
	  (case window.event.srcElement.id
	    ("EditRule"        (EditRule rule-id "body"))
	    ("EditRuleComment" (EditRule (+ "ruleComment" rule-id) "comment"))
	    ("DeleteRule"      (DeleteRule rule-id))
	    ("CloneRule"       (CloneRule rule-id))
	    ("UndoRuleChanges" (UndoRuleChanges rule-id)))) 
               
	#+ignore
	(EditText window.event.srcElement.id)
	#+ignore
	(setf top.location.href "http://www.hit.uib.no/"))
      ))

#+ignore
(ns4.0:define-script
    edit-rule-popup-menu
    (:Java-Script)
  :script ((script stream)
	   (funcall js/edit-rule-popup-menu :nbo stream)))


(progn
  (define-java-script-writer js/edit-cg (stream)
    #j((defun bool (exp)
               (IF (= (typeof exp) "number")
                   (OR exp (= exp 0))
                 exp))
       
       (defun ChangeCG ()
         (let* ((e (new (Enumerator (document.getElementsByTagName "form"))))
                (form (e.item)))
           (form.submit)))
       
       (defun EditDocumentation ()
         ;; delete hidden field with this id
         (let ((hidden (document.getElementById "hidden_value_cgDocumentation")))
           (when hidden (hidden.removeNode)))
         ;; put text of current field into textarea
         (let* ((doc (document.getElementById "cgDocumentation"))
                (textInput (document.createElement "<textarea name=text>"))
                (cr-array (doc.innerHTML.match (regexp "/<BR>/g")))
                cr-count)
           (if cr-array
             (setf cr-count (+ cr-array.length 4))
             (setf cr-count 4))
           (setf textInput.name "documentation"
                 textInput.id "textInputField"
                 textInput.rows cr-count
                 textInput.cols 80
                 textInput.value (doc.innerHTML.replace (regexp "/<BR>/g") "'\\r\\n'")
                 textInput.value (textInput.value.replace (regexp "/&nbsp;/g") " ")
                 textInput.value (textInput.value.replace (regexp "/&amp;/g") "&")
                 textInput.value (textInput.value.replace (regexp "/&gt;/g") ">")
                 textInput.value (textInput.value.replace (regexp "/&lt;/g") "<")
                 textInput.className doc.className
                 textInput.onclickMasqued doc.onclick)
           ;; display text in textarea
           (doc.replaceNode textInput)))

       (defun onDownloadDone (data)
         (alert (+ "Nedlasting ferdig: " data)))))

  #+ignore
  (ns4.0:define-script
   edit-cg
   (:Java-Script)
   ;; :caller ((script stream text) (http::fast-format stream "EditRule('~a')" text))
   :script ((script stream) (js/edit-cg stream))))