mim/development/mim/vax/mimlib/redef.mud

   1 <PACKAGE "REDEF">
   2
   3 <USE "TTY">
   4
   5 <ENTRY REDEF-HANDLER>
   6
   7 <COND (<NOT <GASSIGNED? REDEF-THIS-CHAN>>
   8        <SETG REDEF-THIS-CHAN %<>>
   9        <SETG REDEF? %<>>)>
  10
  11 <DEFINE ERR-REDEF (IGNORE ERR-FRM "TUPLE" ARGS "AUX" NAME CHAR
  12                    (FLOAD-CHAN <COND (<ASSIGNED? LOAD-CHANNEL> .LOAD-CHANNEL)>)
  13                    (INCHAN ,DEBUG-CHANNEL) (OUTCHAN .INCHAN))
  14   #DECL ((ERR-FRM) FRAME (NAME) STRING (CHAR) CHARACTER
  15          (FLOAD-CHAN) <OR CHANNEL FALSE> (INCHAN OUTCHAN) <SPECIAL ANY>)
  16   <COND (<AND <G=? <LENGTH .ARGS> 2>
  17               <==? <2 .ARGS>
  18                    ALREADY-DEFINED-ERRET-NON-FALSE-TO-REDEFINE!-ERRORS>>
  19          <COND (<AND .FLOAD-CHAN <==? ,REDEF-THIS-CHAN .FLOAD-CHAN>>
  20                 <DISMISS ,REDEF? .ERR-FRM>)>
  21          <SET NAME <SPNAME <1 .ARGS>>>
  22          <PRINTSTRING "Redefine ">
  23          <PRINTSTRING .NAME>
  24          <PRINTSTRING " ? ">
  25          <CHANNEL-OP .INCHAN SET-ECHO-MODE T>
  26          <REPEAT ()
  27            <SET CHAR <TYI>>
  28            <COND (<MEMQ .CHAR "YyTt"> <CRLF> <DISMISS T .ERR-FRM>)
  29                  (<MEMQ .CHAR "NnFf"> <CRLF> <DISMISS %<> .ERR-FRM>)
  30                  (<==? .CHAR !\^>
  31                   <CRLF>
  32                   <SETG REDEF-THIS-CHAN .FLOAD-CHAN>
  33                   <SETG REDEF? %<>>
  34                   <DISMISS %<> .ERR-FRM>)
  35                  (<==? .CHAR !\*>
  36                   <CRLF>
  37                   <SETG REDEF-THIS-CHAN .FLOAD-CHAN>
  38                   <SETG REDEF? T>
  39                   <DISMISS T .ERR-FRM>)
  40                  (<MEMQ .CHAR "Rr">
  41                   <CRLF>
  42                   <SET REDEFINE T>
  43                   <DISMISS T .ERR-FRM>)
  44                  (<==? .CHAR !\?>
  45                   <PRINTSTRING "
  46         T or Y  redefine function
  47         F or N  don't redefine function
  48         R       redefine function and <SET REDEFINE T>
  49         *       redefine the rest of the functions from this file
  50         ^       don't redefine any more functions from this file
  51         ?       print this cruft
  52 Redefine ">
  53                   <PRINTSTRING .NAME>
  54                   <PRINTSTRING " ? ">)
  55                  (ELSE
  56                   <CHANNEL-OP .OUTCHAN ERASE-CHAR>
  57                   <CHANNEL-OP .OUTCHAN IMAGE-OUT %<ASCII 7>>
  58                   <CHANNEL-OP .OUTCHAN SET-IMAGE-MODE %<>>
  59                   <CHANNEL-OP .OUTCHAN PAGE-X
  60                               <+ 12 <LENGTH .NAME>>>)>>)>>
  61
  62 <COND (<NOT <FEATURE? "COMPILER">>
  63        <COND (<GASSIGNED? REDEF-HANDLER> <OFF ,REDEF-HANDLER>)>
  64        <SETG REDEF-HANDLER <HANDLER "ERROR" ,ERR-REDEF 1>>
  65        <ON ,REDEF-HANDLER>)>
  66
  67 <ENDPACKAGE>