home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
C!T ROM 2
/
ctrom_ii_b.zip
/
ctrom_ii_b
/
PROGRAM
/
FOXPRO
/
ME102
/
ME.PRG
< prev
Wrap
Text File
|
1993-05-20
|
8KB
|
317 lines
*******************************************************************************
*
* ME - MiniEditor / 2.3.92
*
*******************************************************************************
* Release 1.01 / 31.07.92
* 1.02 / 09.04.93
#include screen.hdr && FCO 2.4
#include bits.hdr
#include data.hdr
#include colors.hdr
#include io.hdr
#include database.hdr
#include fileio.hdr
#include string.hdr
#include system.hdr
#include keys.hdr
#include error.hdr
#include warn.hdr
#include math.hdr
#include memo.hdr
#include date.hdr
#include tsr.hdr
*******************************************************************************
*
* Defines
*
*******************************************************************************
#define vers "1.02"
*******************************************************************************
*
* Database strukture
*
*******************************************************************************
DBFDEF ME
MEMO text
ENDDEF
*******************************************************************************
*
* Global Variables
*
*******************************************************************************
VARDEF
CHAR(80) temp_path
CHAR(80) me_dbf
UINT std_color = &blue_light_cyan
UINT msg_color = &white_black
UINT key_color = &white_red
UINT hi_color = &white_white
UINT ax, bx, cx, dx, si, di, bp, ds, es
FILE f
CHAR(128) datei
CHAR(128) dateiname
CHAR(255) line
LOGICAL insert
ENDDEF
*******************************************************************************
*
* Allgemeine Funktionen
*
*******************************************************************************
*--- Laufzeitfehler ausgeben und Programm korrekt beenden
*
PROCEDURE error_proc
set color to
?? chr(7)
@ 10, 0 clear to 12, 79
@ 11, 5 ?? "Laufzeitfehler:",trim(i_str(__errcode))+", "+e_message()
@ 12, 0
close all
cursor_on
quit
ENDPRO
*--- Shift Status anzeigen
*
PROCEDURE shift_status
PARAMETERS CONST logical x
VARDEF
INT r, c, oldcolor
ENDDEF
IF lastkey() = &K_INS .or. x
oldcolor = __color_std
r = row()
c = col()
__color_std = hi_color
ax = 0x0200
Interrupt(0x16, ax, bx, cx, dx, si, di, bp, ds, es)
IF TestBit( ax,7 )
insert = .t.
@ 0,65 ?? "Einfg"
ELSE
insert = .f.
@ 0,65 ?? space(5)
ENDIF
__color_std = oldcolor
@ r, c
ENDIF
ENDPRO
*--- Alles Eingaben gehen über diese Routine
*
FUNCTION UINT keyfilter
VARDEF
UINT col, row, n
ENDDEF
do shift_status with .f.
ax = 0x0300
Interrupt(0x10, ax, bx, cx, dx, si, di, bp, ds, es)
col = dx % 256
row = dx / 256
DO CASE
CASE lastkey() = &K_F1
save_screen()
IF exist( trim(temp_path)+"me.hlp" )
clear
type( trim(temp_path)+"me.hlp" )
DO WHILE inkey() = 0
ENDDO
ELSE
?? chr(7)
ENDIF
restore_area()
RETURN &K_F1
CASE lastkey() = &K_TAB
IF insert
keyboard( space( 8-( col % 8)))
ELSE
n = 8-( col % 8 )
DO while n > 0
key_int( &K_RIGHT )
n = n - 1
ENDDO
ENDIF
ENDCASE
RETURN lastkey()
ENDPRO
*******************************************************************************
*
* Function: FCO_MAIN
* Description: Main entry point for program.
*
*
*******************************************************************************
PROCEDURE FCO_main
PARAMETERS CONST char(128) cmd_line
SET SCOREBOARD OFF
SET MESSAGE TO 24
SET INTENSITY ON
SET EXACT OFF
SET DATE GERMAN
*--- MemoBuffer setzen
__memo_max = 32768
*--- Hilfe mit F1, alle Eingaben über keyfilter
ON KEY DO keyfilter
*---setup error procedure
ON ERROR DO error_proc
*--- create path from current directory
temp_path = chr( curdrive() + 'A' ) + ":" + curdir( 0 )
IF right( temp_path, 1 ) <> "\"
*--- add ending backslash
temp_path = temp_path + "\"
ENDIF
me_dbf = temp_path + "ME.DBF"
*--- Farben setzen
IF .NOT. iscolor() .OR. "/mono" $ lower( cmd_line )
msg_color = &white_black
std_color = &black_white
key_color = &white_dark_grey
hi_color = &white_black
ENDIF
IF "/mono" $ lower( cmd_line )
datei = AllTrim( stuff( cmd_line, at( "/mono", lower( cmd_line )), 5, "" ))
ELSE
datei = AllTrim( cmd_line )
ENDIF
DO CASE
case len( datei ) = 0
? "MiniEditor v"+&vers
? chr(7)+"Syntax: ME [Laufwerk:]Dateiname [/mono]"
delay(1)
quit
case filesize( datei ) > __memo_max
? chr(7)+"Datei darf maximal",;
trim( i_str( __memo_max )),"Byte groß sein"
delay(1)
quit
ENDCASE
*--- Dateiname ohne Extension sichern
dateiname = left( datei, at( ".", datei ) -1 )
*--- Datenbank neu erzeugen
IF exist( me_dbf )
erase "me.dbf"
erase "me.dbt"
ENDIF
BUILD me_dbf FROM ALIAS me
use me_dbf alias me
append blank
__color_std = std_color
clear
__color_std = msg_color
__color_enhcd = msg_color && Hintergrund auch setzen
@ 0, 0 clear to 0,79
@ 0, 1 ?? "ME v"+&vers,"(c) 1993 by Alfred Klich"
@ 0,38 ?? "["+datei+"]"
__color_std = msg_color
@24, 0 clear to 24,79
@24, 1 ?? " = Hilfe │ = speichern + Ende │ = Abbruch"
__color_std = key_color
@24, 1 ?? "F1"
@24,14 ?? "Ctrl-W"
@24,42 ?? "ESC"
__color_std = std_color
*--- Status und Cursor anzeigen
DO shift_status with .t.
*--- Wenn Datei vorhanden, Text in Memofeld laden
*
IF exist( datei )
f_open( f, datei, &F_READ, &F_TEXT )
m_open( me->text, &MO_CREATE )
f_getln( f, line ) && 1. Zeile übergehen
m_put( me->text, line )
DO WHILE .not. f_eof( f )
f_getln( f, line )
*--- <tabs> durch <space> ersetzen
DO WHILE .T.
IF at( chr( 9 ), line ) > 0
line = stuff( line, at( chr( 9 ), line ), 1,;
space( 9 - at( chr( 9 ), line ) % 8 ))
ELSE
exit
ENDIF
ENDDO
m_putln( me->text, line )
ENDDO
f_close( f )
m_close( me->text )
*--- .TMP-Datei erstellen
copy file datei to dateiname + ".TMP"
ENDIF
*--- Text im Memofeld editieren
*
m_edit( me->text, 1, 0, 23, 79, .F. )
*--- Text wieder in Datei zurückschreiben
*
IF lastkey() <> &K_ESC
m_open( me->text, &MO_READ )
f_open( f, datei, &F_CREATE, &F_TEXT )
m_getln( me->text, line )
f_put( f, line )
DO WHILE .not. m_eof( me->text )
m_getln( me->text, line )
IF IsEmpty( line )
line = " "
ENDIF
f_putln( f, line )
ENDDO
m_close( me->text )
f_close( f )
*--- .TMP in .BAK-Datei umbenennen
IF exist( dateiname + ".BAK" )
erase( dateiname + ".BAK" )
ENDIF
IF exist( dateiname + ".TMP" )
rename( dateiname + ".TMP" ) to ( dateiname + ".BAK" )
ENDIF
ELSE
*--- .TMP-Datei löschen
IF exist( dateiname + ".TMP" )
erase ( dateiname + ".TMP" )
ENDIF
ENDIF
*--- Programm beenden
*
close all
set color to
clear
quit
ENDPRO