added a covert-newlines-p in the text slot presentation.
authorDrew Crampsie <drewc@tech.coop>
Tue, 8 Nov 2005 06:41:53 +0000 (22:41 -0800)
committerDrew Crampsie <drewc@tech.coop>
Tue, 8 Nov 2005 06:41:53 +0000 (22:41 -0800)
darcs-hash:20051108064153-5417e-96ca5041423b6ff00a79a0204ba98485650a57cd.gz

src/slot-presentations.lisp

index 4dcbecc..ceb27ab 100644 (file)
 (defslot-presentation text-slot-presentation ()
   ((rows :initarg :rows :accessor rows :initform 5)
    (columns :initarg :columns :accessor columns :initform 40)
 (defslot-presentation text-slot-presentation ()
   ((rows :initarg :rows :accessor rows :initform 5)
    (columns :initarg :columns :accessor columns :initform 40)
-   (escape-html-p :initarg :escape-html-p :accessor escape-html-p :initform nil))
+   (escape-html-p :initarg :escape-html-p :accessor escape-html-p :initform nil)
+   (convert-newlines-p :initarg :convert-newlines-p :accessor convert-newlines-p :initform nil))
   (:type-name text))
 
 (defmethod present-slot ((slot text-slot-presentation) instance)
   (:type-name text))
 
 (defmethod present-slot ((slot text-slot-presentation) instance)
+  (flet ((maybe-convert-newline-and-escape-html-then-print ()
+          (let ((string (if (convert-newlines-p slot)
+                            (with-output-to-string (new-string)
+                              (with-input-from-string
+                                  (s (presentation-slot-value slot instance))
+                                (loop for line = (read-line s nil)
+                                      while line
+                                      do (format new-string "~A~A" line "<br/>"))))
+                            (presentation-slot-value slot instance))))
+            (if (escape-html-p slot)
+                (<:as-html string)
+                (<:as-is string)))))
+    
     (if (editablep slot)
        (<ucw:textarea
         :accessor (presentation-slot-value slot instance)
     (if (editablep slot)
        (<ucw:textarea
         :accessor (presentation-slot-value slot instance)
@@ -27,9 +41,7 @@
                 "")
         :rows (rows slot)
         :cols (columns slot))
                 "")
         :rows (rows slot)
         :cols (columns slot))
-       (if (escape-html-p slot)
-           (<:as-html (presentation-slot-value slot instance))
-           (<:as-is (presentation-slot-value slot instance)))))
+       (maybe-convert-newline-and-escape-html-then-print))))
 
 
 (defcomponent mewa-slot-presentation ()
 
 
 (defcomponent mewa-slot-presentation ()