DISPATCHER Corrected - oops

> Can you show me the simplest full example of what is required? One
> that I can run and test against?

The following won't compile - stack underflow. To compile, I commented
out the line with CB: as well as ABORTPROC in SET-ABORT-PROC

-----------------------------------------------------------

Function: SetAbortProc ( hDCprt abortProc -- res )

CLASS PRT-FOO

   PRINTDIALOG BUILDS prtdlg

   VARIABLE ABORT-PRINT?

   \ Classic Printer Abort Procedure
   : AbrtProc ( hDCprt error -- flag ) \ True = Continue
      2DROP ( hDC error )
      BEGIN WINMSG 0 0 0 PM_REMOVE :: PeekMessage
      WHILE WINMSG :: TranslateMessage DROP
             WINMSG :: DispatchMessage DROP
      REPEAT ABORT-PRINT? @ NOT ;

   ['] AbrtProc 2 CB: ABORTPROC <<<<<<<< THIS DIES!!!

   : SET-ABORT-PROC
      prtdlg DC @ ABORTPROC :: SetAbortProc DROP ;

   : DEFAULT-PRINTER ( -- )
      0 prtdlg DevMode ! 0 prtdlg DevNames !
      PD_RETURNDC PD_RETURNDEFAULT OR prtdlg Flags !
      PRINTDIALOG SIZEOF prtdlg StructSize !
      prtdlg ADDR :: PrintDlg 0= IOR_PRT_NODEFPRINTER ?THROW ;

   : CONSTRUCT ( -- )
     DEFAULT-PRINTER
     SET-ABORT-PROC
     ( Actual Printing )
     ;

END-CLASS

----------------------------------------------------------------

Mike

----------------------------------------------------------------------
sftalk_at_forth.com The SwiftForth programming discussion email list
To unsubscribe, send subject "unsubscribe sftalk" to listar_at_forth.com
For help with listar commands, send subject "help" to listar_at_forth.com
Archives are located at http://www.forth.com/sftalk -- check them out!
Received on Fri Mar 30 2001 - 19:35:45 PST