mim/development/mim/vax/mimlib/gnjfn.mud

   1
   2 <PACKAGE "GNJFN">
   3
   4 <ENTRY GNJFN
   5        DIR
   6        DIR?
   7        NEXT-FILE
   8        RETURN-FILES
   9        RETURN-DIRS
  10        RETURN-ALL
  11        LOWERCASSIFY>
  12
  13 <USE "NEWSTRUC">
  14
  15 <NEW-CHANNEL-TYPE GNJFN <>
  16                   OPEN GNJFN-OPEN
  17                   PRINT-DATA GNJFN-PRINT-DATA
  18                   NAME GNJFN-NAME
  19                   SHORT-NAME GNJFN-SHORT-NAME
  20                   DEV GNJFN-DEV
  21                   SNM GNJFN-SNM
  22                   NM1 GNJFN-NM1
  23                   NM2 GNJFN-NM2
  24                   DIR GNJFN-DIR
  25                   DIR? GNJFN-DIR?
  26                   NEXT-FILE GNJFN-NEXT-FILE
  27                   CLOSE GNJFN-CLOSE>
  28
  29 <SETG RETURN-FILES 1>
  30
  31 <SETG RETURN-DIRS 2>
  32
  33 <SETG RETURN-ALL 3>
  34
  35 <MANIFEST RETURN-FILES>
  36
  37 <MANIFEST RETURN-DIRS>
  38
  39 <MANIFEST RETURN-ALL>
  40
  41 <NEWSTRUC GNJFN-DATA VECTOR
  42           GN-STRING STRING
  43           GN-BUF STRING
  44           GN-RET FIX
  45           GN-CHAN <CHANNEL 'DISK>
  46           GN-DIR STRING
  47           GN-DIRSNM <PRIMTYPE VECTOR>
  48           GN-DIR? ANY>
  49
  50 <DEFMAC ENTRY-LEN ('BUF)
  51    <FORM + <FORM ASCII <FORM 5 .BUF>> <FORM * 256 <FORM ASCII <FORM 6 .BUF>>>>>
  52
  53 <DEFMAC NAME-LEN ('BUF)
  54    <FORM + <FORM ASCII <FORM 7 .BUF>> <FORM * 256 <FORM ASCII <FORM 8 .BUF>>>>>
  55
  56 <DEFINE GNJFN-OPEN (C-TYPE:ATOM OP:ATOM STR:STRING
  57                     "OPTIONAL" (F-OR-D:FIX ,RETURN-FILES)
  58                     "AUX" (NM-INFO:<PRIMTYPE
  59                                     VECTOR> <IVECTOR 5 <>>) FIX-STRING:STRING
  60                           DIR:STRING CH:<OR <CHANNEL 'DISK> FALSE> BUF:STRING
  61                           CHAN-DAT:GNJFN-DATA
  62                           VAL:<OR FALSE GNJFN-DATA> TF:STRING
  63                           DIR-SPEC?:<OR ATOM FALSE>)
  64         <COND (<MEMQ !\/ .STR> <SET DIR-SPEC? T>) (T <SET DIR-SPEC? <>>)>
  65         <SET FIX-STRING <PARSE-FILE-NAME .STR <> T .NM-INFO>>
  66         <SET STR
  67              <SUBSTRUC .FIX-STRING
  68                        0
  69                        <- <LENGTH .FIX-STRING> 1>
  70                        <REST .FIX-STRING>>>
  71         <REPEAT ((PLACE <LENGTH .STR>))
  72                 #DECL ((PLACE) FIX)
  73                 <COND (<==? <NTH .STR .PLACE> !\/>
  74                        <SET DIR <SUBSTRUC .STR 0 <- .PLACE 1>
  75                                           <ISTRING <- .PLACE 1>>>>
  76                        <SET STR <REST .STR .PLACE>>
  77                        <RETURN>)
  78                       (T <SET PLACE <- .PLACE 1>>)>>
  79         <COND
  80          (<SET CH <CHANNEL-OPEN DISK .DIR "READ" "ASCII" <>>>
  81           <SET BUF <GET-BUFFER>>
  82           <CHANNEL-OP .CH READ-BUFFER .BUF>
  83           <SET BUF <REST .BUF <ENTRY-LEN .BUF>>>
  84           <SET BUF <REST .BUF <ENTRY-LEN .BUF>>>
  85           <SET CHAN-DAT
  86                <CHTYPE [.STR .BUF .F-OR-D .CH
  87                         .DIR .NM-INFO .DIR-SPEC?]
  88                        GNJFN-DATA>>
  89           <COND (<AND <OR <EMPTY? .BUF>
  90                           <NOT <MATCH? .CHAN-DAT>>
  91                           <NOT <DIR-CHECK .CHAN-DAT>>>
  92                       <NOT <GET-NEXT-FILE .CHAN-DAT>>>
  93                  <FREE-BUFFER .BUF>
  94                  <CLOSE .CH>
  95                  <SET VAL #FALSE ("NO MORE MATCHING FILES")>)
  96                 (T <SET VAL .CHAN-DAT>)>
  97           .VAL)>>
  98
  99 <DEFINE DIR-CHECK (DAT:GNJFN-DATA "AUX" (RET <GN-RET .DAT>))
 100    <COND (<==? .RET ,RETURN-ALL>)
 101          (T
 102           <CHANNEL-DATA .CURRENT-CHANNEL .DAT>
 103           <CHANNEL-OPEN? .CURRENT-CHANNEL T>
 104           <COND (<CHANNEL-OP .CURRENT-CHANNEL:<CHANNEL 'GNJFN> DIR?>
 105                  <==? .RET ,RETURN-DIRS>)
 106                 (T
 107                  <==? .RET ,RETURN-FILES>)>)>>
 108
 109 <DEFINE GNJFN-PRINT-DATA (CH:CHANNEL OP:ATOM
 110                           "OPTIONAL" (OUTCHAN:CHANNEL .OUTCHAN)
 111                           "AUX" (DATA:GNJFN-DATA <CHANNEL-DATA .CH>)
 112                                 F-OR-D:FIX)
 113         <SET F-OR-D <GN-RET .DATA>>
 114         <COND (<==? .F-OR-D ,RETURN-FILES> <PRIN1 "RETURN-FILES">)
 115               (<==? .F-OR-D ,RETURN-DIRS> <PRIN1 "RETURN-DIRS">)
 116               (T <PRIN1 "RETURN-ALL">)>>
 117
 118 <DEFINE GNJFN-NAME (CH:CHANNEL OP:ATOM "OPT" (WHICH *37*)
 119                     "AUX" (CHAN-DAT:GNJFN-DATA <CHANNEL-DATA .CH>))
 120    <COND (<NOT <EMPTY? <GN-BUF .CHAN-DAT>>>
 121           <3 <GN-DIRSNM .CHAN-DAT> <GNJFN-NM1 .CH .OP>>
 122           <4 <GN-DIRSNM .CHAN-DAT> <GNJFN-NM2 .CH .OP>>
 123           <I$UNPARSE-SPEC!-INTERNAL <GN-DIRSNM .CHAN-DAT> .WHICH>)>>
 124
 125 <DEFINE GNJFN-SHORT-NAME (CH:CHANNEL OP
 126                           "AUX" (DAT:GNJFN-DATA <CHANNEL-DATA .CH>)
 127                           (BUF <GN-BUF .DAT>))
 128    <I$STD-STRING!-INTERNAL <REST .BUF 8> T
 129                            <REST .BUF <+ 8 <NAME-LEN .BUF>>>>>
 130
 131 <DEFINE GNJFN-DEV (CH:CHANNEL OP
 132                    "AUX" (NM-INFO <GN-DIRSNM <CHANNEL-DATA .CH>:GNJFN-DATA>))
 133         <COND (<==? <1 .NM-INFO> T> <PARSE-DIR <> <> .NM-INFO <> <>>)>
 134         <1 .NM-INFO>>
 135
 136 <DEFINE GNJFN-SNM (CH:CHANNEL OP
 137                    "AUX" (NM-INFO <GN-DIRSNM <CHANNEL-DATA .CH>:GNJFN-DATA>))
 138         <COND (<==? <2 .NM-INFO> T> <PARSE-DIR <> <> .NM-INFO <> <>>)>
 139         <2 .NM-INFO>>
 140
 141 <DEFINE GNJFN-NM1 (CH:CHANNEL OP
 142                    "AUX" NAME:STRING NAME2:<OR STRING FALSE>
 143                    (DAT:GNJFN-DATA <CHANNEL-DATA .CH>) (BUF <GN-BUF .DAT>)
 144                    (LEN <NAME-LEN .BUF>))
 145    <COND (<AND <SET NAME2 <MEMQ !\. <REST .BUF 8>>>
 146                <G? <LENGTH .NAME2> <- <LENGTH .BUF> 8 .LEN>>>
 147           <SET NAME <I$STD-STRING!-INTERNAL <REST .BUF 8> T
 148                                   .NAME2>>)
 149          (T
 150           <SET NAME <I$STD-STRING!-INTERNAL <REST .BUF 8> T
 151                                             <REST .BUF <+ 8 .LEN>>>>)>
 152    .NAME>
 153
 154 <DEFINE GNJFN-NM2 (CH:CHANNEL OP
 155                    "AUX" NAME:<OR FALSE STRING> NAME2:<OR FALSE STRING>
 156                    (DAT:GNJFN-DATA <CHANNEL-DATA .CH>) (BUF <GN-BUF .DAT>)
 157                    (LEN <NAME-LEN .BUF>))
 158    <COND (<AND <SET NAME2 <MEMQ !\. <REST .BUF 8>>>
 159                <G? <LENGTH .NAME2> <- <LENGTH .BUF> 8 .LEN>>>
 160           <I$STD-STRING!-INTERNAL <REST .NAME2> T
 161                                   <REST .BUF <+ 8 .LEN>>>)>>
 162
 163 <DEFINE GNJFN-DIR (CH:CHANNEL OP) <GN-DIR <CHANNEL-DATA .CH>:GNJFN-DATA>>
 164
 165 <DEFINE GNJFN-DIR? (CH:CHANNEL OP
 166                     "AUX" FILE:<OR FALSE STRING>
 167                           (CHAN-DAT:GNJFN-DATA <CHANNEL-DATA .CH>)
 168                           (BUF:STRING <GN-BUF .CHAN-DAT>) (LEN <NAME-LEN .BUF>)
 169                           (TF <GET-BUFFER>) FILE:STRING DLEN VAL)
 170    <SET FILE <SUBSTRUC .BUF 8 .LEN <REST .TF <- 511 .LEN>>>>
 171    <512 .TF <ASCII 0>>
 172    <COND (<GN-DIR? .CHAN-DAT>
 173           <SET FILE <SUBSTRUC <GN-DIR .CHAN-DAT> 0
 174                               <SET DLEN <LENGTH <GN-DIR .CHAN-DAT>>>
 175                               <BACK .FILE <+ .DLEN 1>>>>
 176           <PUT .FILE <+ .DLEN 1> !\/>)>
 177    <SET VAL
 178         <NOT <0? <ANDB <STAT-FIELD <FILE-STAT .FILE>:STRING
 179                                    9
 180                                    2>
 181                        16384>>>>
 182    <FREE-BUFFER .TF>
 183    .VAL>
 184
 185 <DEFINE GNJFN-NEXT-FILE (CH:CHANNEL OP
 186                          "AUX" (CHAN-DAT:GNJFN-DATA <CHANNEL-DATA .CH>))
 187         <GET-NEXT-FILE .CHAN-DAT>>
 188
 189 <DEFINE GNJFN-CLOSE (CH:CHANNEL OP)
 190    <FREE-BUFFER <GN-BUF <CHANNEL-DATA .CH>:GNJFN-DATA>>
 191    <CLOSE <GN-CHAN <CHANNEL-DATA .CH>:GNJFN-DATA>>>
 192
 193 <DEFINE GET-NEXT-FILE (CHAN-DAT:GNJFN-DATA
 194                        "AUX" F-OR-D:FIX BUF:STRING STR:STRING FNAME
 195                              EN-LNTH:FIX FLNTH:FIX
 196                              CHAN:<CHANNEL 'DISK> F?
 197                              FILE:STRING (NMBUF:<OR STRING FALSE> <>))
 198    <SET STR <GN-STRING .CHAN-DAT>>
 199    <SET BUF <GN-BUF .CHAN-DAT>>
 200    <SET BUF <REST .BUF <ENTRY-LEN .BUF>>>
 201    ; "Rest off previous match"
 202    <SET F-OR-D <GN-RET .CHAN-DAT>>
 203    <REPEAT ()
 204      <COND (<EMPTY? .BUF>
 205             <GN-BUF .CHAN-DAT .BUF>
 206             <SET CHAN <GN-CHAN .CHAN-DAT>>
 207             <SET BUF <TOP .BUF>>
 208             <COND (<==? <CHANNEL-OP .CHAN READ-BUFFER .BUF> 0>
 209                    <COND (.NMBUF <FREE-BUFFER .NMBUF>)>
 210                    <RETURN #FALSE ("NO MORE MATCHING FILES")>)
 211                   (T <GN-BUF .CHAN-DAT .BUF>)>)>
 212      <SET EN-LNTH
 213           <ENTRY-LEN .BUF>>
 214      <SET FLNTH
 215           <NAME-LEN .BUF>>
 216      <COND (<NOT .NMBUF> <SET NMBUF <GET-BUFFER>>)>
 217      <SET FNAME
 218           <SUBSTRUC .BUF 8 .FLNTH <REST .NMBUF
 219                                         <- 512 .FLNTH 1>>>>
 220      <512 .NMBUF <ASCII 0>>
 221      <COND
 222       (<NOT <==? .F-OR-D ,RETURN-ALL>>
 223        <COND (<GN-DIR? .CHAN-DAT>
 224               <SET FILE
 225                    <SUBSTRUC <GN-DIR .CHAN-DAT>
 226                              0
 227                              <LENGTH <GN-DIR .CHAN-DAT>>
 228                              <BACK .FNAME <+ 1 <LENGTH <GN-DIR .CHAN-DAT>>>>>>
 229               <PUT .FILE <+ 1 <LENGTH <GN-DIR .CHAN-DAT>>> !\/>)
 230              (T <SET FILE .FNAME>)>
 231        <SET F? <0? <ANDB <STAT-FIELD <FILE-STAT .FILE>:STRING 9 2> 16384>>>
 232        <COND (<OR <AND <==? .F-OR-D ,RETURN-DIRS> .F?>
 233                   <AND <==? .F-OR-D ,RETURN-FILES> <NOT .F?>>>
 234               <SET BUF <REST .BUF <MIN .EN-LNTH <LENGTH .BUF>>>>
 235               <AGAIN>)>)>
 236      <GN-BUF .CHAN-DAT .BUF>
 237      <COND (<MATCH? .CHAN-DAT>
 238             <COND (.NMBUF <FREE-BUFFER .NMBUF>)>
 239             <RETURN T>)
 240            (T
 241             <SET BUF <REST .BUF <MIN .EN-LNTH <LENGTH .BUF>>>>)>>>
 242
 243 <DEFINE MATCH? (CHAN-DAT:GNJFN-DATA "AUX" (BUF:STRING <GN-BUF .CHAN-DAT>)
 244                 (STR:STRING <GN-STRING .CHAN-DAT>) (SLNTH:FIX <LENGTH .STR>)
 245                 (FLEN:FIX <NAME-LEN .BUF>) CHECK
 246                 (FPLACE 1) (FLAG T) (FLAG2 <>))
 247      <SET BUF <REST .BUF 8>>
 248      <OR <AND <==? .SLNTH 1> <==? <1 .STR> !\*>>
 249          <REPEAT ()
 250             <COND (<EMPTY? .STR>
 251                    <COND (<G? .FPLACE .FLEN> <RETURN>)
 252                          (T <SET STR .CHECK>)>)
 253                   (<==? <1 .STR> !\*>
 254                    <COND (.FLAG <SET FLAG <>>)>
 255                    <COND (<==? <LENGTH .STR> 1>
 256                           <COND (.FLAG2 <RETURN>) (T <RETURN <>>)>)
 257                          (T
 258                           <SET STR <REST .STR>>
 259                           <COND (.FLAG2 <SET FLAG2 <>>)>)>)
 260                   (<G? .FPLACE .FLEN>
 261                    <COND (.FLAG2
 262                           <COND (<EMPTY? .STR> <RETURN T>)
 263                                 (T <RETURN <>>)>)
 264                          (T <RETURN <>>)>)
 265                   (<==? <NTH .BUF .FPLACE> <1 .STR>>
 266                    <COND (.FLAG2)
 267                          (T <SET FLAG2 T> <SET CHECK .STR>)>
 268                    <SET STR <REST .STR>>
 269                    <SET FPLACE <+ 1 .FPLACE>>)
 270                   (.FLAG <RETURN <>>)
 271                   (.FLAG2
 272                    <SET FLAG2 <>>
 273                    <SET STR .CHECK>
 274                    <SET FPLACE <+ 1 .FPLACE>>)
 275                   (T <SET FPLACE <+ 1 .FPLACE>>)>>>>
 276
 277 <GDECL (BUFFERS) <VECTOR [REST STRING]>>
 278
 279 <DEFINE GET-BUFFER ("AUX" BUF)
 280    <COND (<NOT <GASSIGNED? BUFFERS>>
 281           <SETG BUFFERS <REST <IVECTOR 3 ""> 3>>)>
 282    <COND (<EMPTY? ,BUFFERS>
 283           <ISTRING 512>)
 284          (T
 285           <SET BUF <TOP <1 ,BUFFERS>>>
 286           <SETG BUFFERS <REST ,BUFFERS>>
 287           .BUF)>>
 288
 289 <DEFINE FREE-BUFFER (BUF:STRING)
 290    <COND (<==? <LENGTH ,BUFFERS> 3>)
 291          (T
 292           <SETG BUFFERS <BACK ,BUFFERS>>
 293           <1 ,BUFFERS .BUF>
 294           T)>>
 295
 296 <ENDPACKAGE>