X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Frect.el;h=28f054913d1fe1ba32bd1b394fa776290601c8da;hb=d3fd3a22f4ed2697da4fde3f2c599876e12b5a02;hp=f70149f78e214b00dace5edd419eb10510825cb9;hpb=716cfba952c1dc0d2cf5c968971f3780ba728a89;p=chise%2Fxemacs-chise.git.1 diff --git a/lisp/rect.el b/lisp/rect.el index f70149f..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. @@ -30,7 +30,7 @@ ;; 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 +;; , 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. @@ -111,6 +111,31 @@ when 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 @@ when the function is called." " " " "]) - ;; This function is untouched --dv (defun spaces-string (n) (if (<= n 8) (aref spaces-strings n) @@ -132,57 +156,6 @@ when 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 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))) - -;;;###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)) - -(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,13 +170,17 @@ 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 ;; stuff like what's happening in `operate-on-rectangle', because the buffer ;; might be read-only. --dv @@ -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,6 +213,33 @@ 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 () @@ -243,6 +247,7 @@ as a list of strings, one for each line of the rectangle." (interactive "*") (insert-rectangle killed-rectangle)) + ;; This function is untouched --dv ;;;###autoload (defun insert-rectangle (rectangle) @@ -266,6 +271,13 @@ 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 the region-rectangle, shifting text right. @@ -277,38 +289,34 @@ on the right side of the rectangle." (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))) - )) + +(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 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. This -command does not delete or overwrite any existing text. +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: ") - (apply-on-rectangle 'string-rectangle-line start end string)) - -(defun string-rectangle-line (startcol endcol string) - (move-to-column startcol t) - (insert string)) + (defvar pending-delete-mode) + (apply-on-rectangle 'string-rectangle-line start end string + (and (boundp 'pending-delete-mode) pending-delete-mode))) ;;;###autoload -(defun clear-rectangle (start end &optional fill) - "Blank out the region-rectangle. -The text previously in the region is overwritten with blanks. +(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)) -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)) (defun clear-rectangle-line (startcol endcol fill) (let ((pt (point-at-eol)) @@ -325,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