[mcclim-cvs] CVS mcclim/Drei
thenriksen
thenriksen at common-lisp.net
Tue Jan 15 18:43:29 UTC 2008
Update of /project/mcclim/cvsroot/mcclim/Drei
In directory clnet:/tmp/cvs-serv4273/Drei
Modified Files:
drei-clim.lisp drei-redisplay.lisp views.lisp
Log Message:
Alright! Horizontal-scrolling workage, I think.
--- /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp 2008/01/11 02:44:13 1.28
+++ /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp 2008/01/15 18:43:28 1.29
@@ -346,9 +346,13 @@
(defmethod initialize-instance :after ((area drei-area)
&key)
(setf (input-editor-position area)
- (multiple-value-list (output-record-position area)))
+ (multiple-value-list (output-record-position area))
+ (extend-pane-bottom (view area)) t)
(tree-recompute-extent area))
+(defmethod (setf view) :after ((new-view drei-view) (drei drei-area))
+ (setf (extend-pane-bottom new-view) t))
+
(defmethod esa-current-window ((drei drei-area))
(editor-pane drei))
--- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/15 14:08:19 1.34
+++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/15 18:43:29 1.35
@@ -556,6 +556,9 @@
(when (> (x2 (stroke-dimensions stroke))
(bounding-rectangle-width pane))
(change-space-requirements pane :width (x2 (stroke-dimensions stroke))))
+ (when (> (y2 (stroke-dimensions stroke))
+ (bounding-rectangle-height pane))
+ (change-space-requirements pane :height (y2 (stroke-dimensions stroke))))
(funcall (drawing-options-function (stroke-drawing-options stroke))
pane view stroke cursor-x cursor-y #'stroke-drawing-fn t)))
@@ -744,7 +747,8 @@
actual-end-offset)))
(defmethod display-drei-view-contents ((pane basic-pane) (view drei-buffer-view))
- (setf (displayed-lines-count view) 0)
+ (setf (displayed-lines-count view) 0
+ (max-line-width view) 0)
(multiple-value-bind (cursor-x cursor-y) (stream-cursor-position pane)
(with-output-recording-options (pane :record nil :draw t)
(loop with start-offset = (offset (beginning-of-line (top view)))
@@ -756,7 +760,8 @@
(setf pump-state new-pump-state
start-offset (1+ (line-end-offset line)))
(incf cursor-y (+ line-height (stream-vertical-spacing pane))))
- when (or (>= (y2 (line-dimensions line)) pane-height)
+ when (or (and (not (extend-pane-bottom view))
+ (>= (y2 (line-dimensions line)) pane-height))
(= (line-end-offset line) (size (buffer view))))
return (progn
(setf (offset (bot view)) (line-end-offset line))
@@ -848,6 +853,30 @@
(- (y2 dimensions) (y1 dimensions))
default-object-width))))))))))
+(defmethod display-drei-view-cursor :around ((pane extended-output-stream)
+ (view point-mark-view)
+ (cursor drei-cursor))
+ ;; Try to draw the cursor...
+ (call-next-method)
+ ;; If it is the point, and there was no space for it...
+ (when (and (eq (mark cursor) (point view))
+ (or (> (bounding-rectangle-max-x cursor)
+ (bounding-rectangle-max-x pane))
+ (> (if (extend-pane-bottom view)
+ (bounding-rectangle-max-y cursor)
+ 0)
+ (bounding-rectangle-max-y pane))))
+ ;; Embiggen the sheet.
+ (change-space-requirements pane
+ :width (max (bounding-rectangle-max-x cursor)
+ (bounding-rectangle-max-x pane))
+ :width (max (if (extend-pane-bottom view)
+ (bounding-rectangle-max-y cursor)
+ 0)
+ (bounding-rectangle-max-y pane)))
+ ;; And draw the cursor again.
+ (call-next-method)))
+
(defmethod display-drei-view-cursor :around ((stream extended-output-stream)
(view drei-buffer-view)
(cursor drei-cursor))
@@ -881,13 +910,6 @@
(+ cursor-x object-width) (+ cursor-y stroke-height)
:ink (ink cursor))))))
-(defmethod display-drei-view-cursor :after ((stream extended-output-stream) (view drei-view)
- (cursor point-cursor))
- ;; Make sure there is room for the cursor.
- (let ((br-height (bounding-rectangle-height (bounding-rectangle cursor))))
- (when (> br-height (bounding-rectangle-height stream))
- (change-space-requirements stream :height br-height))))
-
(defmethod bounding-rectangle* ((view drei-buffer-view))
"Return the bounding rectangle of the visual appearance of
`view' as four values, just as `bounding-rectangle*'. Will return
@@ -895,14 +917,10 @@
(if (zerop (displayed-lines-count view))
(values 0 0 0 0)
(let ((first-line (aref (displayed-lines view) 0))
- (last-line (last-displayed-line view))
- (max-x2 0))
- (do-displayed-lines (line view)
- (setf max-x2 (max max-x2
- (x2 (line-dimensions line)))))
+ (last-line (last-displayed-line view)))
(values (x1 (line-dimensions first-line))
(y1 (line-dimensions first-line))
- max-x2
+ (max-line-width view)
(y2 (line-dimensions last-line))))))
(defmethod bounding-rectangle-width ((view drei-buffer-view))
@@ -1070,34 +1088,33 @@
has `view'."))
(defmethod fix-pane-viewport ((pane drei-pane) (view drei-view))
- (let* ((output-width (bounding-rectangle-width view))
+ (let* ((output-width (drei-bounding-rectangle-width pane))
(viewport (pane-viewport pane))
(viewport-width (and viewport (bounding-rectangle-width viewport)))
(pane-width (bounding-rectangle-width pane)))
;; If the width of the output is greater than the width of the
;; sheet, make the sheet wider. If the sheet is wider than the
;; viewport, but doesn't really need to be, make it thinner.
- (when (or (> output-width pane-width)
- (and viewport
- (> pane-width viewport-width)
- (>= viewport-width output-width)))
+ (when (and viewport
+ (> pane-width viewport-width)
+ (>= viewport-width output-width))
(change-space-requirements pane :width output-width))))
(defmethod fix-pane-viewport :after ((pane drei-pane) (view point-mark-view))
(when (and (pane-viewport pane) (active pane))
- (multiple-value-bind (cursor-x cursor-y line-height object-width)
- (offset-to-screen-position pane view (offset (point view)))
+ (with-bounding-rectangle* (x1 y1 x2 y2) (point-cursor pane)
+ (declare (ignore y1))
(multiple-value-bind (x-position y-position) (transform-position (sheet-transformation pane) 0 0)
(let ((viewport-width (bounding-rectangle-width (or (pane-viewport pane) pane)))
(viewport-height (bounding-rectangle-height (or (pane-viewport pane) pane))))
- (cond ((> (+ cursor-x object-width) (+ x-position viewport-width))
- (move-sheet pane (round (- (- cursor-x viewport-width))) 0))
- ((> x-position (+ cursor-x object-width))
- (move-sheet pane (if (> viewport-width cursor-x)
- 0
- (round (- cursor-x)))
- 0)))
- (when (> (+ cursor-y line-height) (+ y-position viewport-height))
+ (cond ((> x2 (+ (abs x-position) viewport-width))
+ (scroll-extent pane (round (- x2 viewport-width)) 0))
+ ((> (abs x-position) x2)
+ (scroll-extent pane (if (> viewport-width x1)
+ 0
+ (round x1))
+ 0)))
+ (when (> y2 (+ y-position viewport-height))
(full-redisplay pane)
;; We start all over!
(display-drei-pane (pane-frame pane) pane)))))))
--- /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/01/15 14:08:19 1.20
+++ /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/01/15 18:43:29 1.21
@@ -435,7 +435,14 @@
support standard editor commands, you should *not* inherit from
`editor-table' - the command tables containing the editor
commands will be added automatically, as long as this value is
-true."))
+true.")
+ (%extend-pane-bottom :accessor extend-pane-bottom
+ :initarg :extend-pane-bottom
+ :initform nil
+ :documentation "Resize the output pane
+vertically during redisplay (using `change-space-requirements'),
+in order to fit the whole buffer. If this value is false,
+redisplay will stop when the bottom of the pane is reached."))
(:metaclass modual-class)
(:documentation "The base class for all Drei views. A view
observes some other object and provides a visual representation
More information about the Mcclim-cvs
mailing list