home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
rtsi.com
/
2014.01.www.rtsi.com.tar
/
www.rtsi.com
/
OS9
/
OSK
/
CMDS
/
memacs400_cmds.lzh
/
MEMACS400
/
CMD
/
bpage.cmd
next >
Wrap
OS/2 REXX Batch file
|
1996-04-25
|
12KB
|
637 lines
; BPAGE.CMD: Box Macro and rectangualr region page
; for MicroEMACS 3.13 and above
; (C)opyright 1987,1993 by Suresh Konda/Daniel M Lawrence
; Last Update: 11/13/93
; make sure the function key window is up
set %rcfkeys FALSE
toggle-fkeys
write-message "Loading..."
; set the clean procedure up
store-procedure clean
delete-buffer "[b-change-line]"
delete-buffer "[b-del-block]"
delete-buffer "[b-draw-box]"
delete-buffer "[b-ins-line]"
delete-buffer "[b-copy-block]"
delete-buffer "[b-yank-block]"
delete-buffer "[b-ins-blank]"
delete-buffer "[b-yank-block]"
delete-buffer "[getblock]"
delete-buffer "[putblock]"
delete-buffer "[drawbox]"
delete-buffer "[setpoints]"
delete-buffer "[horizontal]"
delete-buffer "[vertical]"
delete-buffer "[horline]"
delete-buffer "[vertline]"
delete-buffer "[delcol]"
!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
store-procedure b-change-line
!if &equ %rcltype 1
set %rcltype 2
set %rctmp "DOUBLE"
!else
!if &equ %rcltype 2
set %rcltype 3
set %rctmp "C-CMNT"
!else
set %rcltype 1
set %rctmp "SINGLE"
!endif
!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
store-procedure b-draw-box
!if &equal %rcltype 1
set %c1 "┌"
set %c2 "─"
set %c3 "┐"
set %c4 "└"
set %c5 "┘"
set %c6 "│"
!else
!if &equal %rcltype 2
set %c1 "╔"
set %c2 "═"
set %c3 "╗"
set %c4 "╚"
set %c5 "╝"
set %c6 "║"
!else
set %c1 "/"
set %c2 "*"
set %c3 "\"
set %c4 "\"
set %c5 "/"
set %c6 "*"
!endif
!endif
run drawbox
!endm
; insert a blank line in a box
store-procedure b-ins-blank
set %rctmp %rcltype
set %rcltype 0
run b-ins-line
set %rcltype %rctmp
!endm
; insert a line in a box
store-procedure b-ins-line
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
; it will also detab the region
set %pcol $curcol
set %pline $curline
exchange-point-and-mark
set %mcol $curcol
set %mline $curline
exchange-point-and-mark
detab-region
set $curline %pline
set $curcol %pcol
!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 &add 2 &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
%mcol insert-string " "
; 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
end-of-line
!if &less $curcol %pcol
&sub %pcol $curcol insert-string " "
!endif
set $curcol %pcol
insert-string " "
insert-string %c6
set $curcol %mcol
insert-string %c6
insert-string " "
!endwhile
;return to point
%pline goto-line
next-line
beginning-of-line
%width forward-character
!force 6 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 "│"
set %s3 "*"
!if &equal %rcltype 0
; then insert blanks
set %c1 "║"
set %c2 "│"
set %c3 " "
set %c4 "║"
set %c5 "│"
set %c6 "║"
set %c7 "│"
set %c8 "*"
!else
!if &equal %rcltype 1
; then insert a single line
set %c1 "╟"
set %c2 "├"
set %c3 "─"
set %c4 "╫"
set %c5 "┼"
set %c6 "╢"
set %c7 "┤"
set %c8 "*"
!else
!if &equal %rcltype 2
; then insert a double line
set %c1 "╠"
set %c2 "╞"
set %c3 "═"
set %c4 "╬"
set %c5 "╪"
set %c6 "╣"
set %c7 "╡"
set %c8 "*"
!else
set %c1 "*"
set %c2 "*"
set %c3 "*"
set %c4 "*"
set %c5 "*"
set %c6 "*"
set %c7 "*"
set %c8 "*"
!endif
!endif
!endif
run horline
!endm
store-procedure vertical
set %s1 "═"
set %s2 "─"
set %s3 "*"
!if &equal %rcltype 0
set %c1 "═"
set %c2 "─"
set %c3 " "
set %c4 "═"
set %c5 "─"
set %c6 "═"
set %c7 "─"
set %c8 "*"
!else
!if &equal %rcltype 1
set %c1 "╤"
set %c2 "┬"
set %c3 "│"
set %c4 "╪"
set %c5 "┼"
set %c6 "╧"
set %c7 "┴"
set %c8 "*"
!else
!if &equal %rcltype 2
set %c1 "╦"
set %c2 "╥"
set %c3 "║"
set %c4 "╬"
set %c5 "╫"
set %c6 "╩"
set %c7 "╨"
set %c8 "*"
!else
set %c1 "*"
set %c2 "*"
set %c3 "*"
set %c4 "*"
set %c5 "*"
set %c6 "*"
set %c7 "*"
set %c8 "*"
!endif
!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
set $curline %pline
set $curcol %pcol
!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
beginning-of-line
newline
previous-line
; 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
!if &sequal %char %s3
insert-string %c8
!else
insert-string %c3
!endif
!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
!if &sequal %char %s3
insert-string %c8
!else
insert-string %c3
!endif
!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
!if &sequal %char %s3
insert-string %c8
!else
insert-string %c3
!endif
!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
!if &sequal %char %s3
insert-string %c8
!else
insert-string %c3
!endif
!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
!if &sequal %char %s3
insert-string %c8
!else
insert-string %c3
!endif
!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
!if &sequal %char %s3
insert-string %c8
!else
insert-string %c3
!endif
!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
store-procedure b-del-block
set %bkcopy FALSE
run getblock
write-message "[Block deleted]"
!endm
; copy a rectangular region
store-procedure b-copy-block
set %bkcopy TRUE
run getblock
write-message "[Block copied]"
!endm
; yank a rectangular region
store-procedure b-yank-block
set %bkcopy TRUE
run putblock
!endm
; insert a rectangular region
store-procedure b-ins-block
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
detab-region
exchange-point-and-mark
set %begpos $curcol
set %begline $curline
set %blwidth &sub %endpos %begpos
;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
1 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
macro-to-key b-change-line S-FN1
macro-to-key b-del-block S-FN2
macro-to-key b-draw-box S-FN3
macro-to-key b-copy-block S-FN4
macro-to-key b-ins-line S-FN5
macro-to-key b-yank-block S-FN6
macro-to-key b-ins-blank S-FN7
macro-to-key b-ins-block S-FN8
; and init some variables
set %rcltype 2
write-message "[Block mode loaded]"
