X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/1af74d06e5bdafad9d629d2ed729c5d743cfaf0f..c05c21ed109720d66c834a0c5b21ea29416683a6:/lisp/emulation/cua-rect.el diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el index 5c4bc01146..5d50d6f48d 100644 --- a/lisp/emulation/cua-rect.el +++ b/lisp/emulation/cua-rect.el @@ -1,17 +1,17 @@ ;;; cua-rect.el --- CUA unified rectangle support ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007 Free Software Foundation, Inc. +;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Kim F. Storm ;; 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 3, 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 @@ -19,9 +19,7 @@ ;; 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 . ;;; Acknowledgements @@ -33,12 +31,8 @@ ;;; Code: -(provide 'cua-rect) - (eval-when-compile - (require 'cua-base) - (require 'cua-gmrk) -) + (require 'cua-base)) ;;; Rectangle support @@ -237,7 +231,7 @@ (move-to-column mc) (set-mark (point)) (goto-char pp) - ;; Move cursor inside rectangle, except if char at rigth edge is a tab. + ;; Move cursor inside rectangle, except if char at right edge is a tab. (if (and (if (cua--rectangle-right-side) (and (= (move-to-column pc) (- pc tab-width)) (not (eolp))) @@ -631,7 +625,7 @@ If command is repeated at same position, delete the rectangle." (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 (filter-buffer-substring s e nil t) rect)))) + (setq rect (cons (cua--filter-buffer-noprops 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) @@ -649,7 +643,7 @@ If command is repeated at same position, delete the rectangle." (setq as (- r (max (current-column) l)) e (point))) (setq row (if (and copy (> e s)) - (filter-buffer-substring s e nil t) + (cua--filter-buffer-noprops s e) "")) (when (> bs 0) (setq row (concat (make-string bs ?\s) row))) @@ -853,7 +847,7 @@ If command is repeated at same position, delete the rectangle." (move-to-column col t)) (cond (to-col (indent-to to-col)) - (ch (insert ch)) + ((and ch (not (eq ch ?\t))) (insert ch)) (t (tab-to-tab-stop))) (if (cua--rectangle-right-side t) (cua--rectangle-insert-col (current-column)) @@ -1061,6 +1055,9 @@ The text previously in the rectangle is overwritten by the blanks." ;; (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") @@ -1127,12 +1124,12 @@ The length of STRING need not be the same as the rectangle width." '(lambda (s e l r) (cond ((re-search-forward "0x\\([0-9a-fA-F]+\\)" e t) - (let* ((txt (filter-buffer-substring (match-beginning 1) (match-end 1) nil t)) + (let* ((txt (cua--filter-buffer-noprops (match-beginning 1) (match-end 1))) (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 (filter-buffer-substring (match-beginning 1) (match-end 1) nil t)) + (let* ((txt (cua--filter-buffer-noprops (match-beginning 1) (match-end 1))) (prefix (if (= (aref txt 0) ?0) "0" "")) (n (string-to-number txt 10)) (fmt (format "%%%s%dd" prefix (length txt)))) @@ -1201,8 +1198,7 @@ The numbers are formatted according to the FORMAT string." (- (cua--rectangle-right) (cua--rectangle-left) -1))) (r (or setup-fct (cua--extract-rectangle))) y z (tr 0)) - (save-excursion - (set-buffer auxbuf) + (with-current-buffer auxbuf (erase-buffer) (if setup-fct (funcall setup-fct) @@ -1348,7 +1344,7 @@ With prefix arg, indent to that column." pad) (if (bolp) nil - (delete-backward-char 1) + (delete-char -1) (if (cua--rectangle-right-side t) (cua--rectangle-insert-col (current-column)) (setq indent (- l (current-column)))))) @@ -1436,6 +1432,8 @@ With prefix arg, indent to that column." (define-key cua--rectangle-keymap [remap beginning-of-buffer] 'cua-resize-rectangle-top) (define-key cua--rectangle-keymap [remap scroll-down] 'cua-resize-rectangle-page-up) (define-key cua--rectangle-keymap [remap scroll-up] 'cua-resize-rectangle-page-down) + (define-key cua--rectangle-keymap [remap scroll-down-command] 'cua-resize-rectangle-page-up) + (define-key cua--rectangle-keymap [remap scroll-up-command] 'cua-resize-rectangle-page-down) (define-key cua--rectangle-keymap [remap delete-backward-char] 'cua-delete-char-rectangle) (define-key cua--rectangle-keymap [remap backward-delete-char] 'cua-delete-char-rectangle) @@ -1491,5 +1489,7 @@ With prefix arg, indent to that column." (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