[mcclim-cvs] CVS mcclim/Drei
thenriksen
thenriksen at common-lisp.net
Wed Dec 6 13:00:00 UTC 2006
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.")
More information about the Mcclim-cvs
mailing list