Return to delam.icn CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / icon / src / cmd

Annotation of 43BSD/contrib/icon/src/cmd/delam.icn, revision 1.1

1.1     ! root        1: #      DELAM(1)
        !             2: #
        !             3: #      Delaminate file using field list
        !             4: #
        !             5: #      Thomas R. Hicks
        !             6: #
        !             7: #      Last modified 7/10/83
        !             8: #
        !             9: 
        !            10: procedure main(a)
        !            11:    local inpt, fylist, ranges
        !            12:    if (not a[1]) | a[1] == "?" then
        !            13:       Usage()
        !            14:    else if any('0123456789',a[1]) then
        !            15:       ranges := fldecode(a[1])
        !            16:    else
        !            17:       {
        !            18:       write(&errout,"Bad argument to delam: ",a[1])
        !            19:       Usage()
        !            20:       }
        !            21:    if not a[2] then
        !            22:       Usage()
        !            23:    else if (match("-",a[2])) then
        !            24:       inpt := &input
        !            25:        else if not (inpt := open(a[2])) then
        !            26:          stop("Cannot open ",a[2])
        !            27:    fylist := doutfyls(a,3)
        !            28:    if *fylist ~= *ranges then
        !            29:       stop("Unequal number of field args and output files")
        !            30:    delamr(inpt,ranges,fylist)
        !            31: end
        !            32: 
        !            33: # Usage - write usage message
        !            34: #
        !            35: procedure Usage()
        !            36:    stop("Usage: delam fieldlist {infile | -} {outputfile | -}...")
        !            37: end
        !            38: 
        !            39: # delamr - do actual division of input file
        !            40: #
        !            41: procedure delamr(ifd,ranges,fylist)
        !            42:    local i, j, k, line
        !            43:    while line := read(ifd) do
        !            44:       {
        !            45:       i := 1
        !            46:       while i <= *fylist do
        !            47:          {
        !            48:          j := ranges[i][1]
        !            49:          k := ranges[i][2]
        !            50:          if k > 0 then
        !            51:             write(fylist[i][2],line[j+:k] | line[j:0] | "")
        !            52:          i +:= 1
        !            53:          }
        !            54:       }
        !            55: end
        !            56: 
        !            57: # doutfyls - process the output file arguments; return list
        !            58: #
        !            59: procedure doutfyls(a,i)
        !            60:    local lst, x
        !            61:    lst := []
        !            62:    while \a[i] do
        !            63:       {
        !            64:       if x := llu(a[i],lst) then               # already in list
        !            65:          lst |||:= [[a[i],lst[x][2]]]
        !            66:       else                                     # not in list
        !            67:          if a[i] == "-" then                   # standard out
        !            68:             lst |||:= [[a[i],&output]]
        !            69:          else                                  # new file
        !            70:             if not (x := open(a[i],"w")) then
        !            71:                stop("Cannot open ",a[i]," for output")
        !            72:             else
        !            73:                lst |||:= [[a[i],x]]
        !            74:       i +:= 1
        !            75:       }
        !            76:    return lst
        !            77: 
        !            78: end
        !            79: 
        !            80: # fldecode - decode the fieldlist argument
        !            81: #
        !            82: procedure fldecode(fldlst)
        !            83:    local fld, flst, poslst, m, n, x
        !            84:    poslst := []
        !            85:    flst := str2lst(fldlst,':,;')
        !            86:    every fld := !flst do
        !            87:       {
        !            88:       if x := upto('-+',fld) then
        !            89:          {
        !            90:          if not (m := integer(fld[1:x])) then
        !            91:             stop("bad argument in field list; ",fld)
        !            92:          if not (n := integer(fld[x+1:0])) then
        !            93:             stop("bad argument in field list; ",fld)
        !            94:          if upto('-',fld) then
        !            95:             {
        !            96:             if n < m then
        !            97:                n := 0
        !            98:             else
        !            99:                n := (n - m) + 1
        !           100:             }
        !           101:          }
        !           102:       else {
        !           103:          if not (m := integer(fld)) then
        !           104:             stop("bad argument in field list; ",fld)
        !           105:          n := 1
        !           106:          }
        !           107:       poslst |||:= [[m,n]]
        !           108:       }
        !           109:    return poslst
        !           110: end
        !           111: 
        !           112: # llu - lookup file name in output file list
        !           113: #
        !           114: procedure llu(str,lst)
        !           115:    local i
        !           116:    i := 1
        !           117:    while \lst[i] do
        !           118:       {
        !           119:       if \lst[i][1] == str then
        !           120:          return i
        !           121:       i +:= 1
        !           122:       }
        !           123: end
        !           124: 
        !           125: # str2lst - create a list from a delimited string
        !           126: #
        !           127: procedure str2lst(str,delim)
        !           128:    local lst, f
        !           129:    lst := []
        !           130:    str ? {
        !           131:       while f := (tab(upto(delim))) do
        !           132:       {
        !           133:       lst |||:= [f]
        !           134:       move(1)
        !           135:       }
        !           136:         if "" ~== (f := tab(0)) then
        !           137:         lst |||:= [f]
        !           138:         }
        !           139:    return lst
        !           140: end

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.