Return to %ufxxx.m CVS log

Up to [Coherent Logic Development] / freem / contrib

Annotation of freem/contrib/%ufxxx.m, revision 1.1

1.1     ! snw         1: %ufxxx ; File i/o Library - version 0.5.0.1
        !             2:  ; A.Trocha [1999/02/01-20:20:05]
        !             3:  ; Utility common file handling subroutines ; Jon Diamond ; 1999-02-18
        !             4:  ; $Source: /cvsroot-fuse/gump/FreeM/mlib/%ufxxx.m,v $
        !             5:  ; $Revision: 1.1 $ $Date: 2000/02/18 15:13:42 $
        !             6:  Q
        !             7:  ; 
        !             8:  ; 
        !             9: direx(path) ;--- test if directory exists
        !            10:  ;        0 = does not exist     1 = success
        !            11:  ; 
        !            12:  S $ZT="%direx99^"_$ZN
        !            13:  N tmp
        !            14:  S tmp=$V(2)
        !            15:  V 2:path
        !            16:  V 2:tmp
        !            17:  Q 1
        !            18:  Q
        !            19: %direx99 ;--- error
        !            20:  Q 0
        !            21:  ; 
        !            22:  ; 
        !            23: mkdir(path) ;--- create directory
        !            24:  ;        0 = error      1 = ok
        !            25:  ; 
        !            26:  N exec
        !            27:  S exec="!mkdir "_path_">/dev/null"
        !            28:  X exec
        !            29:  Q $$direx(path)
        !            30:  ; 
        !            31:  ; 
        !            32: rmdir(path) ;--- delete directory   "rm -r"
        !            33:  ; **** take care ****
        !            34:  N exec
        !            35:  S exec="!rm -r "_path_">/dev/null"
        !            36:  X exec
        !            37:  Q '$$direx(path)
        !            38:  ; 
        !            39:  ; SELECT DEVICE
        !            40:  ; 
        !            41: select(device,type,params) 
        !            42:  n error,d,ntype
        !            43:  s d=$g(device),type=$g(type),params=$g(params) i type="" s type="in"
        !            44: %select1 
        !            45:  s device=d,error=$$readn^%uxxxx($s(type="in":"Input",type="in/out":"Input/Output",1:"Output")_" device: ",.device)
        !            46:  i error<0 q error
        !            47:  s ntype=type
        !            48:  ; 
        !            49:  ; **** add stuff for parameters etc.??????
        !            50:  ; **** is it possible to validate for a device name???
        !            51:  ; **** may want to output to pseudo-device, e.g. global/file
        !            52: %select2 
        !            53:  s error=$$open(device,ntype,params,0)
        !            54:  i error'<0 q "0,select^%ufxxx"
        !            55:  i +error=-1 q error
        !            56:  i +error'=-103 s a=$$write(""," - "_error) g %select1
        !            57:  ; 
        !            58:  ; Now try again if we didn't try and open the file as a new one
        !            59:  i ntype'="in",ntype'="new" s ntype="new" g %select2
        !            60:  s a=$$rerror^%uxxxx("Device not available")
        !            61:  g %select1
        !            62:  ; 
        !            63:  ; 
        !            64:  ; OPEN DEVICE
        !            65:  ; 
        !            66: open(device,type,params,timeout) 
        !            67:  ; ***** error trapping probably needed here to allow for
        !            68:  ; ***** device selection
        !            69:  ; ***** and parameters to be incorrect in some way
        !            70:  s device=$g(device),params=$g(params)
        !            71:  i device=""!(device=0)!(device=$i) q "0,open^%ufxxx"
        !            72:  s timeout=$g(timeout)
        !            73:  ; ***** handle types = in, in/out, out
        !            74:  s type=$g(type,"in")
        !            75:  i type'="out" s params="R"_params
        !            76:  i type'="in" s params="W"_params
        !            77:  i type="new" s params="N"_params
        !            78:  i timeout="" o device:params
        !            79:  e  o device:params:timeout e  q "-103,open^%ufxxx"
        !            80:  q "0,open^%ufxxx"
        !            81:  ; 
        !            82:  ; 
        !            83:  ; CLOSE DEVICE
        !            84: close(device) 
        !            85:  s device=$g(device)
        !            86:  i device=""!(device=0)!(device=$i) q "0,close"
        !            87:  ; ***** do we need to add parameters on close here???
        !            88:  c device
        !            89:  q "0,close^%ufxxx"
        !            90:  ; 
        !            91:  ; READ WITH PROMPT
        !            92:  ; 
        !            93: read(device,prompt,result,length,PX,PY,X,Y,timeout) 
        !            94:  n a,error
        !            95:  i '$d(%ulang) s error=$$init^%uxxxx()
        !            96:  s dev=$i,device=$g(device)
        !            97:  s prompt=$g(prompt)
        !            98:  i prompt'="" s error=$$write(device,$$lprompt^%uxxx(prompt),$g(PX),$g(PY)) i error q error
        !            99:  i dev'=device,device'=0,device'="" u device
        !           100:  i $g(result)'="" s error=$$write(device," <"_result_"> ") i error q error
        !           101:  ; 
        !           102:  ; move to X,Y ********
        !           103:  i $g(X)'="" s $x=$g(X)
        !           104:  i $g(Y)'="" s $y=$g(Y)
        !           105:  i $g(timeout)="" d
        !           106:  . r a
        !           107:  e  d
        !           108:  . r a:$g(timeout)
        !           109:  ; 
        !           110:  ; **** hitting escape or escape sequence processing???
        !           111:  u dev
        !           112:  i a'="" s result=a
        !           113:  i a="@" s result=""
        !           114:  i $g(length),$l(result)>length q "-101,read"
        !           115:  ; 
        !           116:  q "0,read^%ufxxx"
        !           117:  ; 
        !           118:  ; 
        !           119:  ; WRITE TEXT
        !           120: write(device,text,X,Y) 
        !           121:  n error
        !           122:  i '$d(%ulang) s error=$$init() i error q error
        !           123:  s dev=$i,device=$g(device)
        !           124:  i dev'=device,device'=0,device'="" u device
        !           125:  ; 
        !           126:  ; move to X,Y ********
        !           127:  i $g(X)'="" s $x=$g(X)
        !           128:  i $g(Y)'="" s $y=$g(Y)
        !           129:  w text,!
        !           130:  u dev
        !           131:  q "0,write^%ufxxx"
        !           132:  ; 
        !           133:  ; Write header
        !           134: header(device,type,comment) 
        !           135:  n error
        !           136:  s error=$$write^%ufxxx(device,"**** "_type_" ~ "_$$^%uxdat($h,1)_" ****") i error<0 q error
        !           137:  s error=$$write^%ufxxx(device,"**** "_$g(comment)_" ****") i error q error
        !           138:  q "0,header^%ufxxx"
        !           139:  ; 
        !           140:  ; Write trailer
        !           141: trailer(device,type) 
        !           142:  n a,error
        !           143:  s a="**** "_$g(type)_" ~ "_$$^%uxdat($h,1)_" ****"
        !           144:  s error=$$write^%ufxxx(device,"") i error<0 q error
        !           145:  s error=$$write^%ufxxx(device,a) i error q error
        !           146:  q "0,header^%ufxxx"
        !           147: