[mcclim-cvs] CVS mcclim/Drei

[thenriksen]

Update of /project/mcclim/cvsroot/mcclim/Drei
In directory clnet:/tmp/cvs-serv9653

Modified Files:
	input-editor.lisp 
Log Message:
Try to handle "partially readable" objects.


--- /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp	2006/12/01 23:02:59	1.9
+++ /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp	2006/12/06 13:00:00	1.10
@@ -304,6 +304,56 @@
                  printed-rep)
              args))))
 
+;; The purpose of this method is to ensure that things such as lists
+;; should are not completely inserted as literal objects if they have
+;; unreadable elements.
+(defmethod presentation-replace-input
+    ((stream drei-input-editing-mixin) object (type (eql 'expression)) view
+     &rest args &key
+     (buffer-start (input-position stream)) rescan
+     query-identifier (for-context-type type))
+  (declare (ignore query-identifier rescan for-context-type buffer-start))
+  ;; Build up an array, `insertion', and use `replace-input' to insert
+  ;; it.
+  (let ((insertion (make-array 10 :adjustable t :fill-pointer 0)))
+    (labels ((insert-object (object)
+               (vector-push-extend object insertion
+                                   (* (length insertion))))
+             (insert-objects (objects)
+               (setf insertion (adjust-array insertion
+                                             (+ (length insertion)
+                                                (length objects))
+                                             :fill-pointer (+ (fill-pointer insertion)
+                                                              (length objects))))
+               (setf (subseq insertion (- (fill-pointer insertion)
+                                          (length objects))) objects))
+             (present-object (object)
+               (multiple-value-bind (printed-rep accept-object)
+                   (present-acceptably-to-string object 'expression
+                                                 +textual-view+ 'expression)
+                 (if (null accept-object)
+                     (insert-objects printed-rep)
+                     (typecase object
+                       (list (insert-list-in-stream object))
+                       (array (insert-object #\#)
+                              (insert-list-in-stream object))
+                       (function (let ((name (nth-value 2 (function-lambda-expression object))))
+                                   (insert-objects (or (format nil "#'~A" name)
+                                                       (vector object)))))
+                       ;; Okay, we give up, just insert it.
+                       (t (insert-object object)))))))
+      (present-object object))
+    (with-keywords-removed (args (:type :view :query-identifier :for-context-type))
+      (apply #'replace-input stream insertion args))))
+
+(defmethod presentation-replace-input
+    ((stream drei-input-editing-mixin) object (type (eql 'form)) view
+     &rest args &key
+     (buffer-start (input-position stream)) rescan
+     query-identifier (for-context-type type))
+  (declare (ignore query-identifier rescan for-context-type buffer-start))
+  (apply #'presentation-replace-input stream object 'expression view args))
+
 (defvar *drei-input-editing-stream* nil
   "Used to provide CLIM-specified input-editing-commands with the
 input-editing-stream. Bound when executing a command.")