Return to %ugimp.m CVS log

Up to [Coherent Logic Development] / freem / contrib

Annotation of freem/contrib/%ugimp.m, revision 1.1.1.1

1.1       snw         1: %ugimp ; Global import utility - version 0.5.0.1
                      2:  ; Jon Diamond - 1999-03-31
                      3:  ;
                      4:  w !,$t(+1),"  ",$$^%uxdat
                      5:  ;
                      6:  n error,select,device,header,comment,yes,cnt,sel
                      7:  s error=$$init^%uxxxx,device=""
                      8:  ;
                      9:  k @%uwork
                     10:  ;
                     11: %device i device'="" s error=$$close^%ufxxx(device) i err<0 g %exit1
                     12:  s error=$$select^%ufxxx(.device,"in") 
                     13:  i error<0 g %exit1
                     14:  ;
                     15:  s error=$$%header i error<0 s a=$$writep^%uxxxx("Header error on input file") g %exit
                     16:  s error=$$writep^%uxxxx("Header - "_header) i error<0 g %exit
                     17:  s error=$$writep^%uxxxx("Description - "_comment) i error<0 g %exit
                     18:  ;
                     19: %cont s yes=1
                     20:  s error=$$readyn^%uxxxx("Continue? ",.yes)
                     21:  i error<0 g %device
                     22:  i 'yes g %exit
                     23:  ;
                     24: %all s all=1
                     25:  s error=$$readyn^%uxxxx("Restore all globals? ",.all) 
                     26:  i error<0 g %cont
                     27:  ;
                     28: %go s error=$$go(device,all) i error<0 s a=$$error^%uxxxx(error) g %exit
                     29:  s cnt=+error
                     30:  s error=$$writep^%uxxxx("Finished")
                     31:  s error=$$writep^%uxxxx("Globals processed - "_cnt)
                     32:  ;
                     33: %exit i device'="" s error=$$close^%ufxxx(device) i error<0 ; ??? if error
                     34: %exit1 k @%uwork
                     35:  q
                     36:  ;
                     37: %header()
                     38:  s (header,comment)=""
                     39:  s error=$$read^%ufxxx(device,"",.header) i error<0 q error
                     40:  s error=$$read^%ufxxx(device,"",.comment) i error<0 q error
                     41:  q "0,%header^%ugimp"
                     42:  ;
                     43:  ; Executable entry point
                     44:  ; Needs modifying to allow a selection mask (major changes!)
                     45: go(device,all) 
                     46:  n a,b,name,d,error,cnt,this,replace
                     47:  s name="",cnt=0,all=$g(all,1),this=1,replace=""
                     48: %go1 s a="",b=""
                     49:  s error=$$read^%ufxxx(device,"",.a) i error<0 q error
                     50:  s error=$$read^%ufxxx(device,"",.b) i error<0 q error
                     51:  ; w !,a,!,b ; *** debugging
                     52:  i a'?1"^".e g %go2
                     53:  i $p(a,"(",1)'=name d  q:error<0  i this s cnt=cnt+1
                     54:  . s (name,replace)=$p(a,"(",1)
                     55:  . i all s error=$$writep^%uxxxx("Processing - "_name) q
                     56:  . s error=$$readn^%uxxxx("Restore as ",.replace) i error<0 s this=0 q
                     57:  . i replace="*" s all=1,replace=name
                     58:  . i replace="-" s this=0 q
                     59:  . i $e(replace)'="^" s replace="^"_replace
                     60:  . s this=1
                     61:  i this s @(replace_$e(a,$l(name)+1,999)_"=b") g %go1
                     62:  g %go1
                     63:  ;
                     64: %go2 i a?1"****".e1"****",a=b q cnt_",go^%ugimp"
                     65:  q "-104,go^%ugimp,"_a
                     66:  ;
                     67:  ;
                     68:  ; Alternative entry point with Open/Close included
                     69: import(device,all) 
                     70:  n error
                     71:  s error=$$open^%ufxxx(device,"in") q:error<0
                     72:  s error=$$go(device,all) q:error<0
                     73:  s error=$$close^%ufxxx(device)
                     74:  q
                     75: