.CM  SCRIPT , Version - 1.1 , last edited by holger
.ad 8
.bm 8
.fm 4
.bt $Copyright (c) 2000-2005 SAP AG$$Page %$
.tm 12
.hm 6
.hs 3
.TT 1 $SQL$Project Distributed Database System$VIN12$
.tt 2 $$$
.TT 3 $$dialog_editor_functions$1996-03-07$
***********************************************************
.nf
 
.nf
 
 .nf

    ========== licence begin  GPL
    Copyright (c) 2000-2005 SAP AG

    This program is free software; you can redistribute it and/or
    modify it under the terms of the GNU General Public License
    as published by the Free Software Foundation; either version 2
    of the License, or (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
    ========== licence end
.fo

 
.fo
 
 
.fo
.nf
.sp
MODULE  : dialog_editor_rand_functions
=========
.sp
Purpose : Execution of the function keys of
          Rand editor.
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        PROCEDURE
              i12exrandkeys(VAR eform : tin_eform_buffer;
                    VAR evars   : tin_eform_vars;
                    VAR display : tin_display_parms;
                    VAR edit    : tin_edit_work_area;
                    VAR cmd     : tin_cmd_type;
                    VAR relkey  : tin_ls_releasemode;
                    VAR block   : tin_ed_winmark_type);
 
        PROCEDURE
              i12pickrand(VAR eform : tin_eform_buffer;
                    VAR evars   : tin_eform_vars;
                    VAR display : tin_display_parms;
                    VAR edit    : tin_edit_work_area;
                    VAR first_ins  : tin_natural;
                    VAR last_ins   : tin_natural;
                    VAR first_shift : tin_natural;
                    VAR last_shift  : tin_natural);
 
        PROCEDURE
              i12putrand(VAR eform : tin_eform_buffer;
                    VAR evars      : tin_eform_vars;
                    VAR display    : tin_display_parms;
                    VAR edit       : tin_edit_work_area;
                    numb           : tin_natural);
 
        FUNCTION
              in1230 : tsp00_Int4;
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              Kernel_move_and_fill : VGG101;
 
        PROCEDURE
              SAPDB_PascalForcedFill (
                    size        : tsp00_Int4;
                    m           : tsp00_MoveObjPtr;
                    pos         : tsp00_Int4;
                    len         : tsp00_Int4;
                    fillchar    : char);
 
        PROCEDURE
              SAPDB_PascalForcedMove (
                    source_upb  : tsp00_Int4;
                    destin_upb  : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;
                    source_pos  : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;
                    destin_pos  : tsp00_Int4;
                    length      : tsp00_Int4);
 
        PROCEDURE
              s10mv (
                    source_upb  : tsp00_Int4;       
                    destin_upb  : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;    
                    source_pos  : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;    
                    destin_pos  : tsp00_Int4;
                    length      : tsp00_Int4);
 
      ------------------------------ 
 
        FROM
              dialog_editor_functions : VIN11;
 
        PROCEDURE
              i11ekedit_key (
                    VAR relkey      : tin_ls_releasemode;
                    VAR ed_key      : tin_edit_key;
                    VAR error       : boolean );
 
        PROCEDURE
              i11message (
                    msg_id       : tin_edit_msg;
                    VAR msg_text : tin_screenline;
                    VAR err_flag : boolean);
 
      ------------------------------ 
 
        FROM
              standard_editor_functions : VIN14;
 
        PROCEDURE
              i14cleareform (
                    VAR evars     : tin_eform_vars);
 
        PROCEDURE
              i14splitjoin (
                    VAR eform      : tin_eform_buffer;
                    VAR evars      : tin_eform_vars;
                    line_no        : tin_natural;
                    scol           : tin_natural;
                    max_cols       : tin_natural;
                    VAR error      : boolean);
 
        PROCEDURE
              i14insblock (
                    VAR eform      : tin_eform_buffer;
                    VAR evars      : tin_eform_vars;
                    line1          : tin_natural;
                    line2          : tin_natural;
                    scol1          : tin_natural;
                    scol2          : tin_natural;
                    max_cols       : tin_natural;
                    VAR error      : boolean);
 
        PROCEDURE
              i14inserteline (VAR eform  : tin_eform_buffer;
                    VAR evars        : tin_eform_vars;
                    line_nr          : tin_natural;
                    line_count       : tin_natural;
                    VAR error        : boolean);
 
        PROCEDURE
              i14deleteeline (VAR eform  : tin_eform_buffer;
                    VAR evars        : tin_eform_vars;
                    line_nr          : tin_natural;
                    line_count       : tin_natural);
 
        PROCEDURE
              i14geteline (VAR eform     : tin_eform_buffer;
                    VAR evars     : tin_eform_vars;
                    VAR line      : tin_eline;
                    line_nr       : tin_natural;
                    VAR length    : tin_natural;
                    VAR error     : boolean);
 
        PROCEDURE
              i14puteline (VAR eform     : tin_eform_buffer;
                    VAR evars     : tin_eform_vars;
                    VAR line      : tin_eline;
                    line_nr       : tin_natural;
                    length        : tin_natural;
                    VAR error     : boolean);
 
        PROCEDURE
              i14delblock (VAR eform  : tin_eform_buffer;
                    VAR evars      : tin_eform_vars;
                    line1          : tin_natural;
                    line2          : tin_natural;
                    scol1          : tin_natural;
                    scol2          : tin_natural);
 
      ------------------------------ 
 
        FROM
              pick-put-functions : VIN15;
 
        PROCEDURE
              i15putpickbuf (VAR pick      : tin_pick_buffer;
                    VAR line         : tin_eline;
                    line_nr          : tin_natural;
                    length           : tin_natural;
                    first_col        : tin_natural;
                    VAR error        : boolean);
 
        PROCEDURE
              i15getpickbuf (VAR pick      : tin_pick_buffer;
                    VAR line         : tin_eline;
                    line_nr          : tin_natural;
                    VAR length       : tin_natural;
                    VAR error        : boolean);
&       ifdef WINDOWS
 
      ------------------------------ 
 
        FROM
              Clipboard_IO: VIN63;
 
        PROCEDURE
              i63get (
                    handle           : tsp00_Int4;
                    row              : tsp00_Int4;
                    col              : tsp00_Int2;
                    VAR text         : tin_eline;
                    maxlen           : tsp00_Int2;
                    VAR textlen      : tsp00_Int2;
                    VAR ok           : boolean );
 
        PROCEDURE
              i63readopen (
                    listtype         : tsp00_Wlisttype;
                    VAR handle       : tsp00_Int4;
                    VAR nr_rows      : tsp00_Int4;
                    VAR nr_cols      : tsp00_Int2;
                    VAR nr_items     : tsp00_Int4;
                    VAR info         : tsp00_Int2Buf;
                    VAR ok           : boolean );
 
        PROCEDURE
              i63put (
                    handle           : tsp00_Int4;
                    VAR text         : tin_eline;
                    textlen          : tsp00_Int2;
                    VAR ok           : boolean );
 
        PROCEDURE
              i63close (
                    handle           : tsp00_Int4 ;
                    VAR ok           : boolean );
 
        PROCEDURE
              i63writeopen (
                    VAR info         : tin_natural;
                    nr_cols          : tsp00_Int2;
                    VAR handle       : tsp00_Int4;
                    VAR ok           : boolean );
 
      ------------------------------ 
 
        FROM
              Code-Translation: VIN32;
 
        PROCEDURE
              i32repltabs (
                    fcode       : tsp00_Uint1;
                    phys_buflen : integer;
                    VAR buf     : tin_eline;
                    VAR buflen  : tsp00_Int4);
 
        FUNCTION
              i32machinecodetype : tsp00_Uint1;
&       endif
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
&       ifdef WINDOWS
        PROCEDURE
              i63put;
 
              tsp00_MoveObj tsp_eline
 
        PROCEDURE
              i63get;
 
              tsp00_MoveObj tsp_eline
 
        PROCEDURE
              i63writeopen;
 
              tsp00_Int2Buf tin_natural
 
        PROCEDURE
              i32repltabs;
 
              tsp00_Buf     tin_eline
&             endif
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  :
.sp
.cp 3
Created : 1988-02-26
.sp
.cp 3
.sp
.cp 3
Release :  6.1.2     Date : 1995-11-01
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
 
 
.CM *-END-* specification -------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Description:
 
.CM *-END-* description ---------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.nf
.oc _/1
Structure:
 
.CM *-END-* structure -----------------------------------
.sp 2
**********************************************************
.sp
.cp 10
.nf
.oc _/1
.CM -lll-
Code    :
 
 
(*------------------------------*) 
 
FUNCTION
      in1230 : tsp00_Int4;
 
BEGIN
(* linkcheck function *)
in1230 := 219020330;
END;
 
(*------------------------------*) 
 
PROCEDURE
      i12exrandkeys(VAR eform : tin_eform_buffer;
            VAR evars   : tin_eform_vars;
            VAR display : tin_display_parms;
            VAR edit    : tin_edit_work_area;
            VAR cmd     : tin_cmd_type;
            VAR relkey  : tin_ls_releasemode;
            VAR block   : tin_ed_winmark_type);
 
VAR
      numb   : tin_natural;
      ok     : boolean;
      error  : boolean;
      ed_key : tin_edit_key;
 
BEGIN
i11ekedit_key ( relkey, ed_key, error );
&ifdef WINDOWS
numb := 1;
ex_rand_keys(eform,evars,display,edit,ed_key,numb,block);
IF  ed_key <> edk_pick
THEN
    WITH block, block.mark DO
        BEGIN
        mode   := vt_mark_block;
        top    := 0;
        bottom := -1;
        left   := 1;
        right  := 0;
        END;
    (*ENDWITH*) 
&else
(*ENDIF*) 
WITH display,csr_pos,edit DO
    BEGIN
    ok := true;
    numb := 1;
    IF  (((mark1_line = mark2_line) AND (mark1_scol = mark2_scol)
        AND (mark1_line > 0)) OR (mark2_line = 0)
        OR (relkey = f_put)) AND (relkey <> f3)
    THEN
        BEGIN
        readnumber(cmd,numb,ok);
        IF  ok AND (relkey <> f_put)
        THEN
            BEGIN
            mark2_line := mark1_line + numb - 1;
            mark2_scol := mark1_scol;
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  (mark1_line > 0) AND ok
    THEN
        BEGIN
        ex_rand_keys(eform,evars,display,edit,ed_key,numb,block);
        IF  NOT error_found
        THEN
            BEGIN
            mark1 := false;
            mark1_line := 0;
            mark1_scol := 0;
            mark2_line := 0;
            mark2_scol := 0;
            cmd.length := 0;
            END;
        (*ENDIF*) 
        display.changed := true;
        IF  insert_mode
        THEN
            WITH display.frame [display.active_screen ] DO
                IF  (insert_line < upper_margin) OR
                    (insert_line > upper_margin +
                    lines_on_screen - 1)
                THEN
                    IF  mark1_line > lines_on_screen DIV 2
                    THEN
                        upper_margin :=
                              mark1_line -
                              lines_on_screen DIV 2
                    ELSE
                        upper_margin := 1;
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDWITH*) 
        (*ENDIF*) 
        END
    ELSE
        BEGIN
        IF  NOT ok
        THEN
            i11message(option_error,frame [active_screen] .sys_msg,
                  frame [active_screen] .is_error);
        (*ENDIF*) 
        csr_set_by_user := false;
        csr_switch := false;
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
&endif
END;
 
(*------------------------------*) 
 
PROCEDURE
      ex_rand_keys (
            VAR eform : tin_eform_buffer;
            VAR evars   : tin_eform_vars;
            VAR display : tin_display_parms;
            VAR edit    : tin_edit_work_area;
            VAR ed_key  : tin_edit_key;
            numb        : tin_natural;
            block       : tin_ed_winmark_type);
 
VAR
      first_ins  : tin_natural;
      last_ins   : tin_natural;
      first_shift : tin_natural;
      last_shift  : tin_natural;
 
BEGIN
WITH display, edit DO
    BEGIN
    IF  mark2_line >= mark1_line
    THEN
        BEGIN
        first_ins := mark1_line;
        last_ins := mark2_line
        END
    ELSE
        BEGIN
        first_ins := mark2_line;
        last_ins := mark1_line
        END;
    (*ENDIF*) 
    IF  mark2_scol >= mark1_scol
    THEN
        BEGIN
        first_shift := mark1_scol;
        last_shift := mark2_scol;
        END
    ELSE
        BEGIN
        first_shift := mark2_scol;
        last_shift := mark1_scol;
        END;
    (*ENDIF*) 
    CASE ed_key OF
        edk_insert :
            rand_insert(eform,evars,display,edit,
                  first_ins,last_ins,first_shift,last_shift);
        edk_delete :
            BEGIN
&           ifdef WINDOWS
            in12_win_del (eform, evars, display, edit, block);
&           else
            rand_delete(eform,evars,display,edit,
                  first_ins,last_ins,first_shift,last_shift);
&           endif
            END;
        edk_pick :
            BEGIN
&           ifdef WINDOWS
            in12_win_copy (eform, evars, block);
&           else
            i12pickrand(eform,evars,display,edit,
                  first_ins,last_ins,first_shift,last_shift);
&           endif
            END;
        edk_put :
            BEGIN
&           ifdef WINDOWS
            in12_win_paste (display, edit, block);
&           endif
            IF  NOT error_found
            THEN
                i12putrand(eform,evars,display,edit,numb);
            (*ENDIF*) 
            END;
        edk_splitjoin :
            splitjoin(eform,evars,display,edit);
        END;
    (*ENDCASE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      rand_insert(VAR eform : tin_eform_buffer;
            VAR evars   : tin_eform_vars;
            VAR display : tin_display_parms;
            VAR edit : tin_edit_work_area;
            VAR first_ins  : tin_natural;
            VAR last_ins   : tin_natural;
            VAR first_shift : tin_natural;
            VAR last_shift  : tin_natural);
 
BEGIN
WITH display, edit DO
    BEGIN
    IF  mark1_scol = mark2_scol
    THEN
        BEGIN
        (* h.b. dieser Teil fuegt bei INSERT LINE die Zeile darunter ein *)
        (*
              i14inserteline(eform,evars,first_ins+1,
              last_ins - first_ins + 1,error_found);
              IF  NOT error_found
              THEN
              BEGIN
              insert_mode := true;
              insert_line := first_ins+1;
              insert_scol := 1;
              END;
              *)
        i14inserteline(eform,evars,first_ins,
              last_ins - first_ins+1,error_found);
        IF  NOT error_found
        THEN
            BEGIN
            insert_mode := true;
            insert_line := first_ins;
            insert_scol := 1;
            END;
        (*ENDIF*) 
        END
    ELSE
        BEGIN
        i14insblock(eform,evars,first_ins,last_ins, first_shift,
              last_shift,frame [active_screen] .max_cols, error_found);
        IF  NOT error_found
        THEN
            BEGIN
            insert_mode := true;
            insert_line := first_ins;
            insert_scol := first_shift;
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  error_found
    THEN
        BEGIN
        error_type := relkey_error;
        edit.msg_id := eform_overflow;
        i11message(msg_id,frame [active_screen] .sys_msg,
              frame [active_screen] .is_error);
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      rand_delete(VAR eform : tin_eform_buffer;
            VAR evars   : tin_eform_vars;
            VAR display : tin_display_parms;
            VAR edit : tin_edit_work_area;
            VAR first_ins  : tin_natural;
            VAR last_ins   : tin_natural;
            VAR first_shift : tin_natural;
            VAR last_shift  : tin_natural);
 
BEGIN
WITH display, edit DO
    BEGIN
    i12pickrand(eform,evars,display,edit,
          first_ins,last_ins,first_shift,last_shift);
    i11message(ok_msg,frame [active_screen] .sys_msg,
          frame [active_screen] .is_error);
    IF  mark1_scol = mark2_scol
    THEN
        BEGIN
        i14deleteeline(eform,evars,first_ins,last_ins - first_ins + 1);
        insert_scol := 1;
        END
    ELSE
        BEGIN
        i14delblock(eform,evars,first_ins,last_ins,
              first_shift,last_shift);
        insert_scol := first_shift;
        END;
    (*ENDIF*) 
    insert_mode := true;
    insert_line := first_ins;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      i12pickrand(VAR eform : tin_eform_buffer;
            VAR evars   : tin_eform_vars;
            VAR display : tin_display_parms;
            VAR edit    : tin_edit_work_area;
            VAR first_ins  : tin_natural;
            VAR last_ins   : tin_natural;
            VAR first_shift : tin_natural;
            VAR last_shift  : tin_natural);
 
VAR
      i       : tin_natural;
      k       : tin_natural;
      len     : tin_natural;
      line    : tin_eline;
      error   : boolean;
 
BEGIN
WITH display, edit DO
    BEGIN
    error := false;
    i14cleareform (pick.pick_vars);
    IF  first_shift = last_shift
    THEN
        pick.blockwidth := 0
    ELSE
        pick.blockwidth := last_shift - first_shift;
    (*ENDIF*) 
    k := 1;
    FOR i := first_ins TO last_ins DO
        IF  NOT error
        THEN
            BEGIN
            i14geteline(eform,evars,line,i,len,error);
            i15putpickbuf(pick, line, k, len, first_shift, error);
            k := k + 1;
            END;
        (*ENDIF*) 
    (*ENDFOR*) 
    csr_switch := false;
    csr_set_by_user := false;
    IF  error
    THEN
        BEGIN
        i14cleareform (pick.pick_vars);
        i11message(no_pick,frame [active_screen] .sys_msg,
              frame [active_screen] .is_error);
        END
    ELSE
        IF  pick.pick_vars.lines > 0
        THEN
            i11message(pick_done,frame [active_screen] .sys_msg,
                  frame [active_screen] .is_error )
        ELSE
            i11message(no_pick,frame [active_screen] .sys_msg,
                  frame [active_screen] .is_error);
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      splitjoin(VAR eform : tin_eform_buffer;
            VAR evars   : tin_eform_vars;
            VAR display : tin_display_parms;
            VAR edit    : tin_edit_work_area);
 
VAR
      error    : boolean;
 
BEGIN
WITH display,edit DO
    BEGIN
    i14splitjoin(eform,evars,mark1_line,mark1_scol,
          frame [active_screen] .max_cols, error);
    csr_switch := false;
    csr_set_by_user := false;
    IF  error
    THEN
        i11message(eform_overflow,frame [active_screen] .sys_msg,
              frame [active_screen] .is_error);
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      i12putrand(VAR eform : tin_eform_buffer;
            VAR evars   : tin_eform_vars;
            VAR display : tin_display_parms;
            VAR edit    : tin_edit_work_area;
            numb    : tin_natural);
 
VAR
      error      : boolean;
      line       : tin_eline;
      pline      : tin_eline;
      i          : tin_natural;
      k          : tin_natural;
      length     : tin_natural;
      plength    : tin_natural;
      blanklinecount  : tin_natural;
 
BEGIN
WITH display,edit,pick DO
    BEGIN
    error := false;
    IF  mark1_line > evars.lines
    THEN
        blanklinecount := mark1_line - evars.lines
    ELSE
        blanklinecount := 0;
    (*ENDIF*) 
    IF  pick_vars.lines = 0
    THEN
        i11message(buf_empty,frame [active_screen] .sys_msg,
              frame [active_screen] .is_error)
    ELSE
        IF  blockwidth = 0
        THEN
            IF  pick_vars.elength * numb + evars.elength +
                blanklinecount > evars.size
            THEN
                i11message(eform_overflow,
                      frame [active_screen] .sys_msg,
                      frame [active_screen] .is_error)
            ELSE
                BEGIN
                FOR k := 1 TO  numb DO
                    BEGIN
                    i14inserteline(eform,evars,mark1_line,
                          pick_vars.lines,error);
                    FOR i := 1 TO  pick_vars.lines DO
                        BEGIN
                        i15getpickbuf(pick,line,
                              i,length,error);
                        i14puteline(eform,evars,line,
                              mark1_line + i - 1,length,error);
                        END;
                    (*ENDFOR*) 
                    END;
                (*ENDFOR*) 
                insert_mode := true;
                insert_line := mark1_line;
                insert_scol := 1;
                END
            (*ENDIF*) 
        ELSE
            BEGIN
            IF  (blockwidth + 2) * pick_vars.lines *
                numb + blanklinecount +
                evars.elength > evars.size
            THEN
                error := true;
            (*ENDIF*) 
            FOR k := 1 TO  numb DO
                BEGIN
                IF  NOT error
                THEN
                    i14insblock(eform,evars,mark1_line,
                          mark1_line + pick_vars.lines - 1,
                          mark1_scol,mark1_scol + blockwidth,
                          frame [active_screen] .max_cols, error);
                (*ENDIF*) 
                IF  NOT error
                THEN
                    FOR i := 1 TO  pick_vars.lines DO
                        BEGIN
                        i15getpickbuf(pick,pline,
                              i,plength,error);
                        IF  plength < blockwidth
                        THEN
                            SAPDB_PascalForcedFill(mxin_eline,@pline,plength + 1,
                                  blockwidth - plength, ' ');
                        (*ENDIF*) 
                        i14geteline(eform,evars,line,
                              mark1_line + i - 1,length,error);
                        SAPDB_PascalForcedFill(mxin_eline,@line,length + 1,
                              frame [active_screen] .max_cols - length,' ');
                        IF  length < (blockwidth + mark1_scol)
                        THEN
                            length := blockwidth + mark1_scol;
                        (* h.b.
                              SAPDB_PascalForcedFill(mxin_eline,@line,length + 1,
                              frame [active_screen] .max_cols - length,' ');
                              length := frame [active_screen] .max_cols;
                              IF  mark1_scol + plength >
                              frame [active_screen] .max_cols + 1
                              THEN
                              plength :=
                              frame [active_screen] .max_cols - mark1_scol + 1;
                              *)
                        (*ENDIF*) 
                        s10mv(mxin_eline,mxin_eline,
                              @pline,1,
                              @line,mark1_scol,blockwidth);
                        i14puteline(eform,evars,line,
                              mark1_line + i - 1,length,error);
                        END;
                    (*ENDFOR*) 
                (*ENDIF*) 
                END;
            (*ENDFOR*) 
            IF  error
            THEN
                i11message(eform_overflow,
                      frame [active_screen] .sys_msg,
                      frame [active_screen] .is_error)
            ELSE
                BEGIN
                insert_mode := true;
                insert_line := mark1_line;
                insert_scol := mark1_scol;
                END;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    csr_switch := false;
    csr_set_by_user := false;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      readnumber(VAR cmd : tin_cmd_type;
            VAR numb   : tin_natural;
            VAR ok     : boolean);
 
VAR
      pos  : tsp00_Int2;
      i    : tsp00_Int2;
 
BEGIN
WITH cmd DO
    BEGIN
    ok := false;
    numb:=0;
    IF  length = 0
    THEN
        BEGIN
        numb := 1;
        ok := true;
        END
    ELSE
        BEGIN
        pos := 1;
        i := 1;
        WHILE (pos <= length) AND (content [pos ] = ' ')
              DO
            pos := pos + 1;
        (*ENDWHILE*) 
        WHILE (pos <= length) AND (content [pos ]
              in   [ '0'..'9'] )
              AND (i <= 4)
              DO
            BEGIN
            (*=============================*)
            (* convert option into integer *)
            (*=============================*)
            numb := numb * 10 + ord(content [pos] ) - ord('0');
            pos := pos + 1;
            i := i + 1;
            ok := true;
            END;
        (*ENDWHILE*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
&ifdef WINDOWS
(*------------------------------*) 
 
PROCEDURE
      in12_win_copy ( VAR eform   : tin_eform_buffer;
            VAR evars   : tin_eform_vars;
            block       : tin_ed_winmark_type );
 
VAR
      ok         : boolean;
      cliphandle : tsp00_Int4;
      actlen     : tin_natural;
      maxcols    : tin_natural;
      length     : tin_natural;
      templine   : tin_eline;
      i          : integer;
      error      : boolean;
      firstline  : integer;
      lastline   : integer;
      firstcol   : integer;
      lastcol    : integer;
 
BEGIN
WITH block.mark DO
    BEGIN
    firstline := top;
    IF  firstline < 1
    THEN
        firstline := 1;
    (*ENDIF*) 
    lastline := bottom;
    IF  lastline > evars.lines
    THEN
        lastline := evars.lines;
    (*ENDIF*) 
    firstcol := left;
    IF  firstcol < 1
    THEN
        firstcol := 1;
    (*ENDIF*) 
    lastcol := right;
    IF  lastcol > mxin_eline
    THEN
        lastcol := mxin_eline;
    (*ENDIF*) 
    IF  (firstline <= lastline) AND (evars.lines > 0)
    THEN
        BEGIN
        maxcols := mxin_eline;
        i63writeopen (maxcols, 1, cliphandle, ok);
        error := false;
        FOR i := firstline TO lastline DO
            IF  NOT error
            THEN
                BEGIN
                IF  i <= evars.lines
                THEN
                    i14geteline(eform,evars,templine,i,actlen,error)
                ELSE
                    BEGIN
                    error := false;
                    templine [1] := bsp_c1;
                    actlen := 1;
                    END;
                (*ENDIF*) 
                IF  NOT error
                THEN
                    BEGIN
                    IF  block.mode = vt_mark_block
                    THEN
                        BEGIN
                        actlen := actlen - firstcol + 1;
                        length := lastcol - firstcol + 1;
                        IF  actlen < length
                        THEN
                            length := actlen;
                        (*ENDIF*) 
                        IF  length > 0
                        THEN
                            BEGIN
                            s10mv(mxin_eline,mxin_eline,
                                  @templine,firstcol,
                                  @templine,1,length);
                            IF  length > mxin_eline
                            THEN
                                length := mxin_eline;
                            (*ENDIF*) 
                            END;
                        (*ENDIF*) 
                        END
                    ELSE
                        BEGIN
                        length := actlen;
                        END;
                    (*ENDIF*) 
                    IF  (length <= 0)
                    THEN
                        BEGIN
                        length := 1;
                        templine [1] := bsp_c1;
                        END;
                    (*ENDIF*) 
                    i63put ( cliphandle, templine, length, ok );
                    error := NOT ok;
                    END;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
        (*ENDFOR*) 
        i63close ( cliphandle, ok );
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      in12_win_paste (
            VAR display : tin_display_parms;
            VAR edit    : tin_edit_work_area;
            block       : tin_ed_winmark_type );
 
VAR
      nr_rows        : tsp00_Int4;
      dummy_cols     : tsp00_Int2;
      dummy_items    : tsp00_Int4;
      ok             : boolean;
      cliphandle     : tsp00_Int4;
      info           : tsp00_Int2Buf;
      row_count      : tsp00_Int4;
      length         : tsp00_Int2;
      lg_len         : tsp00_Int4;
      perror         : boolean;
      line           : tin_eline;
 
BEGIN
WITH display, edit DO
    WITH frame [ current_eform ] DO
        BEGIN
        i63readopen (wls_line, cliphandle, nr_rows, dummy_cols,
              dummy_items, info, ok);
        IF  NOT ok
        THEN
            BEGIN
            error_found := true;
            msg_id := file_error;
            error_type := ocmd_error;
            csr_pos.scol := cin_ocmd_scol + 5;
            END
        ELSE
            BEGIN
            i14cleareform (pick.pick_vars);
            pick.blockwidth := 0;
            row_count := 1;
            REPEAT
                length := mxin_eline;
                i63get ( cliphandle, row_count, 1, line,
                      frame [ current_eform] .max_cols,
                      length, ok );
                IF  ok
                THEN
                    BEGIN
                    lg_len := length;
                    i32repltabs (i32machinecodetype, mxin_eline,
                          line, lg_len);
                    length := lg_len;
                    IF  (length > pick.blockwidth) AND
                        (block.mode <> vt_mark_line)
                    THEN
                        pick.blockwidth := length;
                    (*ENDIF*) 
                    i15putpickbuf (pick, line, row_count,
                          length, 1, perror);
                    END;
                (*ENDIF*) 
                row_count := row_count + 1;
            UNTIL
                NOT ok OR perror OR (row_count > nr_rows);
            (*ENDREPEAT*) 
            IF  perror
            THEN
                i11message(eform_overflow,
                      frame [active_screen] .sys_msg,
                      frame [active_screen] .is_error);
            (*ENDIF*) 
            IF  NOT ok
            THEN
                BEGIN
                error_found := true;
                msg_id := file_error;
                error_type := ocmd_error;
                csr_pos.scol := cin_ocmd_scol + 5;
                END;
            (*ENDIF*) 
            i63close (cliphandle, ok);
            END;
        (*ENDIF*) 
        END;
    (*ENDWITH*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      in12_win_del ( VAR eform   : tin_eform_buffer;
            VAR evars   : tin_eform_vars;
            VAR display : tin_display_parms;
            VAR edit    : tin_edit_work_area;
            block       : tin_ed_winmark_type );
 
VAR
      firstline  : integer;
      lastline   : integer;
      firstcol   : integer;
      lastcol    : integer;
 
BEGIN
WITH block.mark DO
    BEGIN
    firstline := top;
    IF  firstline < 1
    THEN
        firstline := 1;
    (*ENDIF*) 
    lastline := bottom;
    IF  lastline > evars.lines
    THEN
        lastline := evars.lines;
    (*ENDIF*) 
    firstcol := left;
    IF  firstcol < 1
    THEN
        firstcol := 1;
    (*ENDIF*) 
    lastcol := right;
    IF  lastcol > mxin_eline
    THEN
        lastcol := mxin_eline;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
WITH display, edit DO
    BEGIN
    IF  block.mode = vt_mark_line
    THEN
        BEGIN
        i14deleteeline(eform,evars,firstline,lastline - firstline + 1);
        insert_scol := 1;
        END
    ELSE
        BEGIN
        i14delblock(eform,evars,firstline,lastline,
              firstcol,lastcol+1);
        insert_scol := firstcol;
        insert_mode := true;
        insert_line := firstline;
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
&endif
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
.PA 
