File:  [Coherent Logic Development] / freem / contrib / %urdir.m
Revision 1.1.1.1 (vendor branch): download - view: text, annotated - select for diffs
Sun Jan 19 02:04:04 2025 UTC (6 months, 1 week ago) by snw
Branches: MAIN, CoherentLogicDevelopment
CVS tags: v0-63-1-rc1, v0-63-0-rc1, v0-63-0, v0-62-3, v0-62-2, v0-62-1, v0-62-0, start, HEAD
FreeM

    1: %urdir ; FreeM Routine Directory - version 0.5.0.1
    2:  ; A.Trocha ; 01/29/1999 01:30/GMT+1
    3:  ; $Source: /home/cvsroot/freem/contrib/%urdir.m,v $
    4:  ; $Revision: 1.1.1.1 $ $Date: 2025/01/19 02:04:04 $
    5:  ; this version is very, very beta
    6:  ; todo: LOCKING!!
    7:  ; 
    8:  N no,error
    9:  ; 
   10:  ; 
   11:  ;--- get routine extention
   12:  ; S ext=$V(98)
   13:  ;
   14:  s error=$$init^%uxxxx 
   15:  s error=$$writen^%uxxxx($t(+1)_"  "_$$^%uxdat)
   16:  s error=$$writen^%uxxxx("")
   17:  ; 
   18:  ;--- get and output %-routines
   19:  S $ZT="%error^%urdir"
   20:  s no=$$list(0)+$$list(1)
   21:  ; 
   22:  s error=$$writep^%uxxxx("Number of routines - "_$J(no,8))
   23:  Q
   24:  ; 
   25:  ;--- get and output non-% routines
   26: list(m) ;
   27:  n rnorm,%
   28:  ;--- path to non-% routines
   29:  S rnorm=$V($s(m=1:4,1:8))
   30:  x "!<"_$$dircmd()_" "_$$convpath(rnorm)_"*"_$V(98)_" 2>/dev/null"
   31:  q $$show($$convpath(rnorm),m)_",list^%ugdir"
   32:  ;
   33: show(path,m) ;--- show routines
   34:  ;    m=0 show %routines  ;   m=1 show non% routines
   35:  N i,out,no
   36:  s no=0
   37:  F i=1:1:% D
   38:  . I $G(m)=0&('$F($G(%(i)),"%")) Q
   39:  . I $G(m)=1&($F($G(%(i)),"%")) Q
   40:  . S out=$G(%(i))
   41:  . I path'="" S out=$E(out,$L(path)+1,$L(out))
   42:  . S out=$E(out,1,$L(out)-$L($V(98)))
   43:  . W $$lb("^"_out) S no=no+1
   44:  Q no
   45:  ; 
   46: convpath(dir) 
   47:  ;--- convert path
   48:  N sl
   49:  S sl=$$slash()
   50:  I dir="" Q ""
   51:  I dir="."_sl Q ""
   52:  I $E(dir,$L(dir))'=sl Q dir_sl
   53:  Q dir
   54:  ; 
   55: lb(str) ;---
   56:  Q $E(str,1,9)_$J("",10-$L(str))
   57:  ; 
   58: slash() ;--- get the OS specific directory delimiter (slash)
   59:  Q "/"
   60:  ; 
   61: dircmd() ; 
   62:  ;--- get the OS specific directory command
   63:  ;--- hmm!? how do I know which OS?
   64:  Q "ls"
   65:  ; 
   66: %error ;--- error - trap
   67:  W !,$ZE,!!
   68:  K % Q
   69: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>