From: Drew Crampsie <drewc@tech.coop>
Date: Fri, 5 Aug 2005 21:02:11 +0000 (-0700)
Subject: adding text-slot-presentation from rob
X-Git-Url: https://git.hcoop.net/clinton/lisp-on-lines.git/commitdiff_plain/44108fd67c22992f320e2ea2424bab38a6547473?ds=sidebyside

adding text-slot-presentation from rob

darcs-hash:20050805210211-5417e-6f1132812511ad8ad2593e353c3e5386cf20284a.gz
---

diff --git a/src/mewa/slot-presentations.lisp b/src/mewa/slot-presentations.lisp
index 2ed5b32..2232ec1 100644
--- a/src/mewa/slot-presentations.lisp
+++ b/src/mewa/slot-presentations.lisp
@@ -10,6 +10,28 @@
 		     (multiple-value-funcall->list #',(car form) ,@(cdr form))
 		     ,@body))
 
+
+;;;; ** Textarea Slot Presentation
+;;;;  This should really be in UCW.
+
+(defslot-presentation text-slot-presentation ()
+  ((rows :initarg :rows :accessor rows :initform nil)
+   (columns :initarg :columns :accessor columns :initform nil)
+   (html-contentp :initarg :escape-html-p :accessor escape-html-p :initform nil))
+  (:type-name text))
+
+(defmethod present-slot ((slot text-slot-presentation) instance)
+  (if (editablep slot)
+      (<ucw:textarea :accessor (presentation-slot-value slot instance)
+		     :rows (rows slot)
+		     :cols (columns slot))
+      (if (escape-html-p slot)
+	  (<:as-is (presentation-slot-value slot instance))
+	  (<:as-html (presentation-slot-value slot instance)))))
+
+
+
+
 (defcomponent mewa-slot-presentation ()
   ((slot-name :accessor slot-name 
 	      :initarg :slot-name