home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Crawly Crypt Collection 2
/
crawlyvol2.bin
/
apps
/
text_ed
/
emacs
/
bpage.cmd
< prev
next >
Wrap
OS/2 REXX Batch file
|
1989-06-07
|
11KB
|
559 lines
; BPAGE.CMD: Box Macro and rectangualr region page
; for MicroEMACS 3.9d and above
; (C)opyright 1987 by Suresh Konda and Daniel M Lawrence
; Last Update: 11/02/87
; make sure the function key window is up
set %rcfkeys FALSE
execute-macro-1
write-message "Loading..."
; set the clean procedure up
store-procedure clean
delete-buffer "[Macro 10]"
delete-buffer "[Macro 11]"
delete-buffer "[Macro 12]"
delete-buffer "[getblock]"
delete-buffer "[putblock]"
delete-buffer "[Macro 13]"
delete-buffer "[Macro 14]"
delete-buffer "[Macro 15]"
delete-buffer "[Macro 16]"
delete-buffer "[Macro 17]"
delete-buffer "[Macro 18]"
delete-buffer "[Macro 19]"
delete-buffer "[drawbox]"
delete-buffer "[setpoints]"
delete-buffer "[horizontal]"
delete-buffer "[vertical]"
delete-buffer "[horline]"
delete-buffer "[vertline]"
delete-buffer "[delcol]"
delete-buffer "[iline]"
!endm
; Write out the page instructions
save-window
1 next-window
beginning-of-file
set $curcol 25
overwrite-string " F1 Line type [DOUBLE] F2 kill block "
next-line
set $curcol 25
overwrite-string " F3 draw box F4 copy block "
next-line
set $curcol 25
overwrite-string " F5 insert line F6 yank block "
next-line
set $curcol 18
overwrite-string "BOX "
set $curcol 25
overwrite-string " F7 insert space F8 insert block "
next-line
set $curcol 25
overwrite-string " "
unmark-buffer
beginning-of-file
!force restore-window
update-screen
; this sets overwrite mode to off. to change it, set rcinsert to 1
set %rcinsert 0
; change line type
10 store-macro
!if &equ %rcltype 1
set %rcltype 2
set %rctmp "DOUBLE"
!else
set %rcltype 1
set %rctmp "SINGLE"
!endif
set %cbuf $cbufname
set %cline $cwline
select-buffer "Function Keys"
beginning-of-file
1 goto-line
40 forward-character
6 delete-next-character
insert-string %rctmp
unmark-buffer
select-buffer %cbuf
%cline redraw-display
!return
!endm
; Draw a box
12 store-macro
!if &equal %rcltype 1
set %c1 "Z"
set %c2 "D"
set %c3 "?"
set %c4 "@"
set %c5 "Y"
set %c6 "3"
!else
set %c1 "I"
set %c2 "M"
set %c3 ";"
set %c4 "H"
set %c5 "<"
set %c6 ":"
!endif
run drawbox
!endm
; insert a line in a box
14 store-macro
run iline
!endm
; insert a blank line in a box
16 store-macro
set %rctmp %rcltype
set %rcltype 0
run iline
set %rcltype %rctmp
!endm
store-procedure iline
run setpoints
!if &equal %pcol %mcol
run vertical
!else
!if &equal %pline %mline
run horizontal
!else
write-message "Illegal point and mark for lines"
!endif
!endif
!endm
store-procedure setpoints
; procedure will set pcol, pline, mcol and mline. currently at point
set %pcol $curcol
set %pline $curline
exchange-point-and-mark
set %mcol $curcol
set %mline $curline
exchange-point-and-mark
!endm
store-procedure drawbox
run setpoints
set $curline %mline
set $curcol %mcol
;draw top horizontal line
insert-string %c1
; set %width &sub &sub %pcol %mcol 1
set %width &sub %pcol %mcol
%width insert-string %c2
insert-string %c3
newline-and-indent
;draw bottom horizontal line
%pline goto-line
next-line
end-of-line
newline
set $curcol %mcol
insert-string %c4
%width insert-string %c2
insert-string %c5
; bump pline
set %pline &add %pline 1
;draw verticals -- go to top and work our way down
%mline goto-line
!while &less $curline %pline
next-line
detab-line
previous-line
end-of-line
!if &less $curcol %pcol
&sub %pcol $curcol insert-string " "
!endif
set $curcol %pcol
insert-string %c6
set $curcol %mcol
insert-string %c6
!endwhile
;return to point
%pline goto-line
next-line
beginning-of-line
%width forward-character
2 forward-character
!endm
; user procedure to draw a horizontal from mark to point making spaces for
; the characters.
store-procedure horizontal
set %s1 ":"
set %s2 "3"
!if &equal %rcltype 0
; then insert blanks
set %c1 ":"
set %c2 "3"
set %c3 " "
set %c4 ":"
set %c5 "3"
set %c6 ":"
set %c7 "3"
!else
!if &equal %rcltype 1
; then insert a single line
set %c1 "G"
set %c2 "C"
set %c3 "D"
set %c4 "W"
set %c5 "E"
set %c6 "6"
set %c7 "4"
!else
; then insert a double line
set %c1 "L"
set %c2 "F"
set %c3 "M"
set %c4 "N"
set %c5 "X"
set %c6 "9"
set %c7 "5"
!endif
!endif
run horline
!endm
store-procedure vertical
set %s1 "M"
set %s2 "D"
!if &equal %rcltype 0
set %c1 "M"
set %c2 "D"
set %c3 " "
set %c4 "M"
set %c5 "D"
set %c6 "M"
set %c7 "D"
!else
!if &equal %rcltype 1
set %c1 "Q"
set %c2 "B"
set %c3 "3"
set %c4 "X"
set %c5 "E"
set %c6 "O"
set %c7 "A"
!else
set %c1 "K"
set %c2 "R"
set %c3 ":"
set %c4 "N"
set %c5 "W"
set %c6 "J"
set %c7 "P"
!endif
!endif
run verline
!endm
store-procedure horline
; procedure to draw a line from beginning of line to point
!if &equal %mcol %pcol
!return
!endif
!if &less %pcol %mcol
; then point was to left of mark. exchange and reset variables
exchange-point-and-mark
run setpoints
!endif
!if %rcinsert
set $curcol %mcol
!else
end-of-line
newline
; move to under mark
%mcol insert-string " "
!endif
; see if first char is a vertical line
previous-line
set %char &chr $curchar
next-line
%rcinsert delete-next-character
!if &sequal %char %s1
insert-string %c1
!else
!if &sequal %char %s2
insert-string %c2
!else
insert-string %c3
!endif
!endif
; now for all chars but the last character i.e., char at point
!while &less $curcol %pcol
previous-line
set %char &chr $curchar
next-line
%rcinsert delete-next-character
!if &sequal %char %s1
insert-string %c4
!else
!if &sequal %char %s2
insert-string %c5
!else
insert-string %c3
!endif
!endif
!endwhile
; see if last char is a vertical line
previous-line
set %char &chr $curchar
next-line
%rcinsert delete-next-character
!if &sequal %char %s1
insert-string %c6
!else
!if &sequal %char %s2
insert-string %c7
!else
insert-string %c3
!endif
!endif
!endm
store-procedure verline
; proc to draw vertical line from mark to point. mark should be above point.
!if &equal %mline %pline
!return
!endif
; if point was above mark exchange and reset variables
!if &less %pline %mline
exchange-point-and-mark
run setpoints
!endif
;top line
%mline goto-line
set $curcol %pcol
backward-character
set %char &chr $curchar
forward-character
%rcinsert delete-next-character
!if &sequal %char %s1
insert-string %c1
!else
!if &sequal %char %s2
insert-string %c2
!else
insert-string %c3
!endif
!endif
;all but pline
!while &less $curline &sub %pline 1
next-line
beginning-of-line
set $curcol %pcol
backward-character
set %char &chr $curchar
forward-character
%rcinsert delete-next-character
!if &sequal %char %s1
insert-string %c4
!else
!if &sequal %char %s2
insert-string %c5
!else
insert-string %c3
!endif
!endif
!endwhile
; bottom line
next-line
beginning-of-line
set $curcol %pcol
backward-character
set %char &chr $curchar
forward-character
%rcinsert delete-next-character
!if &sequal %char %s1
insert-string %c6
!else
!if &sequal %char %s2
insert-string %c7
!else
insert-string %c3
!endif
!endif
!endm
store-procedure delcol
; proc to delete column. we will use the getblock procedure with the column of
; the point set to one beyond the column point
set-points
!if &equal %mcol %pcol
; same columns
forward-character
run getblock
!return
!else
!if &equal %mline %pline
run getblock
!return
!endif
!endm
; delete a rectangular block of text
11 store-macro
set %bkcopy FALSE
run getblock
write-message "[Block deleted]"
!endm
; copy a rectangular region
13 store-macro
set %bkcopy TRUE
run getblock
write-message "[Block copied]"
!endm
; yank a rectangular region
15 store-macro
set %bkcopy TRUE
run putblock
!endm
; insert a rectangular region
17 store-macro
set %bkcopy FALSE
run putblock
!endm
store-procedure getblock
;set up needed variables
set $discmd FALSE
delete-buffer "[block]"
set %rcbuf $cbufname
set %cline $cwline
;save block boundries
set %endpos $curcol
set %endline $curline
exchange-point-and-mark
set %begpos $curcol
set %begline $curline
set %blwidth &sub %endpos %begpos
;detab the region
&add &sub %endline %begline 1 detab-line
;scan through the block
set $curline %begline
!while &less $curline &add %endline 1
;grab the part of this line needed
!force set $curcol %begpos
set-mark
!force set $curcol %endpos
kill-region
;bring it back if this is just a copy
!if %bkcopy
yank
!endif
;put the line in the block buffer
select-buffer "[block]"
yank
;and pad it if needed
!if &less $curcol %blwidth
&sub %blwidth $curcol insert-space
end-of-line
!endif
forward-character
;onward...
select-buffer %rcbuf
next-line
!endwhile
;unmark the block
select-buffer "[block]"
unmark-buffer
select-buffer %rcbuf
previous-line
%cline redraw-display
set $discmd TRUE
!endm
; insert/overlay a rectangular block of text
store-procedure putblock
;set up needed variables
set $discmd FALSE
set %rcbuf $cbufname
set %cline $cwline
;save block boundries
set %begpos $curcol
set %begline $curline
;scan through the block
select-buffer "[block]"
beginning-of-file
set %endpos &add %begpos $lwidth
!while ¬ &equ $lwidth 0
;pad the destination if it is needed
select-buffer %rcbuf
beginning-of-line
!if ¬ &equ $lwidth 0
detab-line
previous-line
!endif
!force set $curcol %begpos
!if &less $curcol %begpos
&sub %begpos $curcol insert-space
end-of-line
!endif
;delete some stuff if this should overlay
!if %bkcopy
set-mark
!force set $curcol %endpos
kill-region
!endif
;grab the line from the block buffer
select-buffer "[block]"
beginning-of-line
set-mark
end-of-line
copy-region
forward-character
;put the line in the destination position
select-buffer %rcbuf
yank
next-line
;onward...
select-buffer "[block]"
!endwhile
select-buffer %rcbuf
set $curline %begline
set $curcol %begpos
%cline redraw-display
set $discmd TRUE
!endm
; and init some variables
set %rcltype 2
write-message "[Block mode loaded]"
