extending VED's change character attribute facilities 
Author Message
 extending VED's change character attribute facilities

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]



Wed, 20 Mar 1996 10:06:25 GMT  
 
 [ 1 post ] 

 Relevant Pages 

1. Extended Attributes, Program ID's

2. Programmatically changing a field's attributes

3. getting rid of Fancy VED characters in Emacs

4. Running Ved from Ved

5. (subtypep '(simple-array character (*)) '(array character (*)))

6. The ``obsolete'' facility in Eiffel 2.2

7. Extended attributes and the Setboot command

8. Setting Extended Attributes for files under OS/2.

9. Extended Attributes ".NAME?"

10. get OS/2 extended attributes with REXX

11. get OS/2 extended attributes with REXX

12. Extended Attribute Information?

 

 
Powered by phpBB® Forum Software