]> code.delx.au - gnu-emacs/blobdiff - lisp/emulation/cua-rect.el
Merge from emacs-23
[gnu-emacs] / lisp / emulation / cua-rect.el
index 93709f7660c7f0ca51df945b888759d1d5c36c64..1d8fdcd1af595aa4e9ce345531b244843d6de66b 100644 (file)
@@ -1,17 +1,18 @@
 ;;; cua-rect.el --- CUA unified rectangle support
 
 ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;;   2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
 
 ;; Author: Kim F. Storm <storm@cua.dk>
 ;; Keywords: keyboard emulations convenience CUA
+;; Package: cua-base
 
 ;; 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 +20,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 <http://www.gnu.org/licenses/>.
 
 ;;; Acknowledgements
 
     (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)))
@@ -627,7 +626,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)
@@ -645,7 +644,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)))
@@ -849,7 +848,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))
@@ -1126,12 +1125,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))))
@@ -1200,8 +1199,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)
@@ -1347,7 +1345,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))))))
@@ -1435,6 +1433,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)
@@ -1492,5 +1492,5 @@ With prefix arg, indent to that column."
 
 (provide 'cua-rect)
 
-;;; arch-tag: b730df53-17b9-4a89-bd63-4a71ec196731
+;; arch-tag: b730df53-17b9-4a89-bd63-4a71ec196731
 ;;; cua-rect.el ends here