mim/development/mim/vax/mimlib/eabstr.mud

   1 ;"Implements executable abstr save file with jcl. See abstr.doc."
   2
   3 <USE "JCL" "ABSTR" "PURIFY">
   4
   5 <DEFINE EABSTR ()
   6    <REMOVE EABSTR>
   7    <PURIFY-WORLD>
   8    <SNAME "">
   9    <PROG (JCL:<OR <VECTOR [REST STRING]> FALSE>)
  10       <COND (<AND <=? <SAVE "ABSTR"> "RESTORED">
  11                   <JCLARGS?>
  12                   <SET JCL <PROCESS-JCL <READARGS>>>>
  13              <MAPF <>
  14                    <FUNCTION (NAME:STRING "AUX" RESULT (OUTCHAN:CHANNEL .OUTCHAN))
  15                       <COND (<NOT <SET RESULT <ABSTRACT-PACKAGE .NAME>>>
  16                              <MAPF %<>
  17                                    <FUNCTION (REASON)
  18                                       <CRLF> <PRINC .REASON>>
  19                                    .RESULT>
  20                              <CRLF>)>>
  21                    .JCL>
  22              <EXIT 0>)>
  23       <PRINC "Usage: abstr [-a -i -n -s -d directory] files ...">
  24       <CRLF>
  25       <EXIT 1>>>
  26
  27 <DEFINE PROCESS-JCL (J:<OR <VECTOR [REST STRING]> FALSE>)
  28    <COND (<AND .J <NOT <EMPTY? .J>>>
  29           <REPEAT (ITEM:STRING)
  30              <SET ITEM <1 .J>>
  31              <COND (<AND <NOT <EMPTY? .J>> <==? <1 .ITEM> !\->>
  32                     <COND (<==? <2 .ITEM> !\I>
  33                            <SETG ABSTRACT-IGNORE? T>)
  34                           (<==? <2 .ITEM> !\S>
  35                            <SETG ABSTRACT-NOISY? %<>>)
  36                           (<==? <2 .ITEM> !\N>
  37                            <SETG ABSTRACT-CAREFUL? %<>>)
  38                           (<==? <2 .ITEM> !\A>
  39                            <SETG L-USE-ABSTRACTS? T>
  40                            <SETG L-SECOND-NAMES ["ABSTR" !,L-SECOND-NAMES]>)
  41                           (<AND <==? <2 .ITEM> !\D>
  42                                 <NOT <EMPTY? <SET J <REST .J>>>>>
  43                            <BIND (FN:<CHANNEL 'PARSE>)
  44                               <SET FN <CHANNEL-OPEN PARSE
  45                                                     <STRING <1 .J> "/FOO.BAR">>>
  46                               <SNAME <CHANNEL-OP .FN SNM>>
  47                               <SETG L-SEARCH-PATH
  48                                     ([<SET DEV <CHANNEL-OP .FN DEV>>
  49                                       <SET SNM <CHANNEL-OP .FN SNM>>]
  50                                      !,L-SEARCH-PATH)>>)
  51                           (T
  52                            <RETURN %<>>)>)
  53                    (<NOT <EMPTY? .J>>
  54                     <RETURN .J>)
  55                    (T
  56                     <RETURN %<>>)>
  57              <SET J <REST .J>>>)>>
  58
  59
  60
  61
  62
  63