;;; 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 <verna@inf.enst.fr>
+;; Maintainer: Didier Verna <didier@xemacs.org>
;; Keywords: internal
;; This file is part of XEmacs.
;;; 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
-;; <verna@inf.enst.fr>, Jul 99. The purpose of this rewrite is to be less
+;; #### NOTE: this file has been almost completely rewritten by Didier Verna
+;; <didier@xemacs.org>, 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
;; 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)
(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 '[""
" "
" "
" "])
-
;; This function is untouched --dv
(defun spaces-string (n)
(if (<= n 8) (aref spaces-strings n)
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)))
))
;;;###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)
(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)
(insert (car lines))
(setq lines (cdr lines)))))
-;;;###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.
-
-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)
(let (spaces)
))
;;;###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 open-rectangle (start end &optional fill)
+ "Blank out the region-rectangle, shifting text right.
+
+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")
+ (apply-on-rectangle 'open-rectangle-line start end fill)
+ (goto-char start))
+
+
+(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: ")
+ (apply-on-rectangle 'string-rectangle-line start end string
+ (and (boundp 'pending-delete-mode) pending-delete-mode)))
+
+(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))
(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
projects / chise / xemacs-chise.git.1 / blobdiff