mim/development/mim/vax/mimlib/gtfile.mud

   1
   2 <PACKAGE "GTFILE">
   3
   4 <ENTRY FILE-MENU
   5        GET-FILE
   6        GET-ALL-FILES
   7        COMPLETE
   8        COMPLETE-TERMINATE
   9        TERMINATE
  10        COMPLETE-FIELD>
  11
  12 <USE "SORTX" "GNJFN">
  13
  14 <EXPORT "GNJFN">
  15
  16 <DEFINE GET-DEFAULT (ATM)
  17         <COND (<BOUND? .ATM> <COND (<ASSIGNED? .ATM> ..ATM) (T <>)>)
  18               (<GASSIGNED? .ATM> ,.ATM)>>
  19
  20 <DEFINE DO-TERMINATE (STR:STRING NEW?:<OR ATOM FALSE> "AUX" NS)
  21         <SET STR <PARSE-FILE-NAME .STR T>>
  22         <COND (.NEW? .STR)
  23               (T
  24                <COND (<SET NS <FILE-EXISTS? .STR>> .STR)
  25                      (T <CHTYPE (.STR !.NS) FALSE>)>)>>
  26
  27 <DEFINE GET-FILE (STR:STRING FLEN:<OR
  28                                    FIX FALSE> OPER:ATOM
  29                   "OPT" (NEW?:<OR ATOM FALSE> <>)
  30                         (NM1:<SPECIAL
  31                               <OR STRING FALSE
  32                                   FIX>> <GET-DEFAULT NM1>)
  33                         (NM2:<SPECIAL
  34                               <OR STRING FALSE
  35                                   FIX>> <GET-DEFAULT NM2>)
  36                         (DEV:<SPECIAL
  37                               <OR STRING FALSE
  38                                   FIX>> <GET-DEFAULT DEV>)
  39                         (SNM:<SPECIAL
  40                               <OR STRING FALSE
  41                                   FIX>> <GET-DEFAULT SNM>)
  42                   "AUX" (LEN:FIX <COND (.FLEN .FLEN) (T <LENGTH .STR>)>)
  43                         (RS <STACK <ISTRING .LEN>>) NS
  44                         (TS <STACK <ISTRING <+ .LEN 1>>>))
  45    <SUBSTRUC .STR 0 .LEN .RS>
  46    <COND
  47     (<==? .OPER TERMINATE> <DO-TERMINATE .RS .NEW?>)
  48     (T
  49      <COND (<OR <==? .OPER COMPLETE> <==? .OPER COMPLETE-TERMINATE>>
  50             <COND (<DO-TERMINATE .RS .NEW?>)
  51                   (T
  52                    <SUBSTRUC .STR 0 .LEN .TS>
  53                    <PUT .TS <LENGTH .TS> !\*>
  54                    <COND (<SET NS <DO-COMPLETE .TS .NEW?>>
  55                           <COND (<==? .OPER COMPLETE-TERMINATE>
  56                                  <DO-TERMINATE .NS .NEW?>)
  57                                 (.NS)>)>)>)
  58            (<==? .OPER FILE-MENU>
  59             <SUBSTRUC .STR 0 .LEN .TS>
  60             <PUT .TS <LENGTH .TS> !\*>
  61             <FILE-MENU .TS ,RETURN-ALL>)>)>>
  62
  63 <DEFINE DO-COMPLETE (STR:STRING NEW?:<OR
  64                                       ATOM FALSE>
  65                      "AUX" CH:<OR
  66                                FALSE <CHANNEL
  67                                       'GNJFN>>)
  68    <COND
  69     (<SET CH <CHANNEL-OPEN GNJFN .STR ,RETURN-ALL>>
  70      <REPEAT (NCH:<CHANNEL 'PARSE> (OS <>) (CT 0) NAMSTR TS (DIR? <>)
  71               (N2 <AND <ASSIGNED? NM2> .NM2>) (N2S <>) (NC 0))
  72        <SET NAMSTR <CHANNEL-OP .CH NAME>>
  73        <COND (<AND .N2 <=? <CHANNEL-OP .CH NM2> .N2>>
  74               <SET NC <+ .NC 1>>
  75               <COND (<NOT .N2S> <SET N2S <STRING .NAMSTR>>)
  76                     (T
  77                      <SET N2S <GET-COMMON .N2S <STRING .NAMSTR>>>)>)>
  78        <SET CT <+ .CT 1>>
  79        <SET DIR? <CHANNEL-OP .CH DIR?>>
  80        <COND (<NOT .OS> <SET OS .NAMSTR>)
  81              (T <SET OS <GET-COMMON .OS .NAMSTR>>)>
  82        <COND
  83         (<NOT <CHANNEL-OP .CH NEXT-FILE>>
  84          <CLOSE .CH>
  85          <COND
  86           (<1? .CT>
  87            <COND (.DIR?
  88                   <RETURN <GET-FILE <STRING .OS !\/> <> COMPLETE .NEW?>>)>
  89            <RETURN .OS>)
  90           (<0? .CT> <RETURN <CHTYPE (<STRING .STR> "no matches") FALSE>>)
  91           (T
  92            <COND (.N2S
  93                   <COND (<1? .NC> <RETURN .N2S>)>
  94                   <RETURN <CHTYPE (.N2S "ambiguous") FALSE>>)
  95                  (<AND <MEMQ !\. .OS:STRING> .N2>
  96                   <SET NCH <CHANNEL-OPEN PARSE .OS>>
  97                   <COND (<OR <NOT <SET TS <CHANNEL-OP .NCH NM2>>>
  98                              <AND <SET TS <MEMBER .TS .N2>> <==? .TS .N2>>>
  99                          <SET TS <CHANNEL-OP .NCH NAME 28>>
 100                          <COND (<SET TS <DO-TERMINATE .TS .NEW?>>
 101                                 <CLOSE .NCH>
 102                                 <RETURN .TS>)>)>
 103                   <CLOSE .NCH>)>
 104            <RETURN <CHTYPE (.OS "ambiguous") FALSE>>)>)>>)
 105     (<CHTYPE (<STRING .STR> !.CH) FALSE>)>>
 106
 107 <DEFINE GET-COMMON (STR1:STRING STR2:STRING "AUX" TEMP)
 108    <COND (<G? <LENGTH .STR1> <LENGTH .STR2>>
 109           <SET TEMP .STR2>
 110           <SET STR2 .STR1>
 111           <SET STR1 .TEMP>)>
 112    <MAPR <>
 113     <FUNCTION (S1 S2)
 114             <COND (<N==? <1 .S1> <1 .S2>>
 115                    <MAPLEAVE <SUBSTRUC .STR2
 116                                        0
 117                                        <- <LENGTH .STR2> <LENGTH .S2>>
 118                                        <REST .STR2 <LENGTH .S2>>>>)
 119                   (<1? <LENGTH .S1>>
 120                    <COND (<1? <LENGTH .S2>> <MAPLEAVE .STR2>)>
 121                    <MAPLEAVE <SUBSTRUC .STR1
 122                                        0
 123                                        <LENGTH .STR1>
 124                                        <REST .STR2
 125                                              <- <LENGTH .STR2>
 126                                                 <LENGTH .STR1>>>>>)>>
 127     .STR1
 128     .STR2>>
 129
 130 <DEFINE CP (ST:<PRIMTYPE VECTOR> SNM DEV)
 131   <1 .ST .DEV>
 132   <2 .ST .SNM>>
 133
 134 <DEFINE FILE-MENU (ISTR:STRING
 135                    "OPTIONAL" (F-OR-D:FIX ,RETURN-FILES)
 136                    "AUX" CH:<OR
 137                              <CHANNEL 'GNJFN> FALSE> FILES:VECTOR
 138                          FILE:<OR STRING FALSE> NAME1:<OR
 139                                                        STRING FALSE>
 140                          NAME2:<OR STRING FALSE> (DIR? <>)
 141                          FULL?:<OR ATOM FALSE>
 142                          (STR:STRING .ISTR)
 143                          (ST:<PRIMTYPE VECTOR> <STACK <IVECTOR 2>>))
 144    <COND (<OR <EMPTY? .STR>
 145               <=? .STR "*">>
 146           <SET NAME1
 147                <COND (<BOUND? NM1> <AND <ASSIGNED? NM1> .NM1>)
 148                      (<GASSIGNED? NM1> ,NM1)>>
 149           <SET NAME2
 150                <COND (<BOUND? NM2> <AND <ASSIGNED? NM2> .NM2>)
 151                      (<GASSIGNED? NM2> ,NM2)>>
 152           <COND (.NAME1
 153                  <COND (.NAME2 <SET STR <STRING .NAME1 !\. .NAME2>>)
 154                        (T <SET STR <STRING .NAME1 !\. !\*>>)>)
 155                 (.NAME2 <SET STR <STRING !\* !\. .NAME2>>)
 156                 (T <SET STR "*">)>)>
 157    <CP .ST !<GET-CONNECTED-DIR>>
 158    <COND
 159     (<SET CH <CHANNEL-OPEN GNJFN .STR .F-OR-D>>
 160      <COND (<OR <N=? <CHANNEL-OP .CH DEV> <1 .ST>>
 161                 <N=? <CHANNEL-OP .CH SNM> <2 .ST>>>
 162             <SET FULL? T>)
 163            (T
 164             <SET FULL? <>>)>
 165      <SET FILES
 166           <MAPF ,VECTOR
 167                 <FUNCTION ()
 168                    <COND (<COND (.FULL?
 169                                  <SET FILE <CHANNEL-OP .CH NAME>>)
 170                                 (T
 171                                  <SET FILE <CHANNEL-OP .CH SHORT-NAME>>)>
 172                           <COND (<N==? .F-OR-D ,RETURN-FILES>
 173                                  <SET DIR? <CHANNEL-OP .CH DIR?>>)>
 174                           <COND (<NOT <CHANNEL-OP .CH NEXT-FILE>>
 175                                  <MAPSTOP .FILE>)>
 176                           .FILE)
 177                          (T <MAPSTOP>)>>>>
 178      <CHANNEL-CLOSE .CH>
 179      <COND (<AND <1? <LENGTH .FILES>> .DIR?>
 180             <PUT .ISTR <LENGTH .ISTR> !\/>
 181             <GET-FILE .ISTR <> FILE-MENU>)
 182            (T
 183             <COND (<EMPTY? .FILES>)
 184                   (T <SET FILES <SORT <> .FILES>>)>
 185             .FILES)>)
 186     (T .CH)>>
 187
 188 <GDECL (FLIST DIRS) LIST>
 189
 190 <DEFINE GET-ALL-FILES (STR "OPTIONAL" (F-OR-D ,RETURN-FILES))
 191         #DECL ((STR) STRING (F-OR-D) FIX)
 192         <COND (<==? .F-OR-D ,RETURN-ALL>
 193                <SETG FLIST (T)>
 194                <SETG DIRS (T)>
 195                <GET-ALL-FILES-R .STR ,RETURN-ALL>
 196                <VECTOR <REST ,FLIST> <REST ,DIRS>>)
 197               (<==? .F-OR-D ,RETURN-DIRS>
 198                <SETG DIRS (T)>
 199                <GET-ALL-FILES-R .STR ,RETURN-DIRS>
 200                <REST ,DIRS>)
 201               (T
 202                <SETG FLIST (T)>
 203                <GET-ALL-FILES-R .STR ,RETURN-FILES>
 204                <REST ,FLIST>)>>
 205
 206 <DEFINE GET-ALL-FILES-R (STR F-OR-D "AUX" CH DIR (DLIST ()) FILES FILE)
 207    #DECL ((STR DIR) STRING (F-OR-D) FIX (CH) <OR FALSE CHANNEL>
 208           (DLIST FILES) LIST (FILE) <OR FALSE STRING>)
 209    <COND
 210     (<COND (<==? .F-OR-D ,RETURN-DIRS>
 211             <SET CH <CHANNEL-OPEN GNJFN .STR ,RETURN-DIRS>>)
 212            (T <SET CH <CHANNEL-OPEN GNJFN .STR ,RETURN-ALL>>)>
 213      <SET DIR <CHANNEL-OP .CH DIR>>
 214      <COND
 215       (<==? .F-OR-D ,RETURN-DIRS>
 216        <SET DLIST
 217             <MAPF ,LIST
 218                   <FUNCTION ()
 219                           <COND (<SET FILE <CHANNEL-OP .CH SHORT-NAME>>
 220                                  <CHANNEL-OP .CH NEXT-FILE>
 221                                  <SET FILE <STRING .DIR .FILE>>)
 222                                 (T <MAPSTOP>)>>>>)
 223       (T
 224        <SET FILES
 225             <MAPF ,LIST
 226              <FUNCTION ()
 227                      <COND (<SET FILE <CHANNEL-OP .CH SHORT-NAME>>
 228                             <SET FILE <STRING .DIR .FILE>>
 229                             <COND (<CHANNEL-OP .CH DIR?>
 230                                    <SET DLIST (.FILE !.DLIST)>
 231                                    <CHANNEL-OP .CH NEXT-FILE>
 232                                    <MAPRET>)
 233                                   (T <CHANNEL-OP .CH NEXT-FILE> .FILE)>)
 234                            (T <MAPSTOP>)>>>>)>
 235      <CHANNEL-CLOSE .CH>
 236      <COND (<==? .F-OR-D ,RETURN-FILES>
 237             <PUTREST <REST ,FLIST <- <LENGTH ,FLIST> 1>> .FILES>)
 238            (<==? .F-OR-D ,RETURN-DIRS>
 239             <PUTREST <REST ,DIRS <- <LENGTH ,DIRS> 1>> .DLIST>)
 240            (T
 241             <PUTREST <REST ,FLIST <- <LENGTH ,FLIST> 1>> .FILES>
 242             <PUTREST <REST ,DIRS <- <LENGTH ,DIRS> 1>> .DLIST>)>
 243      <MAPF <>
 244            <FUNCTION (DIRECT)
 245                    <GET-ALL-FILES-R <STRING .DIRECT !\/ !\*> .F-OR-D>>
 246            .DLIST>)
 247     (T .CH)>>
 248
 249 <ENDPACKAGE>