Return to %ursea.m CVS log

Up to [Coherent Logic Development] / freem / contrib

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

1.1     ! snw         1: %ursea ; FreeM Routine Search - version 0.5.0.1
        !             2:  ; Jon Diamond - 1993-03-31
        !             3:  ; 
        !             4:  n error,device,search,replace,cnt
        !             5:  s error=$$init^%uxxxx,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)
        !            14:  i error<0 g %rsel
        !            15:  ; 
        !            16:  k search,replace
        !            17:  s cnt=0
        !            18: %search s error=$$readn^%uxxxx("Search for ",.search)
        !            19:  i error<0 g %device
        !            20:  s error=$$readn^%uxxxx("Replace with ",.replace) 
        !            21:  i error<0 g %search
        !            22:  ; 
        !            23:  s cnt=cnt+1,search(cnt)=search i replace'="" s replace(cnt)=replace
        !            24:  g %search
        !            25:  ; 
        !            26: %go s error=$$go(device,%uwork,.search,.replace) i error<0 s a=$$error^%uxxxx(error) g %exit
        !            27:  s error=$$writep^%uxxxx("Routines modified - "_+error)
        !            28:  s error=$$writep^%uxxxx("Finished")
        !            29:  ; 
        !            30: %exit s error=$$close^%ufxxx(device) i error<0 ; ??? if error
        !            31: %exit1 k @%uwork
        !            32:  q
        !            33:  ; 
        !            34:  ; Executable entry point
        !            35:  ; Needs modifying to allow a selection mask (major changes!)
        !            36: go(device,select,search,replace)
        !            37:  n a,c,cnt,error,f,mod,new,old,r,s
        !            38:  s error=$$write^%ufxxx(device,"Routine Search/Replace "_$$^%uxdat()) q:error<0
        !            39:  f r=1:1 q:'$d(search(r))  s error=$$write^%ufxxx(device,search(r)) q:error<0  s error=$$write^%ufxxx(device,"  >>> "_$g(replace(r))) q:error<0
        !            40:  s a=99999,cnt=0
        !            41:  f  s a=$o(@select@(a)) q:a=""  d  q:error<0
        !            42:  . s error=$$write^%ufxxx(device,a) q:error<0
        !            43:  . s mod=0 k new
        !            44:  . f c=1:1 s (new,old)=$t(@("+"_c_"^"_a)) q:new=""  d  q:error<0
        !            45:  . . f r=1:1 q:'$d(search(r))  s s=search(r) i new[s d
        !            46:  . . . s f=$f(new,s),new=$e(new,1,f-$l(s)-1)_$g(replace(r))_$e(new,f,$l(new))
        !            47:  . . s new(c)=new
        !            48:  . . i new=old q
        !            49:  . . s error=$$write^%ufxxx(device,c_"^"_a_$j("",30-$l(c)-$l(a))_" "_old) q:error<0
        !            50:  . . i $o(replace("")) s error=$$write^%ufxxx(device,$j("",31)_new) q:error<0
        !            51:  . . s error=$$write^%ufxxx(device,"")
        !            52:  . . s mod=1,new(c)=new
        !            53:  . q:error<0
        !            54:  . i mod d
        !            55:  . . s error=$$save^%urxxx(a,.new)
        !            56:  . . i error<0 s error=$$write^%uxxxx(device,"*** Error in saving routine ***") q
        !            57:  . . s error=$$write^%ufxxx(device,""),cnt=cnt+1 q:error<0
        !            58:  i error<0 q error
        !            59:  q cnt_",go^%ursea"
        !            60:  ; 
        !            61:  ; 
        !            62:  ; Alternative entry point with Open/Close included
        !            63: search(device,select,search,replace)
        !            64:  n error
        !            65:  s error=$$open^%ufxxx(device) q:error<0
        !            66:  s error=$$go(device,select,.search,.replace) q:error<0
        !            67:  s error=$$close^%ufxxx(device) q:error<0
        !            68:  q "0,search^%ursea"
        !            69: