Return to %urexp.m CVS log

Up to [Coherent Logic Development] / freem / contrib

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

1.1     ! snw         1: %urexp ; Routine export utility - version 0.5.0.1
        !             2:  ; Jon Diamond - 1999-03-31
        !             3:  ; 
        !             4:  n error,device,comment,version
        !             5:  s error=$$init^%uxxxx(),comment="",version="",device=""
        !             6:  ; 
        !             7:  s error=$$writen^%uxxxx($t(+1)_"  "_$$^%uxdat)
        !             8:  k @%uwork
        !             9: %rsel s error=$$rsel^%urxxx(%uwork) q:error<0
        !            10:  i $o(@%uwork@(""))="" s error=$$writep^%uxxxx("No Routines selected") q
        !            11:  ; 
        !            12: %device i device'="" s error=$$close^%ufxxx(device) i error<0 g %exit1
        !            13:  s error=$$select^%ufxxx(.device,"out") 
        !            14:  i error<0 g %rsel
        !            15:  ; 
        !            16: %comment s error=$$readn^%uxxxx("Header comment ",.comment)
        !            17:  i error<0 g %device
        !            18:  ; 
        !            19: %version s error=$$readn^%uxxxx("Add version text ",.version)
        !            20:  i error<0 g %comment
        !            21:  ; 
        !            22:  s error=$$go(device,%uwork,comment,version) i error<0 s a=$$error^%uxxxx(error) g %exit
        !            23:  s error=$$writep^%uxxxx("Routines written - "_+error)
        !            24:  s error=$$writep^%uxxxx("Finished")
        !            25:  ; 
        !            26: %exit s error=$$close^%ufxxx(device) i error<0 ; ??? if error
        !            27: %exit1 k @%uwork
        !            28:  q
        !            29:  ; 
        !            30:  ; Executable entry point
        !            31:  ; Needs modifying to allow a selection mask (major changes!)
        !            32: go(device,select,comment,version)
        !            33:  n a,b,c,error,cnt
        !            34:  i version'="",version'?." "1P.e s version=" ; "_version
        !            35:  s error=$$header^%ufxxx(device,$t(+1),$g(comment)) i error<0 q error
        !            36:  s a=99999,cnt=0
        !            37:  f  s a=$o(@select@(a)) q:a=""  d  q:error<0
        !            38:  . s error=$$write^%ufxxx(device,a) q:error<0
        !            39:  . s b=$t(@("+1^"_a)) q:b=""  s error=$$write^%ufxxx(device,b_version) q:error<0
        !            40:  . f c=2:1 s b=$t(@("+"_c_"^"_a)) q:b=""  s error=$$write^%ufxxx(device,b) q:error<0
        !            41:  . q:error<0
        !            42:  . s error=$$write^%ufxxx(device,"")
        !            43:  . s cnt=cnt+1
        !            44:  i error'<0 s error=$$trailer^%ufxxx(device,$t(+1))
        !            45:  i error<0 q error
        !            46:  q cnt_",go^%urexp"
        !            47:  ; 
        !            48:  ; 
        !            49:  ; Alternative entry point with Open/Close included
        !            50: export(device,select,comment,version) 
        !            51:  n error
        !            52:  s error=$$open^%ufxxx(device,"out") q:error<0
        !            53:  s error=$$go(device,$g(select),$g(comment),$g(version)) q:error<0
        !            54:  s error=$$close^%ufxxx(device)
        !            55:  q
        !            56: