[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/emulation/cua-rect.el [emacs-unicode
From: |
Miles Bader |
Subject: |
[Emacs-diffs] Changes to emacs/lisp/emulation/cua-rect.el [emacs-unicode-2] |
Date: |
Sat, 04 Sep 2004 05:28:58 -0400 |
Index: emacs/lisp/emulation/cua-rect.el
diff -c emacs/lisp/emulation/cua-rect.el:1.7.6.2
emacs/lisp/emulation/cua-rect.el:1.7.6.3
*** emacs/lisp/emulation/cua-rect.el:1.7.6.2 Mon Jun 28 07:29:46 2004
--- emacs/lisp/emulation/cua-rect.el Sat Sep 4 09:14:25 2004
***************
*** 44,53 ****
(require 'rect)
;; If non-nil, restrict current region to this rectangle.
! ;; Value is a vector [top bot left right corner ins pad select].
;; CORNER specifies currently active corner 0=t/l 1=t/r 2=b/l 3=b/r.
;; INS specifies whether to insert on left(nil) or right(t) side.
! ;; If PAD is non-nil, tabs are converted to spaces when necessary.
;; If SELECT is a regexp, only lines starting with that regexp are affected.")
(defvar cua--rectangle nil)
(make-variable-buffer-local 'cua--rectangle)
--- 44,53 ----
(require 'rect)
;; If non-nil, restrict current region to this rectangle.
! ;; Value is a vector [top bot left right corner ins virt select].
;; CORNER specifies currently active corner 0=t/l 1=t/r 2=b/l 3=b/r.
;; INS specifies whether to insert on left(nil) or right(t) side.
! ;; If VIRT is non-nil, virtual straight edges are enabled.
;; If SELECT is a regexp, only lines starting with that regexp are affected.")
(defvar cua--rectangle nil)
(make-variable-buffer-local 'cua--rectangle)
***************
*** 65,70 ****
--- 65,76 ----
(defvar cua--rectangle-overlays nil)
(make-variable-buffer-local 'cua--rectangle-overlays)
+ (defvar cua--overlay-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\r" 'cua-rotate-rectangle)))
+
+ (defvar cua--virtual-edges-debug nil)
+
;; Per-buffer CUA mode undo list.
(defvar cua--undo-list nil)
(make-variable-buffer-local 'cua--undo-list)
***************
*** 97,103 ****
(defvar cua--tidy-undo-counter 0
"Number of times `cua--tidy-undo-lists' have run successfully.")
! ;; Clean out danling entries from cua's undo list.
;; Since this list contains pointers into the standard undo list,
;; such references are only meningful as undo information if the
;; corresponding entry is still on the standard undo list.
--- 103,109 ----
(defvar cua--tidy-undo-counter 0
"Number of times `cua--tidy-undo-lists' have run successfully.")
! ;; Clean out dangling entries from cua's undo list.
;; Since this list contains pointers into the standard undo list,
;; such references are only meningful as undo information if the
;; corresponding entry is still on the standard undo list.
***************
*** 203,213 ****
(aref cua--rectangle 5))
(cua--rectangle-left))))
! (defun cua--rectangle-padding (&optional set val)
! ;; Current setting of rectangle padding
(if set
(aset cua--rectangle 6 val))
! (and (not buffer-read-only)
(aref cua--rectangle 6)))
(defun cua--rectangle-restriction (&optional val bounded negated)
--- 209,219 ----
(aref cua--rectangle 5))
(cua--rectangle-left))))
! (defun cua--rectangle-virtual-edges (&optional set val)
! ;; Current setting of rectangle virtual-edges
(if set
(aset cua--rectangle 6 val))
! (and ;(not buffer-read-only)
(aref cua--rectangle 6)))
(defun cua--rectangle-restriction (&optional val bounded negated)
***************
*** 226,232 ****
(if (< (cua--rectangle-bot) (cua--rectangle-top))
(message "rectangle bot < top")))
! (defun cua--rectangle-get-corners (&optional pad)
;; Calculate the rectangular region represented by point and mark,
;; putting start in the upper left corner and end in the
;; bottom right corner.
--- 232,238 ----
(if (< (cua--rectangle-bot) (cua--rectangle-top))
(message "rectangle bot < top")))
! (defun cua--rectangle-get-corners ()
;; Calculate the rectangular region represented by point and mark,
;; putting start in the upper left corner and end in the
;; bottom right corner.
***************
*** 245,256 ****
(setq r (1- r)))
(setq l (prog1 r (setq r l)))
(goto-char top)
! (move-to-column l pad)
(setq top (point))
(goto-char bot)
! (move-to-column r pad)
(setq bot (point))))
! (vector top bot l r corner 0 pad nil)))
(defun cua--rectangle-set-corners ()
;; Set mark and point in opposite corners of current rectangle.
--- 251,262 ----
(setq r (1- r)))
(setq l (prog1 r (setq r l)))
(goto-char top)
! (move-to-column l)
(setq top (point))
(goto-char bot)
! (move-to-column r)
(setq bot (point))))
! (vector top bot l r corner 0 cua-virtual-rectangle-edges nil)))
(defun cua--rectangle-set-corners ()
;; Set mark and point in opposite corners of current rectangle.
***************
*** 269,292 ****
(setq pp (cua--rectangle-bot) pc (cua--rectangle-right)
mp (cua--rectangle-top) mc (cua--rectangle-left))))
(goto-char mp)
! (move-to-column mc (cua--rectangle-padding))
(set-mark (point))
(goto-char pp)
! (move-to-column pc (cua--rectangle-padding))))
;;; Rectangle resizing
! (defun cua--forward-line (n pad)
;; Move forward/backward one line. Returns t if movement.
! (if (or (not pad) (< n 0))
! (= (forward-line n) 0)
! (next-line 1)
! t))
(defun cua--rectangle-resized ()
;; Refresh state after resizing rectangle
(setq cua--buffer-and-point-before-command nil)
- (cua--pad-rectangle)
(cua--rectangle-insert-col 0)
(cua--rectangle-set-corners)
(cua--keep-active))
--- 275,305 ----
(setq pp (cua--rectangle-bot) pc (cua--rectangle-right)
mp (cua--rectangle-top) mc (cua--rectangle-left))))
(goto-char mp)
! (move-to-column mc)
(set-mark (point))
(goto-char pp)
! ;; Move cursor inside rectangle, except if char at rigth edge is a tab.
! (if (and (if (cua--rectangle-right-side)
! (and (= (move-to-column pc) (- pc tab-width))
! (not (eolp)))
! (> (move-to-column pc) pc))
! (not (bolp)))
! (backward-char 1))
! ))
;;; Rectangle resizing
! (defun cua--forward-line (n)
;; Move forward/backward one line. Returns t if movement.
! (let ((pt (point)))
! (and (= (forward-line n) 0)
! ;; Deal with end of buffer
! (or (not (eobp))
! (goto-char pt)))))
(defun cua--rectangle-resized ()
;; Refresh state after resizing rectangle
(setq cua--buffer-and-point-before-command nil)
(cua--rectangle-insert-col 0)
(cua--rectangle-set-corners)
(cua--keep-active))
***************
*** 294,340 ****
(defun cua-resize-rectangle-right (n)
"Resize rectangle to the right."
(interactive "p")
! (let ((pad (cua--rectangle-padding)) (resized (> n 0)))
(while (> n 0)
(setq n (1- n))
(cond
- ((and (cua--rectangle-right-side) (or pad (eolp)))
- (cua--rectangle-right (1+ (cua--rectangle-right)))
- (move-to-column (cua--rectangle-right) pad))
((cua--rectangle-right-side)
! (forward-char 1)
! (cua--rectangle-right (current-column)))
! ((or pad (eolp))
! (cua--rectangle-left (1+ (cua--rectangle-left)))
! (move-to-column (cua--rectangle-right) pad))
(t
! (forward-char 1)
! (cua--rectangle-left (current-column)))))
(if resized
(cua--rectangle-resized))))
(defun cua-resize-rectangle-left (n)
"Resize rectangle to the left."
(interactive "p")
! (let ((pad (cua--rectangle-padding)) resized)
(while (> n 0)
(setq n (1- n))
(if (or (= (cua--rectangle-right) 0)
(and (not (cua--rectangle-right-side)) (= (cua--rectangle-left)
0)))
(setq n 0)
(cond
- ((and (cua--rectangle-right-side) (or pad (eolp) (bolp)))
- (cua--rectangle-right (1- (cua--rectangle-right)))
- (move-to-column (cua--rectangle-right) pad))
((cua--rectangle-right-side)
! (backward-char 1)
! (cua--rectangle-right (current-column)))
! ((or pad (eolp) (bolp))
! (cua--rectangle-left (1- (cua--rectangle-left)))
! (move-to-column (cua--rectangle-right) pad))
(t
! (backward-char 1)
! (cua--rectangle-left (current-column))))
(setq resized t)))
(if resized
(cua--rectangle-resized))))
--- 307,341 ----
(defun cua-resize-rectangle-right (n)
"Resize rectangle to the right."
(interactive "p")
! (let ((resized (> n 0)))
(while (> n 0)
(setq n (1- n))
(cond
((cua--rectangle-right-side)
! (cua--rectangle-right (1+ (cua--rectangle-right)))
! (move-to-column (cua--rectangle-right)))
(t
! (cua--rectangle-left (1+ (cua--rectangle-left)))
! (move-to-column (cua--rectangle-right)))))
(if resized
(cua--rectangle-resized))))
(defun cua-resize-rectangle-left (n)
"Resize rectangle to the left."
(interactive "p")
! (let (resized)
(while (> n 0)
(setq n (1- n))
(if (or (= (cua--rectangle-right) 0)
(and (not (cua--rectangle-right-side)) (= (cua--rectangle-left)
0)))
(setq n 0)
(cond
((cua--rectangle-right-side)
! (cua--rectangle-right (1- (cua--rectangle-right)))
! (move-to-column (cua--rectangle-right)))
(t
! (cua--rectangle-left (1- (cua--rectangle-left)))
! (move-to-column (cua--rectangle-right))))
(setq resized t)))
(if resized
(cua--rectangle-resized))))
***************
*** 342,361 ****
(defun cua-resize-rectangle-down (n)
"Resize rectangle downwards."
(interactive "p")
! (let ((pad (cua--rectangle-padding)) resized)
(while (> n 0)
(setq n (1- n))
(cond
((>= (cua--rectangle-corner) 2)
(goto-char (cua--rectangle-bot))
! (when (cua--forward-line 1 pad)
! (move-to-column (cua--rectangle-column) pad)
(cua--rectangle-bot t)
(setq resized t)))
(t
(goto-char (cua--rectangle-top))
! (when (cua--forward-line 1 pad)
! (move-to-column (cua--rectangle-column) pad)
(cua--rectangle-top t)
(setq resized t)))))
(if resized
--- 343,362 ----
(defun cua-resize-rectangle-down (n)
"Resize rectangle downwards."
(interactive "p")
! (let (resized)
(while (> n 0)
(setq n (1- n))
(cond
((>= (cua--rectangle-corner) 2)
(goto-char (cua--rectangle-bot))
! (when (cua--forward-line 1)
! (move-to-column (cua--rectangle-column))
(cua--rectangle-bot t)
(setq resized t)))
(t
(goto-char (cua--rectangle-top))
! (when (cua--forward-line 1)
! (move-to-column (cua--rectangle-column))
(cua--rectangle-top t)
(setq resized t)))))
(if resized
***************
*** 364,383 ****
(defun cua-resize-rectangle-up (n)
"Resize rectangle upwards."
(interactive "p")
! (let ((pad (cua--rectangle-padding)) resized)
(while (> n 0)
(setq n (1- n))
(cond
((>= (cua--rectangle-corner) 2)
(goto-char (cua--rectangle-bot))
! (when (cua--forward-line -1 pad)
! (move-to-column (cua--rectangle-column) pad)
(cua--rectangle-bot t)
(setq resized t)))
(t
(goto-char (cua--rectangle-top))
! (when (cua--forward-line -1 pad)
! (move-to-column (cua--rectangle-column) pad)
(cua--rectangle-top t)
(setq resized t)))))
(if resized
--- 365,384 ----
(defun cua-resize-rectangle-up (n)
"Resize rectangle upwards."
(interactive "p")
! (let (resized)
(while (> n 0)
(setq n (1- n))
(cond
((>= (cua--rectangle-corner) 2)
(goto-char (cua--rectangle-bot))
! (when (cua--forward-line -1)
! (move-to-column (cua--rectangle-column))
(cua--rectangle-bot t)
(setq resized t)))
(t
(goto-char (cua--rectangle-top))
! (when (cua--forward-line -1)
! (move-to-column (cua--rectangle-column))
(cua--rectangle-top t)
(setq resized t)))))
(if resized
***************
*** 408,414 ****
"Resize rectangle to bottom of buffer."
(interactive)
(goto-char (point-max))
! (move-to-column (cua--rectangle-column) (cua--rectangle-padding))
(cua--rectangle-bot t)
(cua--rectangle-resized))
--- 409,415 ----
"Resize rectangle to bottom of buffer."
(interactive)
(goto-char (point-max))
! (move-to-column (cua--rectangle-column))
(cua--rectangle-bot t)
(cua--rectangle-resized))
***************
*** 416,446 ****
"Resize rectangle to top of buffer."
(interactive)
(goto-char (point-min))
! (move-to-column (cua--rectangle-column) (cua--rectangle-padding))
(cua--rectangle-top t)
(cua--rectangle-resized))
(defun cua-resize-rectangle-page-up ()
"Resize rectangle upwards by one scroll page."
(interactive)
! (let ((pad (cua--rectangle-padding)))
! (scroll-down)
! (move-to-column (cua--rectangle-column) pad)
! (if (>= (cua--rectangle-corner) 2)
! (cua--rectangle-bot t)
! (cua--rectangle-top t))
! (cua--rectangle-resized)))
(defun cua-resize-rectangle-page-down ()
"Resize rectangle downwards by one scroll page."
(interactive)
! (let ((pad (cua--rectangle-padding)))
! (scroll-up)
! (move-to-column (cua--rectangle-column) pad)
! (if (>= (cua--rectangle-corner) 2)
! (cua--rectangle-bot t)
! (cua--rectangle-top t))
! (cua--rectangle-resized)))
;;; Mouse support
--- 417,445 ----
"Resize rectangle to top of buffer."
(interactive)
(goto-char (point-min))
! (move-to-column (cua--rectangle-column))
(cua--rectangle-top t)
(cua--rectangle-resized))
(defun cua-resize-rectangle-page-up ()
"Resize rectangle upwards by one scroll page."
(interactive)
! (scroll-down)
! (move-to-column (cua--rectangle-column))
! (if (>= (cua--rectangle-corner) 2)
! (cua--rectangle-bot t)
! (cua--rectangle-top t))
! (cua--rectangle-resized))
(defun cua-resize-rectangle-page-down ()
"Resize rectangle downwards by one scroll page."
(interactive)
! (scroll-up)
! (move-to-column (cua--rectangle-column))
! (if (>= (cua--rectangle-corner) 2)
! (cua--rectangle-bot t)
! (cua--rectangle-top t))
! (cua--rectangle-resized))
;;; Mouse support
***************
*** 450,456 ****
"Set rectangle corner at mouse click position."
(interactive "e")
(mouse-set-point event)
! (if (cua--rectangle-padding)
(move-to-column (car (posn-col-row (event-end event))) t))
(if (cua--rectangle-right-side)
(cua--rectangle-right (current-column))
--- 449,456 ----
"Set rectangle corner at mouse click position."
(interactive "e")
(mouse-set-point event)
! ;; FIX ME -- need to calculate virtual column.
! (if (cua--rectangle-virtual-edges)
(move-to-column (car (posn-col-row (event-end event))) t))
(if (cua--rectangle-right-side)
(cua--rectangle-right (current-column))
***************
*** 470,475 ****
--- 470,476 ----
(cua--deactivate t))
(setq cua--last-rectangle nil)
(mouse-set-point event)
+ ;; FIX ME -- need to calculate virtual column.
(cua-set-rectangle-mark)
(setq cua--buffer-and-point-before-command nil)
(setq cua--mouse-last-pos nil))
***************
*** 489,501 ****
(let ((cua-keep-region-after-copy t))
(cua-copy-rectangle arg)
(setq cua--mouse-last-pos (cons (point) cua--last-killed-rectangle)))))
(defun cua--mouse-ignore (event)
(interactive "e")
(setq this-command last-command))
(defun cua--rectangle-move (dir)
! (let ((pad (cua--rectangle-padding))
! (moved t)
(top (cua--rectangle-top))
(bot (cua--rectangle-bot))
(l (cua--rectangle-left))
--- 490,502 ----
(let ((cua-keep-region-after-copy t))
(cua-copy-rectangle arg)
(setq cua--mouse-last-pos (cons (point) cua--last-killed-rectangle)))))
+
(defun cua--mouse-ignore (event)
(interactive "e")
(setq this-command last-command))
(defun cua--rectangle-move (dir)
! (let ((moved t)
(top (cua--rectangle-top))
(bot (cua--rectangle-bot))
(l (cua--rectangle-left))
***************
*** 503,519 ****
(cond
((eq dir 'up)
(goto-char top)
! (when (cua--forward-line -1 pad)
(cua--rectangle-top t)
(goto-char bot)
(forward-line -1)
(cua--rectangle-bot t)))
((eq dir 'down)
(goto-char bot)
! (when (cua--forward-line 1 pad)
(cua--rectangle-bot t)
(goto-char top)
! (cua--forward-line 1 pad)
(cua--rectangle-top t)))
((eq dir 'left)
(when (> l 0)
--- 504,520 ----
(cond
((eq dir 'up)
(goto-char top)
! (when (cua--forward-line -1)
(cua--rectangle-top t)
(goto-char bot)
(forward-line -1)
(cua--rectangle-bot t)))
((eq dir 'down)
(goto-char bot)
! (when (cua--forward-line 1)
(cua--rectangle-bot t)
(goto-char top)
! (cua--forward-line 1)
(cua--rectangle-top t)))
((eq dir 'left)
(when (> l 0)
***************
*** 526,544 ****
(setq moved nil)))
(when moved
(setq cua--buffer-and-point-before-command nil)
- (cua--pad-rectangle)
(cua--rectangle-set-corners)
(cua--keep-active))))
;;; Operations on current rectangle
! (defun cua--rectangle-operation (keep-clear visible undo pad &optional fct
post-fct)
;; Call FCT for each line of region with 4 parameters:
;; Region start, end, left-col, right-col
;; Point is at start when FCT is called
;; Set undo boundary if UNDO is non-nil.
! ;; Rectangle is padded if PAD = t or numeric and (cua--rectangle-padding)
;; Mark is kept if keep-clear is 'keep and cleared if keep-clear is 'clear.
(let* ((start (cua--rectangle-top))
(end (cua--rectangle-bot))
--- 527,563 ----
(setq moved nil)))
(when moved
(setq cua--buffer-and-point-before-command nil)
(cua--rectangle-set-corners)
(cua--keep-active))))
;;; Operations on current rectangle
! (defun cua--tabify-start (start end)
! ;; Return position where auto-tabify should start (or nil if not required).
! (save-excursion
! (save-restriction
! (widen)
! (and (not buffer-read-only)
! cua-auto-tabify-rectangles
! (if (or (not (integerp cua-auto-tabify-rectangles))
! (= (point-min) (point-max))
! (progn
! (goto-char (max (point-min)
! (- start cua-auto-tabify-rectangles)))
! (search-forward "\t" (min (point-max)
! (+ end
cua-auto-tabify-rectangles)) t)))
! start)))))
!
! (defun cua--rectangle-operation (keep-clear visible undo pad tabify &optional
fct post-fct)
;; Call FCT for each line of region with 4 parameters:
;; Region start, end, left-col, right-col
;; Point is at start when FCT is called
+ ;; Call fct with (s,e) = whole lines if VISIBLE non-nil.
+ ;; Only call fct for visible lines if VISIBLE==t.
;; Set undo boundary if UNDO is non-nil.
! ;; Rectangle is padded if PAD = t or numeric and
(cua--rectangle-virtual-edges)
! ;; Perform auto-tabify after operation if TABIFY is non-nil.
;; Mark is kept if keep-clear is 'keep and cleared if keep-clear is 'clear.
(let* ((start (cua--rectangle-top))
(end (cua--rectangle-bot))
***************
*** 546,556 ****
(r (1+ (cua--rectangle-right)))
(m (make-marker))
(tabpad (and (integerp pad) (= pad 2)))
! (sel (cua--rectangle-restriction)))
(if undo
(cua--rectangle-undo-boundary))
(if (integerp pad)
! (setq pad (cua--rectangle-padding)))
(save-excursion
(save-restriction
(widen)
--- 565,576 ----
(r (1+ (cua--rectangle-right)))
(m (make-marker))
(tabpad (and (integerp pad) (= pad 2)))
! (sel (cua--rectangle-restriction))
! (tabify-start (and tabify (cua--tabify-start start end))))
(if undo
(cua--rectangle-undo-boundary))
(if (integerp pad)
! (setq pad (cua--rectangle-virtual-edges)))
(save-excursion
(save-restriction
(widen)
***************
*** 558,568 ****
(goto-char end)
(and (bolp) (not (eolp)) (not (eobp))
(setq end (1+ end))))
! (when visible
(setq start (max (window-start) start))
(setq end (min (window-end) end)))
(goto-char end)
(setq end (line-end-position))
(goto-char start)
(setq start (line-beginning-position))
(narrow-to-region start end)
--- 578,590 ----
(goto-char end)
(and (bolp) (not (eolp)) (not (eobp))
(setq end (1+ end))))
! (when (eq visible t)
(setq start (max (window-start) start))
(setq end (min (window-end) end)))
(goto-char end)
(setq end (line-end-position))
+ (if (and visible (bolp) (not (eobp)))
+ (setq end (1+ end)))
(goto-char start)
(setq start (line-beginning-position))
(narrow-to-region start end)
***************
*** 575,581 ****
(forward-char 1))
(set-marker m (point))
(move-to-column l pad)
! (if (and fct (>= (current-column) l) (<= (current-column) r))
(let ((v t) (p (point)))
(when sel
(if (car (cdr sel))
--- 597,603 ----
(forward-char 1))
(set-marker m (point))
(move-to-column l pad)
! (if (and fct (or visible (and (>= (current-column) l) (<=
(current-column) r))))
(let ((v t) (p (point)))
(when sel
(if (car (cdr sel))
***************
*** 585,592 ****
(if (car (cdr (cdr sel)))
(setq v (null v))))
(if visible
! (unless (eolp)
! (funcall fct p m l r v))
(if v
(funcall fct p m l r)))))
(set-marker m nil)
--- 607,613 ----
(if (car (cdr (cdr sel)))
(setq v (null v))))
(if visible
! (funcall fct p m l r v)
(if v
(funcall fct p m l r)))))
(set-marker m nil)
***************
*** 594,600 ****
(if (not visible)
(cua--rectangle-bot t))
(if post-fct
! (funcall post-fct l r))))
(cond
((eq keep-clear 'keep)
(cua--keep-active))
--- 615,623 ----
(if (not visible)
(cua--rectangle-bot t))
(if post-fct
! (funcall post-fct l r))
! (when tabify-start
! (tabify tabify-start (point)))))
(cond
((eq keep-clear 'keep)
(cua--keep-active))
***************
*** 607,654 ****
(put 'cua--rectangle-operation 'lisp-indent-function 4)
- (defun cua--pad-rectangle (&optional pad)
- (if (or pad (cua--rectangle-padding))
- (cua--rectangle-operation nil nil t t)))
-
(defun cua--delete-rectangle ()
! (cua--rectangle-operation nil nil t 2
! '(lambda (s e l r)
! (if (and (> e s) (<= e (point-max)))
! (delete-region s e)))))
(defun cua--extract-rectangle ()
(let (rect)
! (cua--rectangle-operation nil nil nil 1
! '(lambda (s e l r)
! (setq rect (cons (buffer-substring-no-properties s e) rect))))
! (nreverse rect)))
! (defun cua--insert-rectangle (rect &optional below)
;; Insert rectangle as insert-rectangle, but don't set mark and exit with
;; point at either next to top right or below bottom left corner
;; Notice: In overwrite mode, the rectangle is inserted as separate text
lines.
! (if (and below (eq below 'auto))
(setq below (and (bolp)
(or (eolp) (eobp) (= (1+ (point)) (point-max))))))
(let ((lines rect)
- (insertcolumn (current-column))
(first t)
p)
(while (or lines below)
(or first
(if overwrite-mode
(insert ?\n)
(forward-line 1)
! (or (bolp) (insert ?\n))
! (move-to-column insertcolumn t)))
(if (not lines)
(setq below nil)
(insert-for-yank (car lines))
(setq lines (cdr lines))
(and first (not below)
(setq p (point))))
! (setq first nil))
(and p (not overwrite-mode)
(goto-char p))))
--- 630,725 ----
(put 'cua--rectangle-operation 'lisp-indent-function 4)
(defun cua--delete-rectangle ()
! (let ((lines 0))
! (if (not (cua--rectangle-virtual-edges))
! (cua--rectangle-operation nil nil t 2 t
! '(lambda (s e l r v)
! (setq lines (1+ lines))
! (if (and (> e s) (<= e (point-max)))
! (delete-region s e))))
! (cua--rectangle-operation nil 1 t nil t
! '(lambda (s e l r v)
! (setq lines (1+ lines))
! (when (and (> e s) (<= e (point-max)))
! (delete-region s e)))))
! lines))
(defun cua--extract-rectangle ()
(let (rect)
! (if (not (cua--rectangle-virtual-edges))
! (cua--rectangle-operation nil nil nil nil nil ; do not tabify
! '(lambda (s e l r)
! (setq rect (cons (buffer-substring-no-properties s e) rect))))
! (cua--rectangle-operation nil 1 nil nil nil ; do not tabify
! '(lambda (s e l r v)
! (let ((copy t) (bs 0) (as 0) row)
! (if (= s e) (setq e (1+ e)))
! (goto-char s)
! (move-to-column l)
! (if (= (point) (line-end-position))
! (setq bs (- r l)
! copy nil)
! (skip-chars-forward "\s\t" e)
! (setq bs (- (min r (current-column)) l)
! s (point))
! (move-to-column r)
! (skip-chars-backward "\s\t" s)
! (setq as (- r (max (current-column) l))
! e (point)))
! (setq row (if (and copy (> e s))
! (buffer-substring-no-properties s e)
! ""))
! (when (> bs 0)
! (setq row (concat (make-string bs ?\s) row)))
! (when (> as 0)
! (setq row (concat row (make-string as ?\s))))
! (setq rect (cons row rect))))))
! (nreverse rect)))
! (defun cua--insert-rectangle (rect &optional below paste-column line-count)
;; Insert rectangle as insert-rectangle, but don't set mark and exit with
;; point at either next to top right or below bottom left corner
;; Notice: In overwrite mode, the rectangle is inserted as separate text
lines.
! (if (eq below 'auto)
(setq below (and (bolp)
(or (eolp) (eobp) (= (1+ (point)) (point-max))))))
+ (unless paste-column
+ (setq paste-column (current-column)))
(let ((lines rect)
(first t)
+ (tabify-start (cua--tabify-start (point) (point)))
+ last-column
p)
(while (or lines below)
(or first
(if overwrite-mode
(insert ?\n)
(forward-line 1)
! (or (bolp) (insert ?\n))))
! (unless overwrite-mode
! (move-to-column paste-column t))
(if (not lines)
(setq below nil)
(insert-for-yank (car lines))
+ (unless last-column
+ (setq last-column (current-column)))
(setq lines (cdr lines))
(and first (not below)
(setq p (point))))
! (setq first nil)
! (if (and line-count (= (setq line-count (1- line-count)) 0))
! (setq lines nil)))
! (when (and line-count last-column (not overwrite-mode))
! (while (> line-count 0)
! (forward-line 1)
! (or (bolp) (insert ?\n))
! (move-to-column paste-column t)
! (insert-char ?\s (- last-column paste-column -1))
! (setq line-count (1- line-count))))
! (when (and tabify-start
! (not overwrite-mode))
! (tabify tabify-start (point)))
(and p (not overwrite-mode)
(goto-char p))))
***************
*** 662,668 ****
(function (lambda (row) (concat row "\n")))
killed-rectangle "")))))
! (defun cua--activate-rectangle (&optional force)
;; Turn on rectangular marking mode by disabling transient mark mode
;; and manually handling highlighting from a post command hook.
;; Be careful if we are already marking a rectangle.
--- 733,739 ----
(function (lambda (row) (concat row "\n")))
killed-rectangle "")))))
! (defun cua--activate-rectangle ()
;; Turn on rectangular marking mode by disabling transient mark mode
;; and manually handling highlighting from a post command hook.
;; Be careful if we are already marking a rectangle.
***************
*** 671,682 ****
(eq (car cua--last-rectangle) (current-buffer))
(eq (car (cdr cua--last-rectangle)) (point)))
(cdr (cdr cua--last-rectangle))
! (cua--rectangle-get-corners
! (and (not buffer-read-only)
! (or cua-auto-expand-rectangles
! force
! (eq major-mode 'picture-mode)))))
! cua--status-string (if (cua--rectangle-padding) " Pad" "")
cua--last-rectangle nil))
;; (defvar cua-save-point nil)
--- 742,749 ----
(eq (car cua--last-rectangle) (current-buffer))
(eq (car (cdr cua--last-rectangle)) (point)))
(cdr (cdr cua--last-rectangle))
! (cua--rectangle-get-corners))
! cua--status-string (if (cua--rectangle-virtual-edges) " [R]" "")
cua--last-rectangle nil))
;; (defvar cua-save-point nil)
***************
*** 698,704 ****
;; Each overlay extends across all the columns of the rectangle.
;; We try to reuse overlays where possible because this is more efficient
;; and results in less flicker.
! ;; If cua--rectangle-padding is nil and the buffer contains tabs or short
lines,
;; the higlighted region may not be perfectly rectangular.
(let ((deactivate-mark deactivate-mark)
(old cua--rectangle-overlays)
--- 765,771 ----
;; Each overlay extends across all the columns of the rectangle.
;; We try to reuse overlays where possible because this is more efficient
;; and results in less flicker.
! ;; If cua--rectangle-virtual-edges is nil and the buffer contains tabs or
short lines,
;; the higlighted region may not be perfectly rectangular.
(let ((deactivate-mark deactivate-mark)
(old cua--rectangle-overlays)
***************
*** 707,718 ****
(right (1+ (cua--rectangle-right))))
(when (/= left right)
(sit-for 0) ; make window top/bottom reliable
! (cua--rectangle-operation nil t nil nil
'(lambda (s e l r v)
(let ((rface (if v 'cua-rectangle-face
'cua-rectangle-noselect-face))
! overlay)
! ;; Trim old leading overlays.
(if (= s e) (setq e (1+ e)))
(while (and old
(setq overlay (car old))
(< (overlay-start overlay) s)
--- 774,840 ----
(right (1+ (cua--rectangle-right))))
(when (/= left right)
(sit-for 0) ; make window top/bottom reliable
! (cua--rectangle-operation nil t nil nil nil ; do not tabify
'(lambda (s e l r v)
(let ((rface (if v 'cua-rectangle-face
'cua-rectangle-noselect-face))
! overlay bs ms as)
(if (= s e) (setq e (1+ e)))
+ (when (cua--rectangle-virtual-edges)
+ (let ((lb (line-beginning-position))
+ (le (line-end-position))
+ cl cl0 pl cr cr0 pr)
+ (goto-char s)
+ (setq cl (move-to-column l)
+ pl (point))
+ (setq cr (move-to-column r)
+ pr (point))
+ (if (= lb pl)
+ (setq cl0 0)
+ (goto-char (1- pl))
+ (setq cl0 (current-column)))
+ (if (= lb le)
+ (setq cr0 0)
+ (goto-char (1- pr))
+ (setq cr0 (current-column)))
+ (unless (and (= cl l) (= cr r))
+ (when (/= cl l)
+ (setq bs (propertize
+ (make-string
+ (- l cl0 (if (and (= le pl) (/= le lb)) 1 0))
+ (if cua--virtual-edges-debug ?. ?\s))
+ 'face 'default))
+ (if (/= pl le)
+ (setq s (1- s))))
+ (cond
+ ((= cr r)
+ (if (and (/= pr le)
+ (/= cr0 (1- cr))
+ (or bs (/= cr0 (- cr tab-width)))
+ (/= (mod cr tab-width) 0))
+ (setq e (1- e))))
+ ((= cr cl)
+ (setq ms (propertize
+ (make-string
+ (- r l)
+ (if cua--virtual-edges-debug ?, ?\s))
+ 'face rface))
+ (if (cua--rectangle-right-side)
+ (put-text-property (1- (length ms)) (length ms)
'cursor t ms)
+ (put-text-property 0 1 'cursor t ms))
+ (setq bs (concat bs ms))
+ (setq rface nil))
+ (t
+ (setq as (propertize
+ (make-string
+ (- r cr0 (if (= le pr) 1 0))
+ (if cua--virtual-edges-debug ?~ ?\s))
+ 'face rface))
+ (if (cua--rectangle-right-side)
+ (put-text-property (1- (length as)) (length as)
'cursor t as)
+ (put-text-property 0 1 'cursor t as))
+ (if (/= pr le)
+ (setq e (1- e))))))))
+ ;; Trim old leading overlays.
(while (and old
(setq overlay (car old))
(< (overlay-start overlay) s)
***************
*** 728,735 ****
(move-overlay overlay s e)
(setq old (cdr old)))
(setq overlay (make-overlay s e)))
! (overlay-put overlay 'face rface)
! (setq new (cons overlay new))))))
;; Trim old trailing overlays.
(mapcar (function delete-overlay) old)
(setq cua--rectangle-overlays (nreverse new))))
--- 850,860 ----
(move-overlay overlay s e)
(setq old (cdr old)))
(setq overlay (make-overlay s e)))
! (overlay-put overlay 'before-string bs)
! (overlay-put overlay 'after-string as)
! (overlay-put overlay 'face rface)
! (overlay-put overlay 'keymap cua--overlay-keymap)
! (setq new (cons overlay new))))))
;; Trim old trailing overlays.
(mapcar (function delete-overlay) old)
(setq cua--rectangle-overlays (nreverse new))))
***************
*** 737,745 ****
(defun cua--indent-rectangle (&optional ch to-col clear)
;; Indent current rectangle.
(let ((col (cua--rectangle-insert-col))
! (pad (cua--rectangle-padding))
indent)
! (cua--rectangle-operation (if clear 'clear 'corners) nil t pad
'(lambda (s e l r)
(move-to-column col pad)
(if (and (eolp)
--- 862,870 ----
(defun cua--indent-rectangle (&optional ch to-col clear)
;; Indent current rectangle.
(let ((col (cua--rectangle-insert-col))
! (pad (cua--rectangle-virtual-edges))
indent)
! (cua--rectangle-operation (if clear 'clear 'corners) nil t pad nil
'(lambda (s e l r)
(move-to-column col pad)
(if (and (eolp)
***************
*** 875,897 ****
(defun cua-rotate-rectangle ()
(interactive)
(cua--rectangle-corner (if (= (cua--rectangle-left) (cua--rectangle-right))
0 1))
! (cua--rectangle-set-corners))
! (defun cua-toggle-rectangle-padding ()
(interactive)
! (if buffer-read-only
! (message "Cannot do padding in read-only buffer.")
! (cua--rectangle-padding t (not (cua--rectangle-padding)))
! (cua--pad-rectangle)
! (cua--rectangle-set-corners))
! (setq cua--status-string (and (cua--rectangle-padding) " Pad"))
(cua--keep-active))
(defun cua-do-rectangle-padding ()
(interactive)
(if buffer-read-only
(message "Cannot do padding in read-only buffer.")
! (cua--pad-rectangle t)
(cua--rectangle-set-corners))
(cua--keep-active))
--- 1000,1021 ----
(defun cua-rotate-rectangle ()
(interactive)
(cua--rectangle-corner (if (= (cua--rectangle-left) (cua--rectangle-right))
0 1))
! (cua--rectangle-set-corners)
! (if (cua--rectangle-virtual-edges)
! (setq cua--buffer-and-point-before-command nil)))
! (defun cua-toggle-rectangle-virtual-edges ()
(interactive)
! (cua--rectangle-virtual-edges t (not (cua--rectangle-virtual-edges)))
! (cua--rectangle-set-corners)
! (setq cua--status-string (and (cua--rectangle-virtual-edges) " [R]"))
(cua--keep-active))
(defun cua-do-rectangle-padding ()
(interactive)
(if buffer-read-only
(message "Cannot do padding in read-only buffer.")
! (cua--rectangle-operation nil nil t t t)
(cua--rectangle-set-corners))
(cua--keep-active))
***************
*** 900,906 ****
The text previously in the region is not overwritten by the blanks,
but instead winds up to the right of the rectangle."
(interactive)
! (cua--rectangle-operation 'corners nil t 1
'(lambda (s e l r)
(skip-chars-forward " \t")
(let ((ws (- (current-column) l))
--- 1024,1030 ----
The text previously in the region is not overwritten by the blanks,
but instead winds up to the right of the rectangle."
(interactive)
! (cua--rectangle-operation 'corners nil t 1 nil
'(lambda (s e l r)
(skip-chars-forward " \t")
(let ((ws (- (current-column) l))
***************
*** 915,921 ****
at that column is deleted.
With prefix arg, also delete whitespace to the left of that column."
(interactive "P")
! (cua--rectangle-operation 'clear nil t 1
'(lambda (s e l r)
(when arg
(skip-syntax-backward " " (line-beginning-position))
--- 1039,1045 ----
at that column is deleted.
With prefix arg, also delete whitespace to the left of that column."
(interactive "P")
! (cua--rectangle-operation 'clear nil t 1 nil
'(lambda (s e l r)
(when arg
(skip-syntax-backward " " (line-beginning-position))
***************
*** 927,933 ****
"Blank out CUA rectangle.
The text previously in the rectangle is overwritten by the blanks."
(interactive)
! (cua--rectangle-operation 'keep nil nil 1
'(lambda (s e l r)
(goto-char e)
(skip-syntax-forward " " (line-end-position))
--- 1051,1057 ----
"Blank out CUA rectangle.
The text previously in the rectangle is overwritten by the blanks."
(interactive)
! (cua--rectangle-operation 'keep nil nil 1 nil
'(lambda (s e l r)
(goto-char e)
(skip-syntax-forward " " (line-end-position))
***************
*** 942,948 ****
"Align rectangle lines to left column."
(interactive)
(let (x)
! (cua--rectangle-operation 'clear nil t t
'(lambda (s e l r)
(let ((b (line-beginning-position)))
(skip-syntax-backward "^ " b)
--- 1066,1072 ----
"Align rectangle lines to left column."
(interactive)
(let (x)
! (cua--rectangle-operation 'clear nil t t nil
'(lambda (s e l r)
(let ((b (line-beginning-position)))
(skip-syntax-backward "^ " b)
***************
*** 984,990 ****
"Replace CUA rectangle contents with STRING on each line.
The length of STRING need not be the same as the rectangle width."
(interactive "sString rectangle: ")
! (cua--rectangle-operation 'keep nil t t
'(lambda (s e l r)
(delete-region s e)
(skip-chars-forward " \t")
--- 1108,1114 ----
"Replace CUA rectangle contents with STRING on each line.
The length of STRING need not be the same as the rectangle width."
(interactive "sString rectangle: ")
! (cua--rectangle-operation 'keep nil t t nil
'(lambda (s e l r)
(delete-region s e)
(skip-chars-forward " \t")
***************
*** 999,1005 ****
(defun cua-fill-char-rectangle (ch)
"Replace CUA rectangle contents with CHARACTER."
(interactive "cFill rectangle with character: ")
! (cua--rectangle-operation 'clear nil t 1
'(lambda (s e l r)
(delete-region s e)
(move-to-column l t)
--- 1123,1129 ----
(defun cua-fill-char-rectangle (ch)
"Replace CUA rectangle contents with CHARACTER."
(interactive "cFill rectangle with character: ")
! (cua--rectangle-operation 'clear nil t 1 nil
'(lambda (s e l r)
(delete-region s e)
(move-to-column l t)
***************
*** 1010,1016 ****
(interactive "sReplace regexp: \nsNew text: ")
(if buffer-read-only
(message "Cannot replace in read-only buffer")
! (cua--rectangle-operation 'keep nil t 1
'(lambda (s e l r)
(if (re-search-forward regexp e t)
(replace-match newtext nil nil))))))
--- 1134,1140 ----
(interactive "sReplace regexp: \nsNew text: ")
(if buffer-read-only
(message "Cannot replace in read-only buffer")
! (cua--rectangle-operation 'keep nil t 1 nil
'(lambda (s e l r)
(if (re-search-forward regexp e t)
(replace-match newtext nil nil))))))
***************
*** 1018,1024 ****
(defun cua-incr-rectangle (increment)
"Increment each line of CUA rectangle by prefix amount."
(interactive "p")
! (cua--rectangle-operation 'keep nil t 1
'(lambda (s e l r)
(cond
((re-search-forward "0x\\([0-9a-fA-F]+\\)" e t)
--- 1142,1148 ----
(defun cua-incr-rectangle (increment)
"Increment each line of CUA rectangle by prefix amount."
(interactive "p")
! (cua--rectangle-operation 'keep nil t 1 nil
'(lambda (s e l r)
(cond
((re-search-forward "0x\\([0-9a-fA-F]+\\)" e t)
***************
*** 1051,1086 ****
(if (= (length fmt) 0)
(setq fmt cua--rectangle-seq-format)
(setq cua--rectangle-seq-format fmt))
! (cua--rectangle-operation 'clear nil t 1
'(lambda (s e l r)
(delete-region s e)
(insert (format fmt first))
(setq first (+ first incr)))))
! (defmacro cua--convert-rectangle-as (command)
! `(cua--rectangle-operation 'clear nil nil nil
'(lambda (s e l r)
(,command s e))))
(defun cua-upcase-rectangle ()
"Convert the rectangle to upper case."
(interactive)
! (cua--convert-rectangle-as upcase-region))
(defun cua-downcase-rectangle ()
"Convert the rectangle to lower case."
(interactive)
! (cua--convert-rectangle-as downcase-region))
(defun cua-upcase-initials-rectangle ()
"Convert the rectangle initials to upper case."
(interactive)
! (cua--convert-rectangle-as upcase-initials-region))
(defun cua-capitalize-rectangle ()
"Convert the rectangle to proper case."
(interactive)
! (cua--convert-rectangle-as capitalize-region))
;;; Replace/rearrange text in current rectangle
--- 1175,1210 ----
(if (= (length fmt) 0)
(setq fmt cua--rectangle-seq-format)
(setq cua--rectangle-seq-format fmt))
! (cua--rectangle-operation 'clear nil t 1 nil
'(lambda (s e l r)
(delete-region s e)
(insert (format fmt first))
(setq first (+ first incr)))))
! (defmacro cua--convert-rectangle-as (command tabify)
! `(cua--rectangle-operation 'clear nil nil nil ,tabify
'(lambda (s e l r)
(,command s e))))
(defun cua-upcase-rectangle ()
"Convert the rectangle to upper case."
(interactive)
! (cua--convert-rectangle-as upcase-region nil))
(defun cua-downcase-rectangle ()
"Convert the rectangle to lower case."
(interactive)
! (cua--convert-rectangle-as downcase-region nil))
(defun cua-upcase-initials-rectangle ()
"Convert the rectangle initials to upper case."
(interactive)
! (cua--convert-rectangle-as upcase-initials-region nil))
(defun cua-capitalize-rectangle ()
"Convert the rectangle to proper case."
(interactive)
! (cua--convert-rectangle-as capitalize-region nil))
;;; Replace/rearrange text in current rectangle
***************
*** 1116,1122 ****
(setq z (reverse z))
(if cua--debug
(print z auxbuf))
! (cua--rectangle-operation nil nil t pad
'(lambda (s e l r)
(let (cc)
(goto-char e)
--- 1240,1246 ----
(setq z (reverse z))
(if cua--debug
(print z auxbuf))
! (cua--rectangle-operation nil nil t pad nil
'(lambda (s e l r)
(let (cc)
(goto-char e)
***************
*** 1232,1240 ****
"Delete char to left or right of rectangle."
(interactive)
(let ((col (cua--rectangle-insert-col))
! (pad (cua--rectangle-padding))
indent)
! (cua--rectangle-operation 'corners nil t pad
'(lambda (s e l r)
(move-to-column
(if (cua--rectangle-right-side t)
--- 1356,1364 ----
"Delete char to left or right of rectangle."
(interactive)
(let ((col (cua--rectangle-insert-col))
! (pad (cua--rectangle-virtual-edges))
indent)
! (cua--rectangle-operation 'corners nil t pad nil
'(lambda (s e l r)
(move-to-column
(if (cua--rectangle-right-side t)
***************
*** 1282,1291 ****
(cua--rectangle-left (current-column)))
(if (>= (cua--rectangle-corner) 2)
(cua--rectangle-bot t)
! (cua--rectangle-top t))
! (if (cua--rectangle-padding)
! (setq unread-command-events
! (cons (if cua-use-hyper-key ?\H-P ?\M-P)
unread-command-events)))))
(if cua--rectangle
(if (and mark-active
(not deactivate-mark))
--- 1406,1412 ----
(cua--rectangle-left (current-column)))
(if (>= (cua--rectangle-corner) 2)
(cua--rectangle-bot t)
! (cua--rectangle-top t))))
(if cua--rectangle
(if (and mark-active
(not deactivate-mark))
***************
*** 1379,1385 ****
(cua--rect-M/H-key ?m 'cua-copy-rectangle-as-text)
(cua--rect-M/H-key ?n 'cua-sequence-rectangle)
(cua--rect-M/H-key ?o 'cua-open-rectangle)
! (cua--rect-M/H-key ?p 'cua-toggle-rectangle-padding)
(cua--rect-M/H-key ?P 'cua-do-rectangle-padding)
(cua--rect-M/H-key ?q 'cua-refill-rectangle)
(cua--rect-M/H-key ?r 'cua-replace-in-rectangle)
--- 1500,1506 ----
(cua--rect-M/H-key ?m 'cua-copy-rectangle-as-text)
(cua--rect-M/H-key ?n 'cua-sequence-rectangle)
(cua--rect-M/H-key ?o 'cua-open-rectangle)
! (cua--rect-M/H-key ?p 'cua-toggle-rectangle-virtual-edges)
(cua--rect-M/H-key ?P 'cua-do-rectangle-padding)
(cua--rect-M/H-key ?q 'cua-refill-rectangle)
(cua--rect-M/H-key ?r 'cua-replace-in-rectangle)
- [Emacs-diffs] Changes to emacs/lisp/emulation/cua-rect.el [emacs-unicode-2],
Miles Bader <=