Mercurial > emacs
comparison lisp/emulation/cua-rect.el @ 56896:77bbb90bd021
(cua--rectangle-set-corners): Ensure that
point is set (and displayed) inside rectangle.
(cua--rectangle-operation): Fix for highlight of empty lines.
(cua--highlight-rectangle): Fix highlight for tabs.
Position cursor at left/right edge of rectangle using new `cursor'
property on overlay strings.
(cua--indent-rectangle): Don't tabify.
(cua-rotate-rectangle): Ignore that point has moved.
| author | Kim F. Storm <storm@cua.dk> |
|---|---|
| date | Thu, 02 Sep 2004 22:56:22 +0000 |
| parents | c1345747d0db |
| children | 8d62e1b62c44 |
comparison
equal
deleted
inserted
replaced
| 56895:b4c980745e7f | 56896:77bbb90bd021 |
|---|---|
| 272 mp (cua--rectangle-top) mc (cua--rectangle-left)))) | 272 mp (cua--rectangle-top) mc (cua--rectangle-left)))) |
| 273 (goto-char mp) | 273 (goto-char mp) |
| 274 (move-to-column mc) | 274 (move-to-column mc) |
| 275 (set-mark (point)) | 275 (set-mark (point)) |
| 276 (goto-char pp) | 276 (goto-char pp) |
| 277 (move-to-column pc) | 277 (if (and (if (cua--rectangle-right-side) |
| 278 (= (move-to-column pc) (- pc tab-width)) | |
| 279 (> (move-to-column pc) pc)) | |
| 280 (not (bolp))) | |
| 281 (backward-char 1)) | |
| 278 )) | 282 )) |
| 279 | 283 |
| 280 ;;; Rectangle resizing | 284 ;;; Rectangle resizing |
| 281 | 285 |
| 282 (defun cua--forward-line (n) | 286 (defun cua--forward-line (n) |
| 567 (when (eq visible t) | 571 (when (eq visible t) |
| 568 (setq start (max (window-start) start)) | 572 (setq start (max (window-start) start)) |
| 569 (setq end (min (window-end) end))) | 573 (setq end (min (window-end) end))) |
| 570 (goto-char end) | 574 (goto-char end) |
| 571 (setq end (line-end-position)) | 575 (setq end (line-end-position)) |
| 576 (if (and visible (bolp) (not (eobp))) | |
| 577 (setq end (1+ end))) | |
| 572 (goto-char start) | 578 (goto-char start) |
| 573 (setq start (line-beginning-position)) | 579 (setq start (line-beginning-position)) |
| 574 (narrow-to-region start end) | 580 (narrow-to-region start end) |
| 575 (goto-char (point-min)) | 581 (goto-char (point-min)) |
| 576 (while (< (point) (point-max)) | 582 (while (< (point) (point-max)) |
| 759 (when (/= left right) | 765 (when (/= left right) |
| 760 (sit-for 0) ; make window top/bottom reliable | 766 (sit-for 0) ; make window top/bottom reliable |
| 761 (cua--rectangle-operation nil t nil nil nil ; do not tabify | 767 (cua--rectangle-operation nil t nil nil nil ; do not tabify |
| 762 '(lambda (s e l r v) | 768 '(lambda (s e l r v) |
| 763 (let ((rface (if v 'cua-rectangle-face 'cua-rectangle-noselect-face)) | 769 (let ((rface (if v 'cua-rectangle-face 'cua-rectangle-noselect-face)) |
| 764 overlay bs as) | 770 overlay bs ms as) |
| 765 (if (= s e) (setq e (1+ e))) | 771 (if (= s e) (setq e (1+ e))) |
| 766 (when (cua--rectangle-virtual-edges) | 772 (when (cua--rectangle-virtual-edges) |
| 767 (let ((lb (line-beginning-position)) | 773 (let ((lb (line-beginning-position)) |
| 768 (le (line-end-position)) | 774 (le (line-end-position)) |
| 769 cl cl0 pl cr cr0 pr) | 775 cl cl0 pl cr cr0 pr) |
| 789 'face 'default)) | 795 'face 'default)) |
| 790 (if (/= pl le) | 796 (if (/= pl le) |
| 791 (setq s (1- s)))) | 797 (setq s (1- s)))) |
| 792 (cond | 798 (cond |
| 793 ((= cr r) | 799 ((= cr r) |
| 794 (if (and (/= cr0 (1- cr)) | 800 (if (and (/= pr le) |
| 795 (= (mod cr tab-width) 0)) | 801 (/= cr0 (1- cr)) |
| 802 (or bs (/= cr0 (- cr tab-width))) | |
| 803 (/= (mod cr tab-width) 0)) | |
| 796 (setq e (1- e)))) | 804 (setq e (1- e)))) |
| 797 ((= cr cl) | 805 ((= cr cl) |
| 798 (setq bs (concat bs | 806 (setq ms (propertize |
| 799 (propertize | 807 (make-string |
| 800 (make-string | 808 (- r l) |
| 801 (- r l) | 809 (if cua--virtual-edges-debug ?, ?\s)) |
| 802 (if cua--virtual-edges-debug ?, ?\s)) | 810 'face rface)) |
| 803 'face rface))) | 811 (if (cua--rectangle-right-side) |
| 812 (put-text-property (1- (length ms)) (length ms) 'cursor t ms) | |
| 813 (put-text-property 0 1 'cursor t ms)) | |
| 814 (setq bs (concat bs ms)) | |
| 804 (setq rface nil)) | 815 (setq rface nil)) |
| 805 (t | 816 (t |
| 806 (setq as (propertize | 817 (setq as (propertize |
| 807 (make-string | 818 (make-string |
| 808 (- r cr0 (if (= le pr) 1 0)) | 819 (- r cr0 (if (= le pr) 1 0)) |
| 809 (if cua--virtual-edges-debug ?~ ?\s)) | 820 (if cua--virtual-edges-debug ?~ ?\s)) |
| 810 'face rface)) | 821 'face rface)) |
| 822 (if (cua--rectangle-right-side) | |
| 823 (put-text-property (1- (length as)) (length as) 'cursor t as) | |
| 824 (put-text-property 0 1 'cursor t as)) | |
| 811 (if (/= pr le) | 825 (if (/= pr le) |
| 812 (setq e (1- e)))))))) | 826 (setq e (1- e)))))))) |
| 813 ;; Trim old leading overlays. | 827 ;; Trim old leading overlays. |
| 814 (while (and old | 828 (while (and old |
| 815 (setq overlay (car old)) | 829 (setq overlay (car old)) |
| 824 (= (overlay-end overlay) e))) | 838 (= (overlay-end overlay) e))) |
| 825 (progn | 839 (progn |
| 826 (move-overlay overlay s e) | 840 (move-overlay overlay s e) |
| 827 (setq old (cdr old))) | 841 (setq old (cdr old))) |
| 828 (setq overlay (make-overlay s e))) | 842 (setq overlay (make-overlay s e))) |
| 829 (overlay-put overlay 'before-string bs) | 843 (overlay-put overlay 'before-string bs) |
| 830 (overlay-put overlay 'after-string as) | 844 (overlay-put overlay 'after-string as) |
| 831 (overlay-put overlay 'face rface) | 845 (overlay-put overlay 'face rface) |
| 832 (setq new (cons overlay new)))))) | 846 (setq new (cons overlay new)))))) |
| 833 ;; Trim old trailing overlays. | 847 ;; Trim old trailing overlays. |
| 834 (mapcar (function delete-overlay) old) | 848 (mapcar (function delete-overlay) old) |
| 837 (defun cua--indent-rectangle (&optional ch to-col clear) | 851 (defun cua--indent-rectangle (&optional ch to-col clear) |
| 838 ;; Indent current rectangle. | 852 ;; Indent current rectangle. |
| 839 (let ((col (cua--rectangle-insert-col)) | 853 (let ((col (cua--rectangle-insert-col)) |
| 840 (pad (cua--rectangle-virtual-edges)) | 854 (pad (cua--rectangle-virtual-edges)) |
| 841 indent) | 855 indent) |
| 842 (cua--rectangle-operation (if clear 'clear 'corners) nil t pad t | 856 (cua--rectangle-operation (if clear 'clear 'corners) nil t pad nil |
| 843 '(lambda (s e l r) | 857 '(lambda (s e l r) |
| 844 (move-to-column col pad) | 858 (move-to-column col pad) |
| 845 (if (and (eolp) | 859 (if (and (eolp) |
| 846 (< (current-column) col)) | 860 (< (current-column) col)) |
| 847 (move-to-column col t)) | 861 (move-to-column col t)) |
| 973 (cua--deactivate)) | 987 (cua--deactivate)) |
| 974 | 988 |
| 975 (defun cua-rotate-rectangle () | 989 (defun cua-rotate-rectangle () |
| 976 (interactive) | 990 (interactive) |
| 977 (cua--rectangle-corner (if (= (cua--rectangle-left) (cua--rectangle-right)) 0 1)) | 991 (cua--rectangle-corner (if (= (cua--rectangle-left) (cua--rectangle-right)) 0 1)) |
| 978 (cua--rectangle-set-corners)) | 992 (cua--rectangle-set-corners) |
| 993 (if (cua--rectangle-virtual-edges) | |
| 994 (setq cua--buffer-and-point-before-command nil))) | |
| 979 | 995 |
| 980 (defun cua-toggle-rectangle-virtual-edges () | 996 (defun cua-toggle-rectangle-virtual-edges () |
| 981 (interactive) | 997 (interactive) |
| 982 (cua--rectangle-virtual-edges t (not (cua--rectangle-virtual-edges))) | 998 (cua--rectangle-virtual-edges t (not (cua--rectangle-virtual-edges))) |
| 983 (cua--rectangle-set-corners) | 999 (cua--rectangle-set-corners) |