Those of you who have Poplog version 14.2 or later may know
(see HELP NEWS) that the editor has been enhanced so that you can
embolden, underline or italicise text, or make it flash (depending
on capabilities of your terminal) which is quite nice for producing
documentation on software and teaching examples.
For details see REF VED_CHAT
In some contexts the implementation can be a bit limiting, as the
scope of a change is restricted to a character, a word, a number of
lines or a marked range.
What follows is LIB VED_BCHAT which extends the scope specifier
to include rectangular text blocks between two saved positions, or
segments of text between two saved positions. E.g.
ENTER bchat b u
will underline the current rectangular block of text. (See also
HELP TEXTBLOCKS). Permitting text segments makes it easy to change
the font of (e.g.) a whole sentence that extends over several lines
without starting and ending with complete lines, and allowing blocks
makes it easy to change a column of text.
The file that follows includes a draft HELP file a well as the code.
to make it autoloadable, install it in $poplocal/local/auto/
Suggestions for improvement welcome.
Aaron
-----------------------------------------------------------------------
;;; LIB VED_BCHAT
;;; $poplocal/local/auto/ved_bchat.p
;;; Aaron Sloman Sat Sep 25 09:12:19 1993
/*
HELP VED_BCHAT Aaron Sloman Sept 1993
Changing character attributes in rectangular blocks of text, and
segments of text, including or excluding spaces.
ENTER bchat <scope> <attr>
This command works exactly like ENTER chat, i.e. it can add or remove
underlining, italics, or boldface, on the basis of character, word,
line, or marked range
However, it has three additions.
1. It permits the "b" scope specifier to indicate that the change should
apply to a rectangular block of text determined by the last two positions
stacked using PUSHKEY (See * vedpushkey, * vedpositionstack). In this it
is similar to the facilities described in HELP VEDBLOCKS, which operate
on a rectangular block of text determined by the last two saved
positions.
2. It permits the "s" scope specifier to indicate that the change
should apply to a segment of text determined by the last two positions
stacked using PUSHKEY (See * vedpushkey, * vedpositionstack). I.e. it
will be the same segment of text as would be removed by ved_cut.
3. In addition it allows the scope specifier to include the prefix 'ns'
(non-space) to indicate that in a line or marked range or block of text
or segment of text the change should not be made to space characters
(which is useful for underlining words without underlining spces).
Thus, the definition of the <scope> attribute for ved_chat is modified
for ved_bchat thus
The SCOPE argument is a letter or -letter specifying the scope
of the change, as follows:
c Current character
w " word
-c Last character
-w " word
l " line
nsl " line excluding spaces
-l " line
ns-l " line excluding spaces
r All characters in the current marked range
nsr Marked range excluding spaces
b All characters in the current block of text
nsr Text block excluding spaces
s Segment of text between positions
nss Segment of text, excluding spaces
For r, nsr, b, nsb, s and nss, the cursor position is left unchanged.
Later, the line, range and block scopes may be extended to allow a
string pattern to be specified, and only characters in occurrences of
that string pattern will be changed.
Note that when the block option is used, vedpositionstack is left
unchanged, so that one can easily try different attributes in the
same block of text.
In order to clear vedpositionstack use * ved_cps
*/
section;
define global vars procedure get_segment_coords() -> (line1, col1, line2, col2);
lvars line1, col1, line2, col2, p1, p2;
;;; get two positions from vedpositionstack, after checking
unless listlength(vedpositionstack) > 1 then
vederror('NOT ENOUGH STACKED POSITIONS FOR BLOCK')
endunless;
front(destpair(vedpositionstack))
-> (p1, p2);
p1(1)-> line1; p1(2)-> col1;
p2(1)-> line2; p2(2)-> col2;
;;; ensure first location is line1,col1.
if line1 > line2 or (line1 == line2 and col1 > col2) then
line1,col1,line2,col2 -> (line2,col2,line1,col1)
endif;
enddefine;
define global vars procedure get_block_coords() -> (line1, col1, line2, col2);
;;; use top two positions on vedpositionstack to find top left and
;;; bottom right coords of rectangle.
lvars line1, col1, line2, col2;
get_segment_coords() -> (line1, col1, line2, col2);
;;; make col2 >= col1 (already done for lin2 >= col2)
if col1 > col2 then col1,col2 -> (col2,col1) endif;
enddefine;
define global vars vedconvert_line_col(test_p, convert_p, nlines);
;;; like vedconvertline, except that test_p takes two
;;; arguments, character code and column number
lvars c, oldchanged = vedchanged, nlines, procedure (test_p, convert_p);
dlocal vedstatic = true, vedautowrite = false;
unless isinteger(nlines) or (strnumber(nlines) ->> nlines) then
1 -> nlines
endunless;
unless isinteger(nlines) then
vederror('LINE COUNT: INTEGER NEEDED, NOT: ' sys_>< nlines)
endunless;
repeat nlines times
vedscreenleft();
while vedcolumn <= vvedlinesize do
vedcurrentdchar() -> c;
if test_p(c, vedcolumn) then
vedcharinsert(convert_p(c))
else
vedcharright()
endif
endwhile;
vednextline()
endrepeat;
if oldchanged then oldchanged + 1 else 1 endif -> vedchanged
enddefine;
define global vars procedure vedconvert_range_col(test_p, convert_p);
;;; like vedconvertrange, except that test_p takes two
;;; arguments, as above
lvars oldchanged = vedchanged, procedure (test_p, convert_p);
vedpositionpush();
vedmarkfind();
vedconvert_line_col(test_p, convert_p, vvedmarkhi-vvedmarklo+1);
vedpositionpop();
if oldchanged then oldchanged + 1 else 1 endif -> vedchanged
enddefine;
define global ved_bchat;
;;; Like vedchat, but allows text blocks.
lvars c, args, scopechar, attr, prev, scope,
mincol = 1, maxcol = 536870911, ;;; should use pop_max_int
nospace = false;
dlocal vedstatic;
define lconstant procedure test_p(/*char,*/ col);
lvars char, col;
-> /*char*/ ;
col >= mincol and col <= maxcol
enddefine;
define lconstant isspace(char);
lvars char = char fi_&& 16:FF;
char == `\s` or char == `\t`
enddefine;
define lconstant procedure bchange_mode(char);
;;; test character and column, and use nospace globally
lvars char;
if nospace and isspace(char) then char
else
if attr &&/=_0 `\[7]` then char &&~~ `\[7]`
else char
endif -> char;
if c == `+` then
char || attr
elseif c == `-` then
char &&~~ attr
else
(char && 16:FFFF) || attr
endif -> char;
char;
endif
enddefine;
sysparse_string(vedargument, false) -> args;
lvars sizewrong = false, len = listlength(args);
if len < 2 then 1 -> sizewrong
elseif len > 2 then 3 -> sizewrong
else
dl(args) -> (scope, attr);
;;; check if scope starts with 'ns' = 'no space'
if isstartstring('ns', scope) then
true -> nospace;
allbutfirst(2, scope) -> scope;
endif;
endif;
if sizewrong
or not(member(scope, ['c' 'w' 'l' '-c' '-w' '-l' 'r', 'b' 's']))
or attr = nullstring
then
vederror('USAGE: bchat <scope> <attributes>')
endif;
if (subscrs(1,scope) ->> scopechar) == `-` then
;;; do previous entity
subscrs(2,scope) -> scopechar;
true
else
false
endif -> prev;
if nospace
and strmember(scopechar, 'cw')
then
vederror('CANNOT COMBINE \'ns\' WITH SCOPE ' <> scope)
endif;
subscrs(1,attr) -> c;
if c == `+` or c == `-` then
allbutfirst(1, attr) -> attr
endif;
unless strnumber('`\\[' <> attr <> ']`') ->> attr then
vederror('INVALID ATTRIBUTES for bchat')
endunless;
if scopechar == `c` or scopechar == `w`
or strmember(scopechar, 'lr') and nospace = false then
ved_chat();
elseif scopechar == `l` then
;;; line, and nospace true
if prev and vedline /== 1 then vedcharup() endif;
vedconvert_line_col(test_p, bchange_mode, 1)
elseif scopechar == `r` then
;;; marked range, and nospace true
vedconvert_range_col(test_p, bchange_mode)
elseif strmember(scopechar, 'bs') then
;;;scopechar == `b`, so do block
lvars line1, line2, oldline = vedline,oldcol = vedcolumn;
dlocal vvedmarklo, vvedmarkhi;
if scopechar == `b` then ;;; do block of text
get_block_coords() -> (line1, mincol, line2, maxcol);
dlocal vvedmarklo = line1, vvedmarkhi = line2;
vedconvert_range_col(test_p, bchange_mode);
elseif scopechar == `s` then
lvars col1,col2;
get_segment_coords() -> (line1, col1, line2, col2);
col1 -> mincol;
vedjumpto(line1,col1);
if line1 == line2 then
col2 -> maxcol;
vedconvert_line_col(test_p, bchange_mode, 1)
else
;;; do first line from col1.
col1 -> mincol;
vedconvert_line_col(test_p, bchange_mode, 1);
1 -> mincol;
;;; do lines between first and last
if line1 + 1 /== line2 then
vedconvert_line_col(test_p, bchange_mode, line2 - line1 - 1)
endif;
;;; now do final line
col2 -> maxcol;
vedconvert_line_col(test_p, bchange_mode, 1)
endif;
vedjumpto(oldline, oldcol);
endif;
else
vederror('bchat -- Unexpected scope specifier')
endif
enddefine;
endsection;
;;;[eof]