[mcclim-cvs] CVS mcclim/Drei
thenriksen
thenriksen at common-lisp.net
Sun Jan 20 19:50:21 UTC 2008
Update of /project/mcclim/cvsroot/mcclim/Drei
In directory clnet:/tmp/cvs-serv12206/Drei
Modified Files:
core-commands.lisp drei-redisplay.lisp packages.lisp
views.lisp
Log Message:
Improved support for nonbuffer views, including various bugfixes here
and there, used that support to revamp Climacs' typeout panes, which
in turn required some ESA changes.
Stability not guaranteed, please test.
--- /project/mcclim/cvsroot/mcclim/Drei/core-commands.lisp 2008/01/17 11:29:55 1.13
+++ /project/mcclim/cvsroot/mcclim/Drei/core-commands.lisp 2008/01/20 19:50:20 1.14
@@ -296,7 +296,7 @@
'((:home :control)))
(define-command (com-page-down :name t :command-table movement-table) ()
- (page-down (current-view)))
+ (page-down (editor-pane (drei-instance)) (current-view)))
(set-key 'com-page-down
'movement-table
@@ -307,7 +307,7 @@
'((:next)))
(define-command (com-page-up :name t :command-table movement-table) ()
- (page-up (current-view)))
+ (page-up (editor-pane (drei-instance)) (current-view)))
(set-key 'com-page-up
'movement-table
--- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/19 12:39:28 1.45
+++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/20 19:50:20 1.46
@@ -652,7 +652,7 @@
(maybe-clear last-clear-x (x1 stroke-dimensions))
(setf last-clear-x (x2 stroke-dimensions)))
;; This clears from end of line to the end of the sheet.
- finally (maybe-clear (1+ last-clear-x) (bounding-rectangle-width pane))))
+ finally (maybe-clear last-clear-x (bounding-rectangle-width pane))))
;; Now actually draw them in a way that makes sure they all
;; touch the bottom of the line.
(loop for stroke-index below (line-stroke-count line)
@@ -994,8 +994,9 @@
(with-bounding-rectangle* (old-x1 old-y1 old-x2 old-y2) drei
(replay drei stream)
(with-bounding-rectangle* (new-x1 new-y1 new-x2 new-y2) drei
- (unless (and (= new-x1 old-x1) (= new-y1 old-y2)
- (= new-x2 old-x2) (= new-y2 old-y2))
+ (unless (or (and (= new-x1 old-x1) (= new-y1 old-y2)
+ (= new-x2 old-x2) (= new-y2 old-y2))
+ (null (output-record-parent drei)))
(recompute-extent-for-changed-child (output-record-parent drei) drei
old-x1 old-y1 old-x2 old-y2))))
(when (point-cursor drei)
@@ -1018,6 +1019,22 @@
;;;
;;; Drei pane redisplay.
+(defgeneric handle-redisplay (pane view region)
+ (:documentation "Handle redisplay of `view' upon `pane' (which
+is a Drei pane) in the given region. Methods defined on this
+function should mark their redisplay information as dirty based
+on `region' and call the default method, which will in turn call
+`display-drei' on `pane'.")
+ (:method ((pane drei-pane) (view drei-view) (region region))
+ (display-drei pane)))
+
+(defmethod handle-repaint ((pane drei-pane) region)
+ (handle-redisplay pane (view pane) region))
+
+(defmethod handle-redisplay ((pane drei-pane) (view drei-buffer-view) (region region))
+ (invalidate-all-strokes (view pane) :cleared t)
+ (call-next-method))
+
(defun reposition-pane (drei-pane)
"Try to put point close to the middle of the pane by moving top
half a pane-size up."
@@ -1037,14 +1054,15 @@
"Reposition the pane if point is outside the region delimited
by the top/bot marks of its view. Returns true if adjustment was
needed."
- (with-accessors ((buffer buffer) (top top) (bot bot)
- (point point)) (view drei-pane)
- (when (or (mark< point top)
- (mark> point bot))
- (reposition-pane drei-pane)
- t)))
+ (when (typep (view drei-pane) 'point-mark-view)
+ (with-accessors ((buffer buffer) (top top) (bot bot)
+ (point point)) (view drei-pane)
+ (when (or (mark< point top)
+ (mark> point bot))
+ (reposition-pane drei-pane)
+ t))))
-(defun page-down (view)
+(defmethod page-down (pane (view drei-buffer-view))
(with-accessors ((top top) (bot bot)) view
(when (mark> (size (buffer bot)) bot)
(setf (offset top) (offset bot))
@@ -1052,7 +1070,7 @@
(setf (offset (point view)) (offset top))
(invalidate-all-strokes view))))
-(defun page-up (view)
+(defmethod page-up (pane (view drei-buffer-view))
(with-accessors ((top top) (bot bot)) view
(when (> (offset top) 0)
(setf (offset (point view)) (offset top))
@@ -1096,11 +1114,6 @@
;; We start all over!
(display-drei-pane (pane-frame pane) pane)))))))
-(defmethod handle-repaint ((pane drei-pane) region)
- (declare (ignore region))
- (invalidate-all-strokes (view pane) :cleared t)
- (redisplay-frame-pane (pane-frame pane) pane))
-
(defmethod pane-needs-redisplay :around ((pane drei-pane))
(values (call-next-method) nil))
--- /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2008/01/19 12:39:28 1.43
+++ /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2008/01/20 19:50:20 1.44
@@ -216,7 +216,7 @@
;; Views and their facilities.
#:drei-view #:modified-p #:no-cursors
- #:drei-buffer-view #:buffer #:top #:bot
+ #:drei-buffer-view #:buffer #:top #:bot #:buffer-view-p
#:drei-syntax-view #:syntax
#:pump-state-for-offset-with-syntax
#:stroke-pump-with-syntax
@@ -248,12 +248,14 @@
#:minibuffer
- #:drei #:drei-pane #:drei-gadget-pane #:drei-area
+ #:drei #:editor-pane
+ #:drei-pane #:drei-gadget-pane #:drei-area
#:handling-drei-conditions #:handle-drei-condition
#:execute-drei-command
;; Redisplay engine.
#:display-drei-view-contents #:display-drei-view-cursor
+ #:handle-redisplay
#:face #:make-face #:face-ink #:face-style
#:drawing-options #:make-drawing-options
#:drawing-options-face #:drawing-options-function
--- /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/01/18 11:00:23 1.23
+++ /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/01/20 19:50:20 1.24
@@ -504,6 +504,14 @@
when (and slot-initarg slot-boundp)
nconc (list slot-initarg (slot-value view slot-name)))))))
+(defgeneric page-down (pane view)
+ (:documentation "Scroll `view', which is displayed on `pane', a
+page up."))
+
+(defgeneric page-up (pane view)
+ (:documentation "Scroll `view', which is displayed on `pane', a
+page up."))
+
(defclass drei-buffer-view (drei-view)
((%buffer :accessor buffer
:initform (make-instance 'drei-buffer)
@@ -574,6 +582,10 @@
(setf (fill-pointer string) 0)
string))
+(defun buffer-view-p (view)
+ "Return true if `view' is a `drei-buffer-view'."
+ (typep view 'drei-buffer-view))
+
(defclass drei-syntax-view (drei-buffer-view)
((%syntax :accessor syntax
:documentation "An instance of the syntax class used
More information about the Mcclim-cvs
mailing list