mim/development/mim/vax/vs/vsbase.mud

   1 <PACKAGE "VSBASE">
   2
   3 <ENTRY SEND-PACKET RECEIVE-PACKET VSB-SEND VSB-DUMP VSB-WAIT>
   4
   5 <ENTRY PROCESS-EVENT NORMAL-KEYS FUNCTION-KEYS GET-EVENT FREE-MOUSE-EVENTS
   6        FREE-WINDOW-EVENTS ANY-INPUT? MOUSE-GRABBED? REDISPLAY-ICON
   7        FREE-RECTANGLES>
   8
   9 <USE "NETBASE">
  10
  11 <INCLUDE "VSTYPES" "VSUTYPES">
  12 <INCLUDE-WHEN <COMPILING? "VSBASE"> "VSDEFS" "VSUDEFS">
  13
  14 <SETG SEND-PACKET <IUVECTOR 6>>
  15 <SETG RECEIVE-PACKET <IUVECTOR 6>>
  16 <GDECL (SEND-PACKET RECEIVE-PACKET) <UVECTOR [6 FIX]>>
  17
  18 <DEFINE VSB-SEND (VS:VS FORCE?:<OR ATOM FALSE> REPLY?:<OR ATOM FIX FALSE>
  19                   "TUPLE" STUFF
  20                   "AUX" (CHN:<CHANNEL 'NETWORK> <VS-CHANNEL .VS>)
  21                   (RES:<OR FIX FALSE> 0))
  22    <VS-REQ .VS <+ <VS-REQ .VS> 1>>
  23    <COND (<OR <NOT <VS-BUFFER .VS>>
  24               <AND .FORCE? <0? <VS-BCT .VS>>>>
  25           <COND (<AND <CHANNEL-OP .CHN WRITE-BUFFER !.STUFF> .REPLY?>
  26                  <VSB-WAIT .VS .REPLY?>)>)
  27          (T
  28           <REPEAT (OBJ:<OR <PRIMTYPE STRING> <PRIMTYPE UVECTOR>>
  29                    LEN:<OR FIX FALSE> NRES)
  30              <COND (<EMPTY? .STUFF>
  31                     <COND (.FORCE?
  32                            <COND (<VSB-DUMP .VS>
  33                                   <COND (.REPLY?
  34                                          <RETURN <VSB-WAIT .VS .REPLY?>>)>
  35                                   <RETURN .RES>)
  36                                  (T <RETURN .NRES>)>)>
  37                     <RETURN .RES>)>
  38              <SET OBJ <1 .STUFF>>
  39              <COND (<==? <LENGTH .STUFF> 1>
  40                     <SET LEN <>>
  41                     <SET STUFF <REST .STUFF>>)
  42                    (T
  43                     <SET LEN <2 .STUFF>>
  44                     <SET STUFF <REST .STUFF 2>>)>
  45              <COND (<SET NRES <STUFF .OBJ .LEN .VS>>
  46                     <SET RES <+ .RES .NRES>>)
  47                    (T
  48                     <RETURN .NRES>)>>)>>
  49
  50 <DEFINE STUFF ST (OBJ:<OR <PRIMTYPE STRING> <PRIMTYPE UVECTOR>>
  51                LEN:<OR FIX FALSE> VS:VS "AUX" (BUF:STRING <VS-BUFFER .VS>)
  52                (CT <VS-BCT .VS>) NOBJ:STRING RES NRES
  53                (CH:<CHANNEL 'NETWORK> <VS-CHANNEL .VS>))
  54    <COND (<==? <ANDB <CALL TYPE .OBJ> *7*> 6>
  55           <COND (.LEN
  56                  <SET RES .LEN>
  57                  <SET LEN <* 4 .LEN>>)
  58                 (T
  59                  <SET RES <LENGTH .OBJ:<PRIMTYPE UVECTOR>>>
  60                  <SET LEN <* 4 .RES>>)>
  61           <SET NOBJ <CALL OBJECT <TYPE-C STRING>
  62                           <* 4 <LENGTH .OBJ:<PRIMTYPE UVECTOR>>>
  63                           <CALL VALUE .OBJ>>>)
  64          (T
  65           <COND (.LEN
  66                  <SET RES .LEN>)
  67                 (T
  68                  <SET RES <SET LEN <LENGTH .OBJ:<PRIMTYPE STRING>>>>)>
  69           <SET NOBJ <CHTYPE .OBJ:<PRIMTYPE STRING> STRING>>)>
  70    <COND (<AND <G? .LEN <LENGTH .BUF>> <NOT <0? .CT>>>
  71           <COND (<NOT <SET NRES <VSB-DUMP .VS>>>
  72                  <RETURN .NRES .ST>)>
  73           <SET BUF <VS-BUFFER .VS>>
  74           <SET CT 0>)>
  75    <COND (<G? .LEN <LENGTH .BUF>>
  76           <COND (<CHANNEL-OP .CH WRITE-BUFFER .NOBJ .LEN> .RES)>)
  77          (T
  78           <SUBSTRUC .NOBJ 0 .LEN .BUF>
  79           <VS-BUFFER .VS <REST .BUF .LEN>>
  80           <VS-BCT .VS <+ .CT .LEN>>
  81           .RES)>>
  82
  83 <DEFINE VSB-DUMP (VS:VS "AUX" (CHN:<CHANNEL 'NETWORK> <VS-CHANNEL .VS>)
  84                   (BUF:STRING <VS-BUFFER .VS>) (CT:FIX <VS-BCT .VS>))
  85    <COND (<G? .CT 0>
  86           <COND (<CHANNEL-OP .CHN WRITE-BUFFER <SET BUF <VS-BUFFER-TOP .VS>>
  87                              .CT>
  88                  <VS-BUFFER .VS .BUF>
  89                  <VS-BCT .VS 0>)>)
  90          (T)>>
  91
  92 <DEFINE VSB-WAIT (VS:VS "OPT" (RACT <>) (NOT-REALLY?:<OR ATOM FALSE> <>)
  93                   "AUX" (CH:<CHANNEL 'NETWORK> <VS-CHANNEL .VS>) (ANY? <>)
  94                   (P:UVECTOR ,RECEIVE-PACKET) (REQ <VS-REQ .VS>) CODE)
  95    <PROG (RES)
  96       <COND (.NOT-REALLY?
  97              <SET RES <AND <CHANNEL-OP .CH INPUT-WAITING>
  98                            <CHANNEL-OP .CH READ-BUFFER .P>>>)
  99             (T
 100              <SET RES <CHANNEL-OP .CH READ-BUFFER .P>>)>
 101       <COND
 102        (.RES
 103         <COND (<==? <SET CODE <VSI-CODE .P>> ,X-ERROR>
 104                ; "Error packet"
 105                <COND (<OR <NOT .RACT>
 106                           <N==? <I-LPAR0 .P> .REQ>>
 107                       ; "Out-of-band error"
 108                       <VSB-REPORT-ERROR .VS .P>
 109                       ; "Report, then try again"
 110                       <AGAIN>)
 111                      (T
 112                       ; "Error in response to request, so return it"
 113                       <CHTYPE (<I-SPAR2 .P> <I-SPAR3 .P>
 114                                <NTH ,VS-ERRORS <I-SPAR2 .P>>) FALSE>)>)
 115               (<==? .CODE ,X-REPLY>
 116                <COND (<NOT .RACT>
 117                       <AGAIN>)
 118                      (<==? .RACT ERROR>)
 119                      (<==? .RACT T> .P)
 120                      (<==? .RACT STRING>
 121                       <PROG ((LEN <I-SPAR0 .P>) ST:STRING)
 122                          <COND (<NOT <GASSIGNED? RANDOM-STRING>>
 123                                 <SET ST <SETG RANDOM-STRING <ISTRING .LEN>>>)
 124                                (<L? <LENGTH <SET ST ,RANDOM-STRING>> .LEN>
 125                                 <SET ST <SETG RANDOM-STRING <ISTRING .LEN>>>)
 126                                (<G? <LENGTH .ST> .LEN>
 127                                 <SET ST <REST .ST <- <LENGTH .ST> .LEN>>>)>
 128                          <CHANNEL-OP .CH READ-BUFFER .ST>
 129                          .ST>)
 130                      (<==? .RACT 1> <I-LPAR0 .P>)
 131                      (T <I-SPAR0 .P>)>)
 132               (.RACT
 133                <PROCESS-EVENT .VS .P>
 134                <AGAIN>)
 135               (T
 136                <COND (<NOT <PROCESS-EVENT .VS .P>> <AGAIN>)
 137                      (T
 138                       <SET ANY? T>
 139                       ; "This hack enables optimization of mouse-moved events"
 140                       <COND (.NOT-REALLY? <AGAIN>)>)>)>)
 141        (<=? .RES #FALSE(4)>
 142         <AGAIN>)
 143        (.NOT-REALLY?
 144         .ANY?)
 145        (T
 146         <ERROR VS100-CONNECTION-DIED!-ERRORS .CH VSB-WAIT>
 147         <AGAIN>)>>>
 148
 149 <DEFINE VSB-REPORT-ERROR (VS:VS PACKET:UVECTOR)
 150    <COND (<TYPE? <INTERRUPT "VS-ERROR" .VS <I-SPAR2 .PACKET>
 151                             <I-SPAR3 .PACKET> <I-LPAR0 .PACKET>>
 152                  DISMISS>)
 153          (T
 154           <ERROR RANDOM-ERROR-FROM-X!-ERRORS
 155                  <NTH ,VS-ERRORS <I-SPAR2 .PACKET>>
 156                  <I-SPAR3 .PACKET>
 157                  <I-LPAR0 .PACKET>
 158                  .VS>)>>
 159 \f
 160 <GDECL (FREE-MOUSE-EVENTS) <LIST [REST MOUSE-EVENT]>
 161        (FREE-WINDOW-EVENTS) <LIST [REST WINDOW-EVENT]>
 162        (FREE-RECTANGLES) <LIST [REST WE-RECTANGLE]>>
 163 <COND (<NOT <GASSIGNED? FREE-MOUSE-EVENTS>>
 164        <SETG FREE-MOUSE-EVENTS ()>
 165        <SETG FREE-WINDOW-EVENTS ()>
 166        <SETG FREE-CELLS ()>
 167        <SETG FREE-RECTANGLES ()>)>
 168
 169 <DEFINE PROCESS-EVENT PE (VS:VS P:UVECTOR "AUX" WID:FIX (SW:ANY <>)
 170                        W:<OR VSCHAN FALSE> ML KIND:FIX (OUT <>) TL:<OR LIST FALSE>
 171                        ME:MOUSE-EVENT WE:WINDOW-EVENT MB:FIX VW:VSW NME
 172                        OWE:<OR WINDOW-EVENT FALSE>)
 173    <COND (<==? <SET KIND <VSI-KIND .P>> ,KEY-RELEASED>
 174           <RETURN <> .PE>)>
 175    <COND (<NOT <0? <SET WID <VSI-SUBWINDOW .P>>>>
 176           <COND (<NOT <SET W <GET-WINDOW .VS .WID>>>
 177                  <SET SW .WID>
 178                  <SET WID <VSI-WINDOW .P>>
 179                  <SET W <GET-WINDOW .VS .WID>>)>)
 180          (T
 181           <SET W <GET-WINDOW .VS <VSI-WINDOW .P>>>)>
 182    <COND
 183     (<AND .W
 184           <CHANNEL-OPEN? .W>
 185           <OR <N==? .W <VS-TOPCHAN .VS>>
 186               <AND <ASSIGNED? MOUSE-GRABBED?>
 187                    .MOUSE-GRABBED?>>>
 188      <COND
 189       (<AND .SW <NOT <EMPTY? <SET ML <VW-MENU-WINDS <CHANNEL-DATA .W>:VSW>>>>>
 190        <REPEAT ()
 191           <COND (<==? <MW-ID <1 .ML>> .SW>
 192                  <SET SW <1 .ML>>
 193                  <RETURN>)>
 194           <COND (<EMPTY? <SET ML <REST .ML>>> <RETURN>)>>)>
 195      <COND
 196       (<==? .KIND ,KEY-PRESSED>
 197        <COND
 198         (<SET OUT <TRANSLATE-KEY .VS
 199                                  <ANDB <VSI-DETAIL .P>
 200                                        %<XORB <ORB ,X-LEFT-MASK
 201                                                    ,X-MIDDLE-MASK
 202                                                    ,X-RIGHT-MASK>
 203                                               -1>>>>
 204          <COND (<EMPTY? <SET TL ,FREE-CELLS>>
 205                 <SET OUT (.OUT)>)
 206                (T
 207                 <SETG FREE-CELLS <REST .TL>>
 208                 <1 .TL .OUT>
 209                 <SET OUT .TL>
 210                 <PUTREST .TL ()>)>)
 211         (<RETURN <> .PE>)>)
 212       (<OR <==? .KIND ,BUTTON-PRESSED>
 213            <==? .KIND ,BUTTON-RELEASED>>
 214        <SET ME <NULL-MOUSE-EVENT>>
 215        <SET MB <ANDB <VSI-DETAIL .P> *377*>>
 216        <ME-KIND .ME <COND (<==? .KIND ,BUTTON-PRESSED>
 217                            <COND (<0? .MB> ,ME-RIGHT-PRESSED)
 218                                  (<1? .MB> ,ME-MIDDLE-PRESSED)
 219                                  (T ,ME-LEFT-PRESSED)>)
 220                           (<0? .MB>
 221                            ,ME-RIGHT-RELEASED)
 222                           (<1? .MB>
 223                            ,ME-MIDDLE-RELEASED)
 224                           (T ,ME-LEFT-RELEASED)>>
 225        <ME-STATE .ME <LSH <VSI-DETAIL .P> -8>>
 226        <ME-X .ME <VSI-X .P>>
 227        <ME-Y .ME <VSI-Y .P>>
 228        <ME-TIME .ME <VSI-TIME .P>>
 229        <ME-WINDOW .ME .W>
 230        <ME-SUBWINDOW .ME .SW>
 231        <ME-LOCATOR .ME <I-LPAR4 .P>>
 232        <VS-LAST-MOUSE .VS .ME>
 233        <SET OUT <1 <ME-CELL .ME> .ME>>)
 234       (<AND <==? .KIND ,MOUSE-MOVED>
 235             <SET NME <VS-LAST-MOUSE .VS>>
 236             <==? <ME-KIND .NME> ,ME-MOVED>>
 237        <ME-X .NME <VSI-X .P>>
 238        <ME-Y .NME <VSI-Y .P>>)
 239       (<OR <==? .KIND ,MOUSE-MOVED>
 240            <==? .KIND ,ENTER-WINDOW>
 241            <==? .KIND ,LEAVE-WINDOW>>
 242        <COND (<==? <ANDB <VSI-DETAIL .P> *377*> 2>
 243               ; "Intermediate event when moving around hierarchy"
 244               <RETURN <> .PE>)>
 245        <SET ME <NULL-MOUSE-EVENT>>
 246        <ME-KIND .ME <COND (<==? .KIND ,MOUSE-MOVED>
 247                            ,ME-MOVED)
 248                           (<==? .KIND ,ENTER-WINDOW>
 249                            ,ME-ENTER-WINDOW)
 250                           (T
 251                            ,ME-LEAVE-WINDOW)>>
 252        <ME-STATE .ME <LSH <VSI-DETAIL .P> -8>>
 253        <ME-X .ME <VSI-X .P>>
 254        <ME-Y .ME <VSI-Y .P>>
 255        <ME-TIME .ME <VSI-TIME .P>>
 256        <ME-WINDOW .ME .W>
 257        <ME-SUBWINDOW .ME .SW>
 258        <ME-LOCATOR .ME <I-LPAR4 .P>>
 259        <VS-LAST-MOUSE .VS .ME>
 260        <SET OUT <1 <ME-CELL .ME> .ME>>)
 261       (<==? .KIND ,UNMAP-WINDOW>
 262        <SET WE <NULL-WINDOW-EVENT>>
 263        <WE-KIND .WE ,WE-UNMAP-WINDOW>
 264        <WE-WINDOW .WE .W>
 265        <WE-SUBWINDOW .WE .SW>
 266        <VW-REDISPLAY <CHANNEL-DATA .W:CHANNEL>:VSW <>>
 267        <ADD-CHANGE .WE 0 0 0 0>
 268        <SET OUT <1 <WE-CELL .WE> .WE>>)
 269       (<AND <OR <==? .KIND ,EXPOSE-WINDOW>
 270                 <==? .KIND ,EXPOSE-REGION>
 271                 <==? .KIND ,EXPOSE-COPY>>
 272             <N==? .W <VS-TOPCHAN .VS>>>
 273        <COND (<COND (<AND <TYPE? .SW MENU-WINDOW>
 274                           <TEST-VW-MODE <MW-BITS .SW> ,VWM-UNSEEN>>
 275                      <MW-BITS .SW <ANDB <MW-BITS .SW>
 276                                         <XORB ,VWM-UNSEEN -1>>>)
 277                     (<AND .W
 278                           <SET VW <CHANNEL-DATA .W:VSCHAN>>
 279                           <TEST-VW-MODE <VW-OUTMODE .VW> ,VWM-UNSEEN>>
 280                      <VW-OUTMODE .VW <ANDB <VW-OUTMODE .VW>
 281                                            <XORB ,VWM-UNSEEN -1>>>)>
 282               ; "Discard exposed events for new windows..."
 283               <RETURN <> .PE>)>
 284        <COND (<NOT <SET OWE <VW-REDISPLAY <SET VW <CHANNEL-DATA .W>>>>>
 285               <SET WE <NULL-WINDOW-EVENT>>)
 286              (T
 287               <SET WE .OWE>)>
 288        <COND (<==? .KIND ,EXPOSE-WINDOW>
 289               <COND (.OWE
 290                      ; "If full redisplay, we can nuke previous saved
 291                         events"
 292                      <VW-REDISPLAY .VW <>>
 293                      <RECYCLE-RECTANGLES <WE-CHANGES .OWE>>
 294                      <WE-CHANGES .OWE ()>)>
 295               <COND (<OR <N==? <I-SPAR4 .P> <VW-WIDTH .VW>>
 296                          <N==? <I-SPAR5 .P> <VW-HEIGHT .VW>>>
 297                      <SET KIND ,WE-RESIZE-WINDOW>
 298                      <WE-OLDH .WE <VW-HEIGHT .VW>>
 299                      <WE-OLDW .WE <VW-WIDTH .VW>>
 300                      <VW-WIDTH .VW <I-SPAR4 .P>>
 301                      <VW-HEIGHT .VW <I-SPAR5 .P>>)
 302                     (T
 303                      <SET KIND ,WE-EXPOSE-WINDOW>)>
 304               <ADD-CHANGE .WE 0 0 <VW-WIDTH .VW> <VW-HEIGHT .VW>>)
 305              (<==? .KIND ,EXPOSE-COPY>
 306               <SET KIND ,WE-EXPOSE-COPY>
 307               <COND (.OWE
 308                      <VW-REDISPLAY .VW <>>
 309                      <SET WE <NULL-WINDOW-EVENT>>)>
 310               <ADD-CHANGE .WE <I-SPAR8 .P> <I-SPAR9 .P>
 311                           <I-SPAR4 .P> <I-SPAR5 .P>>)
 312              (T
 313               <SET KIND ,WE-EXPOSE-REGION>
 314               ; "Remember this guy in case we need to catch some events later"
 315               <VW-REDISPLAY .VW .WE>
 316               <ADD-CHANGE .WE <I-SPAR8 .P> <I-SPAR9 .P>
 317                           <I-SPAR4 .P> <I-SPAR5 .P>>)>
 318        <COND (.OWE
 319               ; "This event is already on the queue, so don't return it"
 320               <WE-KIND .OWE .KIND>
 321               <SET OUT <>>)
 322              (T
 323               <WE-KIND .WE .KIND>
 324               <WE-WINDOW .WE .W>
 325               <WE-SUBWINDOW .WE .SW>
 326               <SET OUT <1 <WE-CELL .WE> .WE>>)>)>
 327      <COND (.OUT
 328             <COND (<EMPTY? <SET TL <VS-ILIST .VS>>>
 329                    <VS-IBUFFER .VS .OUT>
 330                    <VS-ILIST .VS .OUT>)
 331                   (T
 332                    <PUTREST .TL .OUT>
 333                    <VS-ILIST .VS <REST .TL>>)>)>)>>
 334
 335 <DEFINE ADD-CHANGE (WE:WINDOW-EVENT TOP:FIX LEFT:FIX WIDTH:FIX HEIGHT:FIX
 336                     "AUX" (L:LIST <WE-CHANGES .WE>) (LL:LIST ,FREE-RECTANGLES)
 337                     REC:WE-RECTANGLE CELL:LIST)
 338    <COND (<EMPTY? .LL>
 339           <SET CELL
 340                (<SET REC <CHTYPE <UVECTOR
 341                                   .TOP .LEFT .WIDTH .HEIGHT>
 342                                  WE-RECTANGLE>>)>)
 343          (T
 344           <SET CELL .LL>
 345           <SETG FREE-RECTANGLES <REST .LL>>
 346           <PUTREST .CELL ()>
 347           <REC-TOP <SET REC <1 .CELL>> .TOP>
 348           <REC-LEFT .REC .LEFT>
 349           <REC-WIDTH .REC .WIDTH>
 350           <REC-HEIGHT .REC .HEIGHT>)>
 351    <WE-CHANGES .WE <PUTREST .CELL .L>>>
 352
 353 <DEFINE RECYCLE-RECTANGLES (L:LIST)
 354    <COND (<NOT <EMPTY? .L>>
 355           <PUTREST <REST .L <- <LENGTH .L> 1>> ,FREE-RECTANGLES>
 356           <SETG FREE-RECTANGLES .L>)>>
 357
 358 <DEFINE ANY-INPUT? (VS:VS)
 359    <OR <NOT <EMPTY? <VS-IBUFFER .VS>>>
 360        <CHANNEL-OP <VS-CHANNEL .VS> INPUT-WAITING>>>
 361
 362 <DEFINE GET-WINDOW (VS:VS WID:FIX "VALUE" <OR VSCHAN FALSE>)
 363   <REPEAT ((L:<LIST [REST FIX VSCHAN]> <VS-ALL .VS>))
 364      <COND (<EMPTY? .L> <RETURN <>>)>
 365      <COND (<==? <1 .L> .WID> <RETURN <2 .L>>)>
 366      <SET L <REST .L 2>>>>
 367
 368 <DEFINE GET-EVENT (VS:VS "OPT" (WAIT?:<OR ATOM FALSE> T)
 369                    "AUX" L TL (W:<OR VSCHAN FALSE> <>) FROB TCHN VW:VSW)
 370    <PROG ()
 371       <COND (<EMPTY? <SET L <VS-IBUFFER .VS>>>
 372              <COND (.WAIT?
 373                     <VSB-DUMP .VS>
 374                     <VSB-WAIT .VS <>>
 375                     <SET L <VS-IBUFFER .VS>>)
 376                    (<NOT <VSB-WAIT .VS <> T>>
 377                     <RETURN <>>)
 378                    (T
 379                     <SET L <VS-IBUFFER .VS>>)>)>
 380       <VS-IBUFFER .VS <SET TL <REST .L>>>
 381       <COND (<EMPTY? .TL>
 382              <VS-ILIST .VS .TL>)>
 383       <COND (<TYPE? <SET FROB <1 .L>> FIX CHARACTER>
 384              <SETG FREE-CELLS <PUTREST .L ,FREE-CELLS>>
 385              .FROB)
 386             (<TYPE? .FROB MOUSE-EVENT>
 387              <COND (<AND <==? <ME-KIND .FROB> ,ME-MOVED>
 388                          <==? .FROB <VS-LAST-MOUSE .VS>>>
 389                     <VSB-WAIT .VS <> T>)>
 390              <COND (<==? .FROB <VS-LAST-MOUSE .VS>>
 391                     <VS-LAST-MOUSE .VS <>>)>
 392              <COND (<CHANNEL-OPEN? <ME-WINDOW .FROB>>
 393                     <ME-CELL .FROB <1 .L 1>>)
 394                    (T
 395                     <1 <SETG FREE-MOUSE-EVENTS
 396                              <PUTREST <ME-CELL .FROB> ,FREE-MOUSE-EVENTS>>
 397                        .FROB>
 398                     <AGAIN>)>)
 399             (<TYPE? .FROB WINDOW-EVENT>
 400              <COND (<CHANNEL-OPEN? <SET TCHN <WE-WINDOW .FROB>>>
 401                     <COND (<VW-REAL <SET VW <CHANNEL-DATA .TCHN:CHANNEL>>:VSW>
 402                            ; "Handle window events for icons"
 403                            <CHANNEL-OP .TCHN:VSCHAN REDISPLAY-ICON>
 404                            <VW-REDISPLAY .VW <>>
 405                            <1 <SETG FREE-WINDOW-EVENTS
 406                                     <PUTREST <WE-CELL .FROB>
 407                                              ,FREE-WINDOW-EVENTS>>
 408                               .FROB>
 409                            <RECYCLE-RECTANGLES <WE-CHANGES .FROB>>
 410                            <AGAIN>)>
 411                     <COND (<==? <VW-REDISPLAY .VW>
 412                                 .FROB>
 413                            <VSB-WAIT .VS <> T>
 414                            <VW-REDISPLAY .VW <>>)>
 415                     <WE-CELL .FROB <1 .L 1>>)
 416                    (T
 417                     <RECYCLE-RECTANGLES <WE-CHANGES .FROB>>
 418                     <1 <SETG FREE-WINDOW-EVENTS
 419                              <PUTREST <WE-CELL .FROB> ,FREE-WINDOW-EVENTS>>
 420                        .FROB>
 421                     <AGAIN>)>)>
 422       .FROB>>
 423
 424 <DEFINE NULL-MOUSE-EVENT ("AUX" (L:LIST ,FREE-MOUSE-EVENTS) ME:MOUSE-EVENT)
 425    <COND (<EMPTY? .L>
 426           <CHTYPE [0 0 0 0 0 ,OUTCHAN <> 0 (1)] MOUSE-EVENT>)
 427          (T
 428           <SET ME <1 .L>>
 429           <ME-CELL .ME <1 .L 1>>
 430           <SETG FREE-MOUSE-EVENTS <REST .L>>
 431           <PUTREST .L ()>
 432           .ME)>>
 433
 434 <DEFINE NULL-WINDOW-EVENT ("AUX" (L:LIST ,FREE-WINDOW-EVENTS) WE:WINDOW-EVENT)
 435    <COND (<EMPTY? .L>
 436           <CHTYPE [0 ,OUTCHAN 0 () (1) 0 0] WINDOW-EVENT>)
 437          (T
 438           <SET WE <1 .L>>
 439           <WE-CELL .WE <1 .L 1>>
 440           <SETG FREE-WINDOW-EVENTS <REST .L>>
 441           <PUTREST .L ()>
 442           .WE)>>
 443
 444 <DEFINE TRANSLATE-KEY (VS:VS DETAIL:FIX "AUX" (KEYNO:FIX <ANDB .DETAIL 255>)
 445                        (MAPS:<OR VECTOR FALSE> <VS-MAPS .VS>)
 446                        MAP KEY:<OR KEY FALSE> NUM:FIX)
 447    <COND (<NOT .MAPS> <>)
 448          (<AND <G=? .KEYNO ,KEY-MIN-SHIFT>
 449                <L=? .KEYNO ,KEY-MAX-SHIFT>>
 450           ; "Throw away shift key events"
 451           <>)
 452          (T
 453           <COND (<AND <G=? .KEYNO ,KEY-MIN-NORM>
 454                       <L=? .KEYNO ,KEY-MAX-NORM>>
 455                  <SET MAP <1 .MAPS>>)
 456                 (T
 457                  <SET MAP <2 .MAPS>>)>
 458           <SET KEYNO <- .KEYNO <1 .MAP> -1>>
 459           <COND
 460            (<AND <L=? .KEYNO <LENGTH <2 .MAP>:VECTOR>>
 461                  <SET KEY <NTH <2 .MAP>:VECTOR .KEYNO>>>
 462             <COND (<NOT <0? <ANDB .DETAIL ,X-CONTROL-MASK>>>
 463                    <COND (<NOT <0? <ANDB .DETAIL ,X-SHIFT-MASK>>>
 464                           <SET NUM <KD-CS .KEY>>)
 465                          (T
 466                           <SET NUM <KD-CTRL .KEY>>)>)
 467                   (<NOT <0? <ANDB .DETAIL ,X-SHIFT-MASK>>>
 468                    <SET NUM <KD-SHIFT .KEY>>)
 469                   (<NOT <0? <ANDB .DETAIL ,X-SHIFT-LOCK-MASK>>>
 470                    <SET NUM <KD-LOCK .KEY>>)
 471                   (T
 472                    <SET NUM <KD-NORM .KEY>>)>
 473             <COND (<G=? .NUM 0> <CHTYPE .NUM CHARACTER>)
 474                   (T <- .NUM>)>)>)>>
 475
 476 <ENDPACKAGE>