Commit 94ee70d8 authored by Dave Cooper's avatar Dave Cooper

cleaned up ajax response, allowed :parse for js-to-eval to remove redundant...

cleaned up ajax response, allowed :parse for js-to-eval to remove redundant data being sent to client.
parent 8cf961ee
......@@ -163,7 +163,7 @@ o filter inspector slots to local slots
(the (gdl-ajax-call
:function-key :perform-action!
:arguments (list object)
:one-arg? (member (the-child image-format) (list :x3d :x3dom))
:null-event? (member (the-child image-format) (list :x3d :x3dom))
)))
:tatu-root self)
......
......@@ -69,8 +69,10 @@
(use-bsplines? (the use-bsplines-checkbox value))
#+nil
(js-to-eval (when (eql (the image-format) :raphael)
(the raphael-string)))
(recompute? nil :settable)
......
......@@ -161,7 +161,10 @@ This is not tested to see if it is part of the same object tree as current self.
dropped-object nil :settable)
(js-to-eval (let ((image-format (the image-format)))
(js-to-eval
:parse
#+nil
(let ((image-format (the image-format)))
(cond ((eql image-format :raphael)
(the raphael-string))
((eql image-format :x3dom)
......
......@@ -79,8 +79,8 @@
;; to that, instead of referring to
;; the parent here.
;;
(the parent (gdl-sjax-call :js-vals? t :function-key :on-drag))
(the parent (gdl-sjax-call :js-vals? t :function-key :on-drop)))
(the parent (gdl-sjax-call :null-event? t :js-vals? t :function-key :on-drag))
(the parent (gdl-sjax-call :null-event? t :js-vals? t :function-key :on-drop)))
(with-translated-state (:raphael (make-point (- (get-x view-center))
(- (get-y view-center))))
......
......@@ -119,9 +119,9 @@
(*clicked-y* (let ((string (getf query-plist :|y|)))
(when string (ignore-errors (parse-integer string)))))
(js-to-eval-stati (mapcar #'(lambda(section)
(the-object section js-to-eval))
(the-object respondent html-sections))))
(js-to-eval-previi (mapcar #'(lambda(section)
(the-object section js-to-eval))
(the-object respondent html-sections))))
(let ((f-e-p (make-object 'form-element-processor
:bashee bashee
......@@ -149,7 +149,7 @@
(quick-save self)
(respond-with-new-html-sections req ent respondent
:js-to-eval-stati js-to-eval-stati))))
:js-to-eval-previi js-to-eval-previi))))
(publish :path "/gdlAjax" :function 'gdlAjax)
......@@ -166,6 +166,92 @@
))))
(defun respond-with-new-html-sections (req ent respondent &key js-to-eval-previi)
(the-object (make-object 'ajax-response :req req :ent ent :respondent respondent :js-to-eval-previi js-to-eval-previi)
respond!))
(define-object ajax-response ()
:input-slots (req ent respondent (js-to-eval-previi nil))
:computed-slots
((security-ok? (the respondent root do-security-check))
(replace-lists (mapsend (the html-sections) :replace-list))
(html-section-objects (the respondent html-sections))
(mismatch? (< (length (the js-to-eval-previi)) (length (the replace-lists)))))
:objects
((html-sections :type 'html-replacement-section
:sequence (:size (length (the html-section-objects)))
:js-to-eval-previous (nth (the-child index) (the js-to-eval-previi))
:section (nth (the-child index) (the html-section-objects))))
:functions
((respond!
()
(when (the mismatch?)
(warn "the js-to-eval-previous is not the same length as html-section-objects in ~s~%"
(the respondent)))
(with-http-response ((the req) (the ent) :content-type "text/xml")
(with-http-body ((the req) (the ent))
(with-html-output (*html-stream* nil)
(:document
(mapc #'(lambda(replace-pair js-to-eval-status)
(declare (ignore js-to-eval-status)) ;; this can play into the flag
(destructuring-bind (&key dom-id inner-html js-to-eval) replace-pair
(let ((js-to-eval? (and js-to-eval (not (string-equal js-to-eval "")))))
(when (or inner-html js-to-eval?)
(htm
(:html-section (:|replaceId| (str dom-id))
(:|newHTML| (if inner-html
(str (wrap-cdata (if (the security-ok?) inner-html
(with-cl-who-string ()
(:i "Security Error"))))) ""))
(:|jsToEval| (if (and js-to-eval? (the security-ok?))
(str (wrap-cdata js-to-eval)) ""))))))))
(the replace-lists) (the js-to-eval-previi)))))))))
(define-object html-replacement-section ()
:input-slots (section js-to-eval-previous)
:computed-slots ((status (the section (slot-status :inner-html)))
(js-status (the section (slot-status :js-to-eval)))
(stale? (or (eql (the status) :unbound)
(eql (the js-status) :unbound)))
(dom-id (the section dom-id))
(inner-html (when (eql (the status) :unbound)
(let ((timeout? nil))
(multiple-value-bind (value error backtrace)
(ignore-errors-with-backtrace (the section inner-html))
(cond ((typep error 'error)
(with-cl-who-string ()
(:i (esc (format nil "!! This section threw error: ~a !!"
error)))
(:pre (esc backtrace))))
(timeout?
(with-cl-who-string ()
(:i (fmt "!! This section timed out after ~a seconds.
You can reload to get previous state" *ajax-timeout*))
(:pre (esc backtrace))))
(t value))))))
(js-to-eval (multiple-value-bind (value error)
(ignore-errors (the section js-to-eval))
(if (typep error 'error)
(with-cl-who-string ()
(:i (fmt "alert('This section threw error: ~a !!');" error)))
(if (equalp value :parse) "parseme" value))))
(replace-list (when (the stale?)
(list :dom-id (the dom-id)
:inner-html (the inner-html)
:js-to-eval (the js-to-eval))))))
#+nil
(defun respond-with-new-html-sections (req ent self ;;current-body-sans-sections
&key js-to-eval-stati)
......@@ -248,10 +334,11 @@ You can reload to get previous state" *ajax-timeout*))
"")))))))))
replace-list js-to-eval-stati))))))))
#+nil
(defun remove-html-sections (sections string)
(remove-substrings string (mapsend sections :main-div)))
#+nil
(defun remove-substrings (string substrings)
(let ((result string))
(dolist (substring substrings result)
......
......@@ -320,8 +320,7 @@ running the Javascript interpreter to evaluate (the js-to-eval), if any.
js-vals?
form-controls
(asynch? t)
(one-arg? nil)
)
(null-event? nil))
(let ((string-1 (the (encode-ajax-args :bashee bashee
:respondent respondent
......@@ -398,10 +397,8 @@ running the Javascript interpreter to evaluate (the js-to-eval), if any.
js-vals (glisp:replace-regexp js-vals "\\" "\\\\\\\\"))
(if one-arg?
(format nil "gdlAjax1('args=~a~a~a);" string-1 string-2 (or js-vals ""))
(format nil "gdlAjax(event,'args=~a~a~a,~a);" string-1 string-2 (or js-vals "") string-3))))
(format nil "gdlAjax(~a,'args=~a~a~a,~a);"
(if null-event? "null" "event") string-1 string-2 (or js-vals "") string-3)))
(encode-ajax-args
......
......@@ -78,9 +78,9 @@ return y;
}
function gdlAjax1 (params)
function gdlAjax1 (params, asynch)
{
gdlAjax(null, params, true);
gdlAjax(null, params, async);
}
function gdlAjax (evt, params, asynch)
......@@ -139,6 +139,9 @@ function gdlUpdate (request) {
var root = request.responseXML.documentElement;
var children = root.childNodes;
var myelem;
var codes;
for (i=0; i< children.length; i++)
{
......@@ -154,19 +157,32 @@ function gdlUpdate (request) {
if (child.getElementsByTagName('newHTML')[0].firstChild != null)
{newHTML = child.getElementsByTagName('newHTML')[0].firstChild.nodeValue}
var jsToEval = null;
if (child.getElementsByTagName('jsToEval')[0].firstChild != null)
{jsToEval = child.getElementsByTagName('jsToEval')[0].firstChild.nodeValue}
if (myid && newHTML && (newHTML != ''))
{
document.getElementById(myid).innerHTML = newHTML;
}
if (jsToEval && (jsToEval != '')) eval(jsToEval);
myelem = document.getElementById(myid);
myelem.innerHTML = newHTML;
if (jsToEval && (jsToEval == 'parseme'))
{
codes = myelem.getElementsByTagName("script");
for(var j=0;j<codes.length;j++)
{
eval(codes[j].text); }}
}
if (jsToEval && (jsToEval != 'parseme') && (jsToEval != ''))
eval(jsToEval);
}
if (document.getElementById('gdlStatus'))
{
document.getElementById('gdlStatus').innerHTML = 'Done.';
......@@ -281,13 +297,13 @@ function decode64(input) {
function gdlResize()
{
gdlAjax(null, 'args=' + encode64('(:|iid| '+ doublequote + gdliid + doublequote + ' :|bashee| (:%rp% nil) :|function| :set-slot! :|arguments| (:viewport-dimensions (:width ' + (InnerLayout.state.center.innerWidth -20 ) + ' :length ' + (InnerLayout.state.center.innerHeight - 75) + ')))'));
}
function collectMenuSelections(select)
{
var items = "";
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment