!++
! FILENAME: EVEDT_KERNEL.TPU
! FUNCTION: Routines required by multiple modules for build.
! AUTHOR:   Steven K. Shapiro, (C) Copyright SKS Enterprises, Austin TX.
!                                  All Rights Reserved.
!
!           The format, structure and contents of this file are the sole
!           property  of Steven K. Shapiro  and are  copyrighted to  SKS
!           Enterprises, Austin Texas.
!
!           The information may be freely distributed, used and modified
!           provided  that the  information in this  header block is not
!           changed, altered, disturbed or modified in any way.
!
! DATE:     26-AUG-1987 Original.
! HISTORY:  current.
! CONTENTS:
!           evedt_insert_text(the_text)                     
!           evedt_search_quietly(target, dir)               
!           evedt_replace(old, new)                         
!           evedt_find_buffer(buffer_name)                  
!           evedt_defined_procedure(x)                      
!           evedt_set_shift_key ( new_shift_key )           
!           evedt_key ( new_pgm, default_key, new_doc, key_string )  
!           evedt_restore_key ( the_key )                   
!
!23456789A123456789B123456789C123456789D123456789E123456789F123456789G123456789H
!--
!*----------------------------------------------------------------------------*!

procedure evedt_kernel_module_ident 

  local file_date,
        module_vers;

  file_date := "-<( 15-NOV-1988 14:22:21.16 )>-";
  module_vers := substr(file_date,5,2) +
                 substr(file_date,8,3) +
                 substr(file_date,14,2) +
                 substr(file_date,17,5) ;

  return module_vers;

endprocedure;

!*----------------------------------------------------------------------------*!

! This routine will insert text even in overstrike mode.

procedure evedt_insert_text(the_text)         ! Copy_text in insert mode

LOCAL   old_mode;

    old_mode := get_info(current_buffer, "mode");
    set(INSERT, current_buffer);
    copy_text(the_text);
    set(old_mode, current_buffer);

endprocedure;

!*----------------------------------------------------------------------------*!

procedure evedt_search_quietly(target, dir)   ! Search w/o "String not found"

on_error
    return(0);
endon_error;

    return(search(target, dir));

endprocedure;

!*----------------------------------------------------------------------------*!

procedure evedt_replace(old, new)             ! Simple replace function

local   ptr,
        old_mode;

on_error
    return(0);
endon_error;

    ptr := search(old, current_direction);
    if (ptr <> 0) then
        position(ptr);
        erase(ptr);
        old_mode := get_info(current_buffer, "mode");
        set(INSERT, current_buffer);
        copy_text(new);
        set(old_mode, current_buffer);
        return(1);
    else
        return(0);
    endif;

endprocedure;

!*----------------------------------------------------------------------------*!
!
!       This routine translates a buffer name to a buffer pointer
!
!       Inputs:
!               buffer_name     String containing the buffer name
!
procedure evedt_find_buffer(buffer_name)      ! Find a buffer by name

local   the_buffer,             ! Used to hold the buffer pointer
        the_name;               ! A read/write copy of the name

    the_name := buffer_name;
    change_case(the_name, UPPER);
    the_buffer := get_info(buffers, "first");
    loop
        exitif (the_buffer = 0);
        exitif (the_name = get_info(the_buffer, "name"));
        the_buffer := get_info(buffer, "next");
    endloop;
    return the_buffer;

endprocedure

!*----------------------------------------------------------------------------*!

procedure evedt_defined_procedure(x)  ! See if a procedure is defined

local   temp;

on_error

    if (error = tpu$_multiplenames) then
        return(1);
    else
        return(0);
    endif;

endon_error;

    temp := expand_name(x, PROCEDURES);
    return(1);

endprocedure;


!*----------------------------------------------------------------------------*!
!
procedure evedt_set_shift_key ( new_shift_key ) ! Define shift key, save old

local   old_shift_key;

old_shift_key := evedt_g_shift_key;

evedt_g_shift_key := new_shift_key;
if new_shift_key =  ctrl_y_key then
        set (shift_key, key_name (pf1, shift_key));
        undefine_key ( old_shift_key );
else
        set ( shift_key, new_shift_key );
        define_key ("execute (lookup_key (eve$get_shift_key, program))",
            new_shift_key, "shift key");
endif;

return ( old_shift_key );

endprocedure

!*----------------------------------------------------------------------------*!

procedure evedt_key   ! Redefine a key, saving old definition
        ( new_pgm,      ! Valid 1st argument for define_key builtin
          default_key,  ! Default keyname if user hasn't defined one
          new_doc,      ! Valid 3rd argument for define_key builtin
          key_string )  ! String containing name for user defined keys
 
! 1) Determine if we have a user specified key; if not, use default.
! 2) Save the present definition & doc. of the user specified key.
! 3) Do a define key on the new key information.
 
! A note on methods:
 
! We use a string argument for the variable name of the user specified key
! so that: 1) We can successfully pass it to this procedure if its not defined.
!          2) We can generate variables to hold the old key's info, avoiding
!             passing more arguments for these.
 
! We combine the string argument with string constants to form valid TPU
! statements which we then execute.  
!
on_error endon_error;

evedt$x := default_key;       
evedt$x_old_pgm := 0;         
evedt$x_new_doc := new_doc;         

! Determine if we have a user specified key; if not, use default.

if expand_name ( key_string, variables ) <> eve$kt_null then
    evedt$x_string := key_string; 
else
    edit(evedt$x_new_doc, COLLAPSE);
    evedt$x_string := evedt$x_new_doc;
endif;
 
if expand_name ( evedt$x_string, variables ) <> eve$kt_null then

!    message ( 'EVEDT_KEY 1>' + 
!                 'if(get_info('+evedt$x_string+',"type")=integer)then '
!                        +'evedt$x:='+evedt$x_string+';'
!                +'else '
!                        +evedt$x_string+':=evedt$x;'
!                +'endif;' + '<' );

    execute (   'if(get_info('+evedt$x_string+',"type")=integer)then '
                        +'evedt$x:='+evedt$x_string+';'
                +'else '
                        +evedt$x_string+':=evedt$x;'
        +'endif;' );
else
!        message ( 'EVEDT_KEY 2 >' + evedt$x_string + ':=  evedt$x;' + '<' );

        execute ( evedt$x_string + ':=  evedt$x;' );
endif;                                  
                                        
! Save the present definition & doc. of the user specified key
! one exists.

evedt$x_old_pgm := lookup_key ( evedt$x, program);

if (get_info ( evedt$x_old_pgm, "type") = program) then

!        message ( 'EVEDT_KEY 3 >' + evedt$x_string
!                +'_doc := lookup_key ( evedt$x, comment);'
!                +evedt$x_string
!                +'_pgm := lookup_key ( evedt$x, program);' + '<');
                
        execute( evedt$x_string
                +'_doc := lookup_key ( evedt$x, comment);'
                +evedt$x_string
                +'_pgm := lookup_key ( evedt$x, program);');

else
!        message ( 'EVEDT_KEY 4 >' + evedt$x_string +'_doc := "~none~";' + '<');

        execute( evedt$x_string +'_doc := "~none~";');
endif;
 
! Do a define key on the new key information

define_key ( new_pgm, evedt$x, new_doc );
endprocedure

!*----------------------------------------------------------------------------*!

procedure evedt_restore_key ( the_key ) ! Restore a saved key definition.

! This is the companion procedure to evedt_key, and restores the previous
! definition of a key saved during evedt_key.   See evedt_key for
! more info.

local   this_informational;     ! Keyword for display of informational messages

    on_error
    endon_error;

    if get_info (system, "informational")
    then
        this_informational := on;
    else
        this_informational := off;
    endif;
    set (informational, off);

    evedt$x_string := the_key;
    if expand_name ( evedt$x_string+'_pgm', variables ) <> eve$kt_null
    then
        execute ( 'define_key('+evedt$x_string+'_pgm,'
                   +evedt$x_string+',' +evedt$x_string+'_doc); ');
    else
        execute ( 'undefine_key ('+evedt$x_string+'); ');
    endif;
    set (informational, this_informational);

endprocedure