[Gd-chatter] r11583 - trunk/libraries/network/koala/sources/koala
cgay at gwydiondylan.org
cgay at gwydiondylan.org
Wed Dec 26 13:45:06 CET 2007
Author: cgay
Date: Wed Dec 26 13:45:04 2007
New Revision: 11583
Modified:
trunk/libraries/network/koala/sources/koala/dsp-taglib.dylan
trunk/libraries/network/koala/sources/koala/koala.lid
trunk/libraries/network/koala/sources/koala/library-unix.dylan
trunk/libraries/network/koala/sources/koala/library.dylan
trunk/libraries/network/koala/sources/koala/pages.dylan
Log:
Job: koala
Restore some code that was deleted in r11478 and fix it to match the
new APIs.
Modified: trunk/libraries/network/koala/sources/koala/dsp-taglib.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/dsp-taglib.dylan (original)
+++ trunk/libraries/network/koala/sources/koala/dsp-taglib.dylan Wed Dec 26 13:45:04 2007
@@ -71,6 +71,106 @@
end;
+//// Iteration tags
+
+define thread variable *table-has-rows?* :: <boolean> = #f;
+define thread variable *table-first-row?* :: <boolean> = #f;
+define thread variable *table-row-data* :: <object> = #f;
+define thread variable *table-row-number* :: <integer> = -1;
+
+define function current-row () *table-row-data* end;
+define function current-row-number () *table-row-number* end;
+
+define body tag table in dsp
+ (page :: <dylan-server-page>, do-body :: <function>)
+ (generator :: <named-method>)
+ let response = current-response();
+ let stream = output-stream(response);
+ write(stream, "<table");
+ show-tag-call-attributes(stream, exclude: #[#"generator"]);
+ write(stream, ">\n");
+ let (rows, start-index, row-count) = generator(page);
+ let len = size(rows);
+ if (len == 0 | row-count == 0)
+ dynamic-bind(*table-has-rows?* = #f,
+ *table-first-row?* = #t) // so that dsp:hrow will execute
+ do-body();
+ end;
+ else
+ let start :: <integer> = start-index | 0;
+ for (i from start below start + (row-count | len),
+ first-row? = #t then #f,
+ while: i < len)
+ dynamic-bind (*table-has-rows?* = #t,
+ *table-row-data* = rows[i],
+ *table-row-number* = i,
+ *table-first-row?* = first-row?)
+ do-body();
+ end;
+ end;
+ end if;
+ write(stream, "</table>");
+end;
+
+define body tag hrow in dsp
+ (page :: <dylan-server-page>, do-body :: <function>)
+ ()
+ when (*table-first-row?*)
+ let response = current-response();
+ show-table-element(output-stream(response), "tr", do-body);
+ end;
+end;
+
+define body tag row in dsp
+ (page :: <dylan-server-page>, do-body :: <function>)
+ ()
+ when (*table-has-rows?*)
+ let response = current-response();
+ show-table-element(output-stream(response), "tr", do-body);
+ end;
+end;
+
+define body tag hcell in dsp
+ (page :: <dylan-server-page>, do-body :: <function>)
+ ()
+ let response = current-response();
+ show-table-element(output-stream(response), "td", do-body);
+end;
+
+define body tag cell in dsp
+ (page :: <dylan-server-page>, do-body :: <function>)
+ ()
+ let response = current-response();
+ show-table-element(output-stream(response), "td", do-body);
+end;
+
+define body tag no-rows in dsp
+ (page :: <dylan-server-page>, do-body :: <function>)
+ ()
+ when (~ *table-has-rows?*)
+ let response = current-response();
+ show-table-element(output-stream(response), "tr", do-body);
+ end;
+end;
+
+define function show-table-element
+ (stream, element-name :: <string>, do-body :: <function>)
+ format(stream, "<%s", element-name);
+ show-tag-call-attributes(stream);
+ write(stream, ">");
+ do-body();
+ format(stream, "</%s>", element-name);
+end;
+
+define tag row-number in dsp
+ (page :: <dylan-server-page>)
+ ()
+ when (*table-row-number* >= 0)
+ let response = current-response();
+ format(output-stream(response), "%d", *table-row-number* + 1);
+ end;
+end;
+
// ---TODO: Define a tag to replace the HTML <input> tag, that will
// automatically take care of defaulting the value correctly
@@ -107,4 +207,97 @@
//// Internationalization tags
+// Nothing yet, I guess.
+
+
//// XML tags
+
+// Nothing yet, I guess.
+
+
+// A simple error reporting mechanism. Store errors in the page context
+// so they can be displayed when the next page is generated. The idea is
+// that pages should use the <dsp:show-errors/> tag if they can be
+// the target of a GET or POST that might generate errors.
+
+define abstract class <form-note> (<object>)
+ constant slot format-string :: <string>,
+ required-init-keyword: #"format-string";
+ constant slot format-arguments :: <sequence>,
+ required-init-keyword: #"format-arguments";
+end;
+
+define class <form-error> (<form-note>)
+ constant slot form-field-name :: false-or(<string>) = #f,
+ init-keyword: #"form-field-name";
+end;
+
+define class <form-message> (<form-note>)
+end;
+
+define method note-form-error
+ (message :: <string>, #rest args, #key field)
+ add-form-note(make(<form-error>,
+ format-string: message,
+ format-arguments: remove-keys(args, #"field"),
+ form-field-name: field))
+end;
+
+define method note-form-message
+ (message :: <string>, #rest args)
+ add-form-note(make(<form-message>,
+ format-string: message,
+ format-arguments: copy-sequence(args)));
+end;
+
+define constant $form-notes-key = #"form-notes";
+
+// This shows the use of <page-context> to store the form errors since they
+// only need to be accessible during the processing of one page.
+//
+define method add-form-note
+ (note :: <form-note>)
+ let context :: <page-context> = page-context();
+ let notes = get-attribute(context, $form-notes-key) | make(<stretchy-vector>);
+ add!(notes, note);
+ set-attribute(context, $form-notes-key, notes);
+end;
+
+define method display-form-note
+ (out :: <stream>, note :: <form-error>)
+ write(out, "<li>");
+ // Should I call quote-html on this output?
+ apply(format, out, format-string(note), format-arguments(note));
+ write(out, "</li>\n");
+end;
+
+define method display-form-note
+ (out :: <stream>, note :: <form-message>)
+ write(out, "<p>");
+ // Should I call quote-html on this output?
+ apply(format, out, format-string(note), format-arguments(note));
+ write(out, "</p>\n");
+end;
+
+define tag show-form-notes in dsp
+ (page :: <dylan-server-page>)
+ ()
+ let notes = get-attribute(page-context(), $form-notes-key);
+ when (notes)
+ let messages = choose(rcurry(instance?, <form-message>), notes);
+ let errors = choose(rcurry(instance?, <form-error>), notes);
+ let out = output-stream(current-response());
+ write(out, "<div class=\"form-notes\">\n");
+ unless(empty?(messages))
+ write(out, "<div class=\"form-note-message\">\n");
+ do(curry(display-form-note, out), messages);
+ write(out, "</div>\n");
+ end;
+ unless(empty?(errors))
+ format(out, "<div class=\"form-note-errors\">Please fix the following errors:\n<ul>\n");
+ do(curry(display-form-note, out), errors);
+ format(out, "</ul></div>\n");
+ end;
+ write(out, "</div>\n");
+ end;
+end;
Modified: trunk/libraries/network/koala/sources/koala/koala.lid
==============================================================================
--- trunk/libraries/network/koala/sources/koala/koala.lid (original)
+++ trunk/libraries/network/koala/sources/koala/koala.lid Wed Dec 26 13:45:04 2007
@@ -21,6 +21,7 @@
dsp-taglib
database
records
+ pages
xml-rpc-server
config
responders
Modified: trunk/libraries/network/koala/sources/koala/library-unix.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/library-unix.dylan (original)
+++ trunk/libraries/network/koala/sources/koala/library-unix.dylan Wed Dec 26 13:45:04 2007
@@ -65,7 +65,6 @@
wrapping-inc!,
file-contents,
pset, // multiple-value-setq
- ignore-errors,
path-element-equal?,
parent-directory,
date-to-stream,
Modified: trunk/libraries/network/koala/sources/koala/library.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/library.dylan (original)
+++ trunk/libraries/network/koala/sources/koala/library.dylan Wed Dec 26 13:45:04 2007
@@ -65,7 +65,6 @@
wrapping-inc!,
file-contents,
pset, // multiple-value-setq
- ignore-errors,
path-element-equal?,
parent-directory,
date-to-stream,
Modified: trunk/libraries/network/koala/sources/koala/pages.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/pages.dylan (original)
+++ trunk/libraries/network/koala/sources/koala/pages.dylan Wed Dec 26 13:45:04 2007
@@ -80,7 +80,7 @@
request :: <request>,
response :: <response>,
record :: <database-record>)
- process-template(page, request, response);
+ process-template(page);
end;
define open generic respond-to-post-edit-record
@@ -111,9 +111,8 @@
end;
end;
-define method respond-to-post (page :: <edit-record-page>,
- request :: <request>,
- response :: <response>)
+define method respond-to (request-method == #"post", page :: <edit-record-page>)
+ let request :: <request> = current-request();
let record :: <database-record> = get-edit-record(request);
let slots = slot-descriptors(object-class(record));
let bindings = make(<string-table>); // maps form input name to parsed value
@@ -142,6 +141,7 @@
*/
end;
end;
+ let response :: <response> = current-response();
dynamic-bind (*record* = record)
respond-to-post-edit-record(page, request, response, record);
end;
@@ -159,20 +159,20 @@
end;
define tag show-id in dsp
- (page :: <dylan-server-page>, response :: <response>)
+ (page :: <dylan-server-page>)
(key)
let record = select (key by \=)
"row" => current-row();
"record" => *record*;
otherwise => current-row() | *record*;
end;
- format(output-stream(response), "%s", record-id(record));
+ format(output-stream(current-response()), "%s", record-id(record));
end;
define tag show-hidden-fields in dsp
- (page :: <dylan-server-page>, response :: <response>)
+ (page :: <dylan-server-page>)
()
- display-hidden-fields(page, output-stream(response));
+ display-hidden-fields(page, output-stream(current-response()));
end;
// Methods on display-hidden-fields can call this.
More information about the chatter
mailing list