X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/35f901fa576cd5950e0626ac848835c4df612329..fe6456af41ce3e4581e7ebfc01a7f9b5ba67fd67:/lisp/rect.el diff --git a/lisp/rect.el b/lisp/rect.el index 4d9f034d9b..1fa5900b2c 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -1,8 +1,8 @@ -;;; rect.el --- rectangle functions for GNU Emacs. +;;; rect.el --- rectangle functions for GNU Emacs ;; Copyright (C) 1985, 1999, 2000, 2001 Free Software Foundation, Inc. -;; Maintainer: Didier Verna +;; Maintainer: Didier Verna ;; Keywords: internal ;; This file is part of GNU Emacs. @@ -28,7 +28,7 @@ ;; in the Emacs manual. ;; ### NOTE: this file has been almost completely rewritten by Didier Verna -;; in July 1999. The purpose of this rewrite is to be less +;; in July 1999. The purpose of this rewrite is to be less ;; intrusive and fill lines with whitespaces only when needed. A few functions ;; are untouched though, as noted above their definition. @@ -37,21 +37,13 @@ ;;;###autoload (defun move-to-column-force (column &optional flag) - "Move point to column COLUMN rigidly in the current line. -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." - (let ((col (move-to-column column (or flag t)))) - (if (> col column) - (let (pos) - (delete-char -1) - (insert-char ? (- column (current-column))) - (setq pos (point)) - (indent-to col) - (goto-char pos))) - column)) + (move-to-column column (or flag t))) + +;;;###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 @@ -88,12 +80,12 @@ Point is at the end of the segment of this line within the rectangle." (while (< (point) endlinepos) (let (startpos begextra endextra) (if coerce-tabs - (move-to-column-force startcol) + (move-to-column startcol t) (move-to-column startcol)) (setq begextra (- (current-column) startcol)) (setq startpos (point)) (if coerce-tabs - (move-to-column-force endcol) + (move-to-column endcol t) (move-to-column endcol)) ;; If we overshot, move back one character ;; so that endextra will be positive. @@ -135,24 +127,19 @@ the function is called." )) (defun delete-rectangle-line (startcol endcol fill) - (let ((pt (line-end-position))) - (when (= (move-to-column-force startcol (or fill 'coerce)) startcol) - (if (and (not fill) (<= pt endcol)) - (delete-region (point) pt) - ;; else - (setq pt (point)) - (move-to-column-force endcol) - (delete-region pt (point)))) - )) + (when (= (move-to-column startcol (or fill '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-force startcol (or fill 'coerce)) startcol) + (if (< (move-to-column startcol (or fill 'coerce)) startcol) (setcdr lines (cons (spaces-string (- endcol startcol)) (cdr lines))) ;; else (setq pt (point)) - (move-to-column-force endcol) + (move-to-column endcol t) (setcdr lines (cons (buffer-substring pt (point)) (cdr lines))) (delete-region pt (point))) )) @@ -277,9 +264,9 @@ and point is at the lower right corner." (progn (forward-line 1) (or (bolp) (insert ?\n)) - (move-to-column-force insertcolumn))) + (move-to-column insertcolumn t))) (setq first nil) - (insert (car lines)) + (insert-for-yank (car lines)) (setq lines (cdr lines))))) ;;;###autoload @@ -297,17 +284,19 @@ on the right side of the rectangle." (goto-char start)) (defun open-rectangle-line (startcol endcol fill) - (when (= (move-to-column-force startcol (or fill 'coerce)) startcol) + (when (= (move-to-column startcol (or fill '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-force startcol (or fill 'coerce)) startcol) + (when (= (move-to-column startcol (or fill '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. @@ -324,9 +313,9 @@ With a prefix (or a FILL) argument, also fill too short lines." ;; string-rectangle uses this variable to pass the string ;; to string-rectangle-line. (defvar string-rectangle-string) - +(defvar string-rectangle-history nil) (defun string-rectangle-line (startcol endcol string delete) - (move-to-column-force startcol) + (move-to-column startcol t) (if delete (delete-rectangle-line startcol endcol nil)) (insert string)) @@ -337,9 +326,18 @@ With a prefix (or a FILL) argument, also fill too short lines." The length of STRING need not be the same as the rectangle width. Called from a program, takes three args; START, END and STRING." - (interactive "*r\nsString rectangle: ") + (interactive + (progn (barf-if-buffer-read-only) + (list + (region-beginning) + (region-end) + (read-string (format "String rectangle (default `%s'): " + (or (car string-rectangle-history) "")) + nil 'string-rectangle-history + (car string-rectangle-history))))) (apply-on-rectangle 'string-rectangle-line start end string t)) +;;;###autoload (defalias 'replace-rectangle 'string-rectangle) ;;;###autoload @@ -349,7 +347,15 @@ Called from a program, takes three args; START, END and STRING." When called from a program, the rectangle's corners are START and END. The left edge of the rectangle specifies the column for insertion. This command does not delete or overwrite any existing text." - (interactive "*r\nsString insert rectangle: ") + (interactive + (progn (barf-if-buffer-read-only) + (list + (region-beginning) + (region-end) + (read-string (format "String insert rectangle (default `%s'): " + (or (car string-rectangle-history) "")) + nil 'string-rectangle-history + (car string-rectangle-history))))) (apply-on-rectangle 'string-rectangle-line start end string nil)) ;;;###autoload @@ -364,18 +370,17 @@ rectangle which were empty." (apply-on-rectangle 'clear-rectangle-line start end fill)) (defun clear-rectangle-line (startcol endcol fill) - (let ((pt (point-at-eol)) - spaces) - (when (= (move-to-column-force startcol (or fill 'coerce)) startcol) + (let ((pt (point-at-eol))) + (when (= (move-to-column startcol (or fill 'coerce)) startcol) (if (and (not fill) (<= (save-excursion (goto-char pt) (current-column)) endcol)) (delete-region (point) pt) ;; else (setq pt (point)) - (move-to-column-force endcol) - (setq spaces (- (point) pt)) + (move-to-column endcol t) + (setq endcol (current-column)) (delete-region pt (point)) - (indent-to (+ (current-column) spaces)))))) + (indent-to endcol))))) (provide 'rect)