- climacs-cvs@common-lisp.net - mailman3.common-lisp.net

[climacs-cvs] CVS update: Directory change: climacs/Doc
by rstrandh＠common-lisp.net 25 Dec '04

25 Dec '04

Update of /project/climacs/cvsroot/climacs/Doc In directory common-lisp.net:/tmp/cvs-serv28509/Doc Log Message: Directory /project/climacs/cvsroot/climacs/Doc added to the repository Date: Sat Dec 25 13:03:33 2004 Author: rstrandh New directory climacs/Doc added

1 0

[climacs-cvs] CVS update: climacs/gui.lisp
by abakic＠common-lisp.net 24 Dec '04

24 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv21795 Modified Files: gui.lisp Log Message: A minor refactoring, in fact to get around a CMUCL problem (probably related to eval-when...). Date: Sat Dec 25 00:17:48 2004 Author: abakic Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.12 climacs/gui.lisp:1.13 --- climacs/gui.lisp:1.12 Fri Dec 24 09:21:34 2004 +++ climacs/gui.lisp Sat Dec 25 00:17:48 2004 @@ -301,14 +301,10 @@ ;;; for some reason, C-c does not seem to arrive as far as CLIM. -(add-command-to-command-table 'com-quit 'c-x-climacs-table - :keystroke '(#\q :control)) - -(add-command-to-command-table 'com-find-file 'c-x-climacs-table - :keystroke '(#\f :control)) - -(add-command-to-command-table 'com-save-buffer 'c-x-climacs-table - :keystroke '(#\s :control)) - - +(defun c-x-set-key (gesture command) + (add-command-to-command-table command 'c-x-climacs-table + :keystroke gesture :errorp nil)) +(c-x-set-key '(#\q :control) 'com-quit) +(c-x-set-key '(#\f :control) 'com-find-file) +(c-x-set-key '(#\s :control) 'com-save-buffer) \ No newline at end of file

1 0

[climacs-cvs] CVS update: climacs/climacs.asd
by abakic＠common-lisp.net 24 Dec '04

24 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv21427 Modified Files: climacs.asd Log Message: Added a dependency on :clim-clx so that build is smooth for both CMUCL and SBCL. (Make sure CLIM and CLX are in central registry/provided.) Date: Sat Dec 25 00:14:41 2004 Author: abakic Index: climacs/climacs.asd diff -u climacs/climacs.asd:1.4 climacs/climacs.asd:1.5 --- climacs/climacs.asd:1.4 Thu Dec 23 19:49:32 2004 +++ climacs/climacs.asd Sat Dec 25 00:14:40 2004 @@ -42,7 +42,7 @@ :defaults *climacs-directory*)) collect `(:file ,(pathname-name p) :pathname ,p)))))) -(climacs-defsystem (:climacs) +(climacs-defsystem (:climacs :depends-on (:clim-clx)) "Flexichain/skiplist-package" "Flexichain/skiplist" "Flexichain/flexichain-package"

1 0

[climacs-cvs] CVS update: climacs/buffer.lisp climacs/gui.lisp climacs/syntax.lisp
by rstrandh＠common-lisp.net 24 Dec '04

24 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv7462 Modified Files: buffer.lisp gui.lisp syntax.lisp Log Message: Implemented a basic syntax according to the syntax protocol specification (which I haven't written yet). The current implementation should be improved upon, but it basically shows how to do it. Also implemented a demo command that accepts a string and inserts its reverse in the buffer. This shows that the words in the buffer are actually presentations (of type string) that become clickable by the accept. Added two missing methods on region-to-sequence. There were no methods when one of the arguments is an offset instead of a mark. Date: Fri Dec 24 09:21:35 2004 Author: rstrandh Index: climacs/buffer.lisp diff -u climacs/buffer.lisp:1.10 climacs/buffer.lisp:1.11 --- climacs/buffer.lisp:1.10 Thu Dec 23 18:24:44 2004 +++ climacs/buffer.lisp Fri Dec 24 09:21:34 2004 @@ -450,6 +450,12 @@ (assert (eq (buffer mark1) (buffer mark2))) (buffer-sequence (buffer mark1) (offset mark1) (offset mark2))) +(defmethod region-to-sequence ((offset integer) (mark mark-mixin)) + (buffer-sequence (buffer mark) offset (offset mark))) + +(defmethod region-to-sequence ((mark mark-mixin) (offset integer)) + (buffer-sequence (buffer mark) (offset mark) offset)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Buffer modification protocol Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.11 climacs/gui.lisp:1.12 --- climacs/gui.lisp:1.11 Thu Dec 23 19:49:32 2004 +++ climacs/gui.lisp Fri Dec 24 09:21:34 2004 @@ -32,14 +32,15 @@ (defclass climacs-pane (application-pane) ((buffer :initform (make-instance 'climacs-buffer) :accessor buffer) (point :initform nil :initarg :point :reader point) - (syntax :initform (make-instance 'basic-syntax) :initarg :syntax :accessor syntax))) + (syntax :initarg :syntax :accessor syntax))) (defmethod initialize-instance :after ((pane climacs-pane) &rest args) (declare (ignore args)) - (with-slots (buffer point) pane + (with-slots (buffer point syntax) pane (when (null point) (setf point (make-instance 'standard-right-sticky-mark - :buffer buffer))))) + :buffer buffer))) + (setf syntax (make-instance 'basic-syntax :buffer buffer :pane pane)))) (define-application-frame climacs () ((win :reader win)) @@ -162,6 +163,9 @@ (define-command com-insert-weird-stuff () (insert-object (point (win *application-frame*)) (make-instance 'weird))) +(define-command com-insert-reversed-string () + (insert-sequence (point (win *application-frame*)) + (reverse (accept 'string)))) (define-presentation-type completable-pathname () :inherit-from 'pathname) @@ -238,14 +242,14 @@ (define-command com-find-file () (let ((filename (accept 'completable-pathname - :prompt "Find File")) - (buffer (make-instance 'climacs-buffer))) - (setf (buffer (win *application-frame*)) buffer - (filename (buffer (win *application-frame*))) filename) - (with-open-file (stream filename :direction :input) - (input-from-stream stream buffer 0)) - (setf (slot-value (win *application-frame*) 'point) - (make-instance 'standard-right-sticky-mark :buffer buffer)))) + :prompt "Find File"))) + (with-slots (buffer point syntax) (win *application-frame*) + (setf buffer (make-instance 'climacs-buffer) + point (make-instance 'standard-right-sticky-mark :buffer buffer) + syntax (make-instance 'basic-syntax :buffer buffer :pane (win *application-frame*)) + (filename buffer) filename) + (with-open-file (stream filename :direction :input) + (input-from-stream stream buffer 0))))) (define-command com-save-buffer () (let ((filename (or (filename (buffer (win *application-frame*))) @@ -283,6 +287,7 @@ (global-set-key '(#\b :meta) 'com-backward-word) (global-set-key '(#\x :meta) 'com-extended-command) (global-set-key '(#\a :meta) 'com-insert-weird-stuff) +(global-set-key '(#\c :meta) 'com-insert-reversed-string) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.1 climacs/syntax.lisp:1.2 --- climacs/syntax.lisp:1.1 Thu Dec 23 19:49:32 2004 +++ climacs/syntax.lisp Fri Dec 24 09:21:34 2004 @@ -31,63 +31,101 @@ (defgeneric full-redisplay (pane syntax)) (defclass basic-syntax (syntax) - ()) + ((top :reader top) + (bot :reader bot) + (scan :reader scan) + (saved-offset :initform nil :accessor saved-offset) + (cursor-x :initform nil) + (cursor-y :initform nil) + (space-width :initform nil) + (tab-width :initform nil))) + +(defmethod initialize-instance :after ((syntax basic-syntax) &rest args &key buffer pane) + (declare (ignore args)) + (with-slots (top bot scan space-width tab-width) syntax + (setf top (make-instance 'standard-left-sticky-mark :buffer buffer) + bot (make-instance 'standard-right-sticky-mark :buffer buffer) + scan (make-instance 'standard-left-sticky-mark :buffer buffer)) + (let* ((medium (sheet-medium pane)) + (style (medium-text-style medium))) + (setf space-width (text-style-width style medium) + tab-width (* 8 space-width))))) + +(defun present-contents (pane syntax) + (with-slots (saved-offset scan) syntax + (unless (null saved-offset) + (present (coerce (region-to-sequence saved-offset scan) 'string) + 'string + :stream pane) + (setf saved-offset nil)))) + +(defun display-line (pane syntax) + (with-slots (saved-offset bot scan cursor-x cursor-y space-width tab-width) syntax + (loop when (mark= scan (point pane)) + do (multiple-value-bind (x y) (stream-cursor-position pane) + (setf cursor-x (+ x (if (null saved-offset) + 0 + (* space-width (- (offset scan) saved-offset)))) + cursor-y y)) + when (mark= scan bot) + do (present-contents pane syntax) + (return) + until (eql (object-after scan) #\Newline) + do (let ((obj (object-after scan))) + (cond ((eql obj #\Space) + (present-contents pane syntax) + (princ obj pane)) + ((eql obj #\Tab) + (present-contents pane syntax) + (let ((x (stream-cursor-position pane))) + (stream-increment-cursor-position + pane (- tab-width (mod x tab-width)) 0))) + ((constituentp obj) + (when (null saved-offset) + (setf saved-offset (offset scan)))) + (t + (present-contents pane syntax) + (princ obj pane)))) + (incf (offset scan)) + finally (present-contents pane syntax) + (incf (offset scan)) + (terpri pane)))) (defmethod redisplay-with-syntax (pane (syntax basic-syntax)) (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+))) + (height (text-style-height style medium))) + (with-slots (top bot scan cursor-x cursor-y) syntax + (beginning-of-line top) + (end-of-line bot) + (multiple-value-bind (x y w h) (bounding-rectangle* pane) + (declare (ignore x y w)) + (let ((nb-lines (max 1 (floor h (+ height (stream-vertical-spacing pane)))))) + (loop while (> (1+ (- (line-number bot) (line-number top))) nb-lines) + do (beginning-of-line bot) + (decf (offset bot))) + (loop until (end-of-buffer-p bot) + while (< (1+ (- (line-number bot) (line-number top))) nb-lines) + do (incf (offset bot)) + (end-of-line bot)) + (loop while (mark< (point pane) top) + do (decf (offset top)) + (beginning-of-line top) + (beginning-of-line bot) + (decf (offset bot))) + (loop while (mark> (point pane) bot) + do (end-of-line top) + (incf (offset top)) + (incf (offset bot)) + (end-of-line bot)) + (setf (offset scan) (offset top)) + (loop until (mark= scan bot) + do (display-line pane syntax)) + (when (mark= scan (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+))))))

1 0

[climacs-cvs] CVS update: climacs/syntax.lisp climacs/climacs.asd climacs/gui.lisp climacs/packages.lisp
by rstrandh＠common-lisp.net 23 Dec '04

23 Dec '04

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))

1 0

[climacs-cvs] CVS update: climacs/buffer.lisp climacs/buffer.text climacs/packages.lisp
by rstrandh＠common-lisp.net 23 Dec '04

23 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv25441 Modified Files: buffer.lisp buffer.text packages.lisp Log Message: Completed the description of the buffer modification protocol. Implemented the protocol. Updated the buffer package accordingly. Date: Thu Dec 23 18:24:45 2004 Author: rstrandh Index: climacs/buffer.lisp diff -u climacs/buffer.lisp:1.9 climacs/buffer.lisp:1.10 --- climacs/buffer.lisp:1.9 Thu Dec 23 09:00:33 2004 +++ climacs/buffer.lisp Thu Dec 23 18:24:44 2004 @@ -34,8 +34,14 @@ newline characters. The last object of the buffer is not necessarily a newline character.")) +(defgeneric low-mark (buffer)) + +(defgeneric high-mark (buffer)) + (defclass standard-buffer (buffer) - ((contents :initform (make-instance 'standard-cursorchain))) + ((contents :initform (make-instance 'standard-cursorchain)) + (low-mark :reader low-mark) + (high-mark :reader high-mark)) (:documentation "The Climacs standard buffer [an instantable subclass of buffer].")) (defgeneric buffer (mark) @@ -99,6 +105,13 @@ :chain (slot-value (buffer mark) 'contents) :position offset))) +(defmethod initialize-instance :after ((buffer standard-buffer) &rest args) + "Create the low-mark and high-mark" + (declare (ignore args)) + (with-slots (low-mark high-mark) buffer + (setf low-mark (make-instance 'standard-left-sticky-mark :buffer buffer)) + (setf high-mark (make-instance 'standard-right-sticky-mark :buffer buffer)))) + (defgeneric clone-mark (mark &optional type) (:documentation "Clone a mark. By default (when type is NIL) the same type of mark is returned. Otherwise type is the name of a class (subclass of the mark @@ -240,27 +253,6 @@ (defmethod end-of-buffer-p ((mark mark-mixin)) (= (offset mark) (size (buffer mark)))) -(defgeneric beginning-of-line (mark) - (:documentation "Move the mark to the beginning of the line. The mark will be - positioned either immediately after the closest preceding newline - character, or at the beginning of the buffer if no preceding newline - character exists.")) - -(defmethod beginning-of-line ((mark mark-mixin)) - (loop until (or (beginning-of-buffer-p mark) - (eql (object-before mark) #\Newline)) - do (decf (offset mark)))) - -(defgeneric end-of-line (mark) - (:documentation "Move the mark to the end of the line. The mark will be positioned -either immediately before the closest following newline character, or -at the end of the buffer if no following newline character exists.")) - -(defmethod end-of-line ((mark mark-mixin)) - (loop until (or (end-of-buffer-p mark) - (eql (object-after mark) #\Newline)) - do (incf (offset mark)))) - (defgeneric beginning-of-line-p (mark) (:documentation "Return t if the mark is at the beginning of the line (i.e., if the character preceding the mark is a newline character or if the mark is @@ -279,6 +271,25 @@ (or (end-of-buffer-p mark) (eql (object-after mark) #\Newline))) +(defgeneric beginning-of-line (mark) + (:documentation "Move the mark to the beginning of the line. The mark will be + positioned either immediately after the closest preceding newline + character, or at the beginning of the buffer if no preceding newline + character exists.")) + +(defmethod beginning-of-line ((mark mark-mixin)) + (loop until (beginning-of-line-p mark) + do (decf (offset mark)))) + +(defgeneric end-of-line (mark) + (:documentation "Move the mark to the end of the line. The mark will be positioned +either immediately before the closest following newline character, or +at the end of the buffer if no following newline character exists.")) + +(defmethod end-of-line ((mark mark-mixin)) + (loop until (end-of-line-p mark) + do (incf (offset mark)))) + (defgeneric line-number (mark) (:documentation "Return the line number of the mark. Lines are numbered from zero.")) @@ -439,4 +450,32 @@ (assert (eq (buffer mark1) (buffer mark2))) (buffer-sequence (buffer mark1) (offset mark1) (offset mark2))) - +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Buffer modification protocol + +(defmethod insert-buffer-object :before ((buffer standard-buffer) offset object) + (declare (ignore object)) + (setf (offset (low-mark buffer)) + (min (offset (low-mark buffer)) offset)) + (setf (offset (high-mark buffer)) + (max (offset (high-mark buffer)) offset))) + +(defmethod insert-buffer-sequence :before ((buffer standard-buffer) offset sequence) + (declare (ignore sequence)) + (setf (offset (low-mark buffer)) + (min (offset (low-mark buffer)) offset)) + (setf (offset (high-mark buffer)) + (max (offset (high-mark buffer)) offset))) + +(defmethod delete-buffer-range :before ((buffer standard-buffer) offset n) + (setf (offset (low-mark buffer)) + (min (offset (low-mark buffer)) offset)) + (setf (offset (high-mark buffer)) + (max (offset (high-mark buffer)) (+ offset n)))) + +(defgeneric reset-low-high-marks (buffer)) + +(defmethod reset-low-high-marks ((buffer standard-buffer)) + (beginning-of-buffer (high-mark buffer)) + (end-of-buffer (low-mark buffer))) Index: climacs/buffer.text diff -u climacs/buffer.text:1.3 climacs/buffer.text:1.4 --- climacs/buffer.text:1.3 Tue Dec 21 17:19:26 2004 +++ climacs/buffer.text Thu Dec 23 18:24:44 2004 @@ -323,12 +323,13 @@ of its current value and the position of the modification. Redisplay code may use these values to determine what part of the - screen needs to be updated. At the end of an invocation of - redisplay, the offset of the low mark is set to the size of the - buffer, and the offset of the high mark is set to zero. + screen needs to be updated. These values can also be used to update + information about syntax highlighting and other cached information. - These values can also be used to update information about syntax - highlighting and other cached information. +reset-low-high-marks buffer [generic function] + + Set the high-mark to the beginning of the beginning of the buffer and + the low-mark to the end of the buffer. The redisplay protocol ====================== Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.6 climacs/packages.lisp:1.7 --- climacs/packages.lisp:1.6 Thu Dec 23 09:00:33 2004 +++ climacs/packages.lisp Thu Dec 23 18:24:45 2004 @@ -37,7 +37,8 @@ #:delete-buffer-range #:delete-range #:delete-region #:buffer-object #:buffer-sequence - #:object-before #:object-after #:region-to-sequence)) + #:object-before #:object-after #:region-to-sequence + #:low-mark #:high-mark #:reset-low-high-marks)) (defpackage :climacs-base (:use :clim-lisp :climacs-buffer)

1 0

[climacs-cvs] CVS update: climacs/gui.lisp
by rstrandh＠common-lisp.net 23 Dec '04

23 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv22843 Modified Files: gui.lisp Log Message: Rendering of #\Tab characters works. Replaced occurrences of (win frame) by pane in display function. The #\Tab character now self-inserts. Date: Thu Dec 23 17:37:08 2004 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.9 climacs/gui.lisp:1.10 --- climacs/gui.lisp:1.9 Thu Dec 23 09:03:53 2004 +++ climacs/gui.lisp Thu Dec 23 17:37:08 2004 @@ -62,12 +62,14 @@ (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)) - (buffer (buffer (win frame))) - (size (size (buffer (win frame)))) + (tab-width (* 8 width)) + (buffer (buffer pane)) + (size (size (buffer pane))) (offset 0) (offset1 nil) (cursor-x nil) @@ -79,7 +81,7 @@ :stream pane) (setf offset1 nil))) (display-line () - (loop when (= offset (offset (point (win frame)))) + (loop when (= offset (offset (point pane))) do (multiple-value-bind (x y) (stream-cursor-position pane) (setf cursor-x (+ x (if (null offset1) 0 @@ -93,6 +95,11 @@ (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))) @@ -105,7 +112,7 @@ (terpri pane)))) (loop while (< offset size) do (display-line)) - (when (= offset (offset (point (win frame)))) + (when (= offset (offset (point pane))) (multiple-value-bind (x y) (stream-cursor-position pane) (setf cursor-x x cursor-y y)))) @@ -317,6 +324,7 @@ do (global-set-key (code-char code) 'com-self-insert)) (global-set-key #\newline 'com-self-insert) +(global-set-key #\tab 'com-self-insert) (global-set-key '(#\f :control) 'com-forward-object) (global-set-key '(#\b :control) 'com-backward-object) (global-set-key '(#\a :control) 'com-beginning-of-line)

1 0