Return to %uxxxx.m CVS log

Up to [Coherent Logic Development] / freem / contrib

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

1.1     ! snw         1: %uxxxx ; FreeM %u utility library - version 0.5.0.1
        !             2:  ; Jon Diamond - 1999-03-31
        !             3:  q
        !             4:  ; 
        !             5:  ; INITIALISATION
        !             6: init() n a
        !             7:  i $d(^%uparams) s a="^%uparams"
        !             8:  e  s a="^uparams"
        !             9:  s %ulang=$g(@a@("lang")) i %ulang="" s %ulang=0
        !            10:  s %uprompt=$g(@a@("prompt")) i %uprompt="" s %uprompt="^ulang"
        !            11:  s %uwork=$g(@a@("work")) i %uwork="" s %uwork="^uwork("""_$j_""")"
        !            12:  ; Really should be as below, but needs $system to be implemented
        !            13:  ;s %uwork=$g(@a@("work"),"^uwork("""_$system_""","""_$j_""")")
        !            14:  q "0,init^%uxxxx"
        !            15:  ; 
        !            16:  ; 
        !            17:  ; READ WITH PROMPT
        !            18: read(prompt,result,length,PX,PY,X,Y,timeout) 
        !            19:  n a,error
        !            20:  i '$d(%ulang) s error=$$init
        !            21:  s prompt=$g(prompt)
        !            22: %read1 i prompt'="" s error=$$write($$lprompt(prompt),$g(PX),$g(PY)) i error q error
        !            23:  i $g(result)'="" s error=$$write(" <"_result_"> ") i error q error
        !            24:  ; 
        !            25:  ; move to X,Y ********
        !            26:  i $g(X)'="" s $x=$g(X)
        !            27:  i $g(Y)'="" s $y=$g(Y)
        !            28:  i $g(timeout)="" d
        !            29:  . r a
        !            30:  e  d
        !            31:  . r a:$g(timeout)
        !            32:  ; 
        !            33:  ; **** hitting escape or escape sequence processing???
        !            34:  i a'="" s result=a
        !            35:  i a="@" s result=""
        !            36:  i a="^" q "-1,read^%uxxxx" ; *** Standard abort
        !            37:  i $g(length),$l(result)>length s error=$$error("Too many characters") g %read1
        !            38:  ; 
        !            39:  q "0,read^%uxxxx"
        !            40:  ; 
        !            41:  ; 
        !            42:  ; READ WITH NEWLINE FIRST
        !            43: readn(prompt,result,length,PX,PY,X,Y,timeout) 
        !            44:  n error
        !            45:  i '$d(%ulang) s error=$$init i error q error
        !            46:  s error=$$writep($g(prompt)) i error q error
        !            47:  q $$read("",.result,$g(length),"","",$g(X),$g(Y),$g(timeout))
        !            48:  ; 
        !            49:  ; 
        !            50:  ; READN FOR YES/NO
        !            51: readyn(prompt,result) 
        !            52:  n error,res,def
        !            53:  s def=$g(result),def=$$lprompt($s(def=1:"Y",def=0:"N",1:""))
        !            54:  i '$d(%ulang) s error=$$init i error q error
        !            55: %readyn1 s res=def
        !            56:  s error=$$readn(prompt,.res) i error<0 q error
        !            57:  s res=$$upper(res)
        !            58:  i res=$$lprompt("Y") s result=1
        !            59:  e  i res=$$lprompt("N") s result=0
        !            60:  e  s error=$$write(" - "_$$lprompt("Enter Y or N")) g %readyn1
        !            61:  q "0,readyn^%uxxxx"
        !            62:  ; 
        !            63:  ; Application Validation Error display after Read (of any kind)
        !            64: rerror(err)  i err?1"?".e q $$write(" "_err)
        !            65:  q $$write(" - "_$$lprompt(err))
        !            66:  ; 
        !            67:  ; WRITE TEXT
        !            68: write(text,X,Y) 
        !            69:  n error
        !            70:  i '$d(%ulang) s error=$$init i error q error
        !            71:  ; 
        !            72:  ; move to X,Y ********
        !            73:  i $g(X)'="" s $x=$g(X)
        !            74:  i $g(Y)'="" s $y=$g(Y)
        !            75:  w text
        !            76:  q "0,write^%uxxxx"
        !            77:  ; 
        !            78:  ; 
        !            79:  ; WRITE WITH NEWLINE
        !            80: writen(text) 
        !            81:  w !,text
        !            82:  q "0,writen^%uxxxx"
        !            83:  ; 
        !            84:  ; 
        !            85:  ; WRITE WITH NEWLINE/PROMPT
        !            86: writep(text) 
        !            87:  n error
        !            88:  i '$d(%ulang) s error=$$init() i error q error
        !            89:  w !,$$lprompt(text)
        !            90:  q "0,writep^%uxxxx"
        !            91:  ; 
        !            92:  ; 
        !            93:  ; WRITE WITH FORMAT
        !            94: writef(format,text) 
        !            95:  n error,a
        !            96:  i '$d(%ulang) s error=$$init i error q error
        !            97:  s format=$g(format)
        !            98:  f  q:format=""  s a=$p(format,","),format=$p(format,",",2,$l(format,",")) i a?."#"."!"!(a?1"?"1.n) x "w "_a
        !            99:  w $g(text)
        !           100:  q "0,writef^%uxxxx"
        !           101:  ; 
        !           102:  ; 
        !           103:  ; Create+write Error message
        !           104: error(error) 
        !           105:  i +error=-1 q $$writep("User abort")
        !           106:  s error=$$writep("Error - "_$$lprompt(error))
        !           107:  q error
        !           108:  ; 
        !           109:  ; LANGUAGE CONVERSION
        !           110: lprompt(prompt) i $g(prompt)="" q ""
        !           111:  ; Remove trailing spaces before look-up and re-apply after
        !           112:  ; Also everything after first -
        !           113:  ; Everything before ~ is left unchanged and ~ replaced by -
        !           114:  n s,t,u
        !           115:  s u="" i prompt["~" s u=$p(prompt,"~")_" - ",prompt=$p(prompt,"~",2,$l(prompt,"~"))
        !           116:  s t=$f(prompt,"-")-2
        !           117:  i 't s t=$l(prompt)
        !           118:  f t=t:-1 q:$e(prompt,t)'=" "
        !           119:  s s=$e(prompt,t,$l(prompt)),prompt=$e(prompt,1,t-1)
        !           120:  i prompt'="" s t=$g(@%uprompt@(%ulang,prompt)) i t'="" s prompt=t
        !           121:  q u_prompt_s
        !           122:  ; 
        !           123:  ; ********** UPPER/LOWER CONVERSION NEED TO HANDLE DIFFERENT LANGUAGES/CHARACTERS
        !           124: upper(text) 
        !           125:  s text=$tr(text,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
        !           126:  q text
        !           127:  ; 
        !           128: lower(text) 
        !           129:  s text=$tr(text,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
        !           130:  q text
        !           131: