Author: hannes
Date: Thu Nov 3 03:33:10 2005
New Revision: 10329
Modified:
trunk/libraries/koala/sources/examples/buddha/TODO
trunk/libraries/koala/sources/examples/buddha/buddha.dylan
trunk/libraries/koala/sources/examples/buddha/class-editor.dylan
trunk/libraries/koala/sources/examples/buddha/command.dylan
Log:
Bug: 7257
properly implement multi-level persistent redo/undo
Modified: trunk/libraries/koala/sources/examples/buddha/TODO
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/TODO (original)
+++ trunk/libraries/koala/sources/examples/buddha/TODO Thu Nov 3 03:33:10 2005
@@ -8,7 +8,7 @@
*user management/session:
*put obj-tables in user session objects
-*command abstraction for redo/undo, recent changes
+*recent changes
security:
-prevent cross-site scripting (escape <> in all input data)
Modified: trunk/libraries/koala/sources/examples/buddha/buddha.dylan
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/buddha.dylan (original)
+++ trunk/libraries/koala/sources/examples/buddha/buddha.dylan Thu Nov 3
03:33:10 2005
@@ -6,6 +6,14 @@
define variable *commands* = #();
+define variable *version* = 0;
+
+define class <buddha> (<object>)
+ constant slot config :: <config> = *config*;
+ constant slot version :: <integer> = *version*;
+ constant slot commands = *commands*;
+end;
+
define variable *directory* = "www/buddha/";
define sideways method process-config-element
@@ -202,61 +210,20 @@
request :: <request>,
response :: <response>,
#key errors)
- let out = output-stream(response);
- with-buddha-template(out, "Save Database")
- collect(show-errors(errors));
- collect(with-xml()
- div(id => "content")
- { form(action => "/save", \method => "post")
- { div(class => "edit")
- {
- text("Filename"),
- input(type => "text", name => "filename"),
- input(type => "submit",
- name => "save-button",
- value => "Save")
- }
- }
- }
- end);
- end;
-end;
-
-define method respond-to-post
- (page == #"save", request :: <request>, response :: <response>)
- let errors = #();
- let file = get-query-value("filename");
- let handler <buddha-form-warning>
- = method(e :: <buddha-form-warning>, next-handler :: <function>)
- errors := add!(errors, e)
- end;
- block(return)
- if (~file | file = "")
- signal(make(<buddha-form-error>,
- error: "No file specified!"));
- end;
- let dood = make(<dood>,
- locator: concatenate(*directory*, base64-encode(file)),
- direction: #"output",
- if-exists: #"replace");
- dood-root(dood) := *config*;
- dood-commit(dood);
- dood-close(dood);
- /* dood is not able to store functions... :(
- let cmd-dood = make(<dood>,
- locator: concatenate(*directory*,
- base64-encode(file),
- "-commands"),
- direction: #"output",
- if-exists: #"replace");
- dood-root(cmd-dood) := *commands*;
- dood-commit(cmd-dood);
- dood-close(cmd-dood);*/
- exception (e :: <buddha-form-error>)
- errors := add!(errors, e);
- return();
- end;
- respond-to-get(page, request, response, errors: errors);
+ let filename = concatenate("buddha-", integer-to-string(*version*));
+ let dood = make(<dood>,
+ locator: concatenate(*directory*, base64-encode(filename)),
+ direction: #"output",
+ if-exists: #"replace");
+ dood-root(dood) := make(<buddha>);
+ dood-commit(dood);
+ dood-close(dood);
+ *version* := *version* + 1;
+ format(output-stream(response), "Saved %S\n", filename);
+ respond-to-get(#"network",
+ request,
+ response);
+
end;
define method respond-to-get
@@ -266,7 +233,8 @@
#key errors)
let out = output-stream(response);
with-buddha-template(out, "Restore Database")
- with-xml()
+ collect(show-errors(errors));
+ collect(with-xml()
div(id => "content")
{ form(action => "/restore", \method => "post")
{ \select(name => "filename")
@@ -288,29 +256,28 @@
value => "Restore")
}
}
- end;
+ end);
end;
end;
define method respond-to-post
(page == #"restore", request :: <request>, response :: <response>)
let file = get-query-value("filename");
- file := base64-encode(file);
+ let b64file = base64-encode(file);
let dood = make(<dood>,
- locator: concatenate(*directory*, file),
+ locator: concatenate(*directory*, b64file),
direction: #"input");
- *config* := dood-root(dood);
+ let buddha = dood-root(dood);
dood-close(dood);
- /* dood is not able to store functions... :(
- let cmd-dood = make(<dood>,
- locator: concatenate(*directory*,
- file,
- "-commands"),
- direction: #"input");
- *commands* := dood-root(cmd-dood);
- dood-close(cmd-dood); */
- format(output-stream(response), "Restored database\n");
- respond-to-get(page, request, response);
+ *config* := buddha.config;
+ *commands* := buddha.commands;
+ if (buddha.version > *version*)
+ *version* := buddha.version;
+ end;
+ format(output-stream(response), "Restored %s\n", file);
+ respond-to-get(page,
+ request,
+ response);
end;
define method respond-to-get
@@ -327,7 +294,10 @@
div(id => "content")
{
do(browse-table(<network>, *config*.networks)),
- do(add-form(<network>, "Networks", *config*.networks,
fill-from-request: errors))
+ do(add-form(<network>,
+ "Networks",
+ *config*.networks,
+ fill-from-request: errors))
}
end);
end;
Modified: trunk/libraries/koala/sources/examples/buddha/class-editor.dylan
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/class-editor.dylan
(original)
+++ trunk/libraries/koala/sources/examples/buddha/class-editor.dylan Thu Nov
3 03:33:10 2005
@@ -336,10 +336,9 @@
end;
define class <triple> (<object>)
- slot setter, init-keyword: setter:;
- slot old-value, init-keyword: old-value:;
- slot new-value, init-keyword: new-value:;
- slot slot-name, init-keyword: slot-name:;
+ constant slot old-value, init-keyword: old-value:;
+ constant slot new-value, init-keyword: new-value:;
+ constant slot slot-name, init-keyword: slot-name:;
end;
define method save-object (object :: <object>, request :: <request>)
@@ -355,7 +354,6 @@
if (check(value) & value ~= slot.slot-getter-method(object))
slots := add!(slots,
make(<triple>,
- setter: slot.slot-setter-method,
slot-name: slot.slot-name,
new-value: value,
old-value: slot.slot-getter-method(object)));
@@ -371,7 +369,6 @@
if (value & (value ~= current-object))
slots := add!(slots,
make(<triple>,
- setter: slot.slot-setter-method,
slot-name: slot.slot-name,
new-value: value,
old-value: slot.slot-getter-method(object)));
Modified: trunk/libraries/koala/sources/examples/buddha/command.dylan
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/command.dylan (original)
+++ trunk/libraries/koala/sources/examples/buddha/command.dylan Thu Nov 3
03:33:10 2005
@@ -2,24 +2,40 @@
author: Hannes Mehnert <hannes@xxxxxxxxxxx>
define abstract class <command> (<object>)
- slot execute :: <function>, init-keyword: execute:;
- slot unexecute :: <function>, init-keyword: unexecute:;
- slot arguments :: <list>, init-keyword: arguments:;
+ constant slot arguments :: <list>, init-keyword: arguments:;
end;
define class <add-command> (<command>)
- inherited slot execute = add-to-list;
- inherited slot unexecute = remove-from-list;
end;
define class <remove-command> (<command>)
- inherited slot execute = remove-from-list;
- inherited slot unexecute = add-to-list;
end;
define class <edit-command> (<command>)
- inherited slot execute = set-slots;
- inherited slot unexecute = unset-slots;
+end;
+
+define method execute (command :: <add-command>)
+ add-to-list;
+end;
+
+define method unexecute (command :: <add-command>)
+ remove-from-list;
+end;
+
+define method execute (command :: <remove-command>)
+ remove-from-list;
+end;
+
+define method unexecute (command :: <remove-command>)
+ add-to-list;
+end;
+
+define method execute (command :: <edit-command>)
+ set-slots;
+end;
+
+define method unexecute (command :: <edit-command>)
+ unset-slots;
end;
define method print-xml (command :: <command>)
@@ -82,21 +98,43 @@
define method set-slots (object :: <object>, slots :: <list>)
map(method(x)
- x.setter(x.new-value, object)
+ set-slot(x.slot-name, object, x.new-value)
end, slots);
end;
define method unset-slots (object :: <object>, slots :: <list>)
map(method(x)
- x.setter(x.old-value, object)
+ set-slot(x.slot-name, object, x.old-value)
end, slots);
end;
+define method set-slot (name :: <string>,
+ object :: <object>,
+ value :: <object>)
+ local method find-slot (slots)
+ block(return)
+ for (slot in slots)
+ if (slot.slot-name = name)
+ return(slot);
+ end;
+ end;
+ #f;
+ end;
+ end;
+ let slot = find-slot(data-slots(object.object-class));
+ unless (slot)
+ slot := find-slot(reference-slots(object.object-class))
+ end;
+ if (slot)
+ slot.slot-setter-method(value, object)
+ end;
+end;
+
define method undo (#key command = head(*commands*))
- apply(command.unexecute, command.arguments);
+ apply(unexecute(command), command.arguments);
end;
define method redo (#key command = head(*commands*))
- apply(command.execute, command.arguments);
+ apply(execute(command), command.arguments);
end;
--
Gd-chatter mailing list
Gd-chatter@xxxxxxxxxxxxxxxx
https://gauss.gwydiondylan.org/mailman/listinfo/gd-chatter
|
