[climacs-cvs] CVS update: climacs/syntax.lisp climacs/climacs.asd climacs/gui.lisp climacs/packages.lisp
Robert Strandh
rstrandh at common-lisp.net
Thu Dec 23 18:49:36 UTC 2004
Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv29237
Modified Files:
climacs.asd gui.lisp packages.lisp
Added Files:
syntax.lisp
Log Message:
First steps toward a decent redisplay function.
We introduce a protocol class `syntax' used to specialize methods of
the redisplay functions.
We also introduce a class `basic-syntax', a subclass of `syntax' that
can redisplay basic text. Currently, the redisplay method on
basic-syntax is not terribly smart, as it displays the entire buffer.
Each pane that displays a buffer also contains a syntax used to
determine the way the buffer is to be rendered in that pane.
Currently, the implementation is ahead of the specification with
respect to this syntax abstraction. That will not be the case for
very long, though.
Date: Thu Dec 23 19:49:33 2004
Author: rstrandh
Index: climacs/climacs.asd
diff -u climacs/climacs.asd:1.3 climacs/climacs.asd:1.4
--- climacs/climacs.asd:1.3 Wed Dec 22 15:43:18 2004
+++ climacs/climacs.asd Thu Dec 23 19:49:32 2004
@@ -54,4 +54,5 @@
"base"
"io"
"abbrev"
+ "syntax"
"gui")
Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.10 climacs/gui.lisp:1.11
--- climacs/gui.lisp:1.10 Thu Dec 23 17:37:08 2004
+++ climacs/gui.lisp Thu Dec 23 19:49:32 2004
@@ -31,7 +31,8 @@
(defclass climacs-pane (application-pane)
((buffer :initform (make-instance 'climacs-buffer) :accessor buffer)
- (point :initform nil :initarg :point :reader point)))
+ (point :initform nil :initarg :point :reader point)
+ (syntax :initform (make-instance 'basic-syntax) :initarg :syntax :accessor syntax)))
(defmethod initialize-instance :after ((pane climacs-pane) &rest args)
(declare (ignore args))
@@ -63,63 +64,7 @@
(defun display-win (frame pane)
"The display function used by the climacs application frame."
(declare (ignore frame))
- (let* ((medium (sheet-medium pane))
- (style (medium-text-style medium))
- (height (text-style-height style medium))
- (width (text-style-width style medium))
- (tab-width (* 8 width))
- (buffer (buffer pane))
- (size (size (buffer pane)))
- (offset 0)
- (offset1 nil)
- (cursor-x nil)
- (cursor-y nil))
- (labels ((present-contents ()
- (unless (null offset1)
- (present (coerce (buffer-sequence buffer offset1 offset) 'string)
- 'string
- :stream pane)
- (setf offset1 nil)))
- (display-line ()
- (loop when (= offset (offset (point pane)))
- do (multiple-value-bind (x y) (stream-cursor-position pane)
- (setf cursor-x (+ x (if (null offset1)
- 0
- (* width (- offset offset1))))
- cursor-y y))
- when (= offset size)
- do (present-contents)
- (return)
- until (eql (buffer-object buffer offset) #\Newline)
- do (let ((obj (buffer-object buffer offset)))
- (cond ((eql obj #\Space)
- (present-contents)
- (princ obj pane))
- ((eql obj #\Tab)
- (present-contents)
- (let ((x (stream-cursor-position pane)))
- (stream-increment-cursor-position
- pane (- tab-width (mod x tab-width)) 0)))
- ((constituentp obj)
- (when (null offset1)
- (setf offset1 offset)))
- (t
- (present-contents)
- (princ obj pane))))
- (incf offset)
- finally (present-contents)
- (incf offset)
- (terpri pane))))
- (loop while (< offset size)
- do (display-line))
- (when (= offset (offset (point pane)))
- (multiple-value-bind (x y) (stream-cursor-position pane)
- (setf cursor-x x
- cursor-y y))))
- (draw-line* pane
- cursor-x (- cursor-y (* 0.2 height))
- cursor-x (+ cursor-y (* 0.8 height))
- :ink +red+)))
+ (redisplay-with-syntax pane (syntax pane)))
(defun find-gestures (gestures start-table)
(loop with table = (find-command-table start-table)
Index: climacs/packages.lisp
diff -u climacs/packages.lisp:1.7 climacs/packages.lisp:1.8
--- climacs/packages.lisp:1.7 Thu Dec 23 18:24:45 2004
+++ climacs/packages.lisp Thu Dec 23 19:49:32 2004
@@ -53,6 +53,11 @@
(:export #:abbrev-expander #:dictionary-abbrev-expander #:dictionary
#:expand-abbrev #:abbrev-mixin #:possibly-expand-abbrev))
+(defpackage :climacs-syntax
+ (:use :clim-lisp :clim :climacs-buffer :climacs-base)
+ (:export #:syntax #:basic-syntax
+ #:redisplay-with-syntax #:full-redisplay))
+
(defpackage :climacs-gui
- (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev))
+ (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev :climacs-syntax))
More information about the Climacs-cvs
mailing list