# <![CDATA[
# KEHOME/src/command.icn
# Nov/13/2005 Jul/20/2009
$include "keparam.h"
link random
global wininput,winconcept,mywin
global CurrentDirectory,CurrentFile,CurrentFD
global COMMAND,legal_command,kecommand,shcommand
global cyc_command
global EXIT
global PATH
# single-argument functions are listed in hfun.icn
# string
procedure substitute_filename(x)
#===============================
# $variables
local y,z
static info
initial {
info := "INFO: substitute_filename: "
}
#####writes_type_all(x,info||"input x")
y := dequote(x)
z := substitute(y) # replace.icn
#####writes_type_all(z,info||"output z")
return z
end
procedure init_command()
#=======================
# define command names
# do kecommand pplist done
# hdo hdocmd from concept to concept with path done;
# vdo vdocmd od concept with path done;
hdo_init() # HDO_ACTION := set(...)
vdo_init() # VDO_ACTION := set(...)
kecommand := set([
"command", # generic name for grammar examples
"COMMAND", # generic name for grammar examples
"create context",
"import context",
"export context",
# also sh command
"delete comment","deletecomment",# also sh command
"explorer", # also sh command
"select_problem",
"ExtractData",
#"begin", # begin group x;
"cd",
"check",
"clock",
"close cyc",
"close tap",
"dbclose",
"dbopen",
"dbprint",
"delete", # do delete od uname,... from cname done;
"delete/gdbm",
"dump", "vdump",
"dump/gdbm",
"dump/argtable",
"dump/ged",
"dump/hidden",
"dump/nvstack",
"empty", # empties list or set
#"end", # end group x
"entropy",
"exec", # execute proposition list
#"exit", # control structure
"find",
"first-name",
"factsize",
"fsize", # file
"fstatus", # file
"ftype", # file
"getenv",
"get proposition", "import proposition",
"given-name",
"hload","hdump","hget","hput",
"help",
"hwalk", # "hdo", <<== built-in verb
"import ontology","import",
#"input relation",
"interpret_line",
"last-name",
"load", "vload",
"load/ged",
"kbcheck",
"kbwrite",
"ls",
"list member",
"list tables",
"max",
"menu", "concept menu",
"merge", # do merge od uname,... to cname done;
"middle-name",
"min",
"mkdir",
"mount hierarchy",
#"name", # attribute
#"new group", # NO: use: gname is gtype of utype
#"nickname", # attribute
"nvtab",
"open cyc",
"open tap",
"parse list",
#"path2list", # function -- see hfun.icn
"print",
"pwd",
"quote","dquote","squote", "dequote",
"random",
"read",
"read directory", # recursive
##"read_dmoz",
##"read html",
##"read htm",
"read input",
##"read mcf",
##"read owl",
##"read rdf",
##"read tap",
"remove bracket","remove brace","remove angle",
"remove quote",
"replace",
"reverse list",
"rmdir",
"select",
"sh",
"shuffle","deal", # deck
"simplify lattice",
"size", "size/list", "size/infon", "size/gdbm",
"SubL",
"suffix-name",
"sum",
"surname",
"title-name",
"unique",
#"update relation",
#"vdo", # vdo exec od {sentence} done;/
#"vfind", # vdo find od wildcard done;
"vpop",
"vpush",
"year", "month", "day", "ymd", "dmy", "mdy",
"write", "vwrite",
"write directory" # recursive
])
# ! shcommand
# out product
# of domain
# with option
# od directobject
# from infile
# to outfile
# done;
shcommand := set([
# also ke command
"deletecomment",
"explorer",
# UNIX commands
"cat",
"cd",
"date",
"dir",
"grep",
"head",
"lf",
"ls",
"mkdir",
"pwd",
"rmdir",
"tail",
"wc"
])
cyc_command := set([
"write-image",
"generate-phrase",
"cyc-create",
"CYC-CREATE",
"CYC-FIND-OR-CREATE",
"CYC-RENAME",
"CYC-ASSERT",
"CYC-UNASSERT",
"CYC-QUERY",
"CYC-KILL",
"CYC-MERGE",
"CYC-EDIT",
"CYC-RECREATE",
"CYC-REWRITE"
])
COMMAND := kecommand ++ shcommand ++ cyc_command
# define function names
# function is single-argument command
init_function() # hfun.icn
COMMAND ++:= FUNCTION
legal_command := COMMAND ++ legal_function
# verbs & actions which are also commands
#####legal_command ++:= set([ "isd","isi" ])
legal_command ++:= set([ "differentiate","integrate" ])
legal_command ++:= set([ "measure","classify" ])
end
procedure add_command()
#======================
# declare commands
local atab,cmd
atab := KNIT[new_concept("ke")].act
every cmd := ! COMMAND do {
if cmd == ("command"|"COMMAND") then { } else {
add_species(cmd,"COMMAND") # cmd isu COMMAND
insert(atab,cmd,[]) # ke do cmd done
}
}
end
# list
procedure command2arglist(symbol)
#================================
# build arglist in standard order from atlist & pplist
# NOTE: physically deletes pplist from symbol (copy problem ???)
local format,NEWarglist
static info
initial {
info := "INFO: command2arglist: "
}
format := new_bse([symbol],"{"," ","}") # bselist.icn
NEWarglist := format2rolelist(format) # role.icn
if DEBUG==("FORMAT"|"ROLE") then {
writes_type_all(symbol,info||"symbol")
writes_type_all(NEWarglist,info||"NEWarglist")
}
return NEWarglist
end
# list
procedure command(line,symbol,stype,propname,cmdfd)
#==================================================
# called by xx() in sentence.icn
# doverb ::= do | ! | ido | hdo | vdo
# do cmdlist done; # SYMBOL(Dcd, svalue)
# do cmdlist pplist done; # SYMBOL(Dcpd,svalue)
# vdo cmdlist pplist done; # pp can be od {sentence}
#
# cmdlist ::= nvobject
# nvobject ::= SYMBOL("nvobject",nvlist)
# pplist ::=
# at space,time => not used
# of cmd part => not used
# with cmd characteristic => with option
# out product => product := do ... done
# od directobject => od directobject
# from initial characteristic => from infile
# to final characteristic => to outfile
#
# do ::=
# do | can | vdo | hdo
# !
# cmd ::=
# phrase
# reduce to
# qword
# isverb => isd,isi
local variable
local args,inrel,outrel,condition
local nvoption,nvcondition
local ShProduct,ppShProduct
local node,array
local nconcept,btable
local tname
local d,num
local L
local interaction
local program,world,date
local doword,cmdlist,arglist,exline,ctype,outfd,namespace
local url,uname,subject,pattern,replacement,action,path
local pfile,pfd,pline,qline,rline
local varlist,value,sline,fname
local dmozformat,dmozfile,tapformat,tapfile,fsdir
local echoline
local pplist,ppobj,NEWarglist
local context,part,product,option,directobject,infile,outfile
local concept,directory
local dval,sentence
local cmd,ppstring,wildcard,newlist,newcmd
local head,ct,fd,kbfile,kbdata
local arg,vname,cname,cmdobj,rc,dir
local kfile,ktype,newfd,kfilelist
local proplist
local letter, htmlfile
local saveUniqueName,saveDBMODE
local cyccmd,preprocessor,postprocessor
local cinfo,cerror,cwarning
local ncard,ndiscard
local deck,hand,stock,discard, handi,i
local qdeck,qhand,qstock,qdiscard, qhandi
local mem,x,ix,qx,y,iy,qy
local udirectobject,uinfile,uoutfile
local s,sep
local translation
local viewlist,view, dbdir,dbfile, kline
static squote,dquote,b,c,lsep,psep
static info,error,ierror,warning
static SaveStack
initial {
/SaveStack := []
info := "INFO: command: "
error := "ERROR: command: "
ierror := "Internal ERROR: command: "
warning := "WARNING: command: "
squote := "\'"
dquote := "\""
b := " "
c := ","
lsep := ","
psep := " "
}
push(SaveStack,KFORMAT)
/cmdfd := myout # myout can change ?
NCOMMAND +:= 1
NkuSENTENCE +:= 1
NPROPOSITION +:= 1
if DEBUG=="TIME" then
write(mybug,"## ",&time," ## command: begin ##")
# get pplist & NEWarglist
#=======================#
# NOTE: physically deletes pplist from symbol (copy problem ???)
pplist := find_stype("pplist",symbol)
NEWarglist := command2arglist(symbol)
#DEBUG := "COMMAND"
if DEBUG == ("YES"|"COMMAND") then {
writes_type_all(line,info||"line")
writes_type_all(symbol,info||"symbol")
writes_type_all(NEWarglist,info||"NEWarglist")
}
dval := []
case type(symbol) of {
default: {
writes_type(mylog,symbol,ierror||"unexpected type")
NCOMMAND -:= 1
add_statement(line,symbol,"newstatement",propname)
KFORMAT := pop(SaveStack)
fail
}
"SYMBOL": { }
}
case symbol.stype of {
default: {
writes_type_all(symbol,ierror||"not command")
NCOMMAND -:= 1
add_statement(line,symbol,"newstatement",propname)
KFORMAT := pop(SaveStack)
fail
}
("Dcd"|"Dcpd"): { }
"command": { symbol := symbol.svalue }
} # end case stype
case symbol.stype of {
default: {
writes_type(mylog,symbol,ierror||"unexpected stype")
NCOMMAND -:= 1
add_statement(line,symbol,"newstatement",propname)
return dval
}
"Dcd": { # do cmd done;
doword := symbol.svalue[1]
cmdlist := symbol.svalue[2]
#####pplist := SYMBOL("ppnull",[])
} # continue below
"Dcpd": {
# do cmd pplist done;
# hdo action with path from concept done;
doword := symbol.svalue[1]
cmdlist := symbol.svalue[2]
#####pplist := symbol.svalue[3]
} # continue below
} # end case stype
#----------------------------------------------------------------
#-----------------------------------------------------------------
# cmdlist ::= nvobject ::= SYMBOL("nvobject",nvlist)
cmd := unparse(cmdlist,b)
cmdlist := [cmd]
every cmd := !cmdlist do {
#=================================================#
cmd := unparse(cmd,b)
cinfo := info||cmd||": "
cerror := error||cmd||": "
cwarning := warning||cmd||": "
if DEBUG == "COMMAND" then {
head := cinfo||"before dollar substitution: "
writes_type_all(cmd,head||"cmd")
writes_type_all(pplist,head||"pplist")
writes_type_all(NEWarglist,head||"NEWarglist")
}
case cmd of {
"?": {
NCOMMAND -:= 1
NQUESTION +:= 1
# do ? done; # without "ke"
dval := write_char(cmdfd,"ke","act")
next
}
("command"|"COMMAND"): { # generic name for grammar examples
newcmd := unique_name(cmd)
writes_all([TypeComment||warning||
"generic name <",cmd,"> changed to <",newcmd,">"])
cmd := newcmd
}
} # end case cmd
# substitute dollar variables
#===========================#
# NOTE:
# dot variables replaced by dollar variables Oct/27/2002
# MKR variables have values "$.","$..","$..."
# external files are ".",".."
# so it's OK to substitute MKR dot variables
# cmd $ substitution for shell commands
cmd := replace_dollar_line(cmd) # replace.icn
pplist := replace_dollar_symbol(pplist) # replace.icn
pplist := replace_pronoun_symbol(pplist) # replace.icn
NEWarglist := replace_dollar_symbol(NEWarglist) # replace.icn
NEWarglist := replace_pronoun_symbol(NEWarglist) # replace.icn
arglist := NEWarglist
if DEBUG == ("COMMAND"|"MEANING") then {
head := cinfo||"after dollar substitution: "
writes_type_all(cmd,head||"cmd")
writes_type_all(pplist,head||"pplist")
writes_type_all(NEWarglist,head||"NEWarglist")
}
#=========================#
# echo after substitution #
#=========================#
echoline := doword||" "||cmd
if is_ppnull(pplist) then { } else {
echoline ||:= " "||unparse(pplist)
}
echoline ||:= " done;"
if ECHO == "on" then {
if DEBUG=="DOLLAR" then {
writes_all(["# command (",echoline,")"])
} else {
writes_all(["# command (",line,")"])
}
}
case cmd of {
"dbopen": { } # don't do db_add_unit()
default: {
#####add_statement(echoline,symbol,"command",,"later") # newword.icn
add_statement(echoline,symbol,"command",propname) # newword.icn
}
} # end case cmd
if \myout then
flush(myout) # because of shell commands
if \myerr then
flush(myerr) # because of shell commands
# separate pp
#============#
ppobj := get_ppobject(pplist,"nv") # pplist.icn
nvoption := ppobj.ppwith # with nvlist
ppobj := get_ppobject(pplist,"nov") # pplist.icn
context := ppobj.ppat # at nvlist
part := ppobj.ppof # of nvlist
option := ppobj.ppwith # with nvlist
product := ppobj.ppout # out nvlist
directobject := ppobj.ppod # od nvlist
infile := ppobj.ppfrom # from nvlist
outfile := ppobj.ppto # to nvlist
array := ppobj.ppin # in array
if DEBUG==("NV"|"COMMAND") then {
writes_type(mylog,cmd,info||"after get_ppobject: cmd")
if *context > 0 then writes_type(mylog,context,info||"context")
if *part > 0 then writes_type(mylog,part, info||"part")
if *option > 0 then writes_type(mylog,option, info||"option")
if *product > 0 then writes_type(mylog,product,info||"product")
if *directobject > 0 then writes_type(mylog,directobject,info||"directobject")
if *infile > 0 then writes_type(mylog,infile, info||"infile")
if *outfile > 0 then writes_type(mylog,outfile,info||"outfile")
if *array > 0 then writes_type(mylog,array ,info||"array")
}
#===============================================================#
# declare files
#==============#
#####case cmd of {
#####"cat": { every arg := !directobject do add_unit(unparse(arg[1]),"file") }
#####"cd": { every arg := !directobject do add_unit(unparse(arg[1]),"file") }
#####"fsize": { every arg := !directobject do add_unit(unparse(arg[1]),"file") }
#####"fstatus": { every arg := !directobject do add_unit(unparse(arg[1]),"file") }
#####"ftype": { every arg := !directobject do add_unit(unparse(arg[1]),"file") }
#####("import ontology"|"import"): { every arg := !infile do add_unit(unparse(arg[1]),"file") }
#####"ls": { every arg := !directobject do add_unit(unparse(arg[1]),"file") }
#####"read": { every arg := !infile do add_unit(unparse(arg[1]),"file") }
#####"write": { every arg := !outfile do add_unit(unparse(arg[1]),"file") }
#####"read directory": { every arg := !infile do add_unit(unparse(arg[1]),"directory") }
#####"write directory": { every arg := !outfile do add_unit(unparse(arg[1]),"directory") }
#####default: { }
#####}
exline := echoline
if DEBUG=="COMMAND" then {
writes_type(mybug,exline,info||"executing")
writes_type(mylog,exline,info||"executing")
}
ctype := get_ctype(cmd)
# look for methods
#=================#
if ctype == "method" then {
writes_type(mylog,exline,info||"executing method")
if DEBUG=="METHOD" then
writes_type(mybug,exline,info||"executing method")
dval := do_method(cmd,directobject,pplist,NEWarglist,ppobj) # method.icn
# look for functions
#===================#
} else if member(legal_function,cmd) then {
add_word(exline,symbol,stype,propname) # file newwords
dval := do_function(cmd,directobject,cmdfd) # hfun.icn
# look for sh commands
#=====================#
} else if doword == "!" then {
# ShProduct := ! cmd with option od directobject from infile to outfile done;
if member(shcommand,cmd) then {
# OK
} else {
writes_type(mylog,cmd,warning||"unexpected sh command")
add_unit(cmd,"sh command")
} # end if
ShProduct := new_ShProduct()
add_unit(ShProduct,"file")
put_vtype(ShProduct,"attribute")
ppShProduct := new_pp("out",ShProduct)
put_product(ppobj,ppShProduct)
dval := shell(cmd,ppobj) # shell.icn
##write(myout,unparse(dval))
# look for cyc commands
#======================#
} else if member(cyc_command,cmd) then {
dval := do_cyc_command(cmd,directobject,
option,product,infile,outfile) # cyc.icn
# look for vdo commands
#=====================#
} else if doword == "vdo" then {
# vdo cmd pplist done
dval := vdo(cmd,ppobj,echoline) # context.icn
# look for hdo commands (hwalk)
#=============================#
} else if doword == "hdo" then {
# hdo action with path from concept done
action := cmd
cname := unparse(infile)
path := unparse(option)
dval := hwalk( # hwalk.icn
cname, # concept
action, # action
path # path
)
# look for interactions
#======================
} else if doword == "happens" then {
# happens interaction pplist done;
interaction := cmd
dval := do_interaction( # interaction.icn
doword,
interaction,
pplist
)
} else {
# "do"|"can"|"hdo"|"vdo" ???
# do cmd pplist done
# continue below
case cmd of {
#===========#
default: {
if member(kecommand,cmd) then {
writes_type(myerr,exline,warning||"not implemented")
writes_type(mylog,exline,warning||"not implemented")
} else {
unknown_command(exline,symbol,stype,propname)
}
} # end default
"remove bracket": {
# do remove bracket od x done;
x := unparse(directobject)
dval := remove_bracket(x)
}
"remove brace": {
# do remove brace od x done;
x := unparse(directobject)
dval := remove_brace(x)
}
"remove angle": {
# do remove angle od x done;
x := unparse(directobject)
dval := remove_angle(x)
}
"select": {
# do select od args from inrel to outrel with condition done;
# outrel := do select od args from inrel with condition done;
writes_all([])
writes_type_all(line,cinfo||"line")
args := list_unparse(directobject)
nvcondition := list_unparse(nvoption,";",psep)
if DEBUG == "SELECT" then {
writes_type_all(args,cinfo||"args")
writes_type_all(nvcondition,cinfo||"nvcondition")
}
##nvcondition := replace(nvcondition,"=","is")
##nvcondition := replace(nvcondition,",",";")
inrel := unparse(infile)
outrel := unparse(outfile)
if outrel == "[]" then
outrel := unparse(product)
if (type(outrel) == "null") | (*outrel = 0) then {
outrel := inrel||unique_name("select")
}
argdef_copy(inrel,outrel,args,nvcondition)
nrel_copy(inrel,outrel,args,nvcondition)
dval := [outrel]
}
"create context": {
dval := knit_init(cmd,ppobj) # knit.icn
}
"import context": {
dval := import_knit(cmd,ppobj) # knit.icn
}
"export context": {
dval := export_knit(cmd,ppobj) # knit.icn
}
"open cyc": {
# do open cyc od context with option from world done;
# option ::= "write" | "quiet"
option := unparse(option)
context := unparse(directobject)
world := unparse(infile)
#####dval := do_opencyc(option,world,context) # cyc.icn
dval := cyc_open(option,context,world) # cyc.icn
}
"close cyc": {
# do close cyc done;
dval := cyc_close()
}
#####"open tap": {
##### # do open tap od kbdata with option to kbfile done;
##### # option ::= "write" | "quiet"
##### option := unparse(option)
##### kbdata := unparse(directobject)
##### kbfile := unparse(outfile)
##### dval := tap_open(option,kbdata,kfile) # tap.icn
##### }
#####"close tap": {
##### # do close tap done;
##### dval := tap_close()
##### }
"size/gdbm": {
# do size/gdbm od gdbmtable,... done;
dval := []
every x := !list_unparse(directobject) do {
x := !x
if d := gdbm_open(x) then {
num := *d
put(dval,num)
write(cmdfd,num)
close(d)
} else {
head := "# ERROR: size/gdbm: can't open GDBM table: "
writes_all([head,x])
}
} # end every x
}
"list tables": {
# do list tables od view,... done;
dval := []
viewlist := list_unparse(directobject)
if *viewlist == 0 then
viewlist := [["tabula rasa"]] # default
every view := !viewlist do {
view := !view
dbdir := KEDB||"/"||view
dbfile := dbdir||"/*.dir"
kline := "! ls "||squote||dbdir||squote||" done;"
writes_all(["##### view = ",view," #####"])
interpret_line(kline)
} # end every view
}
"size": { # do size od x done;
dval := []
every x := !list_unparse(directobject) do {
x := !x
if DEBUG==("VALUE"|"VARIABLE") then {
writes_type_all(x,cinfo||"x[value]")
}
case type(x) of {
default: {
writes_type_all(x,warning||"size not implemented for")
}
"string": {
case x of {
default: {
writes_type_all(x,warning||"size not implemented for")
}
"BOOT": {
num := *BOOT
put(dval,num)
write(cmdfd,num)
}
"KNIT": {
num := *KNIT
put(dval,num)
write(cmdfd,num)
}
"CHIT": {
num := *CHIT
put(dval,num)
write(cmdfd,num)
}
"HIDDEN": {
num := *HIDDEN
put(dval,num)
write(cmdfd,num)
}
}
} # end "string"
("list"|"infon"): {
num := list_size(x) # array.icn
put(dval,num)
write(cmdfd,num)
} # end "list"
"table": {
num := *x
put(dval,num)
write(cmdfd,num)
} # end "table"
"SYMBOL": {
writes_type_all(x,warning||"size not implemented for")
} # end "SYMBOL"
} # end case t
} # end every x
}
(
"size/list"|
"size/infon"
): {
# do size od infon,... done;
# infon isa RELUNIT()
dval := []
every x := !list_unparse(directobject) do {
x := !x
if DEBUG==("VALUE"|"VARIABLE") then {
writes_type_all(x,cinfo||"x[value]")
}
num := list_size(x) # array.icn
put(dval,num)
write(cmdfd,num)
} # end every x
}
"hload": { # do hload from file to boot done;
kfile := unparse(infile)
btable := unparse(outfile)
nconcept := hload(kfile)
dval := nconcept
}
"hdump": { # do hdump from boot to file done;
writes_all([TypeComment||warning||"not implemented"])
}
"hget": { # do hget od concept from boot done;
concept := unparse(directobject)
btable := unparse(infile)
if node := hget(concept,,"user") then {
###writes_type_all(node,info||"node")
delete(BOOT,concept)
every kline := !node do
dval := interpret_line(kline)
} # end if
}
"hput": { # do hput od concept to boot done;
writes_all([TypeComment||warning||"not implemented"])
}
"dump/gdbm": {
# array stored in GDBM database
# do dump/gdbm od cname... with translation to outfile done;
translation := unparse(option)
if *outfile > 0 then {
outfile := unparse(outfile)
fd := open(outfile,"w")
} else {
fd := cmdfd
} # end if
every cname := !list_unparse(directobject) do {
cname := !cname
if tname := gdbm_open(cname) then { # myio.icn
db_dump(fd,tname,cname,translation) # database.icn
} else {
writes_type_all(cname,cerror||
"can't open GDBM table for cname")
} # end if
} # end every cname
if *outfile > 0 then {
close(fd)
} # end if
}
"dump/argtable": {
# array stored in argtable member of relation/method
# do dump/argtable od cname to outfile done;
outfile := unparse(outfile)
if *outfile > 0 then {
fd := open(outfile,"w")
} else {
fd := cmdfd
} # end if
every cname := !list_unparse(directobject) do {
cname := !cname
if tname := ARGINFO[new_argdef(cname)].argtable then { # myio.icn
writes(fd,cname," = {")
writes(fd,table_unparse(tname)) # unparse.icn
writes(fd,"};\n")
} else {
writes_type_all(cname,cerror||
"can't access argtable for cname")
} # end if
} # end every cname
if *outfile > 0 then {
close(fd)
} # end if
}
"delete/gdbm": {
# do delete/gdbm od uname... from cname done;
# array stored in GDBM database
cname := unparse(infile)
every uname := !list_unparse(directobject) do {
uname := !uname
if tname := gdbm_open(cname) then { # myio.icn
db_delete(tname,uname) # database.icn
} else {
writes_type_all(cname,cerror||
"can't open GDBM table for cname")
} # end if
} # end every uname
}
"delete/argtable": {
# do delete/argtable od uname... from cname done;
# array stored in argtable member of relation/method
cname := unparse(infile)
every uname := !list_unparse(directobject) do {
uname := !uname
if tname := ARGINFO[new_argdef(cname)].argtable then { # myio.icn
delete(tname,uname) # database.icn
} else {
writes_type_all(cname,cerror||
"can't access argtable for cname")
} # end if
} # end every uname
}
"parse list": {
# do parse list od string with separator done;
# use parse_list() in symbol.icn
s := unparse(directobject)
sep := unparse(option)
dval := parse_list(s,sep)
}
"quote": {
# qs := do quote od s done;
# enclose string in dquote
s := unparse(directobject)
dval := dquote||s||dquote
}
"dquote": {
# qs := do dquote od s done;
# enclose string in dquote
s := unparse(directobject)
dval := dquote||s||dquote
}
"squote": {
# qs := do squote od s done;
# enclose string in squote
s := unparse(directobject)
dval := squote||s||squote
}
"dequote": {
# s := do dequote od qs done;
# remove quotemarks from string
s := unparse(directobject)
dval := dequote(s) # convert.icn
}
"empty": {
# do empty od x done;
# empties list/set/alternation/...
every x := !directobject do {
x := unparse(x)
delete_member_all(x) # hop.icn
delete_alternative_all(x) # hop.icn
}
}
"reverse list": {
# do reverse list od x done;
every x := !directobject do {
qx := new_concept(x)
KNIT[qx].member := reverse(KNIT[qx].member)
dval := KNIT[qx].member
}
}
"list member": {
# do list member od mem from x,ix to y,iy done;
#writes_type(mybug,directobject,info||"directobject")
#writes_type(mybug,infile,info||"infile")
#writes_type(mybug,outfile,info||"outfile")
dval := list_member(directobject,infile,outfile) # arrayref.icn
#### mem := ""
#### if *directobject > 0 then {
#### if *directobject > 1 then {
#### udirectobject := unparse(directobject)
#### writes_type(myerr,udirectobject,cwarning||"ignoring extra member in od")
#### writes_type(mylog,udirectobject,cwarning||"ignoring extra member in od")
#### }
#### mem := unparse(directobject[1])
#### if *infile > 0 then {
#### uinfile := unparse(infile)
#### writes_type(myerr,uinfile,cwarning||"ignoring from")
#### writes_type(mylog,uinfile,cwarning||"ignoring from")
#### }
#### if *outfile = 0 then {
#### uoutfile := unparse(outfile)
#### writes_type(myerr,uoutfile,cwarning||"missing to")
#### writes_type(mylog,uoutfile,cwarning||"missing to")
#### }
#### } else {
#### uinfile := unparse(infile)
#### if *infile > 2 then {
#### writes_type(myerr,uinfile,cwarning||"extra agument in from")
#### writes_type(mylog,uinfile,cwarning||"extra agument in from")
#### }
#### x := unparse(infile[1])
#### ix := unparse(infile[2])
#### if numeric(ix) then {
#### qx := new_concept(x)
#### mem := KNIT[qx].member[ix]
#### } else {
#### writes_type(myerr,ix,cerror||"non-numeric index in from")
#### writes_type(mylog,ix,cerror||"non-numeric index in from")
#### }
#### } # end if *directobject
#### if *outfile > 0 then {
#### uoutfile := unparse(outfile)
#### if *outfile > 2 then {
#### writes_type(myerr,uoutfile,cwarning||"extra agument in to")
#### writes_type(mylog,uoutfile,cwarning||"extra agument in to")
#### }
#### y := unparse(outfile[1])
#### iy := unparse(outfile[2])
#### if numeric(iy) then {
#### qy := new_concept(y)
#### KNIT[qy].member[iy] := mem
#### } else {
#### writes_type(myerr,iy,cerror||"non-numeric index in to")
#### writes_type(mylog,iy,cerror||"non-numeric index in to")
#### }
#### } # end if *outfile
#### dval := [mem]
}
"random": { dval := random(arglist) } # utility.icn
"shuffle": {
# do shuffle od deck done;
# deck is list of card;
deck := unparse(directobject[1])
qdeck := new_concept(deck)
randomize()
shuffle(KNIT[qdeck].member)
dval := KNIT[qdeck].member
}
"deal": {
# do deal od ncard,ndiscard from deck to hand,stock,discard done;
# ncard,ndiscard isu integer;
# deck isu list of card;
# hand iss set of card;
# stock isu list of card;
# discard isu list of card;
# arglist ::= [deck,hand,stock,discard]
ncard := unparse(directobject[1])
ndiscard := unparse(directobject[2])
deck := unparse(infile[1])
hand := unparse(outfile[1])
discard := unparse(outfile[2])
stock := unparse(outfile[3])
if DEBUG == "DEAL" then {
writes_type(mybug,ncard,info||"ncard")
writes_type(mybug,ndiscard,info||"ndiscard")
writes_type(mybug,deck,info||"deck")
writes_type(mybug,hand,info||"hand")
writes_type(mybug,discard,info||"discard")
writes_type(mybug,stock,info||"stock")
}
qdeck := new_concept(deck)
qhand := new_concept(hand)
qdiscard := new_concept(discard)
qstock := new_concept(stock)
# delete previous handi and discard
KNIT[qstock].member := copy_list(KNIT[qdeck].member)
every handi := !KNIT[qhand].unit do {
qhandi := new_concept(handi)
KNIT[qhandi].member := []
}
KNIT[qdiscard].member := []
# deal ncard cards per hand and ndiscard cards per discard
every i := 1 to ncard do {
every handi := !KNIT[qhand].unit do {
qhandi := new_concept(handi)
put(KNIT[qhandi].member,get(KNIT[qstock].member))
KNIT[qhandi].member := set(KNIT[qhandi].member)
KNIT[qhandi].member := set2list(KNIT[qhandi].member)
}
}
every i := 1 to ndiscard do {
put(KNIT[qdiscard].member,get(KNIT[qstock].member))
}
}
"select_problem": { dval := select_problem(arglist) } # test.icn
"simplify lattice": { dval := simplify_lattice(arglist) } # integrate.icn
"dbclose": { dval := db_close(unparse(arglist)) } # database.icn
"dbopen": { dval := db_open(unparse(arglist)) } # database.icn
"dbprint": { dval := db_print_hierarchy(unparse(arglist)) } # database.icn
"mount hierarchy": { mount_hierarchy(arglist) } # mount.icn
"kbcheck": { dval := check_kb(outfd) } # ke.icn
"kbwrite": { dval := write_kb(outfd) } # ke.icn
#####("import ontology"|"import"): {
##### # do import ontology od namespace from url done
##### namespace := unparse(directobject)
##### url := unparse(infile)
##### dval := do_import_namespace(namespace,url) # xml.icn
##### }
#####"ExtractData": {
##### # do ExtractData od letter from letter.html done
##### # do ExtractData od letter,letter.html done
##### letter := directobject[1][1]
##### htmlfile := directobject[1][2] | infile[1][1]
##### dval := xdletter(letter,htmlfile)
##### }
"exec": {
# do exec od {proplist} done
# execute proposition list
proplist := unparse(directobject," ") # string
proplist := remove_brace(proplist)
#proplist := trim(proplist,";") # semicolon now required
if DEBUG=="EXEC" then {
writes_type(mybug,directobject,info||"exec: directobject")
writes_type(mybug,proplist,info||"exec: proplist")
writes_type(mylog,directobject,info||"exec: directobject")
writes_type(mylog,proplist,info||"exec: proplist")
}
dval := interpret_line(proplist)
} # end "exec"
#####"new group": {
##### # gname is gtype of utype <<== much better
##### # do new group od gname, gtype of utype done <<== NO
##### # create new group of units
##### gname := directobject[1][1]
##### gtype := directobject[2][1]
##### utype := part[1][1]
##### dval := new_group(gname,gtype,utype)
##### } # end "new"
"input relation": {
# do input relation od rname done
dval := write(myerr,exline,info||"executing command")
} # end "input relation"
"update relation": {
# do update relation od rname from infile to outfile done
# do read od rname from infile done
# do input relation od rname done
# do write od rname to outfile done
dval := write(myerr,exline,info||"executing command")
} # end "update relation"
"delete": {
# do delete od uname,... from cname done
uname := directobject
cname := infile
dval := delete_unit(uname,cname) # hop.icn
dval := delete_species(uname,cname) # hop.icn
###dval := delete_member(uname,cname) # hop.icn
###dval := delete_alternative(uname,cname) # hop.icn
} # end "delete"
"merge": {
# do merge od uname,... to cname done;
uname := directobject
cname := outfile
dval := merge_species(uname,cname) # hop.icn
} # end "merge"
"replace": {
# product := do replace od subject,pattern,replacement done
if DEBUG == "HWALK" then
writes_type(mybug,directobject,info||"replace directobject")
subject := !directobject[1]
pattern := !directobject[2]
replacement := !directobject[3]
dval := replace_pattern(subject,pattern,replacement)
} # end "replace"
#####"hdo": {
##### # do hdo od action with path from cname done;
##### # ==>> hdo action with path from cname done;
##### # see action.icn
##### #if DEBUG == "HWALK" then {
##### writes_type(mybug,directobject,info||"hwalk directobject")
##### writes_type(mylog,directobject,info||"hwalk directobject")
##### #}
##### directobject := delete_separator(directobject)
##### action := unparse(directobject)
##### path := unparse(option)
##### cname := unparse(infile)
##### dval := hwalk(cname,action,path)
##### } # end "hwalk"
"hwalk": {
# do hwalk od cname,action,path done;
if DEBUG == "HWALK" then {
writes_type(mybug,directobject,info||"hwalk directobject")
writes_type(mylog,directobject,info||"hwalk directobject")
}
directobject := delete_separator(directobject)
cname := unparse(directobject[1])
action := unparse(directobject[1])
path := unparse(directobject[2])
dval := hwalk(cname,action,path)
} # end "hwalk"
"interpret_line": {
# do interpret_line od proposition list done
if DEBUG == "PARSE" then
writes_type(mybug,directobject,info||"interpret_line directobject")
proplist := directobject[1][1]
dval := interpret_line(proplist)
} # end "interpret_line"
#####"scroll": {
######=======#
##### dval := scroll(mycon,myscroll,"scroll")
##### }
"dump": {
#-----#
# do dump od directobject from array done
dval := []
infile := unparse(infile)
case infile of {
"BOOT": { BOOTprint(directobject) }
default: {
every cname := ! directobject do {
cname := unparse(cname)
#####cname := dequote(cname)
put(dval, dump_concept(cmdfd,cname)) # concept.icn
} # end every
} # end default
} # end case
} # end "dump"
"dump/hidden": {
#-----#
# do dump od directobject done
dval := []
every cname := ! arglist do {
cname := unparse(cname)
cname := dequote(cname)
put(dval, dump_hidden(cmdfd,cname)) # concept.icn
}
} # end "dump/hidden"
"dump/ged": { dval := dump_ged(cmd,arglist,pplist) } # ged.icn
"load/ged": { dval := load_ged(cmd,arglist,pplist) } # ged.icn
"dump/nvstack": {
dval := ns_dump(cmdfd)
}
"vdump": { # do vdump od view to directory done;
dval := dump_view(arglist) # ke.icn
}
"vload": { # do vload od view from directory done;
dval := load_view(arglist) # ke.icn
}
"clock": { # ke.icn
dval := clock ! arglist
}
("menu"|"concept menu"): {
# do menu done;
# do concept menu od concept done;
# MENUWINDOW ::= "input" | "concept" | "console" | "scroll"
case MENU of {
("no"|"NO"): {
writes_type_all(MENU,cinfo||"menu disabled: MENU")
}
default: {
case SYSTYPE of {
(
"Linux" |
"Mac" |
"Cygwin" |
"Interix" |
"WinXP" |
"Win98" |
"Windows"
): {
wininput := mywopen("input")
winconcept := mywopen("concept")
case cmd of {
"menu": {
MENUWINDOW := "input"
mywin := wininput
dval := menu_input(wininput) # menu_input.icn
}
"concept menu": {
MENUWINDOW := "concept"
mywin := winconcept
concept := unparse(directobject)
if concept == "[]" then
concept := DOT1
if DEBUG=="MENU" then
writes_type_all(concept,cinfo||"concept")
dval := concept_menu_input(winconcept,concept) # menu_concept.icn
}
}
case dval of {
default: { }
"Close": { }
"Exit": { do_exit() }
} # end case dval
case MENUWINDOW of {
default: { }
"input": { mywclose(wininput) }
"concept": { mywclose(winconcept) }
"console": { }
} # end case MENUWINDOW
mywclose(wininput)
mywclose(winconcept)
} # end default
default: {
dval := ""
writes_type(myerr,SYSTYPE,warning||cmd||" not available for systype")
writes_type(mylog,SYSTYPE,warning||cmd||" not available for systype")
}
} # end case SYSTYPE
} # end "menu"
} # end default
} # end case MENU
"unique": { dval := write(cmdfd,unique_name(directobject[1][1])) } # newid.icn
"measure": { dval := do_measure(cmd,directobject,option) } # view.icn
"classify": { dval := do_classify(cmd,directobject,option,outfile) } # view.icn
#----------------------------------------------------------------
"SubL": {
# do SubL od exp done;
case KBMODE of {
"cycws": {
dval := cycws_SubL(unparse(directobject))
}
default: {
writes_type(myerr,KBMODE,warning||cmd||" not available for kbmode")
writes_type(mylog,KBMODE,warning||cmd||" not available for kbmode")
}
} # end case KBMODE
}
"find": {
case KBMODE of {
"cycws": {
# do find od pat* with option done;
wsget_concept(unparse(directobject),option)
}
default: {
# do find od pat in array done;
# do find od pat from subhierarchy done;
###writes_type_all(infile,cinfo||"infile")
dval := wild_find(cmd,directobject,infile,array) # mywildcard.icn
}
} # end case KBMODE
}
"vpush":{ every vname := ! arglist do dval := vpush(vname) } # context.icn
"vpop": { dval := vpop() } # context.icn
#----------------------------------------------------------------
("differentiate"|"isd"|"isd*"):{
dval := do_differentiate(cmd,directobject,option) # view.icn
}
("integrate"|"isi"|"isi*"):{
dval := do_integrate(cmd,directobject,option) # view.icn
}
#----------------------------------------------------------------
"check": {
#-----#
# do check od directobject done;
#writes_type(mybug,directobject,info||"check directobject")
#writes_type(mylog,directobject,info||"check directobject")
directobject := [unparse(directobject)]
case *directobject of {
default: {
dval := []
every arg := !arglist do {
arg := unparse(arg)
put(dval,check(mycheck,arg)) # check.icn
}
}
0: { dval := check(mycheck,"") } # check.icn
} # end case
} # end "check"
"print":{
#-----#
# do print to outfile od directobject done;
head := info||"print: "
dval := []
#DEBUG := "PRINT"
if DEBUG=="PRINT_DETAIL" then {
writes_type(mybug,outfile,head||"outfile")
writes_type(mybug,directobject,head||"directobject")
writes_type(mybug,arglist,head||"arglist")
} # end if DEBUG
pfile := unparse(outfile[1][1]) | ""
case pfile of {
default: { pfd := open(pfile,"a") }
"": { pfd := cmdfd }
"output": { pfd := &output }
} # end case pfile
#####every cname := ! arglist do {
every cname := ! directobject do {
qline := unparse(cname)
#####if *qline > 0 then {
#####if is_quote(qline) then {
pline := dequote(qline)
rline := replace_dollar_line(pline)
#rline := substitute(pline)
if DEBUG==("PRINT"|"QUOTE") then {
writes_type(mybug,cname,head||"cname")
writes_type(mybug,qline,head||"qline")
writes_type(mybug,pline,head||"pline")
writes_type(mybug,rline,head||"rline")
}
put(dval, write(pfd,rline))
#####} else {
##### put(dval, print_concept(pfd,qline)) # concept.icn
#####}
#####} # end if *qline
} # end every cname
case pfile of {
default: { close(\pfd) }
"": { }
"output": { }
} # end case pfile
} # end "print"
"help": { dval := help(cmd,directobject) } # help.icn
#-----#
#---------------------------------------------------------------#
("name"|"nickname"|
"given-name"|"surname"|
"title-name"|"suffix-name"|
"first-name"|"middle-name"|"last-name"): {
#--------------------------------------#
every cname := !directobject do {
dval := write(cmdfd,get_name(cname,cmd)) # alias.icn
}
}
"average": {
dval := write(cmdfd,list_average(directobject)) # utility.icn
}
("min"|"max"|"sum"): {
#-----------------#
dval := write(cmdfd,get_numeric(cmd,directobject)) # utility.icn
}
("year"|"month"|"day"|"ymd"|"dmy"|"mdy"): {
#--------------------------------------#
date := directobject[1][1]
date := unparse(date)
dval := write(cmdfd,get_date(cmd,date)) # utility.icn
}
"dir": {
#----#
# DOS dir command - list files in directory
if *directobject > 0 then
cmdobj := cmd ||" "||directobject[1]
else
cmdobj := cmd
rc := system(cmdobj)
dval := write(mylog,"# INFO: ",rc," = system(\"",cmdobj,"\")")
} # end "dir"
"getenv": {
#---------#
# do getenv od variable done
varlist := directobject[1]
every variable := !varlist do {
if value := getenv(variable) then {
} else {
value := "not found"
}
write(myout,"set ",variable," = ",value)
} # end every do
} # end "getenv"
"get proposition": {
# proposition isc* ?;
# do get proposition from view done;
proplist := get_proposition() # context.icn
dval := proplist
}
"import proposition": {
# proposition isc* ?;
# do get proposition from view done;
proplist := get_proposition() # context.icn
dval := parse_file(proplist)
}
#========================================================#
# emulate UNIX commands
"pwd": {
#-----#
# do pwd done
dval := do_pwd() # shell.icn
if *dval > 0 then
write(myout,dval)
}
"cd": {
#-----#
# do cd od directory done
directobject := unparse(directobject)
dval := do_cd(directobject) # shell.icn
write(myout,dval)
}
"ls": {
#-----#
# do ls with option od directobject done
directobject := list_unparse(directobject)
dval := do_ls(directobject,option) # shell.icn
every write(myout,!dval)
}
"mkdir": {
#--------#
# do mkdir od directory done
directobject := list_unparse(directobject)
dval := do_mkdir(directobject) # shell.icn
write(myout,dval)
}
"rmdir": {
#--------#
# do rmdir od directory done
directobject := list_unparse(directobject)
dval := do_rmdir(directobject) # shell.icn
write(myout,dval)
}
#========================================================#
# special Windows commands
("delete comment"|"deletecomment"): {
# do deletecomment od infile to outfile done;
# ke and sh command
writes_type(mylog,line,info||"executing as sh command")
dval := shell(cmd,directobject,option,outfile)
} # end "deletecomment"
"explorer": {
# do explorer od directory done
# execute Windows Explorer
# ke and sh command
writes_type(mylog,line,info||"executing as ke command")
cmd := WEXPLORE # set by init.icn
directory := directobject[1][1] | ""
dir := map(directory,"/","\\") # windows path
sline := cmd
if *dir > 0 then {
sline ||:= " "||dir
}
if dval := system(sline) then {
writes_type(mylog,sline,info||"explorer: success: system")
} else
if dval := shell(sline) then {
writes_type(mylog,sline,info||"explorer: success: shell")
} else {
dval := ""
writes_type(mylog,sline,warning||"explorer: FAILED")
}
} # end "explorer"
#========================================================#
# special Icon commands -- only in Icon 9.3.2
"ftype": {
#--------#
# do ftype od file done
# get type of file
# ftype ::= - b c d l p
fname := directobject[1][1]
dval := get_ftype(fname) # shell.icn
write(myout,dval)
} # end "ftype"
"fstatus": {
#----------#
# do fstatus od file done
# get status of file
# fstatus ::= -rwxrwxrwx
fname := directobject[1][1]
dval := get_fstatus(fname) # shell.icn
write(myout,dval)
} # end "fstatus"
"fsize": {
#--------#
# do fsize od file done
# get size of file
# fsize ::= bytes
fname := directobject[1][1]
dval := get_fsize(fname) # shell.icn
write(myout,dval)
} # end "fsize"
#========================================================#
# special ke commands
#####"read_dmoz": {
######-----------------#
##### # do read_dmoz from dmozfile done;
##### dmozformat := "rdf"
##### if DEBUG==("DMOZ"|"GOOGLE") then {
##### writes_type_all(option,cinfo||"option")
##### writes_type_all(infile[1][1],cinfo||"infile[1][1]")
##### }
##### dmozfile := unparse(infile[1][1])
##### dmozfile := substitute_filename(dmozfile) # command.icn $variables
##### add_unit(dmozfile,"file")
#####
##### saveUniqueName := UniqueName; UniqueName := "rootname"
##### writes_type_all(DBMODE,cinfo||"DBMODE")
##### writes_type_all(UniqueName,cinfo||"UniqueName")
##### writes_type_all(DisplayName,cinfo||"DisplayName")
#####
######======================================================================
##### # code adapted from "read" command
##### if dmozfile == "input" then {
##### fd := &input
##### } else if fd := keopen(dmozfile,"r") then {
##### } else {
##### KERROR +:= 1
##### writes_type(myerr,dmozfile,cerror||"can't open input file")
##### writes_type(mylog,dmozfile,cerror||"can't open input file")
##### fail
##### } # end if dmozfile == "input"
##### file_init(dmozfile,"begin") # includes dmozfile isu file;
##### CurrentFD := fd
##### get_file_parameter(dmozfile,directobject,pplist,"read") # fparam.icn
##### #OLDcomplete("_BeginRead_")
#####
##### dval := read_tap(fd,dmozfile,"rdf") # dmoz.icn
#####
##### #OLDcomplete("_EndRead_")
##### NEWcomplete("_restart_") # nesting stack
##### file_init(dmozfile,"end")
##### CurrentFD := FD
##### if dmozfile == "input" then { } else {
##### close(fd)
##### }
######===================================================================
#####
##### UniqueName := saveUniqueName
#####
##### } # end "read_dmoz"
"read input": {
# do read input done;
# read line from standard input
if dval := read(&input) then { } else {
fail
} # end if
}
#####(
#####"read html"|
#####"read htm"|
#####"read mcf"|
#####"read owl"|
#####"read rdf"|
#####"read tap"
#####): {
######-----------------#
##### # do read tap from tapfile
##### # with tapformat=tf # defaults to rdf
##### # done;
##### # tapformat ::= mcf | rdf | daml
##### if DEBUG==("TAP"|"RDF"|"MCF"|"DAML") then {
##### writes_type_all(option,cinfo||"option")
##### writes_type_all(infile[1][1],cinfo||"infile[1][1]")
##### }
##### if *option = 0 then
##### option := [["tapformat","=","rdf"]]
##### name := unparse(option[1][1])
##### tapformat := unparse(option[1][3])
##### if name == "tapformat" then { } else {
##### writes_type(myerr,name,cwarning||"name not tapformat")
##### writes_type(mylog,name,cwarning||"name not tapformat")
##### }
##### tapfile := unparse(infile[1][1])
##### tapfile := substitute_filename(tapfile) # command.icn $variables
#####
######======================================================================
##### # code adapted from "read" command
##### if tapfile == "input" then {
##### fd := &input
##### } else if fd := keopen(tapfile,"r") then {
##### } else {
##### KERROR +:= 1
##### writes_type(myerr,tapfile,cerror||"can't open input file")
##### writes_type(mylog,tapfile,cerror||"can't open input file")
##### fail
##### } # end if tapfile == "input"
##### file_init(tapfile,"begin") # includes tapfile isu file;
##### CurrentFD := fd
##### get_file_parameter(tapfile,directobject,pplist,"read") # fparam.icn
##### #OLDcomplete("_BeginRead_")
#####
##### case cmd of {
##### "read mcf": { dval := read_mcf(fd,tapfile) } # tap.icn
##### "read html":{ dval := read_tap(fd,tapfile) } # tap.icn
##### "read htm": { dval := read_tap(fd,tapfile) } # tap.icn
##### "read owl": { dval := read_tap(fd,tapfile) } # tap.icn
##### "read rdf": { dval := read_tap(fd,tapfile) } # tap.icn
##### "read tap": { dval := read_tap(fd,tapfile,tapformat) } # tap.icn
##### }
#####
##### #OLDcomplete("_EndRead_")
##### NEWcomplete("_restart_") # nesting stack
##### file_init(tapfile,"end")
##### CurrentFD := FD
##### if tapfile == "input" then { } else {
##### close(fd)
##### }
######===================================================================
#####
##### } # end "read tap"
"read directory": {
#-----------------#
# do read directory od concept from directory done;
# recursive read from file system to knit
saveUniqueName := UniqueName
UniqueName := "rootname"
option := option[1][1]
cname := directobject[1][1]
fsdir := infile[1][1]
fsdir := substitute_filename(fsdir) # command.icn $variables
#add_unit(cname,"hierarchy")
dval := read_directory(cname,fsdir,option) # dir.icn
UniqueName := saveUniqueName
NEWcomplete("_restart_") # nesting stack
} # end "read directory"
"write directory": {
#------------------#
# do write directory od concept to directory done;
# recursive write from knit to file system
option := option[1][1]
cname := directobject[1][1]
fsdir := outfile[1][1]
fsdir := substitute_filename(fsdir) # command.icn $variables
#add_unit(cname,"hierarchy")
dval := write_directory(cname,fsdir,option) # dir.icn
} # end "write directory"
#========================================================#
#
"read": {
#----#
# do read with read characteristic
# out product
# od hfocus
# from kfile
# done;
# read characteristic ::=
# cname
# kformat
# nvseparator
# relseparator
# hoseparator
##### if frompp := get_pp("from",pplist) then {
##### # ok
##### } else {
##### writes_type(myerr,pplist,cerror||"missing from: pplist")
##### writes_type(myerr,directobject,cerror||"missing from: directobject")
##### fail
##### }
##### kfilelist := nvnull_name(frompp.svalue[2])
if DEBUG=="ARGLIST" then {
writes_type(mybug,directobject,cinfo||"directobject")
writes_type(mybug,infile,cinfo||"infile")
}
kfilelist := list_unparse(infile)
#writes_type_all(kfilelist,info||"kfilelist")
every kfile := !kfilelist do {
#writes_type_all(kfile,cinfo||"kfile")
kfile := !kfile
if kfile == "[]" then
kfile := namein
if DEBUG == "READ" then {
writes_type(mybug,kfile,cinfo||"read from kfile")
writes_type(mylog,kfile,cinfo||"read from kfile")
}
kfile := substitute_filename(kfile) # command.icn $variables
#======================================================================
if kfile == nameinput then {
fd := &input
} else if kfile == namein then {
fd := myin
} else if fd := keopen(kfile,"r") then {
} else {
KERROR +:= 1
writes_type(myerr,kfile,cerror||"can't open input file")
writes_type(mylog,kfile,cerror||"can't open input file")
next # break # fail
} # end if kfile == "input"
KFORMAT := "ku" # why do this ???
file_init(kfile,"begin") # includes kfile isu file;
CurrentFD := fd
get_file_parameter(kfile,directobject,pplist,"read") # fparam.icn
#OLDcomplete("_BeginRead_")
dval := read_knit(fd,kfile) # ke.icn
#OLDcomplete("_EndRead_")
NEWcomplete("_restart_") # nesting stack
file_init(kfile,"end")
CurrentFD := FD
if kfile == (nameinput|namein) then { } else {
close(fd)
}
} # end every kfile
#===================================================================
} # end "read"
"write": {
#-----#
# do write with write characteristic
# od hfocus
# to kfile
# done;
# write characteristic ::=
# cname
# hformat
# nvseparator
# relseparator
# hoseparator
##### if topp := get_pp("to",pplist) then {
##### # ok
##### } else {
##### writes_type(myerr,pplist,cerror||"missing to: pplist")
##### writes_type(myerr,directobject,cerror||"missing to: directobject")
##### fail
##### }
##### kfilelist := topp.svalue[2][1].svalue
cname := unparse(directobject[1])
case ct := get_ctype(cname) of {
"event": {
event_write(cmdfd,cname) # event.icn
dval := cname
}
default: {
kfile := unparse(outfile)
if kfile == "[]" then
kfile := nameout
kfile := substitute_filename(kfile) # command.icn $variables
if DEBUG == "WRITE" then {
writes_type(mybug,kfile,cinfo||"write to kfile")
writes_type(mylog,kfile,cinfo||"write to kfile")
}
#if *directobject > 0 then {
#======================================================================
ktype := file2ext(kfile)
if kfile == nameoutput then {
fd := &output
} else if kfile == nameout then {
fd := myout
} else if fd := keopen(kfile,"w",,ktype) then {
#####HFORMAT := ktype
} else {
KERROR +:= 1
writes_type(myerr,kfile,cerror||"can't open output file")
writes_type(mylog,kfile,cerror||"can't open output file")
fail
} # end if kfile == nameoutput
file_init(kfile,"begin") # includes kfile isu file;
get_file_parameter(kfile,directobject,pplist,"write") # fparam.icn
dval := write_knit(fd,kfile) # ke.icn
file_init(kfile,"end")
if kfile == (nameoutput|nameout) then { } else {
close(fd)
}
#======================================================================
#} # end if *directobject > 0
} # end default
} # end case ctype
} # end "write"
#####"entropy": {
######-------#
##### # count file
##### if *directobject > 0 then {
##### kfile := unparse(directobject)
##### kfile := substitute_filename(kfile) # command.icn $variables
##### get_file_parameter(kfile,directobject,pplist,"read") # fparam.icn
##### ##if fd := open(kfile,"r") then {
##### if fd := keopen(kfile,"r") then {
##### dval := count_file(fd,kfile) # entropy.icn
##### close(fd)
##### } else {
##### write(myerr,"# ERROR: can't open: ",kfile)
##### } # end if fd := open()
##### } else {
##### unknown_command(exline,symbol,stype,propname)
##### return dval
##### } # end if *directobject > 0
##### } # end count
} # end case cmd
#----------------------------------------------------------------
add_word(exline,cmd)
add_word(exline,pplist)
if DEBUG==("DOLLAR"|"MEANING"|"PRODUCT") then {
writes_type(mybug,dval,cinfo||"dval")
}
} # end if ctype=="method"
#=================================================#
} # end every cmd
if DEBUG=="PRODUCT" then
writes_type_all(dval,info||"dval")
if /dval then {
writes(myerr,"\n")
writes_type(myerr,exline,ierror||"$Command not set for line")
writes(mylog,"\n")
writes_type(mylog,exline,ierror||"$Command not set for line")
dval := "'***** UNKNOWN *****'"
}
put_dollar("Command",dval)
put_dollar("Sentence",dval)
KFORMAT := pop(SaveStack)
return dval
end
#---------------------------------------------------------------#
procedure unknown_command(line,symbol,stype,propname)
#====================================================
local dval
static info,error,ierror,warning
initial {
info := "INFO: unknown_command: "
error := "ERROR: unknown_command: "
ierror := "Internal ERROR: unknown_command: "
warning := "WARNING: unknown_command: "
}
writes_type(myerr,line,warning||"line")
writes_type(mylog,line,warning||"line")
dval := []
put_dollar("Command",dval)
put_dollar("Sentence",dval)
NCOMMAND -:= 1
add_statement(line,symbol,"newstatement",propname)
end
# ]]>