xemacs-beta: lisp/rect.el comparison

comparison lisp/rect.el @ 442:abe6d1db359e r21-2-36

Import from CVS: tag r21-2-36

author	cvs
date	Mon, 13 Aug 2007 11:35:02 +0200
parents	8de8e3f6228a
children	1ccc32a20af4

comparison

equal deleted inserted replaced

-:72a7cfa4a488
+:abe6d1db359e
 ;;; 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.
 ;; XEmacs is free software; you can redistribute it and/or modify it
 ;; 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
+;; <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:
 (while (< (point) endpt)
 	(apply function startcol endcol args)
 	(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)
 (let ((val ""))
 (while (> n 8)
 	(setq val (concat "        " val)
 	      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)))
 (if (< (move-to-column startcol (or fill 'coerce)) startcol)
 	(setcdr lines (cons (spaces-string (- endcol startcol))
 (setcdr lines (cons (buffer-substring pt (point)) (cdr lines)))
 (delete-region pt (point)))
 ))
 ;;;###autoload
-(defun extract-rectangle (start end)
+(defun delete-extract-rectangle (start end &optional fill)
-"Return the contents of the rectangle with corners at START and END,
+"Delete the contents of the rectangle with corners at START and END, and
-as a list of strings, one for each line of the rectangle."
+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
 (defun extract-rectangle-line (startcol endcol lines)
 	(setq line (concat (spaces-string begextra)
 			   line
 			   (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 "*")
 (insert-rectangle killed-rectangle))
 ;; This function is untouched --dv
 ;;;###autoload
 (defun insert-rectangle (rectangle)
 "Insert text of RECTANGLE with upper left corner at point.
 	    (move-to-column insertcolumn t)))
 (setq first nil)
 (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.
 When called from a program, the rectangle's corners are START and END.
 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)
+(defun string-rectangle-line (startcol endcol string delete)
-(when (= (move-to-column startcol (or fill 'coerce)) startcol)
+(move-to-column startcol t)
-(unless (and (not fill)
+(if delete
-		   (= (point) (point-at-eol)))
+(delete-rectangle-line startcol endcol nil))
-	(indent-to endcol)))
+(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
+The left edge of the rectangle specifies the column for insertion.
-command does not delete or overwrite any existing text.
+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))
+(defvar pending-delete-mode)
+(apply-on-rectangle 'string-rectangle-line start end string
-(defun string-rectangle-line (startcol endcol string)
+(and (boundp 'pending-delete-mode) pending-delete-mode)))
-(move-to-column startcol t)
-(insert string))
+(defun replace-rectangle (start end string)
+"Like `string-rectangle', but unconditionally replace the original region,
-;;;###autoload
+as if `pending-delete-mode' were active."
-(defun clear-rectangle (start end &optional fill)
+(interactive "*r\nsString rectangle: ")
-"Blank out the region-rectangle.
+(apply-on-rectangle 'string-rectangle-line start end string t))
-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))
 (defun clear-rectangle-line (startcol endcol fill)
 (let ((pt (point-at-eol))
 	spaces)
 (when (= (move-to-column startcol (or fill 'coerce)) startcol)
 	(setq spaces (- (point) pt))
 	(delete-region pt (point))
 	(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

Mercurial > hg > xemacs-beta

comparison lisp/rect.el @ 442:abe6d1db359e r21-2-36