889 lines
21 KiB
Plaintext
Executable File
889 lines
21 KiB
Plaintext
Executable File
*******************************************************************************
|
|
*
|
|
* Convert a PRIME VOC or a PICK M/DICT to a uni*Verse VOC
|
|
*
|
|
* Module %M% Version %I% Date %H%
|
|
*
|
|
* (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
|
|
* This is unpublished proprietary source code of Ardent Software Inc.
|
|
* The copyright notice above does not evidence any actual or intended
|
|
* publication of such source code.
|
|
*
|
|
*******************************************************************************
|
|
*
|
|
* Maintenence log - insert most recent change descriptions at top
|
|
*
|
|
* Date.... GTAR# WHO Description.........................................
|
|
* 10/14/98 23801 SAP Change copyrights.
|
|
* 06/05/96 18438 JC Port to NT
|
|
* 05/04/93 11385 PVW Fixed so screen does appear.
|
|
* 08/24/92 9549 PVW Stop truncating of Prime Remote Pointers
|
|
* 08/03/92 8791 PVW Use ADDS suffix for IN2 conversion
|
|
* 07/27/92 8792 PVW Changed sleep period to 3 seconds before cls
|
|
* 07/15/92 9033 PVW Corrected spelling of remote from remove
|
|
* 07/14/92 9697 PVW Corrected spelling of vocabulatry in Title
|
|
* 05/13/91 8345 DTM changed print to tprint
|
|
* 05/09/91 8316 DTM Fixed screen message
|
|
* 05/09/91 8331 DTM Fixed Enter.box.b to handle F.4
|
|
* 04/22/91 7121 GMH Added code to move description on F types
|
|
* 02/26/91 7673 DTM Added paramter to ENTER.BOX.B for case checking
|
|
* 12/31/90 7673 DTM Added motif menuing
|
|
* 06/08/90 7116 JWT reset remote flag after each loop
|
|
* 04/19/89 5890 JWT Added IN2 to conversion menu. Setup to run as PICK
|
|
* 07/25/88 - - Maintenence log purged at 5.2.1, see release 5.1.10.
|
|
*
|
|
*******************************************************************************
|
|
|
|
$OPTIONS DEFAULT
|
|
|
|
$INCLUDE UNIVERSE.INCLUDE DC.COMM.DECL
|
|
$INCLUDE UNIVERSE.INCLUDE FILENAMES.H
|
|
$INCLUDE UNIVERSE.INCLUDE MACHINE.NAME
|
|
$INCLUDE UNIVERSE.INCLUDE MTF.INCL.H
|
|
|
|
prime.remote.ptr = 0
|
|
counter=0
|
|
NO.UCODES = 1
|
|
equ PATH to UV.ROOT:'/'
|
|
equ TYPES to 15
|
|
|
|
equ o.VERB to 1
|
|
equ o.CATALOG to 2
|
|
equ o.KEYWORD to 3
|
|
equ o.FILE to 4
|
|
equ o.QPOINTER to 5
|
|
equ o.ITYPE to 6
|
|
equ o.DICT to 7
|
|
equ o.PARAGRAPH to 8
|
|
equ o.PHRASE to 9
|
|
equ o.PROVERB to 10
|
|
equ o.SENTENCE to 11
|
|
equ o.REMOTE to 12
|
|
equ o.MENU to 13
|
|
equ o.USER to 14
|
|
equ o.OTHER to 15
|
|
|
|
equ id.PICK to 1
|
|
equ id.PRIME to 2
|
|
|
|
equ cat.ADDS to 1
|
|
equ cat.MICRO to 2
|
|
equ cat.PRIME to 3
|
|
equ cat.ULTI to 4
|
|
equ cat.IBM to 5
|
|
|
|
dim nosupport(TYPES)
|
|
dim noconvert(TYPES)
|
|
dim vocexists(TYPES,TYPES)
|
|
dim convertok(TYPES,TYPES)
|
|
dim out(TYPES)
|
|
dim in(TYPES)
|
|
|
|
out(o.VERB) = "VERBS"
|
|
out(o.CATALOG) = "CATALOGED PROGRAMS"
|
|
out(o.KEYWORD) = "KEYWORDS"
|
|
out(o.FILE) = "FILES"
|
|
out(o.QPOINTER) = "Q-POINTERS"
|
|
out(o.ITYPE) = "I-TYPES"
|
|
out(o.DICT) = "DICTIONARY DEFINITIONS"
|
|
out(o.PHRASE) = "PHRASES"
|
|
out(o.PARAGRAPH)= "PARAGRAPHS"
|
|
out(o.PROVERB) = "PROVERBS"
|
|
out(o.SENTENCE) = "SENTENCES"
|
|
out(o.REMOTE) = "REMOTES"
|
|
out(o.MENU) = "MENUS"
|
|
out(o.USER) = "USER DEFINED ITEMS"
|
|
out(o.OTHER) = "UNIDENTIFIED ITEMS"
|
|
|
|
TPRINT @(-1)
|
|
ftrans = "ISYS":@AM:UV.ROOT
|
|
|
|
Title=PROD.NAMEU:" vocabulary conversion utility"
|
|
CALL *DRAW.SCRN.B(Title,1)
|
|
cvoc = ""
|
|
dest.voc = ""
|
|
sentence = trim( @sentence )
|
|
word.count = dcount( sentence, " " )
|
|
|
|
for i = 1 to word.count
|
|
word = upcase( field( sentence, " ", i ))
|
|
begin case
|
|
case word = "CONVERT.VOC"
|
|
null
|
|
case word = "RUN"
|
|
i += 2
|
|
case word = "RAID"
|
|
i += 2
|
|
case word[ 1, 1 ] = "<" and len( word ) > 1
|
|
cvoc = word[ 2, 999 ]
|
|
in.name = cvoc
|
|
case word = "FROM" or word[ 1, 1 ] = "<"
|
|
i += 1
|
|
cvoc = field( sentence, " ", i )
|
|
in.name = cvoc
|
|
case word[ 1, 1 ] = ">" and len( word ) > 1
|
|
dest.voc = word[ 2, 999 ]
|
|
case word = "TO" or word = ">"
|
|
i += 1
|
|
dest.voc = field( sentence, " ", i )
|
|
case 1
|
|
msg1="Invalid command line option. "
|
|
CALL *HELP.PRINT.B(msg1,2)
|
|
SLEEP 1
|
|
STOP @(-1)
|
|
end case
|
|
next i
|
|
if dest.voc = "" then dest.voc = "VOC"
|
|
|
|
title=NULL
|
|
title<1>=0
|
|
title<2>="Computer"
|
|
title<3>="Operating System"
|
|
array=NULL
|
|
array<1,1>="ADDS"
|
|
array<1,2>="Mentor"
|
|
array<2,1>="IBM PC-XT"
|
|
array<2,2>="Pick"
|
|
array<3,1>="MICRODATA"
|
|
array<3,2>="Reality"
|
|
array<4,1>="PRIME"
|
|
array<4,2>="Information"
|
|
array<5,1>="ULTIMATE"
|
|
array<5,2>="Ultimate"
|
|
array<6,1>="IN2"
|
|
array<6,2>="IN-Pick"
|
|
csys=1
|
|
msg10="Use arrow keys to highlight selection and press <cr> to select Computer and Operating System converting from."
|
|
CALL *HELP.PRINT.B(msg10,2)
|
|
CALL *LIST.BOX.B(title,5,6,array,6,3,csys,0)
|
|
IF csys=-1 THEN RETURN
|
|
msg2="Do you want a hard copy report?"
|
|
flag=1
|
|
CALL *HELP.PRINT.B(NULL,3)
|
|
CALL *YES.NO.BOX.B(17,msg2,flag)
|
|
IF flag=-1 THEN RETURN
|
|
IF flag=1 THEN hcpy="Y" ELSE hcpy="N"
|
|
msg3="Include non-ERROR conversions on the report?"
|
|
flag=1
|
|
CALL *YES.NO.BOX.B(17,msg3,flag)
|
|
IF flag=-1 THEN RETURN
|
|
IF flag=1 THEN ierr="Y" ELSE ierr="N"
|
|
|
|
error.include = (upcase(ierr[1,1]) = "Y")
|
|
|
|
begin case
|
|
* ADDS
|
|
case csys = 1
|
|
suffix = "ADDS"
|
|
cat.id = "E6"
|
|
cat.type = cat.ADDS
|
|
goto PICKsetup
|
|
* IBM
|
|
case csys = 2
|
|
suffix = "IBM"
|
|
cat.id = "E6"
|
|
cat.type = cat.IBM
|
|
goto PICKsetup
|
|
* MICRODATA
|
|
case csys = 3
|
|
suffix = "MICRODATA"
|
|
cat.id = "10B4"
|
|
cat.type = cat.MICRO
|
|
goto PICKsetup
|
|
* PRIME
|
|
case csys = 4
|
|
suffix = "PRIME"
|
|
cat.id = "IB"
|
|
cat.type = cat.PRIME
|
|
in(01) = "VERBS"
|
|
in(02) = "CATALOGED PROGRAMS"
|
|
in(03) = "KEYWORDS"
|
|
in(04) = "FILES"
|
|
in(05) = "I-TYPES"
|
|
in(06) = "DICTIONARY DEFINITIONS"
|
|
in(07) = "PHRASES"
|
|
in(08) = "PARAGRAPHS"
|
|
in(09) = "SENTENCES"
|
|
in(10) = "REMOTES"
|
|
in(11) = "MENUS"
|
|
in(12) = "USER DEFINED ITEMS"
|
|
in(13) = "UNIDENTIFIED ITEMS"
|
|
id.type = id.PRIME
|
|
in.count = 13
|
|
cat.amc = 3
|
|
if cvoc = "" then
|
|
cvoc = "PRIME.VOC"
|
|
in.name = "VOC"
|
|
end
|
|
dict.flag= 1
|
|
gosub prime.remote.form
|
|
|
|
* ULTIMATE
|
|
case csys = 5
|
|
suffix = "ULTIMATE"
|
|
cat.id = "E6"
|
|
cat.type = cat.ULTI
|
|
goto PICKsetup
|
|
* IN2 - These parameters are a guess
|
|
case csys = 6
|
|
suffix = "ADDS"
|
|
cat.id = "E6"
|
|
cat.type = cat.ADDS
|
|
goto PICKsetup
|
|
* PICK
|
|
case 1
|
|
suffix = "PICK"
|
|
cat.id = "E6"
|
|
cat.type = cat.ADDS
|
|
PICKsetup:
|
|
in(01) = "VERBS"
|
|
in(02) = "CATALOGED PROGRAMS"
|
|
in(03) = "CONNECTIVES"
|
|
in(04) = "FILES"
|
|
in(05) = "Q-POINTERS"
|
|
in(06) = "PROCS"
|
|
in(07) = "DICTIONARY DEFINITIONS"
|
|
in(08) = "UNIDENTIFIED ITEMS"
|
|
id.type = id.PICK
|
|
cat.amc = 2
|
|
in.count = 8
|
|
if cvoc = "" then
|
|
cvoc = "PICK.VOC"
|
|
in.name = "M/DICT"
|
|
end
|
|
dict.flag= 0
|
|
end case
|
|
msg4="Cannot open file - "
|
|
open dest.voc to f.voc else
|
|
CALL *HELP.PRINT.B(msg4:dest.voc,2)
|
|
SLEEP 3
|
|
STOP @(-1)
|
|
END
|
|
msg5="Cannot open DICT - "
|
|
open "DICT", dest.voc to d.voc else
|
|
CALL *HELP.PRINT.B(msg5:dest.voc,2)
|
|
SLEEP 3
|
|
STOP @(-1)
|
|
END
|
|
open cvoc to f.cvoc else
|
|
CALL *HELP.PRINT.B(msg4:cvoc,2)
|
|
SLEEP 3
|
|
STOP @(-1)
|
|
END
|
|
if dict.flag then
|
|
open "DICT",cvoc to d.cvoc else
|
|
CALL *HELP.PRINT.B(msg5:cvoc,2)
|
|
SLEEP 3
|
|
STOP @(-1)
|
|
END
|
|
end
|
|
|
|
map = PATH:"CVI/":suffix
|
|
openpath map to f.map else
|
|
CALL *HELP.PRINT.B(msg4:map,2)
|
|
SLEEP 3
|
|
STOP @(-1)
|
|
END
|
|
|
|
open "NEWACC" to f.nac else
|
|
CALL *HELP.PRINT.B(msg4:"NEWACC",2)
|
|
SLEEP 3
|
|
STOP @(-1)
|
|
END
|
|
|
|
if id.type = id.PICK then
|
|
open "BASE_FILE" to f.base then
|
|
base.open = 1
|
|
msg6="Delete the BASE_FILE when done ?"
|
|
delb=1
|
|
CALL *HELP.PRINT.B(NULL,3)
|
|
CALL *YES.NO.BOX.B(17,msg6,delb)
|
|
IF delb=-1 OR delb=2 THEN delb="N" ELSE delb="Y"
|
|
end else
|
|
base.open = 0
|
|
delb = "N"
|
|
end
|
|
end else
|
|
base.open = 0;
|
|
delb = "N"
|
|
end
|
|
|
|
******************************************************************************
|
|
|
|
width = 4
|
|
|
|
sselect f.cvoc
|
|
if upcase(hcpy[1,1]) = "Y" then printer on; width = 6
|
|
filename = in.name; vocname = dest.voc
|
|
file = f.cvoc; vocfile = f.voc
|
|
mat nosupport = ""; mat noconvert = ""
|
|
mat vocexists = ""; mat convertok = ""
|
|
cat.para = ""
|
|
|
|
on id.type gosub convert.pick,convert.prime
|
|
if cat.para <> "" then
|
|
cat.para = "PA" : cat.para
|
|
write cat.para on f.voc, "&CATALOG.ALL&"
|
|
end
|
|
if dict.flag then
|
|
sselect d.cvoc
|
|
filename = "DICT " : in.name; vocname = "DICT " : dest.voc
|
|
file = d.cvoc; vocfile = d.voc
|
|
mat nosupport = ""; mat noconvert = ""
|
|
mat vocexists = ""; mat convertok = ""
|
|
on id.type gosub convert.pick,convert.prime
|
|
end
|
|
|
|
if error.include and id.type = id.PRIME then
|
|
printer reset
|
|
h = "'C'Map of PRIMOS UFD''s to UNIX pathnames'LL'"
|
|
h:= "PRIMOS.UFD............... UNIX.pathname............'L'"
|
|
headinge h
|
|
footing "'LC' 'D' - Page 'P'"
|
|
n = dcount(ftrans<1>,@vm)
|
|
for i = 1 to n
|
|
tprint fmt(ftrans<1,i>,"l#25"):" ":ftrans<2,i>
|
|
next i
|
|
end
|
|
|
|
if base.open and upcase(delb[1,1]) = "Y" then
|
|
execute "DELETE.FILE BASE_FILE"
|
|
end
|
|
stop
|
|
|
|
|
|
convert.prime:
|
|
ncvt = 0;
|
|
line=17
|
|
counter=4
|
|
CALL *HELP.PRINT.B(NULL,3)
|
|
convert.prime.loop:
|
|
prime.remote.ptr = 0
|
|
readnext id else crt1=0; goto DUMP
|
|
read item from file,id else goto convert.prime.loop
|
|
|
|
ncvt+=1
|
|
if mod(ncvt,10)=0 then
|
|
counter+=1
|
|
TPRINT @(counter,line):"*":
|
|
IF counter=70 THEN
|
|
counter=4
|
|
line+=1
|
|
IF line=20 THEN
|
|
CALL *HELP.PRINT.B(NULL,3)
|
|
line=17
|
|
END
|
|
END
|
|
end
|
|
type = item[1,1];
|
|
if type='P' then type=item[1,2]
|
|
|
|
begin case
|
|
case type='V'; sub = 1; code = 1
|
|
case type='K'; sub = 2; code = 3
|
|
case type='F'; sub = 3; code = 4
|
|
case type='I'; sub = 4; code = 5
|
|
case type='D'; sub = 5; code = 6
|
|
case type='PH'; sub = 5; code = 7
|
|
case type='PA'; sub = 5; code = 8
|
|
case type='S'; sub = 5; code = 9
|
|
case type='R'; sub = 5; code = 10
|
|
case type='M'; sub = 5; code = 11
|
|
case type='X'; sub = 5; code = 12
|
|
case 1; sub = 5; code = 13; type = "?"
|
|
end case
|
|
|
|
on sub gosub PRIME.VERB,KEYWORD,PRIME.FILE,ITYPE,STUFF
|
|
|
|
goto convert.prime.loop
|
|
|
|
convert.pick:
|
|
ncvt = 0;
|
|
PFV = vocfile
|
|
LOGGING = 0
|
|
SOURCE.MACHINE = "O"
|
|
line=17
|
|
counter=4
|
|
CALL *HELP.PRINT.B(NULL,3)
|
|
convert.pick.loop:
|
|
readnext id else crt1=0; goto DUMP
|
|
read item from file,id else goto convert.pick.loop
|
|
|
|
ncvt+=1
|
|
if mod(ncvt,10)=0 then
|
|
counter+=1
|
|
TPRINT @(counter,line):"*":
|
|
IF counter=70 THEN
|
|
counter=4
|
|
line+=1
|
|
IF line=20 THEN
|
|
CALL *HELP.PRINT.B(NULL,3)
|
|
line=17
|
|
END
|
|
END
|
|
end
|
|
type = item[1,1];
|
|
if type='P' and item[2,1]='Q' then type="PQ"
|
|
|
|
begin case
|
|
case type='P'; sub = 1; code = 1
|
|
case type='C'; sub = 2; code = 3
|
|
case type='D'; sub = 3; code = 4
|
|
case type='A'; sub = 4; code = 7
|
|
case type='S'; sub = 4; code = 7
|
|
case type='X'; sub = 5; code = 7
|
|
case type='Q'; sub = 5; code = 5
|
|
case type='PQ'; sub = 5; code = 6
|
|
case 1; sub = 5; code = 8; type = "?"
|
|
end case
|
|
|
|
on sub gosub PICK.VERB,CONNECTIVE,PICK.FILE,PICK.DICT,STUFF
|
|
|
|
goto convert.pick.loop
|
|
|
|
DUMP:
|
|
PRINTER RESET
|
|
HEADINGE "'C'Conversion of ":suffix:" ":filename:" to ":PROD.NAME:" ":vocname:"'LL'"
|
|
FOOTING "'LC' 'D' - Page 'P'"
|
|
for i = 1 to in.count
|
|
msg = " not supported by ":PROD.NAME
|
|
rpt = nosupport(i)
|
|
gosub PRINT
|
|
|
|
msg = " that cannot be converted"
|
|
rpt = noconvert(i)
|
|
gosub PRINT
|
|
|
|
for j = 1 to TYPES
|
|
msg = " defined as different ":PROD.NAME:" ":out(j)
|
|
rpt = vocexists(i,j)
|
|
gosub PRINT
|
|
next
|
|
if error.include then
|
|
for j = 1 to TYPES
|
|
msg = " converted to ":PROD.NAME:" ":out(j)
|
|
rpt = convertok(i,j)
|
|
gosub PRINT
|
|
next
|
|
end
|
|
next
|
|
if cat.para <> "" then
|
|
tprint; tprint
|
|
tprint '"&CATALOG.ALL&" paragraph added to VOC file.'
|
|
end
|
|
return
|
|
|
|
PRINT:
|
|
if rpt = "" then return
|
|
tprint; tprint
|
|
tprint in(i):msg
|
|
remove x from rpt setting z; k = 1;
|
|
loop
|
|
remove x from rpt setting z
|
|
tprint fmt(oconv(x,"mcp"),"l#18 "):
|
|
if mod(k,width)=0 then tprint
|
|
while z do
|
|
k+=1
|
|
repeat
|
|
return
|
|
|
|
PRIME.VERB:
|
|
n = dcount(item,@fm)
|
|
cvt = "V"
|
|
for i=2 to n
|
|
cvt := "*":item<i>
|
|
next
|
|
loop while cvt[1]='*' do cvt = cvt[1,len(cvt)-1] repeat
|
|
if item<2> = "-RADIX" then cvt:="*":id
|
|
|
|
goto GENERAL.VERB
|
|
|
|
PICK.VERB:
|
|
n = dcount(item,@fm)
|
|
cvt = item<1>
|
|
for i=2 to n
|
|
cvt := "*":item<i>
|
|
next
|
|
loop while cvt[1]='*' do cvt = cvt[1,len(cvt)-1] repeat
|
|
|
|
GENERAL.VERB:
|
|
is.cat = ( item<cat.amc> = cat.id )
|
|
if is.cat then code+=1
|
|
|
|
gosub MAP
|
|
|
|
if not( is.cat ) then convert "-" to "." in id
|
|
|
|
begin case
|
|
case ccode = 0
|
|
gosub CHECK.VOC
|
|
case ccode = 1
|
|
nosupport(code) := @fm : id
|
|
case ccode = 2
|
|
if is.cat then
|
|
begin case
|
|
case cat.type = cat.ADDS
|
|
cat.para := @AM : "CATALOG " : item< 5 > : " " : id
|
|
case cat.type = cat.IBM
|
|
cat.para := @AM : "CATALOG " : item< 6 > : " " : id
|
|
case cat.type = cat.MICRO
|
|
cname = "*":item<5>:"*":id
|
|
cname = cname[ 1, 41 ]
|
|
citem = "V":@fm:cname:@fm:"B":@fm:"BN"
|
|
gosub CHECK.VOC
|
|
case cat.type = cat.PRIME
|
|
if item<2>[1,1] = "*" then
|
|
cname = item<2>[ 1, 41 ]
|
|
citem = "V":@fm:cname:@fm:"B":@fm:"BN"
|
|
gosub CHECK.VOC
|
|
end else
|
|
gosub PRIME.CATALOG.LOCAL
|
|
gosub CHECK.VOC
|
|
end
|
|
case cat.type = cat.ULTI
|
|
cat.para := @AM : "CATALOG " : field( item< 5 >, " ", 1)
|
|
fnam = field(item<5>," ",2);
|
|
if fnam = "" then fnam = id
|
|
cat.para := " " : fnam
|
|
end case
|
|
end else
|
|
noconvert(code) := @fm : id
|
|
end
|
|
end case
|
|
return
|
|
|
|
KEYWORD:
|
|
n = dcount(item,@fm)
|
|
cvt = "K"
|
|
for i=2 to n
|
|
cvt := "*":item<i>
|
|
next
|
|
loop while cvt[1]='*' do cvt = cvt[1,len(cvt)-1] repeat
|
|
|
|
gosub MAP
|
|
gosub CHECK.MAP
|
|
return
|
|
|
|
CONNECTIVE:
|
|
cvt = item<1>
|
|
gosub MAP
|
|
gosub CHECK.MAP
|
|
return
|
|
|
|
ITYPE:
|
|
n = index(item,@AM,15)
|
|
if n then item=item[1,n]
|
|
citem = replace(item,1;"I")
|
|
gosub CHECK.VOC
|
|
return
|
|
|
|
PRIME.FILE:
|
|
fname = item<2>; gosub Ftrans; item<2> = fname
|
|
fname = item<3>; gosub Ftrans; item<3> = fname
|
|
gosub STUFF
|
|
return
|
|
|
|
PICK.FILE:
|
|
if base.open then
|
|
read bitem from f.base,item<2> then
|
|
fnam = bitem<2>
|
|
end else
|
|
fnam = id
|
|
end
|
|
end else
|
|
fnam = id
|
|
end
|
|
gosub EFTOIF
|
|
citem = "F":@FM:pnam:@FM:"D_":pnam
|
|
gosub CHECK.VOC
|
|
return
|
|
|
|
PICK.DICT:
|
|
ITEM.NAME = id
|
|
citem = item
|
|
call *DC.ITEM(citem , assoc.name , assoc.item , flag )
|
|
gosub CHECK.VOC
|
|
return
|
|
|
|
STUFF:
|
|
|
|
cvt = type : "*" : id
|
|
gosub MAP
|
|
begin case
|
|
case ccode = 0
|
|
gosub CHECK.VOC
|
|
case ccode = 1
|
|
nosupport(code) := @fm : id
|
|
case ccode = 2
|
|
citem = item
|
|
gosub CHECK.VOC
|
|
end case
|
|
return
|
|
|
|
Ftrans:
|
|
directory.levels = count(fname,">")
|
|
if directory.levels then
|
|
prime.remote.ptr = 1
|
|
* split prime pathname into directory and file
|
|
prime.directory = FIELD(fname,">",1,directory.levels)
|
|
prime.filename = FIELD(fname,">",directory.levels + 1,1)
|
|
* locate prime.directory in list
|
|
locate prime.directory in ftrans<1> by 'al' setting loc
|
|
then
|
|
unix.directory = ftrans<2,loc>
|
|
end
|
|
else
|
|
printer.on = system(1)
|
|
if printer.on then
|
|
PRINTER OFF
|
|
end
|
|
unix.directory = ""
|
|
call *HELP.PRINT.B(NULL,3)
|
|
call *HELP.PRINT.B(convert.form<convert.form.line,5>,3)
|
|
call *PUT.FORM.B(convert.form.size,convert.form,prime.directory:@AM:unix.directory,PRMPT,1)
|
|
loop
|
|
TPRINT convert.form<convert.form.line,2>:
|
|
temp = unix.directory
|
|
call *CINPUT.B(SEC.PRMPT,temp,special,convert.form<convert.form.line,6>,convert.form<convert.form.line,7>)
|
|
if NOT(temp = "" or temp = "*")
|
|
then
|
|
if temp[1,1] # "/" or temp[1,1] # "\"
|
|
then
|
|
temp = "/":temp
|
|
end
|
|
unix.directory = temp
|
|
end
|
|
until unix.directory # "" do
|
|
repeat
|
|
call *HELP.PRINT.B(NULL,3)
|
|
ins prime.directory before ftrans<1,loc>
|
|
ins unix.directory before ftrans<2,loc>
|
|
call *DRAW.SCRN.B(Title,1)
|
|
if printer.on then
|
|
PRINTER ON
|
|
end
|
|
end
|
|
|
|
remote.file = unix.directory:"/&TRUNCATED&"
|
|
truncated.name = ""
|
|
openpath remote.file to truncated.file
|
|
then
|
|
readv truncated.name from truncated.file,prime.filename,2
|
|
else
|
|
truncated.name = ""
|
|
end
|
|
end
|
|
close truncated.file
|
|
if truncated.name = ""
|
|
then
|
|
fnam = prime.filename
|
|
gosub EFTOIF
|
|
fname = unix.directory:"/":pnam
|
|
end
|
|
else
|
|
fname = unix.directory:"/":truncated.name
|
|
end
|
|
end
|
|
return
|
|
|
|
MAP:
|
|
read mitem from f.map,cvt then
|
|
mtype = mitem<2>
|
|
cid = mitem<3>
|
|
begin case
|
|
case mtype = "C"
|
|
ccode = 0
|
|
read citem from f.nac, cid else citem = ""
|
|
case mtype = "S"
|
|
ccode = 0
|
|
citem = "S":@fm:cid
|
|
case mtype = "P"
|
|
ccode = 0
|
|
citem = "PH":@fm:cid
|
|
case 1
|
|
ccode = 1
|
|
citem = ""
|
|
end case
|
|
end else
|
|
ccode = 2
|
|
citem = ""
|
|
end
|
|
citem<1> = citem<1>[1,if citem<1>[1,1] = "P" then 2 else 1]
|
|
return
|
|
|
|
CHECK.MAP:
|
|
begin case
|
|
case ccode = 0
|
|
gosub CHECK.VOC
|
|
case ccode = 1
|
|
nosupport(code) := @fm : id
|
|
case ccode = 2
|
|
noconvert(code) := @fm : id
|
|
end case
|
|
return
|
|
|
|
CHECK.VOC:
|
|
loop while citem[1]=@fm do citem = citem[1,len(citem)-1] repeat
|
|
read xitem from vocfile,id then
|
|
gosub IDENTIFY
|
|
xitem<1> = itype
|
|
if itype = "I" then
|
|
n = index(xitem,@AM,15)
|
|
if n then xitem=xitem[1,n]
|
|
end
|
|
loop while xitem[1]=@AM do xitem=xitem[1,len(xitem)-1] repeat
|
|
if itype = "F" and (citem<1>[2,9999] # "") then
|
|
xitem<1> = xitem<1>:citem<1>[2,9999]
|
|
write xitem on vocfile,id
|
|
end
|
|
if prime.remote.ptr
|
|
then
|
|
gosub PRIME.REMOTE.POINTER
|
|
end
|
|
else
|
|
if xitem = citem then
|
|
convertok(code,idtype) := @fm : id
|
|
end else
|
|
vocexists(code,idtype) := @fm : id
|
|
end
|
|
end
|
|
end else
|
|
xitem = citem
|
|
gosub IDENTIFY
|
|
convertok(code,idtype) := @fm : id
|
|
write citem on vocfile,id
|
|
end
|
|
return
|
|
|
|
IDENTIFY:
|
|
itype = upcase(xitem[1,1])
|
|
if itype = "P" then itype = upcase(xitem[1,2])
|
|
begin case
|
|
case itype = "V"; idtype = if xitem<3> # "B" then o.VERB else o.CATALOG
|
|
case itype = "K"; idtype = o.KEYWORD
|
|
case itype = "F"; idtype = o.FILE
|
|
case itype = "Q"; idtype = o.QPOINTER
|
|
case itype = "I"; idtype = o.ITYPE
|
|
case itype = "D"; idtype = o.DICT
|
|
case itype = "PA"; idtype = o.PARAGRAPH
|
|
case itype = "PH"; idtype = o.PHRASE
|
|
case itype = "PQ"; idtype = o.PROVERB
|
|
case itype = "S"; idtype = o.SENTENCE
|
|
case itype = "R"; idtype = o.REMOTE
|
|
case itype = "M"; idtype = o.MENU
|
|
case itype = "X"; idtype = o.USER
|
|
case 1; idtype = o.OTHER
|
|
end case
|
|
return
|
|
|
|
EFTOIF:
|
|
if fnam = '' then
|
|
pnam = '?'
|
|
end else
|
|
if fnam[1,1] = '.' then
|
|
pnam='?.'; m=2
|
|
end else
|
|
pnam='' ; m=1
|
|
end
|
|
l = len(fnam)
|
|
for j=m to l
|
|
c = fnam[j,1]
|
|
begin case
|
|
case c='?'; pnam:='??'
|
|
case c='/'; pnam:='?\'
|
|
case c='\'; pnam:='?\'
|
|
case c=char(0); pnam:='?0'
|
|
case 1; pnam:=c
|
|
end case
|
|
next j
|
|
end
|
|
return
|
|
|
|
PRIME.CATALOG.LOCAL:
|
|
*
|
|
* Remove prefix $ or suffix .IRUN from item<2> to get program name.
|
|
* Prime item<4> gives directory name which when appended by .O results in
|
|
* basic objects file name under uniVerse. Locally catlogued universe files
|
|
* have voc entry for second field as the object programs pathname and the
|
|
* ninth field as object directory name.
|
|
* Also continue appending to cat.para.
|
|
*
|
|
if item<2>[1,1] = "$"
|
|
then
|
|
cname = item<2>[2,41]
|
|
end
|
|
else
|
|
pos.irun = index(item<2>,".IRUN",1)
|
|
if pos.irun
|
|
then
|
|
cname = item<2>[1,pos.irun-1]
|
|
end
|
|
else
|
|
cname = item<2>
|
|
end
|
|
end
|
|
citem<1> = "V"
|
|
citem<2> = item<4>:".O/":cname
|
|
citem<3> = "B"
|
|
citem<4> = "BN"
|
|
citem<9> = item<4>:".O"
|
|
cat.para := @AM : "CATALOG " : item<4> : " " : cname : " LOCAL"
|
|
return
|
|
PRIME.REMOTE.POINTER:
|
|
prime.remote.ptr = 0
|
|
res1 = 0 ; res2 = 0
|
|
if xitem = citem then
|
|
convertok(code,idtype) := @fm : id
|
|
end else
|
|
if itype = "F" then
|
|
diff.msg=str(" ",77)
|
|
diff.msg:=FMT("Prime remote pointer has equivalent VOC entry for record id = ":id,"L#77")
|
|
diff.msg:=FMT("PRIME.VOC entry : ":citem<1>:" ":citem<2>:" ":citem<3>,"L#77")
|
|
diff.msg:=FMT(" VOC entry : ":xitem<1>:" ":xitem<2>:" ":xitem<3>,"L#77")
|
|
msg8="Do you want to overwrite existing voc entry?"
|
|
CALL *HELP.PRINT.B(diff.msg,3)
|
|
CALL *YES.NO.BOX.B(11,msg8,res1)
|
|
if res1 then
|
|
convertok(code,idtype) := @fm : id
|
|
write citem on vocfile,id
|
|
slash.found = index(convert('\','/',xitem<2>),'/',1)
|
|
if slash.found then
|
|
null
|
|
end else
|
|
msg9= "Do you want to remove local files defined by this voc entry?"
|
|
CALL *YES.NO.BOX.B(17,msg9,res2)
|
|
if res2 then
|
|
delete.cmd='delete.file ':xitem<2>
|
|
execute delete.cmd
|
|
end
|
|
end
|
|
end else
|
|
vocexists(code,idtype) := @fm : id
|
|
end
|
|
end else
|
|
vocexists(code,idtype) := @fm : id
|
|
end
|
|
end
|
|
return
|
|
|
|
prime.remote.form:
|
|
convert.msg = UVREADMSG(073740,"")
|
|
convert.form = NULL
|
|
convert.form.size = 2
|
|
convert.form.line = 2
|
|
convert.form.top = 4
|
|
convert.form<1,1> = @(02,convert.form.top)
|
|
convert.form<1,2> = @(02,convert.form.top+2)
|
|
convert.form<1,3> = convert.msg<2>
|
|
convert.form<1,6> = 75
|
|
convert.form<1,7> = 1
|
|
convert.form<2,1> = @(02,convert.form.top+4)
|
|
convert.form<2,2> = @(02,convert.form.top+6)
|
|
convert.form<2,3> = convert.msg<3>
|
|
convert.form<2,4> = convert.msg<4>
|
|
convert.form<2,5> = convert.form<2,4>
|
|
convert.form<2,6> = 75
|
|
convert.form<2,7> = 1
|
|
return
|
|
end
|