;;; cua-rect.el --- CUA unified rectangle support
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Keywords: keyboard emulations convenience CUA
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Acknowledgements
;;; Code:
-(provide 'cua-rect)
-
(eval-when-compile
- (require 'cua-base)
- (require 'cua-gmrk)
-)
+ (require 'cua-base))
;;; Rectangle support
;; List of overlays used to display current rectangle.
(defvar cua--rectangle-overlays nil)
(make-variable-buffer-local 'cua--rectangle-overlays)
+(put 'cua--rectangle-overlays 'permanent-local t)
(defvar cua--overlay-keymap
(let ((map (make-sparse-keymap)))
(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))))
+ (setq rect (cons (filter-buffer-substring s e nil t) 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)
(setq as (- r (max (current-column) l))
e (point)))
(setq row (if (and copy (> e s))
- (buffer-substring-no-properties s e)
+ (filter-buffer-substring s e nil t)
""))
(when (> bs 0)
(setq row (concat (make-string bs ?\s) row)))
(defun cua--deactivate-rectangle ()
;; This is used to clean up after `cua--activate-rectangle'.
- (mapcar (function delete-overlay) cua--rectangle-overlays)
+ (mapc (function delete-overlay) cua--rectangle-overlays)
(setq cua--last-rectangle (cons (current-buffer)
(cons (point) ;; cua-save-point
cua--rectangle))
(make-string
(- l cl0 (if (and (= le pl) (/= le lb)) 1 0))
(if cua--virtual-edges-debug ?. ?\s))
- 'face 'default))
+ 'face (or (get-text-property (1- s) 'face) 'default)))
(if (/= pl le)
(setq s (1- s))))
(cond
(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))
+ (put-text-property (1- (length ms)) (length ms) 'cursor 2 ms)
+ (put-text-property 0 1 'cursor 2 ms))
(setq bs (concat bs ms))
(setq rface nil))
(t
(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))
+ (put-text-property (1- (length as)) (length as) 'cursor 2 as)
+ (put-text-property 0 1 'cursor 2 as))
(if (/= pr le)
(setq e (1- e))))))))
;; Trim old leading overlays.
(overlay-put overlay 'window (selected-window))
(setq new (cons overlay new))))))
;; Trim old trailing overlays.
- (mapcar (function delete-overlay) old)
+ (mapc (function delete-overlay) old)
(setq cua--rectangle-overlays (nreverse new))))
(defun cua--indent-rectangle (&optional ch to-col clear)
;; (setq cua-save-point (point))
))))
+(declare-function cua--cut-rectangle-to-global-mark "cua-gmrk" (as-text))
+(declare-function cua--copy-rectangle-to-global-mark "cua-gmrk" (as-text))
+
(defun cua-copy-rectangle-as-text (&optional arg delete)
"Copy rectangle, but store as normal text."
(interactive "P")
'(lambda (s e l r)
(cond
((re-search-forward "0x\\([0-9a-fA-F]+\\)" e t)
- (let* ((txt (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
+ (let* ((txt (filter-buffer-substring (match-beginning 1) (match-end 1) nil t))
(n (string-to-number txt 16))
(fmt (format "0x%%0%dx" (length txt))))
(replace-match (format fmt (+ n increment)))))
((re-search-forward "\\( *-?[0-9]+\\)" e t)
- (let* ((txt (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
+ (let* ((txt (filter-buffer-substring (match-beginning 1) (match-end 1) nil t))
(prefix (if (= (aref txt 0) ?0) "0" ""))
(n (string-to-number txt 10))
(fmt (format "%%%s%dd" prefix (length txt))))
(when replace
(goto-char (point-min))
(while (not (eobp))
- (setq z (cons (buffer-substring (point) (line-end-position)) z))
+ (setq z (cons (filter-buffer-substring (point) (line-end-position)) z))
(forward-line 1))))
(if (not cua--debug)
(kill-buffer auxbuf))
(setq z (cdr z)))
(if cua--debug
(print (list (current-column) cc) auxbuf))
+ (just-one-space 0)
(indent-to cc))))
(if (> tr 0)
(message "Warning: Truncated %d row%s" tr (if (> tr 1) "s" "")))
(defun cua-help-for-rectangle (&optional help)
(interactive)
- (let ((M (if cua-use-hyper-key " H-" " M-")))
+ (let ((M (cond ((eq cua--rectangle-modifier-key 'hyper) " H-")
+ ((eq cua--rectangle-modifier-key 'super) " s-")
+ ((eq cua--rectangle-modifier-key 'alt) " A-")
+ (t " M-"))))
(message
(concat (if help "C-?:help" "")
M "p:pad" M "o:open" M "c:close" M "b:blank"
(if (and mark-active
(not deactivate-mark))
(cua--highlight-rectangle)
- (cua--deactivate-rectangle)))
+ (cua--deactivate-rectangle))
+ (when cua--rectangle-overlays
+ ;; clean-up after revert-buffer
+ (mapc (function delete-overlay) cua--rectangle-overlays)
+ (setq cua--rectangle-overlays nil)
+ (setq deactivate-mark t)))
(when cua--rect-undo-set-point
(goto-char cua--rect-undo-set-point)
(setq cua--rect-undo-set-point nil)))
(cua--M/H-key cua--rectangle-keymap key cmd))
(defun cua--init-rectangles ()
- (unless (eq cua-use-hyper-key 'only)
- (define-key cua--rectangle-keymap [(control return)] 'cua-clear-rectangle-mark)
- (define-key cua--region-keymap [(control return)] 'cua-toggle-rectangle-mark))
- (when cua-use-hyper-key
- (cua--rect-M/H-key 'space 'cua-clear-rectangle-mark)
- (cua--M/H-key cua--region-keymap 'space 'cua-toggle-rectangle-mark))
+ (define-key cua--rectangle-keymap cua-rectangle-mark-key 'cua-clear-rectangle-mark)
+ (define-key cua--region-keymap cua-rectangle-mark-key 'cua-toggle-rectangle-mark)
+ (unless (eq cua--rectangle-modifier-key 'meta)
+ (cua--rect-M/H-key ?\s 'cua-clear-rectangle-mark)
+ (cua--M/H-key cua--region-keymap ?\s 'cua-toggle-rectangle-mark))
(define-key cua--rectangle-keymap [remap copy-region-as-kill] 'cua-copy-rectangle)
(define-key cua--rectangle-keymap [remap kill-ring-save] 'cua-copy-rectangle)
(setq cua--rectangle-initialized t))
-;;; arch-tag: b730df53-17b9-4a89-bd63-4a71ec196731
+(provide 'cua-rect)
+
+;; arch-tag: b730df53-17b9-4a89-bd63-4a71ec196731
;;; cua-rect.el ends here