home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Media Share 9
/
MEDIASHARE_09.ISO
/
clarion
/
ppstpx.zip
/
OM.TPL
< prev
next >
Wrap
Text File
|
1993-06-08
|
34KB
|
593 lines
#!------------------------------------------------------------------------------
#!
#! The OM Template File
#!
#! OM.TPL is the first of a chain of template files that contain the
#! standard Clarion procedure templates. These templates generate CUA
#! compliant, text-based applications. Other files in the template chain
#! are OM1.TPX, OM2.TPX, and so forth.
#!
#! Initial screen, report, and action images are contained in corresponding
#! application files with an extension of .APP (e.g. OM.APP).
#!
#! Template Directory
#!
#! OM1.TPX Batch Sequential record processing of a file.
#! OM3.TPX Browse Browse records directly from a file
#! OM6.TPX Child Update a batch of Child records
#! OM1.TPX External Document external procedure call
#! OM8.TPX File Select a file from a directory listing
#! OM4.TPX Form Update a record with a form
#! OM3.TPX List List a file's records from a memory queue
#! OM3.TPX Lookup Setup procedure to lookup a field
#! OM2.TPX Menu Execute a procedure from a pop-up menu
#! OM.TPL Module Initialize a module
#! OM4.TPX MultiPage Update a file with a multiple page entry form
#! OM4.TPX PageOf Data entry 'Page' used with the MultiPage Form
#! OM1.TPX Print Print a report from memory
#! OM.TPL Program Initialize a program
#! OM2.TPX Pulldown Execute a procedure from a pulldown menu
#! OM8.TPX Redirect Select destination for a report
#! OM7.TPX Report Print a report
#! OM1.TPX Screen Process any screen
#! OM3.TPX Select Load a selected record into memory
#! OM1.TPX Source Process any source code
#! OM1.TPX Todo Undefined procedure code
#! OM3.TPX Validate Edit procedure to lookup a field
#! OM8.TPX View View a selected text file in a listbox
#! OM9.TPX #GROUPs Groups used by multiple templates
#!
#!------------------------------------------------------------------------------
#PROGRAM
#!------------------------------------------------------------------------------
#!
#! The Program Template
#!
#! The Program template generates the PROGRAM statement, MAP structure,
#! FILE structures, and global declarations for a Clarion program. This
#! template also blanks the screen and calls the first procedure. There
#! is only one #PROGRAM segment in a template file chain.
#!
#!------------------------------------------------------------------------------
#PROMPT('Enable &Shared Files',CHECK),%SharedFiles
#PROMPT('Enable Mouse Support',CHECK),%MouseSupport
#PROMPT('Enhanced Background?',CHECK),%EnhancedBackground
#PROMPT('Thin Borders?',CHECK),%ThinBorders #! Thin borders wanted ? PPS
#PROMPT('Enable File Manager',CHECK),%FileMgr #! File Manager wanted ? PPS
#PROMPT('If &File Not Found',OPTION),%FileNotFound
#PROMPT('Create',RADIO)
#PROMPT('Halt',RADIO)
#PROMPT('Program &Author',@S30),%Author
#!
#IF(%SharedFiles)
#SET(%AccessMode,'42h')
#ELSE
#SET(%AccessMode,'22h')
#ENDIF
TITLE('%Program')
OMIT('╝')
╔════════════════════════════════════════════════════════════════════════════╗
║ Program - %Program #<! ║
║ Author - %Author #<! ║
╚════════════════════════════════════════════════════════════════════════════╝
PROGRAM
INCLUDE('KEYCODES.EQU')
INCLUDE('CLARION.EQU')
INCLUDE('ERRORS.EQU')
MAP
CheckOpen(*FILE)
#IF(%FileMgr) #! If using File Manager then
FileMgr(STRING,<STRING>,<*BYTE>,<*FILE>,<STRING>)
#ENDIF #! declare it. PPS
DiskError(<STRING>),BYTE
ShowWarning
%ModuleStructures
END
EJECT('File Layouts')
%GlobalData
#!#FOR(%AppFiles) Changed to put all files in dct in app. PPS
#! #FIX(%File,%AppFiles)
#FOR(%File)
%FileStructure
#ENDFOR
AddRecord EQUATE(1) #<! Add a new record
ChangeRecord EQUATE(2) #<! Change the current record
DeleteRecord EQUATE(3) #<! Delete the current record
#IF(%FileMgr)
#<! Create Global File Manager
#<! variables - PPS
#INSERT(%GlobalFileMgrVars)
#ENDIF
#EMBED('Data Section')
CODE
#EMBED('Setup Program')
LOADSYMBOLS #<!Display graphic mouse
#IF(%ThinBorders)
LOADBORDER #<!Display thin borders PPS
#ENDIF
#IF(%EnhancedBackground)
SETNOBLINK #<!Enable enhanced colors
#ENDIF
#IF(%HelpFile)
HELP('%HelpFile') #<!Open the help file
#ENDIF
#IF(%StyleFile )
GETSTYLES('%StyleFile') #<!Open the style file
#ENDIF
#IF(%MouseSupport)
SETMOUSE(1,1) #<!Turn on mouse
#ENDIF
SETCOLOR(WhiteOnBlack) #<!Set white on black
BLANK #<!Clear the screen
SETCOLOR #<!Turn off override color
%FirstProcedure #<!Call the first procedure
#EMBED('Before return to DOS')
RETURN #<!Return to DOS
OMIT('╝')
╔════════════════════════════════════════════════════════════════════════════╗
║ Check ERROR() function after opening a file ║
╚════════════════════════════════════════════════════════════════════════════╝
CheckOpen PROCEDURE(File)
CODE
OPEN(File,%AccessMode) #<!Attempt to open the file
CASE ERRORCODE() #<! and check for errors
OF NoError #<!Return if no error
OROF IsOpenErr #<! or if already open.
RETURN
#IF(%FileNotFound <> 'Halt')
OF NoFileErr #<!If file was not found
CREATE(File) #<!Create the file
OPEN(File,%AccessMode) #<! then open it
IF ~ERRORCODE() THEN RETURN. #<! And return if it opened
#ENDIF
OF InvalidFileErr #<!Invalid Record Declaration
GLO:Message1 = 'Error accessing: '& NAME(File)
GLO:Message2 = 'Code: ' & ERRORCODE() & ' ' & ERROR()
GLO:Message3 = 'Press OK to return to DOS'
ShowWarning
HALT(InvalidFileErr)
OF BadKeyErr #<!Key Files must be rebuilt
GLO:Message1 = NAME(File) & ' Key file is invalid'
GLO:Message3 = 'Press OK to rebuild keyfile'
ShowWarning
OPEN(File,12H) #<!Open for exclusive access
BUILD(File) #<!Rebuild the key files
IF ERRORCODE()
GLO:Message1 = NAME(File) & ' The file cannot be repaired'
GLO:Message2 = 'while other stations are using it'
GLO:Message3 = 'Press OK to return to DOS'
ShowWarning
HALT(BadKeyErr)
ELSE
CLOSE(File) #<!Close
OPEN(File,%AccessMode) #<! then open it
END
END #<!End of Case Structure
IF DiskError(NAME(File) & ' File could not be opened') THEN HALT(0). #<!Cannot resume
OMIT('╝')
╔════════════════════════════════════════════════════════════════════════════╗
║ File manager procedure to only open files that are needed. It also has ║
║ a table that can be called by any procedure via a CtrlGAst. ║
║ ║
║ This procedure can be passed five parameters. The do as follows: ║
║ ║
║ 1. LEVEL: This call needs to have the first parameter of LEVEL, the ║
║ procedure name, and the file manager level variable that needs to be ║
║ modified. The LEVEL parameter and the procedure name are passed by value ║
║ and the file manager variable is passed by address. The procedure looks ║
║ through the file manager Queue and finds all of the occurences of the ║
║ procedure being called. It then gets the highest level of the procedure, ║
║ puts that value into the file manager level variable that was passed by ║
║ address and then increments it by one. ║
║ ║
║ 2. OPEN: This call needs to have first parameter as OPEN, the procedure ║
║ name, the file manager level variable, the file, and the file name. ║
║ The OPEN parameter, the procedure name, and the file name are all passed ║
║ by value. The file manager level variable and the file are passed by ║
║ address. This parameter causes the procedure to look through the file ║
║ manager Queue and see if the requested file is open. If it is it makes ║
║ a note of it in the queue but does not try to open the file again. If ║
║ the file is not open it makes a note of it in the queue and opens the ║
║ file with the standard CheckOpen. ║
║ ║
║ 3. CLOSE: This call needs to have the first parameter as CLOSE, the ║
║ procedure name, the file manager level variable, the file, and the file ║
║ name. The CLOSE parameter, the procedure name, and the file name are ║
║ all passed by value. The file manager level variable and the file are ║
║ passed by address. This parameter causes the procedure to look through ║
║ the file manager Queue and close the passed file. It will only close the ║
║ passed file if it has not been opened by any other procedure. ║
║ ║
║ 4. EXIT: This call needs to have the first parameter as EXIT, the ║
║ procedure name, and the file manager level variable. The EXIT parameter ║
║ and the procedure name are passed by value. The file manager level ║
║ variable is passed by address. This parameter causes the procedure to ║
║ look through the file manager queue and close every file for this ║
║ procedure and level. It will only close the file if no other procedure ║
║ needs it to be open. ║
║ ║
║ 5. VIEW: This call needs to have the first parameter as VIEW. The VIEW ║
║ parameter is passed by value. This parameter causes the procedure to ║
║ display a scrolling table with the file manager queue being used. This ║
║ will allow the user to see all files that should be opened. This call ║
║ has been placed in every templates keyboard control loop. If the user ║
║ hits ALT-MINUS (alt and the minus sign key) it will call this procedure ║
║ with the VIEW parameter. ║
╚════════════════════════════════════════════════════════════════════════════╝
FileMgr PROCEDURE(OpenType,PassedProcName,FileMgrLvlVar,|
PassedFile,PassedFileName)
MainFileQueuePtr byte !File Manager Queue Pointer
MainFileQueueTop byte !File Manager Queue Top Ptr
OpenFlag byte !Flag to signal to open file
Level byte !File Manager level holder
CurrentFile string(8) !Current file to close holder
FileViewQueuePtr byte
FileViewQueueTop byte
FileViewQueue QUEUE,pre(fvq) ! File Management View Queue
display_string string(78)
.
QueueViewScr SCREEN(22,80),SHADOW,ZOOM,CUA,COLOR(19)
!dimensions=25,80,25,80
ROW(1,1) PAINT(1,25),COLOR(49)
ROW(1,55) PAINT(1,26),COLOR(49)
ROW(1,26) STRING('FILE MANAGER QUEUE VIEW TABLE'),COLOR(49)
ROW(22,1) STRING('╒╟{78}╨')
REPEAT(20)
ROW(2,1) STRING('')
ROW(2,80) STRING('╥')
.
ROW(4,4) LIST(15,74),FROM(FileViewQueue),VSCROLL,USE(?FileViewList),MSG('Up/Down arrow, PgUp/PgDwn, Enter to select'),HIDE,COLOR(112,143,120)
ROW(20,38) BUTTON(' E&xit |'),SHADOW,USE(?EXIT),MSG('Return to previous screen'),COLOR(32,143,39,47,143)
.
CODE
case clip(left(upper(OpenType)))
of 'LEVEL' !File Manager to compute
! current file open level.
if records(FileManagerQueue) !If records in file mgr queue
sort(FileManagerQueue,fmq:ProcName,|!Sort the File Manager queue
fmq:FileMgrLvl)
Level = 0 !Set the level holder to zero
MainFileQueuePtr = 1 !Set the queue ptr to 1
MainFileQueueTop = | !Set the queue top ptr to
records(FileManagerQueue) ! number of rec's in queue
loop !Start queue look loop
get(FileManagerQueue,| !Get the queue record for
MainFileQueuePtr) ! the queue pointer
if fmq:ProcName = PassedProcName !If queue proc name equal
Level = fmq:FileMgrLvl ! to passed proc name then
! store the level for the
! proc in the level holder
. !End if queue proc name equal
MainFileQueuePtr += 1 !Increment queue pointer
if MainFileQueuePtr > | !If queue pointer is greater
MainFileQueueTop ! than the top ptr then
break ! break.
. !End if queue ptr greater
. !End queue look loop
FileMgrLvlVar = Level + 1 !Increment file mgr lvl
else !If no records in file mgr
! queue
FileMgrLvlVar = 1 !Set file mgr lvl var to 1
. !End if records in file mgr
! queue
of 'OPEN' !Request to open a file
OpenFlag = 1 !Set OpenFlag to 1 (Open File)
if records(FileManagerQueue) then !If records in file mgr queue
MainFileQueuePtr = 1 !Set queue ptr to one
MainFileQueueTop = | !Set queue top ptr to number
records(FileManagerQueue) ! of records in queue
loop !Start queue look loop
get(FileManagerQueue,| !Get queue record for queue
MainFileQueuePtr) ! pointer
if fmq:FileName = PassedFileName !If queue file file name equal
! to procedure name
OpenFlag = 0 !Set open flag to 0 (No Open)
break !Break out of look loop
. !End if queue file equal
MainFileQueuePtr += 1 !Increment queue ptr
if MainFileQueuePtr > | !If queue ptr greater than
MainFileQueueTop ! queue top ptr
break !Break out of look loop
. !End if queue ptr greater
. !End queue look loop
sort(FileManagerQueue,fmq:ProcName,|!Sort file mgr queue by proc
fmq:FileName,fmq:FileMgrLvl) ! name, file name, level
fmq:FileName = PassedFileName !Set queue file name to passed
fmq:ProcName = PassedProcName !Set queue proc name to passed
fmq:FileMgrLvl = FileMgrLvlVar !Set queue level to passed
get(FileManagerQueue,fmq:ProcName,| !Get record in queue that
fmq:FileName,fmq:FileMgrLvl) ! matches passed values
if errorcode() = 30 then !If queue rec not found
clear(fmq:record) !Clear the queue record
fmq:FileName = PassedFileName ! structure and add passed
fmq:ProcName = PassedProcName ! values to the queue
fmq:FileMgrLvl = FileMgrLvlVar !
add(FileManagerQueue) !
if OpenFlag then !If open flag is set then
CheckOpen(PassedFile) ! call CheckOpen with file
. !End if open flag set
. !End if queue rec not found
else !
clear(fmq:record) !If no records in queue then
fmq:FileName = PassedFileName ! fill queue record structure
fmq:ProcName = PassedProcName ! with the passed values and
fmq:FileMgrLvl = FileMgrLvlVar ! add to the queue
add(FileManagerQueue) !
CheckOpen(PassedFile) !Call CheckOpen with file
. !End if records in queue
!
of 'CLOSE' !File close requested
MainFileQueuePtr = 1 !Set queue ptr to 1
MainFileQueueTop = | !Set queue top ptr to number
records(FileManagerQueue) ! of records in queue
loop !Start queue look loop
get(FileManagerQueue, | !Get queue record for ptr
MainFileQueuePtr) !
if fmq:ProcName = PassedProcName| !If the queue proc name,
and fmq:FileMgrLvl = FileMgrLvlVar|
and fmq:FileName = PassedFileName! queue level, and queue file
! match the passed values
delete(FileManagerQueue) !Delete the queue record
if records(FileManagerQueue) !If records are left in queue
sort(FileManagerQueue,| !Sort queue by file name
fmq:FileName) !
fmq:FileName = | !Fill queue file name with
PassedFileName ! passed value
get(FileManagerQueue,| !Check if file name is in
fmq:FileName) ! the queue
if errorcode() = 30 !If file name is not in the
case PassedFileName ! queue then close the
! passed file.
#FOR(%File)
of '%File'
close(%File)
#ENDFOR
. !End case CurrentFile
. !End if file name not found
else !
case PassedFileName !If no records in queue
! then close the passed
! file
#FOR(%File)
of '%File'
close(%File)
#ENDFOR
. !End case CurrentFile
. !End if file name not found
MainFileQueuePtr = 1 !Reset the queue ptr to 1
MainFileQueueTop =| !Reset the queue top ptr
records(FileManagerQueue)! no of recs in queue
if MainFileQueueTop = 0 !If queue top ptr is zero
free(FileManagerQueue) !Destroy the queue structure
break ! break out of look loop
. !End if queue top ptr zero
cycle !Go to top of loop
. !End if proc name equal passed
MainFileQueuePtr += 1 !Increment queue ptr
if MainFileQueuePtr >| !If queue ptr greater than top
MainFileQueueTop ! ptr then break out of look
break ! loop
. !End if queue ptr greater
. !End of look loop
!
of 'EXIT' !File mgr exit requested
MainFileQueuePtr = 1 !Set queue ptr to 1
MainFileQueueTop =| !Set queue top ptr to number
records(FileManagerQueue) ! of records in queue
loop !Start queue look loop
get(FileManagerQueue,| !Get queue record for ptr
MainFileQueuePtr) !
if fmq:ProcName = PassedProcName| !If the queue proc name,
and fmq:FileMgrLvl = FileMgrLvlVar
! queue level, and queue file
! match the passed values
CurrentFile = fmq:FileName !Fill CurrentFile with que file
delete(FileManagerQueue) !Delete the queue records
if records(FileManagerQueue) !If records are left in queue
sort(FileManagerQueue,| !Sort queue by file name
fmq:FileName) !
fmq:FileName = CurrentFile !Fill queue file name with
! the current file name
get(FileManagerQueue,| !Check if file name is in
fmq:FileName) ! the queue
if errorcode() = 30 !If file name is not in the
case CurrentFile ! queue then close the
! passed file.
#FOR(%File)
of '%File'
close(%File)
#ENDFOR
. !End case CurrentFile
. !End if file name not found
else !
case CurrentFile !If no records in queue
! then close the passed
! file
#FOR(%File)
of '%File'
close(%File)
#ENDFOR
. !End case CurrentFile
. !End if file name not found
MainFileQueuePtr = 1 !Reset the queue ptr to 1
MainFileQueueTop =| !Reset the queue top ptr
records(FileManagerQueue)! no of recs in queue
if MainFileQueueTop = 0 !If queue top ptr is zero
free(FileManagerQueue) !Destroy the queue structure
break ! break out of look loop
. !End if queue top ptr zero
cycle !Go to top of loop
. !End if proc name equal passed
MainFileQueuePtr += 1 !Increment queue ptr
if MainFileQueuePtr >| !If queue ptr greater than top
MainFileQueueTop ! ptr then break out of look
break ! loop
. !End if queue ptr greater
. !End of look loop
!
of 'VIEW' !File mgr view requested
if records(FileManagerQueue) !If recs are in queue
sort(FileManagerQueue,fmq:ProcName,|!Sort file mgr queue by proc
fmq:FileName,fmq:FileMgrLvl) ! name, file name, level
MainFileQueuePtr = 1 !Set queue ptr to 1
MainFileQueueTop = | !Reset the queue top ptr
records(FileManagerQueue) ! no of recs in queue
loop !Start queue transfer loop
get(FileManagerQueue,| !Get the queue record for
MainFileQueuePtr) ! queue ptr
fvq:display_string = ' ' &| !Fill the display string
left(fmq:ProcName,50) | ! with the proc name, file
& ' │ ' & | ! name, and file manager
left(fmq:FileName) | ! level
& ' │ ' & | !
fmq:FileMgrLvl !
add(FileViewQueue) !Add record to view queue
MainFileQueuePtr += 1 !Increment queue ptr
if MainFileQueuePtr > | !Increment queue ptr
MainFileQueueTop !If queue ptr greater than top
! ptr then break out of transfer
break ! loop
. !End if queue ptr greater
. !End of transfer loop
open(QueueViewScr) !Open the view screen
loop !Start of keyboard loop
accept !
case field() !
of ?EXIT !If EXIT button is hit then
break ! break out of the loop
. !
case keycode() !
of EscKey !If ESC is hit then break
break ! out of the loop
. !
. !End keyboard loop
free(FileViewQueue) !Remove the view queue stru.
close(QueueViewScr) !Close the view screen
else !
glo:message1 = | !If no files to be managed
'No managed files to view' ! then warn the user with
showwarning ! showwarning
clear(glo:message1) !
. !
. !
return !Return to the caller
OMIT('╝')
╔════════════════════════════════════════════════════════════════════════════╗
║ Check ERROR() function after a disk access ║
╚════════════════════════════════════════════════════════════════════════════╝
DiskError FUNCTION(Cause)
StopMsg:: STRING(180)
CODE
IF ~ERRORCODE() THEN RETURN(0). #<!Return with no error
IF ~OMITTED(1) #<!If a cause was given
StopMsg:: = 'Cause: ' & Cause & LF:CR #<! Display it
END #<!End IF
IF ERRORFILE() #<!If error involves a file
StopMsg:: = CLIP(StopMsg::) & 'File : ' | #<! display the file
& ERRORFILE() & LF:CR
END #<!End IF
StopMsg:: = CLIP(StopMsg::) & 'Error: ' | #<!Display the error code
& ERRORCODE() & ' - ' | #<! and the error message
& ERROR() & LF:CR
STOP(StopMsg::) #<!Stop with message
RETURN(1) #<!Return with error
OMIT('╝')
╔════════════════════════════════════════════════════════════════════════════╗
║ Display a warning message using 3 Global message variables. ║
╚════════════════════════════════════════════════════════════════════════════╝
ShowWarning PROCEDURE
SaveStyle STRING(256)
!
! COMMENTED OUT TO CHANGE TO FOLLOW THE PPS SCREEN CONVENTIONS
!Screen SCREEN(9,53),PRE(SCR),CENTER,SHADOW,CUA,COLOR(112)
! ROW(1,1) STRING('█▀{51}█'),COLOR(116)
! ROW(9,1) STRING('█▄{51}█'),COLOR(116)
! REPEAT(7)
! ROW(2,1) STRING('█'),COLOR(116)
! ROW(2,53) STRING('█'),COLOR(116)
! .
! ROW(3,5) ENTRY(@S45),USE(GLO:Message1),INS,SKIP,COLOR(112,112,112)
! ROW(4,5) ENTRY(@S45),USE(GLO:Message2),INS,SKIP,COLOR(112,112,112)
! ROW(5,5) ENTRY(@s45),USE(GLO:Message3),INS,SKIP,COLOR(112,112,112)
! ROW(7,24) BUTTON(' &Ok |'),SHADOW,USE(?Ok),COLOR(23,71,24,31,79)
! .
Screen SCREEN(9,53),PRE(SCR),CENTER,SHADOW,ZOOM,CUA,COLOR(79)
!dimensions=25,80,25,80
ROW(1,1) STRING('█{18}'),COLOR(207)
COL(19) STRING('USER MESSAGE FORM'),COLOR(241)
COL(36) STRING('█{18}'),COLOR(207)
ROW(9,1) STRING('╒╟{51}╨')
REPEAT(7)
ROW(2,1) STRING('')
ROW(2,53) STRING('╥')
.
ROW(3,5) ENTRY(@S45),USE(GLO:Message1),INS,SKIP,COLOR(112,112,112)
ROW(4,5) ENTRY(@S45),USE(GLO:Message2),INS,SKIP,COLOR(112,112,112)
ROW(5,5) ENTRY(@s45),USE(GLO:Message3),INS,SKIP,COLOR(112,112,112)
ROW(7,24) BUTTON(' &Ok |'),SHADOW,USE(?Ok),COLOR(23,143,24,31,143)
.
CODE
SaveStyle = STYLES() #<!Save current style
GETSTYLES('') #<!Turn off Styles
GLO:Message1 = CENTER(GLO:Message1,SIZE(GLO:Message1))
GLO:Message2 = CENTER(GLO:Message2,SIZE(GLO:Message2))
GLO:Message3 = CENTER(GLO:Message3,SIZE(GLO:Message3))
OPEN(Screen)
DISPLAY
ACCEPT #<!Enable keyboard and mouse
CLEAR(GLO:MessageGroup) #<!Blank out message fields
SETSTYLES(SaveStyle) #<!Restore user styles
RETURN
#!
#MODULE
#!------------------------------------------------------------------------------
#!
#! The Module Template
#!
#! The Module template generates the MEMBER statement, and module
#! level data declarations for a source module of a Clarion program.
#! There is only one #MODULE segment in a template file chain.
#!
#!------------------------------------------------------------------------------
MEMBER('%Program')
OMIT('╝')
╔════════════════════════════════════════════════════════════════════════════╗
║ %Module - %ModuleDescription #<! ║
╚════════════════════════════════════════════════════════════════════════════╝
%ModuleData
#EMBED('Data Section')
#!
#CHAIN('OM1.TPX')