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