Index: openacs-4/packages/acs-templating/tcl/richtext-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/richtext-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/acs-templating/tcl/richtext-procs.tcl 27 Jan 2003 13:55:09 -0000 1.1
@@ -0,0 +1,191 @@
+ad_library {
+ Rich text input widget and datatype for OpenACS templating system.
+
+ @author Lars Pind (lars@pinds.com)
+ @creation-date 2003-01-27
+ @cvs-id $Id$
+}
+
+namespace eval template::util::richtext {}
+
+ad_proc -public template::util::richtext { command args } {
+ Dispatch procedure for the richtext object
+} {
+ eval template::util::richtext::$command $args
+}
+
+ad_proc -public template::util::richtext::create {
+ {contents {}}
+ {format {}}
+} {
+ return [list $contents $format]
+}
+
+ad_proc -public template::util::richtext::acquire { type { value "" } } {
+ Create a new richtext value with some predefined value
+ Basically, create and set the richtext value
+} {
+ set richtext_list [template::util::richtext::create]
+ return [template::util::richtext::set_property $type $richtext_list $value]
+}
+
+ad_proc -public template::util::richtext::formats {} {
+ Returns a list of valid richtext formats
+} {
+ return { text/enhanced text/plain text/html text/fixed-width }
+}
+
+ad_proc -public template::util::richtext::format_options {} {
+ Returns a formatting option list
+} {
+ return {
+ {"Enhanced Text" text/enhanced}
+ {"Plain Text" text/plain}
+ {"Fixed-width Text" text/fixed-width}
+ {"HTML" text/html}
+ }
+}
+
+ad_proc -public template::data::validate::richtext { value_ref message_ref } {
+
+ upvar 2 $message_ref message $value_ref value
+
+ # a richtext is a 2 element list consisting of { contents format }
+ set contents [lindex $value 0]
+ set format [lindex $value 1]
+
+ if { [lsearch [template::util::richtext::formats] $format] == -1 } {
+ set message "Invalid format, '$format'."
+ return 0
+ }
+
+ # enhanced text and HTML needs to be security checked
+ if { [lsearch { text/enhanced text/html } $format] != -1 } {
+ set check_result [ad_html_security_check $contents]
+ if { ![empty_string_p $check_result] } {
+ set message $check_result
+ return 0
+ }
+ }
+
+ return 1
+}
+
+ad_proc -public template::data::transform::richtext { element_ref } {
+
+ upvar $element_ref element
+ set element_id $element(id)
+
+ set contents [ns_queryget $element_id]
+ set format [ns_queryget $element_id.format]
+
+ set richtext_list [list $contents $format]
+
+ return [list $richtext_list]
+}
+
+ad_proc -public template::util::richtext::set_property { what richtext_list value } {
+
+ # There's no internal error checking, just like the date version ...
+
+ set contents [lindex $richtext_list 0]
+ set format [lindex $richtext_list 1]
+
+ switch $what {
+ contents {
+ $ Replace contents with value
+ return [list $value $format]
+ }
+ format {
+ # Replace format with value
+ return [list $contents $value]
+ }
+ }
+}
+
+ad_proc -public template::util::richtext::get_property { what richtext_list } {
+
+ # There's no internal error checking, just like the date version ...
+
+ set contents [lindex $richtext_list 0]
+ set format [lindex $richtext_list 1]
+
+ switch $what {
+ contents {
+ return $contents
+ }
+ format {
+ return $format
+ }
+ html_value {
+ return [ad_html_text_convert -from $format -to "text/html" -- $contents]
+ }
+ }
+}
+
+ad_proc -public template::widget::richtext { element_reference tag_attributes } {
+
+ upvar $element_reference element
+
+ if { [info exists element(html)] } {
+ array set attributes $element(html)
+ }
+
+ array set attributes $tag_attributes
+
+ set output {}
+
+ if { [string equal $element(mode) "edit"] } {
+ append output {
+
+ }
+
+ if { [info exists element(value)] } {
+ set contents [template::util::richtext::get_property contents $element(value)]
+ set format [template::util::richtext::get_property format $element(value)]
+ } else {
+ set contents {}
+ set format {}
+ }
+
+ append output [textarea_internal "$element(id)" attributes $contents]
+ append output "
Format: [menu "$element(id).format" [template::util::richtext::format_options] $format {}]"
+
+ } else {
+ # Display mode
+ if { [info exists element(value)] } {
+ append output [template::util::richtext::get_property html_value $element(value)] $element(mode)]
+ }
+ }
+
+ return $output
+}
Index: openacs-4/packages/acs-templating/tcl/widget-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/widget-procs.tcl,v
diff -u -r1.16 -r1.17
--- openacs-4/packages/acs-templating/tcl/widget-procs.tcl 13 Jan 2003 15:23:50 -0000 1.16
+++ openacs-4/packages/acs-templating/tcl/widget-procs.tcl 27 Jan 2003 13:55:09 -0000 1.17
@@ -38,42 +38,61 @@
upvar $element_reference element
- if { ![string equal $element(mode) "edit"] } {
+ if { [info exists element(html)] } {
+ array set attributes $element(html)
+ }
+ array set attributes $tag_attributes
+
+ if { [info exists element(value)] } {
+ set value $element(value)
+ } else {
+ set value {}
+ }
+
+ if { [info exists element(mode)] } {
+ set mode $element(mode)
+ } else {
+ set mode {}
+ }
+
+
+ set output [textarea_internal $element(name) attributes $value $mode]
+
+ return $output
+}
+
+ad_proc -public template::widget::textarea_internal {
+ name
+ attribute_reference
+ {value {}}
+ {mode edit}
+} {
+ upvar $attribute_reference attributes
+
+ if { ![string equal $mode "edit"] } {
set output {}
- if { [info exists element(value)] } {
- append output [ad_quotehtml $element(value)]
- append output ""
+ if { ![empty_string_p value] } {
+ append output "[ad_quotehtml $value]"
}
} else {
- if { [info exists element(html)] } {
- array set attributes $element(html)
- }
+ set output ""
+ append output ">[ad_quotehtml $value]"
}
return $output
}
+
+
ad_proc -public template::widget::inform { element_reference tag_attributes } {
A static information widget that does not submit any data
} {
@@ -208,8 +227,13 @@
return [input button element $tag_attributes]
}
-ad_proc -public template::widget::menu { widget_name options_list values_list \
- attribute_reference {mode edit} } {
+ad_proc -public template::widget::menu {
+ widget_name
+ options_list
+ values_list
+ attribute_reference
+ {mode edit}
+} {
upvar $attribute_reference attributes