[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
FILL RECTANGLE WITH WHITESPACE {was : Re: Zmacs question}
>How do I rigidly shift text beyond the left margin in Zmacs?...
>How can I CHOP OFF COLUMS of text on the left side to the screen?...
The following commands will do the above (actually, they're somewhat more
general than this). These commands allow you to shift or delete arbitrary
columns in the middle of text. These are very useful for formatting text
or code.
{BTW, if anybody outside of BBN gets this, can you drop me a short
response; we were having trouble reaching the outside on this list, so I'm
just checking. Thanks.}
In the following, a "rectangle" is defined as the rectangular area whose
opposite corners are marked by the location of the POINT and MARK (in
either order).
COM-FILL-RECTANGLE-WITH-WHITESPACE
Fills the marked rectangle with whitespace.
For example, if the POINT is set at P and the Mark at M in the following:
::::::::::
::!P!:::::
::! 1!::::
::! 2!:::
::!:::M!::
::::::::::
...executing the command will give:
::::::::::
::! P!:::::
::! 1!::::
::! 2!:::
::! :::M!::
::::::::::
A numeric ARG says align stuff with the left edge, and then shift.
(Aligning means to remove *ALL* whitespace to the right of the left edge).
In this case the result of applying the command to the above text would be:
::::::::::
::! P!:::::
::! 1!::::
::! 2!:::
::! :::M!::
::::::::::
COM-KILL-RECTANGLE
Kills all text in the marked rectangle.
This Kills all the text in the specified rectangle:
::::::::::
::!::::
::!::::
::!!:::
::!M!::
::::::::::
Following is the code, some supporting functions and some example key-bindings.
Enjoy.
NICHAEL
;;; -*- Mode : LISP; Syntax : ZETALISP; Base: 10; Package: ZWEI -*-
;;;********************************************************************************
;;; Written by Nichael Lynn CramerD,#TD1PsT[Begin using 006 escapes](1 0 (NIL 0) (NIL :ITALIC NIL) "CPTFONTI").
(2 0 (NIL 0) (NIL NIL NIL) "CPTFONT");;;***********************************************************************NLC8FEB90
;;; Move POINT to pixel GOAL, leaving it on the same line. Return t if successful.
;;; If reach the end of the line, return nil, with POINT left at the end of the line.
(defun move-point-to-position (GOAL)
(with-bp (END-BP (POINT) nil)
(let ((FLAG nil))
(move-bp (POINT) (beg-line (POINT) 0 t))
(move-bp END-BP (move-bp END-BP (end-line (POINT) 0 t)))
(loop for INDENT = (bp-indentation (POINT))
do (cond ((<= GOAL INDENT) ;;; FOUND THE GOAL; NORMAL END
(setq FLAG t)
(loop-finish))
((char-equal (bp-char (POINT)) #/Tab) ;;; WE FOUND US A TAB
(if (< GOAL (bp-indentation (FORWARD-CHAR (POINT) 1))) ;;; THE GOAL IS INSIDE THIS TAB
(tab-convert (POINT) (forward-char (POINT) 1)) ;;; CONVERT THIS TAB AND CONTINUE
(move-bp (POINT) (FORWARD-CHAR (POINT) 1)))) ;;; ELSE JUST MOVE FORWARD
((move-bp (POINT) (forward-char (POINT) 1)) ;;; IF THIS IS NIL, WE WANT TO END
(unless (eq (bp-line END-BP) (bp-line (POINT)))
(move-point (forward-char (POINT) -1)) ;;; FELL OFF THE END OF THE LINE
(loop-finish)))
(t
(beep)
(loop-finish))))
FLAG))
)
;;; Fill the rectangular region (defined by the POINT and the MARK being at
;;; opposite corners) with whitespace.
;;; HARD-ALIGN? means kill all whitespace to the right of the left edge before
;;; inserting the whitespace.
(defun whitespace-fill-internal (HARD-ALIGN?)
(let ((X1 (bp-indentation (POINT)))
(L2 (bp-line (MARK)))
(X2 (bp-indentation (MARK))))
(when (< X2 X1)
(swapf X1 X2))
(loop do (when (move-point-to-position X1)
(when HARD-ALIGN?
(delete-interval (POINT) (forward-over *WHITESPACE-CHARS* (POINT)) t))
(indent-to (POINT) X2))
until (search-for-line (bp-line (POINT)) L2)
do (down-real-line 1)))
)
;;; Kill the rectangular region (defined by the POINT and the MARK being at
;;; opposite corners).
(defun delete-rectangle-internal ()
(let ((X1 (bp-indentation (POINT)))
(L2 (bp-line (MARK)))
(X2 (bp-indentation (MARK)))
(TT))
(when (< X2 X1)
(swapf X1 X2))
(loop do (when (move-point-to-position X1)
(setq TT (copy-bp (point)))
(cond ((move-point-to-position X2)
;;; NORMAL CASE: CHOP OUT THE REGION ON THIS LINE
(kill-interval TT (POINT) t))
((and (char= (bp-char (point)) #/Return)
(bp-< X2 (POINT)))
;;; IF LINE ENDS IN THE MIDDLE OF THE REGION, SAVE THE CARRIAGE-RETURN
(kill-interval TT (move-point (forward-char (POINT) -1)) t))))
until (search-for-line (bp-line (POINT)) L2)
do (down-real-line 1)))
)
;;;********************************************************************************
;;; Delete Rectangle.
;;;**********************************************************************NLC15AUG89
(defcom COM-KILL-RECTANGLE "Kill the rectangular, marked region.
The 'rectangular region' is defined by the MARK and the POINT being at opposite corners.
If past the end of a particular line, skip it."
()
(cond ((window-region-p)
(when (bp-< (MARK) (POINT)) (swap-point-and-mark))
(delete-rectangle-internal))
((window-mark-p *WINDOW*)
(barf "There is a region, but it is empty"))
(t
(barf "No Region Marked.")))
DIS-TEXT)
;;;********************************************************************************
;;; Fill rectangle with whitespace.
;;;**********************************************************************NLC22SEP87
(defcom COM-FILL-RECTANGLE-WITH-WHITESPACE "Fill the rectangular, marked region with whitespace.
The 'rectangular region' is defined by the MARK and the POINT being at opposite corners.
If past the end of a particular line, skip it.
With ARG, first kill all whitespace to the right of the left edge, then move the
rest of the resulting line over to where the left edge is."
()
(cond ((window-region-p)
(when (bp-< (MARK) (POINT)) (swap-point-and-mark))
(whitespace-fill-internal *NUMERIC-ARG-P*))
((window-mark-p *WINDOW*)
(barf "There is a region, but it is empty"))
(t
(barf "No Region Marked.")))
DIS-TEXT)
#|
(set-comtab *STANDARD-COMTAB*
'(#\Hyper-Space COM-FILL-RECTANGLE-WITH-WHITESPACE
#\Hyper-W COM-KILL-RECTANGLE
))
|#