Return to %urexp.m CVS log

Up to [Coherent Logic Development] / freem / contrib

FreeM

    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: