[climacs-cvs] CVS climacs
dmurray
dmurray at common-lisp.net
Sun May 14 07:13:43 UTC 2006
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
More information about the Climacs-cvs
mailing list