Ibuffer: Mark buffers by content

[gnu-emacs] / lisp / rect.el

diff --git a/lisp/rect.el b/lisp/rect.el
index 75585d2f080c7ff55b5213a97bca862059b9830c..8803a47215fece267148c9c78ba5ab1338ac728d 100644 (file)
--- a/lisp/rect.el
+++ b/lisp/rect.el
@@ -1,6 +1,6 @@
 ;;; rect.el --- rectangle functions for GNU Emacs  -*- lexical-binding:t -*-
 
 ;;; rect.el --- rectangle functions for GNU Emacs  -*- lexical-binding:t -*-
 

-;; Copyright (C) 1985, 1999-2015 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1999-2016 Free Software Foundation, Inc.

 
 ;; Maintainer: Didier Verna <didier@xemacs.org>
 ;; Keywords: internal
 
 ;; Maintainer: Didier Verna <didier@xemacs.org>
 ;; Keywords: internal


@@ -257,6 +257,19 @@ Return it as a list of strings, one for each line of the rectangle."
     (apply-on-rectangle 'extract-rectangle-line start end lines)
     (nreverse (cdr lines))))
 
     (apply-on-rectangle 'extract-rectangle-line start end lines)
     (nreverse (cdr lines))))
 

+(defun extract-rectangle-bounds (start end)
+  "Return the bounds of the rectangle with corners at START and END.
+Return it as a list of (START . END) positions, one for each line of
+the rectangle."
+  (let (bounds)
+    (apply-on-rectangle
+     (lambda (startcol endcol)
+       (move-to-column startcol)
+       (push (cons (prog1 (point) (move-to-column endcol)) (point))
+            bounds))
+     start end)
+    (nreverse bounds)))
+

 (defvar killed-rectangle nil
   "Rectangle for `yank-rectangle' to insert.")
 
 (defvar killed-rectangle nil
   "Rectangle for `yank-rectangle' to insert.")
 


@@ -346,7 +359,8 @@ no text on the right side of the rectangle."
 (defun delete-whitespace-rectangle-line (startcol _endcol fill)
   (when (= (move-to-column startcol (if fill t 'coerce)) startcol)
     (unless (= (point) (point-at-eol))
 (defun delete-whitespace-rectangle-line (startcol _endcol fill)
   (when (= (move-to-column startcol (if fill t 'coerce)) startcol)
     (unless (= (point) (point-at-eol))

-      (delete-region (point) (progn (skip-syntax-forward " ") (point))))))
+      (delete-region (point) (progn (skip-syntax-forward " " (point-at-eol))
+                                   (point))))))

 
 ;;;###autoload
 (defalias 'close-rectangle 'delete-whitespace-rectangle) ;; Old name
 
 ;;;###autoload
 (defalias 'close-rectangle 'delete-whitespace-rectangle) ;; Old name


@@ -356,7 +370,7 @@ no text on the right side of the rectangle."
   "Delete all whitespace following a specified column in each line.
 The left edge of the rectangle specifies the position in each line
 at which whitespace deletion should begin.  On each line in the
   "Delete all whitespace following a specified column in each line.
 The left edge of the rectangle specifies the position in each line
 at which whitespace deletion should begin.  On each line in the

-rectangle, all continuous whitespace starting at that column is deleted.
+rectangle, all contiguous whitespace starting at that column is deleted.

 
 When called from a program the rectangle's corners are START and END.
 With a prefix (or a FILL) argument, also fill too short lines."
 
 When called from a program the rectangle's corners are START and END.
 With a prefix (or a FILL) argument, also fill too short lines."


@@ -384,48 +398,51 @@ With a prefix (or a FILL) argument, also fill too short lines."
 (defun rectangle--space-to (col)
   (propertize " " 'display `(space :align-to ,col)))
 
 (defun rectangle--space-to (col)
   (propertize " " 'display `(space :align-to ,col)))
 

-(defface rectangle-preview-face '((t :inherit region))
-  "The face to use for the `string-rectangle' preview.")
+(defface rectangle-preview '((t :inherit region))
+  "The face to use for the `string-rectangle' preview."
+  :version "25.1")

 
 (defcustom rectangle-preview t
   "If non-nil, `string-rectangle' will show an-the-fly preview."
 
 (defcustom rectangle-preview t
   "If non-nil, `string-rectangle' will show an-the-fly preview."

+  :version "25.1"

   :type 'boolean)
 
 (defun rectangle--string-preview ()
   :type 'boolean)
 
 (defun rectangle--string-preview ()

-  (let ((str (minibuffer-contents)))
-    (when (equal str "")
-      (setq str (or (car-safe minibuffer-default)
-                    (if (stringp minibuffer-default) minibuffer-default))))
-    (when str (setq str (propertize str 'face 'region)))
-    (with-selected-window rectangle--string-preview-window
-      (unless (or (null rectangle--string-preview-state)
-                  (equal str (car rectangle--string-preview-state)))
-        (rectangle--string-flush-preview)
-        (apply-on-rectangle
-         (lambda (startcol endcol)
-           (let* ((sc (move-to-column startcol))
-                  (start (if (<= sc startcol) (point)
-                           (forward-char -1)
-                           (setq sc (current-column))
-                           (point)))
-                  (ec (move-to-column endcol))
-                  (end (point))
-                  (ol (make-overlay start end)))
-             (push ol (nthcdr 3 rectangle--string-preview-state))
-             ;; FIXME: The extra spacing doesn't interact correctly with
-             ;; the extra spacing added by the rectangular-region-highlight.
-             (when (< sc startcol)
-               (overlay-put ol 'before-string (rectangle--space-to startcol)))
-             (let ((as (when (< endcol ec)
-                         ;; (rectangle--space-to ec)
-                         (spaces-string (- ec endcol))
-                         )))
-               (if (= start end)
-                   (overlay-put ol 'after-string (if as (concat str as) str))
-                 (overlay-put ol 'display str)
-                 (if as (overlay-put ol 'after-string as))))))
-         (nth 1 rectangle--string-preview-state)
-         (nth 2 rectangle--string-preview-state))))))
+  (when rectangle-preview
+    (let ((str (minibuffer-contents)))
+      (when (equal str "")
+        (setq str (or (car-safe minibuffer-default)
+                      (if (stringp minibuffer-default) minibuffer-default))))
+      (when str (setq str (propertize str 'face 'rectangle-preview)))
+      (with-selected-window rectangle--string-preview-window
+        (unless (or (null rectangle--string-preview-state)
+                    (equal str (car rectangle--string-preview-state)))
+          (rectangle--string-flush-preview)
+          (apply-on-rectangle
+           (lambda (startcol endcol)
+             (let* ((sc (move-to-column startcol))
+                    (start (if (<= sc startcol) (point)
+                             (forward-char -1)
+                             (setq sc (current-column))
+                             (point)))
+                    (ec (move-to-column endcol))
+                    (end (point))
+                    (ol (make-overlay start end)))
+               (push ol (nthcdr 3 rectangle--string-preview-state))
+               ;; FIXME: The extra spacing doesn't interact correctly with
+               ;; the extra spacing added by the rectangular-region-highlight.
+               (when (< sc startcol)
+                 (overlay-put ol 'before-string (rectangle--space-to startcol)))
+               (let ((as (when (< endcol ec)
+                           ;; (rectangle--space-to ec)
+                           (spaces-string (- ec endcol))
+                           )))
+                 (if (= start end)
+                     (overlay-put ol 'after-string (if as (concat str as) str))
+                   (overlay-put ol 'display str)
+                   (if as (overlay-put ol 'after-string as))))))
+           (nth 1 rectangle--string-preview-state)
+           (nth 2 rectangle--string-preview-state)))))))

 
 ;; FIXME: Should this be turned into inhibit-region-highlight and made to apply
 ;; to non-rectangular regions as well?
 
 ;; FIXME: Should this be turned into inhibit-region-highlight and made to apply
 ;; to non-rectangular regions as well?


@@ -459,10 +476,15 @@ Called from a program, takes three args; START, END and STRING."
                              #'rectangle--string-erase-preview nil t)
                    (add-hook 'post-command-hook
                              #'rectangle--string-preview nil t))
                              #'rectangle--string-erase-preview nil t)
                    (add-hook 'post-command-hook
                              #'rectangle--string-preview nil t))

-          (read-string (format "String rectangle (default %s): "
-                               (or (car string-rectangle-history) ""))
-                       nil 'string-rectangle-history
+               (read-string (format "String rectangle (default %s): "
+                                    (or (car string-rectangle-history) ""))
+                            nil 'string-rectangle-history

                             (car string-rectangle-history)))))))
                             (car string-rectangle-history)))))))

+  ;; If we undo this change, we want to have the point back where we
+  ;; are now, and not after the first line in the rectangle (which is
+  ;; the first line to be changed by the following command).
+  (unless (eq buffer-undo-list t)
+    (push (point) buffer-undo-list))

   (goto-char
    (apply-on-rectangle 'string-rectangle-line start end string t)))
 
   (goto-char
    (apply-on-rectangle 'string-rectangle-line start end string t)))
 


@@ -562,6 +584,8 @@ with a prefix argument, prompt for START-AT and FORMAT."
               #'rectangle--unhighlight-for-redisplay)
 (add-function :around region-extract-function
               #'rectangle--extract-region)
               #'rectangle--unhighlight-for-redisplay)
 (add-function :around region-extract-function
               #'rectangle--extract-region)

+(add-function :around region-insert-function
+              #'rectangle--insert-region)

 
 (defvar rectangle-mark-mode-map
   (let ((map (make-sparse-keymap)))
 
 (defvar rectangle-mark-mode-map
   (let ((map (make-sparse-keymap)))


@@ -680,8 +704,12 @@ Ignores `line-move-visual'."
 
 
 (defun rectangle--extract-region (orig &optional delete)
 
 
 (defun rectangle--extract-region (orig &optional delete)

-  (if (not rectangle-mark-mode)
-      (funcall orig delete)
+  (cond
+   ((not rectangle-mark-mode)
+    (funcall orig delete))
+   ((eq delete 'bounds)
+    (extract-rectangle-bounds (region-beginning) (region-end)))
+   (t

     (let* ((strs (funcall (if delete
                               #'delete-extract-rectangle
                             #'extract-rectangle)
     (let* ((strs (funcall (if delete
                               #'delete-extract-rectangle
                             #'extract-rectangle)


@@ -695,7 +723,14 @@ Ignores `line-move-visual'."
         (put-text-property 0 (length str) 'yank-handler
                            `(rectangle--insert-for-yank ,strs t)
                            str)
         (put-text-property 0 (length str) 'yank-handler
                            `(rectangle--insert-for-yank ,strs t)
                            str)

-        str))))
+        str)))))
+
+(defun rectangle--insert-region (orig strings)
+  (cond
+   ((not rectangle-mark-mode)
+    (funcall orig strings))
+   (t
+    (funcall #'insert-rectangle strings))))

 
 (defun rectangle--insert-for-yank (strs)
   (push (point) buffer-undo-list)
 
 (defun rectangle--insert-for-yank (strs)
   (push (point) buffer-undo-list)