The attached removes actions that can't be interactively invoked
anymore, due to rerendering.  The important bits are in docstrings:

parameter *widget-action-symbiosis* (default t):

  "Whether to assume that references to actions (e.g. links) are
  rendered within the dynamic context of the call to
  `render-widget-body' that renders the widget directly containing
  said references.

  Essentially, when this is NIL, `kill-action-with-render' does
  nothing.  We strongly recommend doing all rendering for any given
  widget within the dynamic context of the `render-widget-body' call
  on that particular widget.  If this does not describe your code, you
  may want to set me to NIL."

function kill-action-with-render:

  "When WIDGET is not nil (by default the currently-rendering widget,
aka the innermost `render-widget' call), arrange for ACTION-CODE's
deletion when the browser is no longer rendering it.

We try to be conservative with this, so ACTION-CODE will not be
deleted immediately on the following request, but instead on the
request that follows that, to avoid the race between the browser
rendering cycle and impatient multi-clicking users.  Deletion may also
occur when the widget is garbage-collected."

This seems incredibly straightforward given the render-widget-body
methods I write, and the style that we have advocated repeatedly with
regard to separating action handling and rendering on this list, but I
wanted to see if styles in the wild broke these assumptions.  Otherwise,
I'll throw trivial-garbage onto the fire (see the end of that last
docstring there) and push it today or tomorrow.

Full patch attached:


--~--~---------~--~----~------------~-------~--~----~
You received this message because you are subscribed to the Google Groups 
"weblocks" group.
To post to this group, send email to [email protected]
To unsubscribe from this group, send email to 
[email protected]
For more options, visit this group at 
http://groups.google.com/group/weblocks?hl=en
-~----------~----~----~----~------~----~------~--~---

# HG changeset patch
# User Stephen Compall <[email protected]>
# Date 1239695976 18000
# Node ID 404d3eb10722477510d1991c6afa449ea872b346
# Parent  b2e88604ff8cb4b96d4b11ecb1bba73768d8fffd
Remove browser-unreferenced actions

This entails some assumptions about how users implement `render-widget-body' methods.  For example, render-link should always be called eagerly in that context; one shouldn't ever try to be super-clever about rendering.  All this is documented heavily in src/actions.lisp.  To disable it, set `*widget-action-symbiosis*' to NIL.

diff --git a/src/actions.lisp b/src/actions.lisp
--- a/src/actions.lisp
+++ b/src/actions.lisp
@@ -6,7 +6,9 @@
           page-not-found-handler
           make-action-url
           make-action
-          function-or-action->action))
+          function-or-action->action
+	  *widget-action-symbiosis*
+	  kill-action-with-render))
 
 (defvar *expired-action-handler* 'default-expired-action-handler
   "Must be bound to a designator of a function with a single optional
@@ -16,6 +18,8 @@
 situation (e.g. redirect, signal an error, etc.)  Default function
 redirects to the root of the application.")
 
+(declaim (special *current-widget*))	;defined later
+
 (defgeneric expired-action-handler (app)
   (:documentation "Webapp specific protocol now used in action 
    handler.  This method provides backwards compatability")
@@ -106,6 +110,58 @@
                *action-string* "="
 	       (url-encode (princ-to-string action-code))))
 
+;; The only consequence of overwriting this accidentally is a leaked
+;; action or two.  That's not really important, because we're better
+;; off with some GC versus no GC.
+;;
+;; Both of these tables should be upgraded to :weakness :key
+;; :weakness-matters nil if trivial-garbage is added.
+(defun webapp-live-actions ()
+  (sor (webapp-session-value 'live-actions)
+       (setf it (make-hash-table :test 'eq))))
+
+(defun webapp-halfdead-actions ()
+  (sor (webapp-session-value 'halfdead-actions)
+       (setf it (make-hash-table :test 'eq))))
+
+(defparameter *widget-action-symbiosis* t
+  "Whether to assume that references to actions (e.g. links) are
+  rendered within the dynamic context of the call to
+  `render-widget-body' that renders the widget directly containing
+  said references.
+
+  Essentially, when this is NIL, `kill-action-with-render' does
+  nothing.  We strongly recommend doing all rendering for any given
+  widget within the dynamic context of the `render-widget-body' call
+  on that particular widget.  If this does not describe your code, you
+  may want to set me to NIL.")
+
+(defun kill-action-with-render (action-code &optional
+				(widget (and (boundp '*current-widget*)
+					     *current-widget*)))
+  "When WIDGET is not nil (by default the currently-rendering widget,
+aka the innermost `render-widget' call), arrange for ACTION-CODE's
+deletion when the browser is no longer rendering it.
+
+We try to be conservative with this, so ACTION-CODE will not be
+deleted immediately on the following request, but instead on the
+request that follows that, to avoid the race between the browser
+rendering cycle and impatient multi-clicking users.  Deletion may also
+occur when the widget is garbage-collected."
+  (when (and *widget-action-symbiosis* widget)
+    (push action-code (gethash widget (webapp-live-actions)))))
+
+(defun cycle-widget-symbiotic-actions (widget)
+  "Kill those actions whose rendered references should have been dead
+before the request that triggered the current rendering of WIDGET,
+arrange to kill its live actions on the next call of this function,
+and reset the list of live actions."
+  (when *widget-action-symbiosis*
+    (mapc #'delete-webapp-session-value
+	  (prog1 (shiftf (gethash widget (webapp-halfdead-actions))
+			 (gethash widget (webapp-live-actions)))
+	    (remhash widget (webapp-live-actions))))))
+
 (defun get-request-action-name ()
   "Gets the name of the action from the request."
   (let* ((request-action-name (request-parameter *action-string*))
diff --git a/src/log-actions.lisp b/src/log-actions.lisp
--- a/src/log-actions.lisp
+++ b/src/log-actions.lisp
@@ -7,13 +7,15 @@
 (setf (documentation '*rendered-actions* 'variable)
       "A list of actions rendered during the request.")
 
-;; Logging UI action elements for easy querying in tests
+;; Logging UI action elements for GC and easy querying in tests
 (defun log-ui-action (type name action &key id class)
-  "If called during an active unit test, logs the UI action to the
-  test's temporary database so that it can be queried during the unit
-  test's verification process. If no active unit test is present, does
-  nothing."
+  "Associate ACTION with `*current-widget*' if
+`*widget-action-symbiosis*' is enabled.  In addition, if called during
+an active unit test, logs the UI action to the test's temporary
+database so that it can be queried during the unit test's verification
+process. If no active unit test is present, does nothing."
   (declare (special *rendered-actions*))
+  (kill-action-with-render action)
   (when (boundp '*rendered-actions*)
     (push (list (cons :type type)
 		(cons :name name)
diff --git a/src/widgets/widget/widget.lisp b/src/widgets/widget/widget.lisp
--- a/src/widgets/widget/widget.lisp
+++ b/src/widgets/widget/widget.lisp
@@ -25,7 +25,9 @@
        (declare (ignore obj))
        (dependencies-by-symbol (quote ,name)))))
 
-
+(defvar *current-widget*)
+(setf (documentation '*current-widget* 'variable)
+      "The current receiver of `render-widget'.")
 
 (defclass widget (dom-object-mixin)
   ((propagate-dirty :accessor widget-propagate-dirty
@@ -78,7 +80,6 @@
   (:metaclass widget-class)
   (:documentation "Base class for all widget objects."))
 
-
 ;; Process the :name initarg and set the dom-id accordingly. Note that
 ;; it is possible to pass :name nil, which simply means that objects
 ;; will render without id in generated HTML.
@@ -429,20 +430,22 @@
 	  (append *page-dependencies* (dependencies obj))))
   (let ((*current-widget* obj))
     (declare (special *current-widget*))
-    (if inlinep
-      (progn (apply #'render-widget-body obj args)
-	     (apply #'render-widget-children obj (remove-keyword-parameter args :inlinep)))
-      (apply #'with-widget-header
-	     obj
-	     (lambda (obj &rest args)
-	       (apply #'render-widget-body obj args)
-	       (apply #'render-widget-children obj (remove-keyword-parameter args :inlinep)))
-             (append
-               (when (widget-prefix-fn obj)
-                 (list :widget-prefix-fn (widget-prefix-fn obj)))
-               (when (widget-suffix-fn obj)
-                 (list :widget-suffix-fn (widget-suffix-fn obj)))
-               args)))
+    (flet ((delegate-render (obj &rest args)
+	     (cycle-widget-symbiotic-actions obj)
+	     (apply #'render-widget-body obj args)
+	     (apply #'render-widget-children obj
+		    (remove-keyword-parameter args :inlinep))))
+      (if inlinep
+	  (apply #'delegate-render obj args)
+	  (apply #'with-widget-header
+		 obj
+		 #'delegate-render
+		 (append
+		  (when (widget-prefix-fn obj)
+		    (list :widget-prefix-fn (widget-prefix-fn obj)))
+		  (when (widget-suffix-fn obj)
+		    (list :widget-suffix-fn (widget-suffix-fn obj)))
+		  args))))
     (setf (widget-rendered-p obj) t)))
 
 (defgeneric mark-dirty (w &key propagate putp)
Also if this is implemented somewhere else already, please hit me over
the head repeatedly with a stick.

-- 
Sorry but you say Nibiru is a Hoax?  Doesnt Exist?  So maybe The
Sumerian people doesnt exist also! --Anonymous by way of SkI

Reply via email to