Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv31448
Modified Files: pane.lisp packages.lisp file-commands.lisp Log Message: Banish Basic syntax in favour of Fundamental (and some region highlighting fiddling).
--- /project/climacs/cvsroot/climacs/pane.lisp 2006/05/07 06:40:19 1.41 +++ /project/climacs/cvsroot/climacs/pane.lisp 2006/05/14 07:13:43 1.42 @@ -255,7 +255,7 @@ (declare (ignore args)) (with-slots (syntax point) buffer (setf syntax (make-instance - 'basic-syntax :buffer (implementation buffer)) + 'fundamental-syntax :buffer (implementation buffer)) point (clone-mark (low-mark buffer) :right))))
(defmethod (setf syntax) :after (syntax (buffer climacs-buffer)) @@ -626,76 +626,100 @@ ;; mark or point is above the screen, and point or mark below it ((and (null cursor-y) (null mark-y) (or (and cursor-x (null mark-x)) - (and (null cursor-x) mark-y))) - (updating-output (pane :unique-id -3) - (draw-rectangle* pane - 0 0 - (stream-text-margin pane) (bounding-rectangle-height - (window-viewport pane)) - :ink ink))) + (and (null cursor-x) mark-x))) + (let ((width (stream-text-margin pane)) + (height (bounding-rectangle-height + (window-viewport pane)))) + (updating-output (pane :unique-id -3 + :cache-value (list cursor-y mark-y cursor-x mark-x + height width ink)) + (draw-rectangle* pane + 0 0 + width height + :ink ink)))) ;; mark is above the top of the screen ((and (null mark-y) (null mark-x)) - (updating-output (pane :unique-id -3) - (draw-rectangle* pane - 0 0 - (stream-text-margin pane) cursor-y - :ink ink) - (draw-rectangle* pane - 0 cursor-y - cursor-x (+ cursor-y line-height) - :ink ink))) + (let ((width (stream-text-margin pane))) + (updating-output (pane :unique-id -3 + :cache-value ink) + (updating-output (pane :cache-value (list mark-y mark-x cursor-y width)) + (draw-rectangle* pane + 0 0 + width cursor-y + :ink ink)) + (updating-output (pane :cache-value (list cursor-y cursor-x)) + (draw-rectangle* pane + 0 cursor-y + cursor-x (+ cursor-y line-height) + :ink ink))))) ;; mark is below the bottom of the screen ((and (null mark-y) mark-x) - (updating-output (pane :unique-id -3) - (draw-rectangle* pane - 0 (+ cursor-y line-height) - (stream-text-margin pane) (bounding-rectangle-height - (window-viewport pane)) - :ink ink) - (draw-rectangle* pane - cursor-x cursor-y - (stream-text-margin pane) (+ cursor-y line-height) - :ink ink))) + (let ((width (stream-text-margin pane)) + (height (bounding-rectangle-height + (window-viewport pane)))) + (updating-output (pane :unique-id -3 + :cache-value ink) + (updating-output (pane :cache-value (list cursor-y width height)) + (draw-rectangle* pane + 0 (+ cursor-y line-height) + width height + :ink ink)) + (updating-output (pane :cache-value (list cursor-x cursor-y width)) + (draw-rectangle* pane + cursor-x cursor-y + width (+ cursor-y line-height) + :ink ink))))) ;; mark is at point ((and (= mark-x cursor-x) (= mark-y cursor-y)) nil) ;; mark and point are on the same line ((= mark-y cursor-y) - (updating-output (pane :unique-id -3) + (updating-output (pane :unique-id -3 + :cache-value (list offset1 offset2 ink)) (draw-rectangle* pane mark-x mark-y cursor-x (+ cursor-y line-height) :ink ink))) ;; mark and point are both visible, mark above point ((< mark-y cursor-y) - (updating-output (pane :unique-id -3) - (draw-rectangle* pane - mark-x mark-y - (stream-text-margin pane) (+ mark-y line-height) - :ink ink) - (draw-rectangle* pane - 0 cursor-y - cursor-x (+ cursor-y line-height) - :ink ink) - (draw-rectangle* pane - 0 (+ mark-y line-height) - (stream-text-margin pane) cursor-y - :ink ink))) + (let ((width (stream-text-margin pane))) + (updating-output (pane :unique-id -3 + :cache-value ink) + (updating-output (pane :cache-value (list mark-x mark-y width)) + (draw-rectangle* pane + mark-x mark-y + width (+ mark-y line-height) + :ink ink)) + (updating-output (pane :cache-value (list cursor-x cursor-y)) + (draw-rectangle* pane + 0 cursor-y + cursor-x (+ cursor-y line-height) + :ink ink)) + (updating-output (pane :cache-value (list mark-y cursor-y width)) + (draw-rectangle* pane + 0 (+ mark-y line-height) + width cursor-y + :ink ink))))) ;; mark and point are both visible, point above mark (t - (updating-output (pane :unique-id -3) - (draw-rectangle* pane - cursor-x cursor-y - (stream-text-margin pane) (+ cursor-y line-height) - :ink ink) - (draw-rectangle* pane - 0 mark-y - mark-x (+ mark-y line-height) - :ink ink) - (draw-rectangle* pane - 0 (+ cursor-y line-height) - (stream-text-margin pane) mark-y - :ink ink))))))) + (let ((width (stream-text-margin pane))) + (updating-output (pane :unique-id -3 + :cache-value ink) + (updating-output (pane :cache-value (list cursor-x cursor-y width)) + (draw-rectangle* pane + cursor-x cursor-y + width (+ cursor-y line-height) + :ink ink)) + (updating-output (pane :cache-value (list mark-x mark-y)) + (draw-rectangle* pane + 0 mark-y + mark-x (+ mark-y line-height) + :ink ink)) + (updating-output (pane :cache-value (list cursor-y mark-y width)) + (draw-rectangle* pane + 0 (+ cursor-y line-height) + width mark-y + :ink ink)))))))))
(defmethod highlight-region ((pane climacs-pane) (mark1 mark) (mark2 mark) &optional (ink (compose-in +green+ (make-opacity .1)))) --- /project/climacs/cvsroot/climacs/packages.lisp 2006/05/06 19:51:04 1.93 +++ /project/climacs/cvsroot/climacs/packages.lisp 2006/05/14 07:13:43 1.94 @@ -127,6 +127,11 @@ #:line-comment-region #:comment-region #:line-uncomment-region #:uncomment-region))
+(defpackage :climacs-fundamental-syntax + (:use :clim-lisp :clim :climacs-buffer :climacs-base + :climacs-syntax :flexichain :climacs-pane) + (:export #:fundamental-syntax)) + (defpackage :climacs-kill-ring (:use :clim-lisp :flexichain) (:export #:kill-ring #:kill-ring-length #:kill-ring-max-size @@ -144,7 +149,7 @@
(defpackage :climacs-pane (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev - :climacs-syntax :flexichain :undo) + :climacs-syntax :flexichain :undo :climacs-fundamental-syntax) (:export #:climacs-buffer #:needs-saving #:filepath #:file-saved-p #:file-write-time #:read-only-p #:buffer-read-only @@ -170,7 +175,7 @@
(defpackage :climacs-gui (:use :clim-lisp :clim :climacs-buffer :climacs-base - :climacs-abbrev :climacs-syntax + :climacs-abbrev :climacs-syntax :climacs-fundamental-syntax :climacs-kill-ring :climacs-pane :clim-extensions :undo :esa) ;;(:import-from :lisp-string) (:export :climacs ; Main entry point. @@ -182,11 +187,6 @@ :mark :insert-character))
-(defpackage :climacs-fundamental-syntax - (:use :clim-lisp :clim :climacs-buffer :climacs-base - :climacs-syntax :flexichain :climacs-pane) - (:export)) - (defpackage :climacs-html-syntax (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-syntax :flexichain :climacs-pane)) --- /project/climacs/cvsroot/climacs/file-commands.lisp 2006/05/10 20:33:45 1.16 +++ /project/climacs/cvsroot/climacs/file-commands.lisp 2006/05/14 07:13:43 1.17 @@ -127,7 +127,7 @@ :test (lambda (x y) (member x y :test #'string-equal)) :key #'climacs-syntax::syntax-description-pathname-types)) - 'basic-syntax)) + 'fundamental-syntax))
(defun evaluate-attributes (buffer options) "Evaluate the attributes `options' and modify `buffer' as