[climacs-cvs] CVS climacs
dmurray
dmurray at common-lisp.net
Sat May 6 19:51:05 UTC 2006
Update of /project/climacs/cvsroot/climacs
In directory clnet:/tmp/cvs-serv9866
Modified Files:
cl-syntax.lisp fundamental-syntax.lisp html-syntax.lisp
lisp-syntax.lisp misc-commands.lisp packages.lisp pane.lisp
prolog-syntax.lisp slidemacs.lisp ttcn3-syntax.lisp
Log Message:
Changed mark-visibility to region visibility. Turn it on
and off with Visible Region, for now.
--- /project/climacs/cvsroot/climacs/cl-syntax.lisp 2006/03/03 19:38:57 1.17
+++ /project/climacs/cvsroot/climacs/cl-syntax.lisp 2006/05/06 19:51:04 1.18
@@ -1141,7 +1141,7 @@
do (let ((token (lexeme lexer start-token-index)))
(display-parse-tree token syntax pane))
(incf start-token-index))))))))
- (when (mark-visible-p pane) (display-mark pane syntax))
+ (when (region-visible-p pane) (display-region pane syntax))
(display-cursor pane syntax current-p)))
--- /project/climacs/cvsroot/climacs/fundamental-syntax.lisp 2005/08/15 23:31:22 1.2
+++ /project/climacs/cvsroot/climacs/fundamental-syntax.lisp 2006/05/06 19:51:04 1.3
@@ -185,7 +185,7 @@
:cache-value line
:cache-test #'eq)
(display-line pane (start-mark (element* lines i))))))))))
- (when (mark-visible-p pane) (display-mark pane syntax))
+ (when (region-visible-p pane) (display-region pane syntax))
(display-cursor pane syntax current-p))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
--- /project/climacs/cvsroot/climacs/html-syntax.lisp 2005/08/15 23:31:22 1.32
+++ /project/climacs/cvsroot/climacs/html-syntax.lisp 2006/05/06 19:51:04 1.33
@@ -798,6 +798,6 @@
do (let ((token (lexeme lexer start-token-index)))
(display-parse-tree token syntax pane))
(incf start-token-index))))))))
- (when (mark-visible-p pane) (display-mark pane syntax))
+ (when (region-visible-p pane) (display-region pane syntax))
(display-cursor pane syntax current-p)))
--- /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/05/06 17:23:33 1.65
+++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/05/06 19:51:04 1.66
@@ -1590,7 +1590,7 @@
(let ((*current-faces* *standard-faces*))
(with-slots (stack-top) syntax
(display-parse-tree stack-top syntax pane)))
- (when (mark-visible-p pane) (display-mark pane syntax))
+ (when (region-visible-p pane) (display-region pane syntax))
(display-cursor pane syntax current-p))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
--- /project/climacs/cvsroot/climacs/misc-commands.lisp 2006/05/06 15:38:42 1.10
+++ /project/climacs/cvsroot/climacs/misc-commands.lisp 2006/05/06 19:51:04 1.11
@@ -1538,7 +1538,6 @@
'marking-table
'((#\h :control :meta)))
-(define-command (com-visible-mark :name t :command-table marking-table) ()
- "Toggle the visibility of the mark in the current pane.
-This is particularly (only?) useful for experimenting with marking commands."
- (setf (mark-visible-p (current-window)) (not (mark-visible-p (current-window)))))
+(define-command (com-visible-region :name t :command-table marking-table) ()
+ "Toggle the visibility of the region in the current pane."
+ (setf (region-visible-p (current-window)) (not (region-visible-p (current-window)))))
--- /project/climacs/cvsroot/climacs/packages.lisp 2006/05/06 06:27:14 1.92
+++ /project/climacs/cvsroot/climacs/packages.lisp 2006/05/06 19:51:04 1.93
@@ -152,7 +152,7 @@
#:clear-cache
#:redisplay-pane #:full-redisplay
#:display-cursor
- #:display-mark
+ #:display-region
#:page-down #:page-up
#:top #:bot
#:tab-space-count #:space-width #:tab-width
@@ -163,7 +163,7 @@
#:isearch-mode #:isearch-states #:isearch-previous-string
#:query-replace-state #:string1 #:string2
#:query-replace-mode
- #:mark-visible-p
+ #:region-visible-p
#:with-undo
#:url
#:climacs-textual-view #:+climacs-textual-view+))
--- /project/climacs/cvsroot/climacs/pane.lisp 2006/05/06 06:27:14 1.38
+++ /project/climacs/cvsroot/climacs/pane.lisp 2006/05/06 19:51:04 1.39
@@ -280,7 +280,7 @@
(isearch-previous-string :initform nil :accessor isearch-previous-string)
(query-replace-mode :initform nil :accessor query-replace-mode)
(query-replace-state :initform nil :accessor query-replace-state)
- (mark-visible-p :initform nil :accessor mark-visible-p)
+ (region-visible-p :initform nil :accessor region-visible-p)
(full-redisplay-p :initform nil :accessor full-redisplay-p)
(cache :initform (let ((cache (make-instance 'standard-flexichain)))
(insert* cache 0 nil)
@@ -564,7 +564,7 @@
(defmethod redisplay-pane-with-syntax ((pane climacs-pane) (syntax basic-syntax) current-p)
(display-cache pane)
- (when (mark-visible-p pane) (display-mark pane syntax))
+ (when (region-visible-p pane) (display-region pane syntax))
(display-cursor pane syntax current-p))
(defgeneric redisplay-pane (pane current-p))
@@ -589,43 +589,118 @@
(defgeneric display-cursor (pane syntax current-p))
(defmethod display-cursor ((pane climacs-pane) (syntax basic-syntax) current-p)
- (with-slots (top) pane
- (let* ((cursor-line (number-of-lines-in-region top (point pane)))
- (style (medium-text-style pane))
- (ascent (text-style-ascent style pane))
- (descent (text-style-descent style pane))
- (height (+ ascent descent))
- (cursor-y (+ (* cursor-line (+ height (stream-vertical-spacing pane)))))
- (cursor-column
- (buffer-display-column
- (buffer (point pane)) (offset (point pane))
- (round (tab-width pane) (space-width pane))))
- (cursor-x (* cursor-column (text-style-width (medium-text-style pane) pane))))
+ (let ((point (point pane)))
+ (multiple-value-bind (cursor-x cursor-y line-height)
+ (offset-to-screen-position (offset point) pane)
(updating-output (pane :unique-id -1)
(draw-rectangle* pane
(1- cursor-x) cursor-y
- (+ cursor-x 2) (+ cursor-y ascent descent)
+ (+ cursor-x 2) (+ cursor-y line-height)
:ink (if current-p +red+ +blue+))))))
-(defgeneric display-mark (pane syntax))
+(defgeneric display-region (pane syntax))
-(defmethod display-mark ((pane climacs-pane) (syntax basic-syntax))
+(defmethod display-region ((pane climacs-pane) (syntax basic-syntax))
+ (multiple-value-bind (cursor-x cursor-y line-height)
+ (offset-to-screen-position (offset (point pane)) pane)
+ (multiple-value-bind (mark-x mark-y)
+ (offset-to-screen-position (offset (mark pane)) pane)
+ (cond
+ ;; 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 (compose-in +green+
+ (make-opacity .1)))
+ (draw-rectangle* pane
+ 0 cursor-y
+ cursor-x (+ cursor-y line-height)
+ :ink (compose-in +green+
+ (make-opacity .1)))))
+ ;; 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 (compose-in +green+
+ (make-opacity .1)))
+ (draw-rectangle* pane
+ cursor-x cursor-y
+ (stream-text-margin pane) (+ cursor-y line-height)
+ :ink (compose-in +green+
+ (make-opacity .1)))))
+ ;; 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)
+ (draw-rectangle* pane
+ mark-x mark-y
+ cursor-x (+ cursor-y line-height)
+ :ink (compose-in +green+
+ (make-opacity .1)))))
+ ;; 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 (compose-in +green+
+ (make-opacity .1)))
+ (draw-rectangle* pane
+ 0 cursor-y
+ cursor-x (+ cursor-y line-height)
+ :ink (compose-in +green+
+ (make-opacity .1)))
+ (draw-rectangle* pane
+ 0 (+ mark-y line-height)
+ (stream-text-margin pane) cursor-y
+ :ink (compose-in +green+
+ (make-opacity .1)))))
+ ;; 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 (compose-in +green+
+ (make-opacity .1)))
+ (draw-rectangle* pane
+ 0 mark-y
+ mark-x (+ mark-y line-height)
+ :ink (compose-in +green+
+ (make-opacity .1)))
+ (draw-rectangle* pane
+ 0 (+ cursor-y line-height)
+ (stream-text-margin pane) mark-y
+ :ink (compose-in +green+
+ (make-opacity .1)))))))))
+
+(defun offset-to-screen-position (offset pane)
+ "Returns the position of offset as a screen position.
+Returns X Y LINE-HEIGHT CHAR-WIDTH as values if offset is on the screen,
+NIL if offset is before the beginning of the screen,
+and T if offset is after the end of the screen."
(with-slots (top bot) pane
- (let ((mark (mark pane)))
- (when (<= (offset top) (offset mark) (offset bot))
- (let* ((mark-line (number-of-lines-in-region top mark))
- (style (medium-text-style pane))
- (ascent (text-style-ascent style pane))
- (descent (text-style-descent style pane))
- (height (+ ascent descent))
- (mark-y (+ (* mark-line (+ height (stream-vertical-spacing pane)))))
- (mark-column
- (buffer-display-column
- (buffer mark) (offset mark)
- (round (tab-width pane) (space-width pane))))
- (mark-x (* mark-column (text-style-width (medium-text-style pane) pane))))
- (updating-output (pane :unique-id -2)
- (draw-rectangle* pane
- (1- mark-x) mark-y
- (+ mark-x 2) (+ mark-y ascent descent)
- :ink +green+)))))))
\ No newline at end of file
+ (cond
+ ((< offset (offset top)) nil)
+ ((< (offset bot) offset) t)
+ (t
+ (let* ((line (number-of-lines-in-region top offset))
+ (style (medium-text-style pane))
+ (style-width (text-style-width style pane))
+ (ascent (text-style-ascent style pane))
+ (descent (text-style-descent style pane))
+ (height (+ ascent descent))
+ (y (+ (* line (+ height (stream-vertical-spacing pane)))))
+ (column
+ (buffer-display-column
+ (buffer pane) offset
+ (round (tab-width pane) (space-width pane))))
+ (x (* column style-width)))
+ (values x y height style-width))))))
\ No newline at end of file
--- /project/climacs/cvsroot/climacs/prolog-syntax.lisp 2006/03/03 19:38:57 1.26
+++ /project/climacs/cvsroot/climacs/prolog-syntax.lisp 2006/05/06 19:51:04 1.27
@@ -1310,7 +1310,7 @@
do (let ((token (lexeme lexer start-token-index)))
(display-parse-tree token syntax pane))
(incf start-token-index))))))))
- (when (mark-visible-p pane) (display-mark pane syntax))
+ (when (region-visible-p pane) (display-region pane syntax))
(display-cursor pane syntax current-p)))
#|
--- /project/climacs/cvsroot/climacs/slidemacs.lisp 2006/03/03 19:38:57 1.8
+++ /project/climacs/cvsroot/climacs/slidemacs.lisp 2006/05/06 19:51:04 1.9
@@ -454,5 +454,5 @@
do (let ((token (lexeme lexer start-token-index)))
(display-parse-tree token syntax pane))
(incf start-token-index))))))))
- (when (mark-visible-p pane) (display-mark pane syntax))
+ (when (region-visible-p pane) (display-region pane syntax))
(display-cursor pane syntax current-p)))
--- /project/climacs/cvsroot/climacs/ttcn3-syntax.lisp 2006/03/03 19:38:57 1.4
+++ /project/climacs/cvsroot/climacs/ttcn3-syntax.lisp 2006/05/06 19:51:04 1.5
@@ -452,6 +452,6 @@
do (let ((token (lexeme lexer start-token-index)))
(display-parse-tree token syntax pane))
(incf start-token-index))))))))
- (when (mark-visible-p pane) (display-mark pane syntax))
+ (when (region-visible-p pane) (display-region pane syntax))
(display-cursor pane syntax current-p)))
More information about the Climacs-cvs
mailing list