X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Frect.el;h=28f054913d1fe1ba32bd1b394fa776290601c8da;hb=89dd1955617972a104d64b0343cf81a54331656b;hp=737e1d32cc6bacbf1e7f901c2b8037416869678f;hpb=1e7fd761ecf5fd2208bde8e30fc6f7cbf789b7db;p=chise%2Fxemacs-chise.git.1 diff --git a/lisp/rect.el b/lisp/rect.el index 737e1d3..28f0549 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -1,8 +1,8 @@ ;;; rect.el --- rectangle functions for XEmacs. -;; Copyright (C) 1985, 1993, 1994, 1999 Free Software Foundation, Inc. +;; Copyright (C) 1985-2000 Free Software Foundation, Inc. -;; Maintainer: Didier Verna +;; Maintainer: Didier Verna ;; Keywords: internal ;; This file is part of XEmacs. @@ -26,18 +26,18 @@ ;;; Commentary: -;; This package provides the operations on rectangles that are ocumented +;; This package provides the operations on rectangles that are documented ;; in the XEmacs Reference Manual. -;; ### NOTE: this file has been almost completely rewritten by Didier Verna -;; , Jul 99. The purpose of this rewrite is to be less +;; #### NOTE: this file has been almost completely rewritten by Didier Verna +;; , Jul 99. 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. ;;; Code: -;; ### NOTE: this function is untouched, but not used anymore. +;; #### NOTE: this function is untouched, but not used anymore. ;; `apply-on-rectangle' is used instead. It's still there because it's ;; documented so people might use it in their code, so I've decided not to ;; touch it. --dv @@ -86,10 +86,10 @@ Point is at the end of the segment of this line within the rectangle." ;; The replacement for `operate-on-rectangle' -- dv (defun apply-on-rectangle (function start end &rest args) - "Call FUNCTION for each line of rectangle with corners at START, END. + "Call FUNCTION for each line of rectangle with corners at START and END. FUNCTION is called with two arguments: the start and end columns of the -rectangle, plus ARGS extra arguments. Point is at the beginning of line when -the function is called." +rectangle, plus ARGS extra arguments. Point is at the beginning of line +when the function is called." (let (startcol startpt endcol endpt) (save-excursion (goto-char start) @@ -111,6 +111,31 @@ the function is called." (forward-line 1))) )) + +(defun delete-rectangle-line (startcol endcol fill) + (let ((pt (point-at-eol))) + (when (= (move-to-column startcol (or fill 'coerce)) startcol) + (if (and (not fill) (<= pt endcol)) + (delete-region (point) pt) + ;; else + (setq pt (point)) + (move-to-column endcol t) + (delete-region pt (point)))) + )) + +;;;###autoload +(defun delete-rectangle (start end &optional fill) + "Delete the text in the region-rectangle without saving it. +The same range of columns is deleted in each line starting with the line +where the region begins and ending with the line where the region ends. + +When called from a program, the rectangle's corners are START and END. +With a prefix (or FILL) argument, also fill lines where nothing has to be +deleted." + (interactive "*r\nP") + (apply-on-rectangle 'delete-rectangle-line start end fill)) + + ;; I love ascii art ;-) (defconst spaces-strings '["" " " @@ -122,7 +147,6 @@ the function is called." " " " "]) - ;; This function is untouched --dv (defun spaces-string (n) (if (<= n 8) (aref spaces-strings n) @@ -132,57 +156,6 @@ the function is called." n (- n 8))) (concat val (aref spaces-strings n))))) -;;;###autoload -(defvar killed-rectangle nil - "Rectangle for yank-rectangle to insert.") - -;;;###autoload -(defun kill-rectangle (start end &optional fill) - "Delete the rectangle with corners at point and mark (START and END when -called from a program) and save it as the last killed one. 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))) - -;;;###autoload -(defun delete-rectangle (start end &optional fill) - "Delete (don't save) text in rectangle with corners at point and mark (START -and END when called from a program). The same range of columns is deleted in -each line starting with the line where the region begins and ending with the -line where the region ends. - -With a prefix (or a FILL) argument, also fill lines where nothing has to be -deleted." - (interactive "r\nP") - (apply-on-rectangle 'delete-rectangle-line start end fill)) - -(defun delete-rectangle-line (startcol endcol fill) - (let ((pt (point-at-eol))) - (when (= (move-to-column startcol (or fill 'coerce)) startcol) - (if (and (not fill) (<= pt endcol)) - (delete-region (point) pt) - ;; else - (setq pt (point)) - (move-to-column endcol t) - (delete-region pt (point)))) - )) - -;;;###autoload -(defun delete-extract-rectangle (start end &optional fill) - "Delete the contents of the rectangle with corners at START and END, and -return it as a list of strings, one for each line of the rectangle. - -With an optional FILL argument, also fill lines where nothing has to be -deleted." - (let ((lines (list nil))) - (apply-on-rectangle 'delete-extract-rectangle-line start end lines fill) - (nreverse (cdr lines)))) (defun delete-extract-rectangle-line (startcol endcol lines fill) (let ((pt (point-at-eol))) @@ -197,14 +170,18 @@ deleted." )) ;;;###autoload -(defun extract-rectangle (start end) - "Return the contents of the rectangle with corners at START and END, -as a list of strings, one for each line of the rectangle." +(defun delete-extract-rectangle (start end &optional fill) + "Delete the contents of the rectangle with corners at START and END, and +return it as a list of strings, one for each line of the rectangle. + +With an optional FILL argument, also fill lines where nothing has to be +deleted." (let ((lines (list nil))) - (apply-on-rectangle 'extract-rectangle-line start end lines) + (apply-on-rectangle 'delete-extract-rectangle-line start end lines fill) (nreverse (cdr lines)))) -;; ### NOTE: this is actually the only function that needs to do complicated + +;; #### NOTE: this is actually the only function that needs to do complicated ;; stuff like what's happening in `operate-on-rectangle', because the buffer ;; might be read-only. --dv (defun extract-rectangle-line (startcol endcol lines) @@ -224,7 +201,7 @@ as a list of strings, one for each line of the rectangle." (goto-char start) (while (search-forward "\t" end t) (let ((width (- (current-column) - (save-excursion (forward-char -1) + (save-excursion (backward-char 1) (current-column))))) (setq line (concat (substring line 0 (- (point) end 1)) (spaces-string width) @@ -236,13 +213,41 @@ as a list of strings, one for each line of the rectangle." (spaces-string endextra)))) (setcdr lines (cons line (cdr lines))))) +;;;###autoload +(defun extract-rectangle (start end) + "Return the contents of the rectangle with corners at START and END, +as a list of strings, one for each line of the rectangle." + (let ((lines (list nil))) + (apply-on-rectangle 'extract-rectangle-line start end lines) + (nreverse (cdr lines)))) + + +;;;###autoload +(defvar killed-rectangle nil + "Rectangle for `yank-rectangle' to insert.") + +;;;###autoload +(defun kill-rectangle (start end &optional fill) + "Delete the region-rectangle and save it as the last killed one. +You might prefer to use `delete-extract-rectangle' from a program. + +When called from a program, the rectangle's corners are START and END. +With a prefix (or 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))) + ;; This function is untouched --dv ;;;###autoload (defun yank-rectangle () "Yank the last killed rectangle with upper left corner at point." - (interactive) + (interactive "*") (insert-rectangle killed-rectangle)) + ;; This function is untouched --dv ;;;###autoload (defun insert-rectangle (rectangle) @@ -266,50 +271,52 @@ and point is at the lower right corner." (insert (car lines)) (setq lines (cdr lines))))) + +(defun open-rectangle-line (startcol endcol fill) + (when (= (move-to-column startcol (or fill 'coerce)) startcol) + (unless (and (not fill) + (= (point) (point-at-eol))) + (indent-to endcol)))) + ;;;###autoload (defun open-rectangle (start end &optional fill) - "Blank out rectangle with corners at point and mark (START and END when -called from a program), shifting text right. The text previously in the region -is not overwritten by the blanks, but instead winds up to the right of the -rectangle. + "Blank out the region-rectangle, shifting text right. -With a prefix (or a FILL) argument, fill with blanks even if there is no text +When called from a program, the rectangle's corners are START and END. +With a prefix (or FILL) argument, fill with blanks even if there is no text on the right side of the rectangle." - (interactive "r\nP") + (interactive "*r\nP") (apply-on-rectangle 'open-rectangle-line start end fill) (goto-char start)) -(defun open-rectangle-line (startcol endcol fill) - (let (spaces) - (when (= (move-to-column startcol (or fill 'coerce)) startcol) - (unless (and (not fill) - (= (point) (point-at-eol))) - (indent-to endcol))) - )) -;;;###autoload -(defun string-rectangle (start end string) - "Insert STRING on each line of the rectangle with corners at point and mark -(START and END when called from a program), shifting text right. The left edge -of the rectangle specifies the column for insertion. This command does not -delete or overwrite any existing text." - (interactive "r\nsString rectangle: ") - (apply-on-rectangle 'string-rectangle-line start end string)) - -(defun string-rectangle-line (startcol endcol string) +(defun string-rectangle-line (startcol endcol string delete) (move-to-column startcol t) + (if delete + (delete-rectangle-line startcol endcol nil)) (insert string)) ;;;###autoload -(defun clear-rectangle (start end &optional fill) - "Blank out the rectangle with corners at point and mark (START and END when -called from a program). The text previously in the region is overwritten with -blanks. +(defun string-rectangle (start end string) + "Insert STRING on each line of the region-rectangle, shifting text right. +The left edge of the rectangle specifies the column for insertion. + +If `pending-delete-mode' is active the string replace the region. +Otherwise this command does not delete or overwrite any existing text. + +When called from a program, the rectangle's corners are START and END." + (interactive "*r\nsString rectangle: ") + (defvar pending-delete-mode) + (apply-on-rectangle 'string-rectangle-line start end string + (and (boundp 'pending-delete-mode) pending-delete-mode))) + +;;;###autoload +(defun replace-rectangle (start end string) + "Like `string-rectangle', but unconditionally replace the original region, +as if `pending-delete-mode' were active." + (interactive "*r\nsString rectangle: ") + (apply-on-rectangle 'string-rectangle-line start end string t)) -With a prefix (or a FILL) argument, also fill with blanks the parts of the -rectangle which were empty." - (interactive "r\nP") - (apply-on-rectangle 'clear-rectangle-line start end fill)) (defun clear-rectangle-line (startcol endcol fill) (let ((pt (point-at-eol)) @@ -326,6 +333,18 @@ rectangle which were empty." (indent-to (+ (current-column) spaces)))) )) +;;;###autoload +(defun clear-rectangle (start end &optional fill) + "Blank out the region-rectangle. +The text previously in the region is overwritten with blanks. + +When called from a program, the rectangle's corners are START and END. +With a prefix (or FILL) argument, also fill with blanks the parts of the +rectangle which were empty." + (interactive "*r\nP") + (apply-on-rectangle 'clear-rectangle-line start end fill)) + + (provide 'rect) ;;; rect.el ends here