X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/0c54cd99f539b7fb790e590dd59a1ea73a4ec59d..9250c1e82544edcc8bf62ec9a5149e575fa3c73f:/lisp/rect.el diff --git a/lisp/rect.el b/lisp/rect.el index f20ae6b5b4..eb188fc1d5 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -1,16 +1,17 @@ ;;; rect.el --- rectangle functions for GNU Emacs -;; Copyright (C) 1985, 1999, 2000, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1999, 2000, 2001, 2002, 2003, 2004 +;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. ;; Maintainer: Didier Verna ;; Keywords: internal ;; 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 @@ -18,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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -32,17 +31,26 @@ ;; intrusive and fill lines with whitespaces only when needed. A few functions ;; are untouched though, as noted above their definition. +;;; Global key bindings + +;;;###autoload (define-key ctl-x-r-map "c" 'clear-rectangle) +;;;###autoload (define-key ctl-x-r-map "k" 'kill-rectangle) +;;;###autoload (define-key ctl-x-r-map "d" 'delete-rectangle) +;;;###autoload (define-key ctl-x-r-map "y" 'yank-rectangle) +;;;###autoload (define-key ctl-x-r-map "o" 'open-rectangle) +;;;###autoload (define-key ctl-x-r-map "t" 'string-rectangle) ;;; Code: ;;;###autoload (defun move-to-column-force (column &optional flag) - "Obsolete. Use `move-to-column'. -If COLUMN is within a multi-column character, replace it by spaces and tab. + "If COLUMN is within a multi-column character, replace it by spaces and tab. As for `move-to-column', passing anything but nil or t in FLAG will move to the desired column only if the line is long enough." (move-to-column column (or flag t))) -(make-obsolete 'move-to-column-force "move-to-column" "21.2") + +;;;###autoload +(make-obsolete 'move-to-column-force 'move-to-column "21.2") ;; not used any more --dv ;; extract-rectangle-line stores lines into this list @@ -126,21 +134,20 @@ the function is called." )) (defun delete-rectangle-line (startcol endcol fill) - (when (= (move-to-column startcol (or fill 'coerce)) startcol) + (when (= (move-to-column startcol (if fill t 'coerce)) startcol) (delete-region (point) (progn (move-to-column endcol 'coerce) (point))))) (defun delete-extract-rectangle-line (startcol endcol lines fill) (let ((pt (point-at-eol))) - (if (< (move-to-column startcol (or fill 'coerce)) startcol) + (if (< (move-to-column startcol (if fill t 'coerce)) startcol) (setcdr lines (cons (spaces-string (- endcol startcol)) (cdr lines))) ;; else (setq pt (point)) (move-to-column endcol t) - (setcdr lines (cons (buffer-substring pt (point)) (cdr lines))) - (delete-region pt (point))) + (setcdr lines (cons (filter-buffer-substring pt (point) t) (cdr lines)))) )) ;; ### NOTE: this is actually the only function that needs to do complicated @@ -180,13 +187,10 @@ the function is called." ;; this one is untouched --dv (defun spaces-string (n) + "Return a string with N spaces." (if (<= n 8) (aref spaces-strings n) - (let ((val "")) - (while (> n 8) - (setq val (concat " " val) - n (- n 8))) - (concat val (aref spaces-strings n))))) - + (make-string n ?\s))) + ;;;###autoload (defun delete-rectangle (start end &optional fill) "Delete (don't save) text in the region-rectangle. @@ -231,12 +235,22 @@ When called from a program the rectangle's corners are START and END. You might prefer to use `delete-extract-rectangle' from a program. With a prefix (or a FILL) argument, also fill lines where nothing has to be -deleted." - (interactive "*r\nP") - (when buffer-read-only - (setq killed-rectangle (extract-rectangle start end)) - (barf-if-buffer-read-only)) - (setq killed-rectangle (delete-extract-rectangle start end fill))) +deleted. + +If the buffer is read-only, Emacs will beep and refrain from deleting +the rectangle, but put it in the kill ring anyway. This means that +you can use this command to copy text from a read-only buffer. +\(If the variable `kill-read-only-ok' is non-nil, then this won't +even beep.)" + (interactive "r\nP") + (condition-case nil + (setq killed-rectangle (delete-extract-rectangle start end fill)) + ((buffer-read-only text-read-only) + (setq killed-rectangle (extract-rectangle start end)) + (if kill-read-only-ok + (progn (message "Read only text copied to kill ring") nil) + (barf-if-buffer-read-only) + (signal 'text-read-only (list (current-buffer))))))) ;; this one is untouched --dv ;;;###autoload @@ -265,7 +279,7 @@ and point is at the lower right corner." (or (bolp) (insert ?\n)) (move-to-column insertcolumn t))) (setq first nil) - (insert (car lines)) + (insert-for-yank (car lines)) (setq lines (cdr lines))))) ;;;###autoload @@ -276,24 +290,26 @@ The text previously in the region is not overwritten by the blanks, but instead winds up to the right of the rectangle. When called from a program the rectangle's corners are START and END. -With a prefix (or a FILL) argument, fill with blanks even if there is no text -on the right side of the rectangle." +With a prefix (or a FILL) argument, fill with blanks even if there is +no text on the right side of the rectangle." (interactive "*r\nP") (apply-on-rectangle 'open-rectangle-line start end fill) (goto-char start)) (defun open-rectangle-line (startcol endcol fill) - (when (= (move-to-column startcol (or fill 'coerce)) startcol) + (when (= (move-to-column startcol (if fill t 'coerce)) startcol) (unless (and (not fill) (= (point) (point-at-eol))) (indent-to endcol)))) (defun delete-whitespace-rectangle-line (startcol endcol fill) - (when (= (move-to-column startcol (or fill 'coerce)) startcol) + (when (= (move-to-column startcol (if fill t 'coerce)) startcol) (unless (= (point) (point-at-eol)) (delete-region (point) (progn (skip-syntax-forward " ") (point)))))) -;;;###autoload (defalias 'close-rectangle 'delete-whitespace-rectangle) ;; Old name +;;;###autoload +(defalias 'close-rectangle 'delete-whitespace-rectangle) ;; Old name + ;;;###autoload (defun delete-whitespace-rectangle (start end &optional fill) "Delete all whitespace following a specified column in each line. @@ -318,7 +334,6 @@ With a prefix (or a FILL) argument, also fill too short lines." (insert string)) ;;;###autoload - (defun string-rectangle (start end string) "Replace rectangle contents with STRING on each line. The length of STRING need not be the same as the rectangle width. @@ -329,7 +344,7 @@ Called from a program, takes three args; START, END and STRING." (list (region-beginning) (region-end) - (read-string (format "String rectangle (default `%s'): " + (read-string (format "String rectangle (default %s): " (or (car string-rectangle-history) "")) nil 'string-rectangle-history (car string-rectangle-history))))) @@ -350,7 +365,7 @@ This command does not delete or overwrite any existing text." (list (region-beginning) (region-end) - (read-string (format "String insert rectangle (default `%s'): " + (read-string (format "String insert rectangle (default %s): " (or (car string-rectangle-history) "")) nil 'string-rectangle-history (car string-rectangle-history))))) @@ -369,7 +384,7 @@ rectangle which were empty." (defun clear-rectangle-line (startcol endcol fill) (let ((pt (point-at-eol))) - (when (= (move-to-column startcol (or fill 'coerce)) startcol) + (when (= (move-to-column startcol (if fill t 'coerce)) startcol) (if (and (not fill) (<= (save-excursion (goto-char pt) (current-column)) endcol)) (delete-region (point) pt) @@ -382,4 +397,5 @@ rectangle which were empty." (provide 'rect) +;; arch-tag: 178847b3-1f50-4b03-83de-a6e911cc1d16 ;;; rect.el ends here