Return to %ufxxx.m CVS log

Up to [Coherent Logic Development] / freem / contrib

Annotation of freem/contrib/%ufxxx.m, revision 1.1.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: