mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-30 12:21:25 -08:00
Code Issues Projects Releases Wiki Activity

(cua--undo-list, cua--tidy-undo-counter)

Browse source 
(cua--rect-undo, cua--tidy-undo-lists, cua--rectangle-on-off): Remove.
(cua--rect-undo-set-point): New var.
(cua--rectangle-undo-boundary): Setup undo apply entry.
(cua--rect-undo-handler): New function for rectangle undo.
(cua--rect-start-position, cua--rect-end-position): Add.
(cua--rectangle-post-command): Call cua--rectangle-set-corners
for restored rectangle.  Set point if cua--rect-undo-set-point.
This commit is contained in:
Kim F. Storm 2005-02-07 11:44:57 +00:00
parent 4905133fd7
commit e4907bbe3b
1 changed files with 50 additions and 74 deletions
Download patch file Download diff file Expand all files Collapse all files

124
lisp/emulation/cua-rect.el
View file

@ -1,6 +1,6 @@
;;; cua-rect.el --- CUA unified rectangle support
;; Copyright (C) 1997-2002, 2004 Free Software Foundation, Inc.
;; Copyright (C) 1997-2002, 2004, 2005 Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Keywords: keyboard emulations convenience CUA
@ -71,71 +71,28 @@
(defvar cua--virtual-edges-debug nil)
;; Per-buffer CUA mode undo list.
(defvar cua--undo-list nil)
(make-variable-buffer-local 'cua--undo-list)
;; Undo rectangle commands.
(defvar cua--rect-undo-set-point nil)
;; Record undo boundary for rectangle undo.
(defun cua--rectangle-undo-boundary ()
(when (listp buffer-undo-list)
(if (> (length cua--undo-list) cua-undo-max)
(setcdr (nthcdr (1- cua-undo-max) cua--undo-list) nil))
(undo-boundary)
(setq cua--undo-list
(cons (cons (cdr buffer-undo-list) (copy-sequence cua--rectangle)) cua--undo-list))))
(let ((s (cua--rect-start-position))
(e (cua--rect-end-position)))
(undo-boundary)
(push (list 'apply 0 s e
'cua--rect-undo-handler
(copy-sequence cua--rectangle) t s e)
buffer-undo-list))))
(defun cua--rectangle-undo (&optional arg)
"Undo some previous changes.
Knows about CUA rectangle highlighting in addition to standard undo."
(interactive "*P")
(if cua--rectangle
(cua--rectangle-undo-boundary))
(undo arg)
(let ((l cua--undo-list))
(while l
(if (eq (car (car l)) pending-undo-list)
(setq cua--restored-rectangle
(and (vectorp (cdr (car l))) (cdr (car l)))
l nil)
(setq l (cdr l)))))
(setq cua--buffer-and-point-before-command nil))
(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.
(defun cua--tidy-undo-lists (&optional clean)
(let ((buffers (buffer-list)) (cnt cua--tidy-undo-counter))
(while (and buffers (or clean (not (input-pending-p))))
(with-current-buffer (car buffers)
(when (local-variable-p 'cua--undo-list)
(if (or clean (null cua--undo-list) (eq buffer-undo-list t))
(progn
(kill-local-variable 'cua--undo-list)
(setq cua--tidy-undo-counter (1+ cua--tidy-undo-counter)))
(let* ((bul buffer-undo-list)
(cul (cons nil cua--undo-list))
(cc (car (car (cdr cul)))))
(while (and bul cc)
(if (setq bul (memq cc bul))
(setq cul (cdr cul)
cc (and (cdr cul) (car (car (cdr cul)))))))
(when cc
(if cua--debug
(setq cc (length (cdr cul))))
(if (eq (cdr cul) cua--undo-list)
(setq cua--undo-list nil)
(setcdr cul nil))
(setq cua--tidy-undo-counter (1+ cua--tidy-undo-counter))
(if cua--debug
(message "Clean undo list in %s (%d)"
(buffer-name) cc)))))))
(setq buffers (cdr buffers)))
(/= cnt cua--tidy-undo-counter)))
(defun cua--rect-undo-handler (rect on s e)
(if (setq on (not on))
(setq cua--rect-undo-set-point s)
(setq cua--restored-rectangle (copy-sequence rect))
(setq cua--buffer-and-point-before-command nil))
(push (list 'apply 0 s (if on e s)
'cua--rect-undo-handler rect on s e)
buffer-undo-list))
;;; Rectangle geometry
@ -287,6 +244,27 @@ Knows about CUA rectangle highlighting in addition to standard undo."
(backward-char 1))
))
(defun cua--rect-start-position ()
;; Return point of top left corner
(save-excursion
(goto-char (cua--rectangle-top))
(and (> (move-to-column (cua--rectangle-left))
(cua--rectangle-left))
(not (bolp))
(backward-char 1))
(point)))
(defun cua--rect-end-position ()
;; Return point of bottom right cornet
(save-excursion
(goto-char (cua--rectangle-bot))
(and (= (move-to-column (cua--rectangle-right))
(- (cua--rectangle-right) tab-width))
(not (eolp))
(not (bolp))
(backward-char 1))
(point)))
;;; Rectangle resizing
(defun cua--forward-line (n)
@ -1394,10 +1372,12 @@ With prefix arg, indent to that column."
(defun cua--rectangle-post-command ()
(if cua--restored-rectangle
(setq cua--rectangle cua--restored-rectangle
cua--restored-rectangle nil
mark-active t
deactivate-mark nil)
(progn
(setq cua--rectangle cua--restored-rectangle
cua--restored-rectangle nil
mark-active t
deactivate-mark nil)
(cua--rectangle-set-corners))
(when (and cua--rectangle cua--buffer-and-point-before-command
(equal (car cua--buffer-and-point-before-command) (current-buffer))
(not (= (cdr cua--buffer-and-point-before-command) (point))))
@ -1411,20 +1391,16 @@ With prefix arg, indent to that column."
(if (and mark-active
(not deactivate-mark))
(cua--highlight-rectangle)
(cua--deactivate-rectangle))))
(cua--deactivate-rectangle)))
(when cua--rect-undo-set-point
(goto-char cua--rect-undo-set-point)
(setq cua--rect-undo-set-point nil)))
;;; Initialization
(defun cua--rect-M/H-key (key cmd)
(cua--M/H-key cua--rectangle-keymap key cmd))
(defun cua--rectangle-on-off (on)
(cancel-function-timers 'cua--tidy-undo-lists)
(if on
(run-with-idle-timer 10 t 'cua--tidy-undo-lists)
(cua--tidy-undo-lists t)))
(defun cua--init-rectangles ()
(unless (face-background 'cua-rectangle-face)
(copy-face 'region 'cua-rectangle-face)