/[climacs]/climacs/gui.lisp
ViewVC logotype

Diff of /climacs/gui.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.10 by rstrandh, Thu Dec 23 16:37:08 2004 UTC revision 1.11 by rstrandh, Thu Dec 23 18:49:32 2004 UTC
# Line 31  Line 31 
31    
32  (defclass climacs-pane (application-pane)  (defclass climacs-pane (application-pane)
33    ((buffer :initform (make-instance 'climacs-buffer) :accessor buffer)    ((buffer :initform (make-instance 'climacs-buffer) :accessor buffer)
34     (point :initform nil :initarg :point :reader point)))     (point :initform nil :initarg :point :reader point)
35       (syntax :initform (make-instance 'basic-syntax) :initarg :syntax :accessor syntax)))
36    
37  (defmethod initialize-instance :after ((pane climacs-pane) &rest args)  (defmethod initialize-instance :after ((pane climacs-pane) &rest args)
38    (declare (ignore args))    (declare (ignore args))
# Line 63  Line 64 
64  (defun display-win (frame pane)  (defun display-win (frame pane)
65    "The display function used by the climacs application frame."    "The display function used by the climacs application frame."
66    (declare (ignore frame))    (declare (ignore frame))
67    (let* ((medium (sheet-medium pane))    (redisplay-with-syntax pane (syntax 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+)))  
68    
69  (defun find-gestures (gestures start-table)  (defun find-gestures (gestures start-table)
70    (loop with table = (find-command-table start-table)    (loop with table = (find-command-table start-table)

Legend:
Removed from v.1.10  
changed lines
  Added in v.1.11

  ViewVC Help
Powered by ViewVC 1.1.5