Suggested new transpose-rectangle command

Suggested new transpose-rectangle command

[Gustav Hållberg]

[-- Attachment #1: Type: text/plain, Size: 212 bytes --]

I somewhat often find myself wanting to mirror or transpose a
rectangle (optionally transposing the lines and/or the columns within
the rectangle).

Attaching a proposed patch that adds such a command.

- Gustav

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: transpose-rect.patch --]
[-- Type: text/x-patch; name="transpose-rect.patch", Size: 2423 bytes --]

Index: lisp/rect.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/rect.el,v
retrieving revision 1.52
diff -u -r1.52 rect.el
--- lisp/rect.el	8 Apr 2006 10:30:19 -0000	1.52
+++ lisp/rect.el	13 Aug 2006 06:40:26 -0000
@@ -392,6 +392,57 @@
 	(delete-region pt (point))
 	(indent-to endcol)))))
 
+(defun transpose-array (array)
+  "Returns a new array which is a transposed copy of
+ARRAY (vector, string, or bool-vector)."
+  (let* ((length (length array))
+         (result (apply (cond ((vectorp array) 'make-vector)
+                              ((stringp array) 'make-string)
+                              ((bool-vector-p array) 'make-bool-vector)
+                              (t (signal 'wrong-type-argument '(arrayp array))))
+                        (list length 0)))
+         (index length))
+    (while (> index 0)
+      (setq index (1- index))
+      (aset result index (aref array (- length 1 index))))
+    result))
+
+(defun ntranspose-array (array)
+  "Transposes the characters in ARRAY. Returns ARRAY."
+  (let* ((length (length array))
+         (index (/ length 2)))
+    (while (> index 0)
+      (setq index (1- index))
+      (let ((tmp (aref array index)))
+        (aset array index (aref array (- length 1 index)))
+        (aset array (- length 1 index) tmp)))
+    array))
+
+;;;###autoload
+(defun transpose-rectangle (start end &optional horizontal vertical)
+  "Replace the region-rectangle with its mirror image.
+
+By default, only horizontal transposition is done. With a prefix
+argument, ask whether to transpose horizontally and/or vertically.
+
+If HORIZONTAL is non-nil, each line in the rectangle is transposed.
+If VERTICAL is non-nil, all lines in the rectangle are transposed.
+
+When called from a program, the rectangle's corners are START and END."
+  (interactive
+   (append (list (region-beginning) (region-end))
+           (if current-prefix-arg
+               (list (y-or-n-p "Transpose horizontally? ")
+                     (y-or-n-p "Transpose vertically? "))
+             '(t nil))))
+  (let ((rect (delete-extract-rectangle start end)))
+    (when vertical
+      (setq rect (nreverse rect)))
+    (when horizontal
+      (setq rect (mapcar (function ntranspose-array) rect)))
+    (goto-char start)
+    (insert-rectangle rect)))
+
 (provide 'rect)
 
 ;;; arch-tag: 178847b3-1f50-4b03-83de-a6e911cc1d16

[-- Attachment #3: Type: text/plain, Size: 149 bytes --]

_______________________________________________
bug-gnu-emacs mailing list
bug-gnu-emacs@gnu.org
http://lists.gnu.org/mailman/listinfo/bug-gnu-emacs

Re: Suggested new transpose-rectangle command

[Gustav Hållberg]

[-- Attachment #1: Type: text/plain, Size: 262 bytes --]

On 8/12/06, Gustav Hållberg <gustav@gmail.com> wrote:
> Attaching a proposed patch that adds such a command.

Erh, that patch was broken, sorry about that.

Attaching a better one!

- Gustav

PS. Maybe a better command name would be (mirror-rectangle)

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: transpose-rect.patch --]
[-- Type: text/x-patch; name="transpose-rect.patch", Size: 2050 bytes --]

Index: lisp/rect.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/rect.el,v
retrieving revision 1.52
diff -u -r1.52 rect.el
--- lisp/rect.el	8 Apr 2006 10:30:19 -0000	1.52
+++ lisp/rect.el	13 Aug 2006 20:44:44 -0000
@@ -392,6 +392,46 @@
 	(delete-region pt (point))
 	(indent-to endcol)))))
 
+(defun transpose-array (array)
+  "Returns a new array which is a transposed copy of
+ARRAY (vector, string, or bool-vector)."
+  (let* ((length (length array))
+         (result (apply (cond ((vectorp array) 'make-vector)
+                              ((stringp array) 'make-string)
+                              ((bool-vector-p array) 'make-bool-vector)
+                              (t (signal 'wrong-type-argument '(arrayp array))))
+                        (list length 0)))
+         (index length))
+    (while (> index 0)
+      (setq index (1- index))
+      (aset result index (aref array (- length 1 index))))
+    result))
+
+;;;###autoload
+(defun transpose-rectangle (start end &optional horizontal vertical)
+  "Replace the region-rectangle with its mirror image.
+
+By default, only horizontal transposition is done. With a prefix
+argument, ask whether to transpose horizontally and/or vertically.
+
+If HORIZONTAL is non-nil, each line in the rectangle is transposed.
+If VERTICAL is non-nil, all lines in the rectangle are transposed.
+
+When called from a program, the rectangle's corners are START and END."
+  (interactive
+   (append (list (region-beginning) (region-end))
+           (if current-prefix-arg
+               (list (y-or-n-p "Transpose horizontally? ")
+                     (y-or-n-p "Transpose vertically? "))
+             '(t nil))))
+  (let ((rect (delete-extract-rectangle start end)))
+    (when vertical
+      (setq rect (reverse rect)))
+    (when horizontal
+      (setq rect (mapcar (function transpose-array) rect)))
+    (goto-char start)
+    (insert-rectangle rect)))
+
 (provide 'rect)
 
 ;;; arch-tag: 178847b3-1f50-4b03-83de-a6e911cc1d16

[-- Attachment #3: Type: text/plain, Size: 149 bytes --]

_______________________________________________
bug-gnu-emacs mailing list
bug-gnu-emacs@gnu.org
http://lists.gnu.org/mailman/listinfo/bug-gnu-emacs