/* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is the Printers+ front-end.
 *
 * The Initial Developer of the Printers front-end is Acorn Computers Ltd.
 * The Initial Developer of the Printers+ extensions is RISCOS Ltd.
 *
 * Portions created by the Initial Developers are Copyright (C) 2003
 * the Initial Developers. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** */

  /*!RunImage

    All singing, all dancing printer manager.

    Written by Philip Colmer
    Changed subsequently by
       Jonathan Coxhead
    Broken in new and exciting ways for AUN Quantum (#ifdef Sparrow) by
       Chris Marshall

    Here's one using CPP to make various different flavours. CPP macros
    are in "Mixed_Case," to avoid clashes with keywords (upper case) and
    variables (lower case).

    The following may be set on the command line:

      -DUseChoices ensures that we use the Choices structure
      -DDISC       generates a disc version (otherwise a ROM version is made)
      -DTrace      sets tracing (to tube)

    Use C-style comments rather than REM ones! (Cc -E looks at REM
    ones and complains about unbalanced quotation marks.)

    Changes
    26th February 1993 J R C:
    Configure and connections windows are available from the icon bar menu,
        as well as from the Printer control window (user interface
        improvement).
    Configure and connection windows have OK and Cancel, rather than OK
        Close and Back icons (Style Guide compliance).
    Direct drive icon now always present (but sometimes shaded).
    Printer Control window uses multiple icons to convey the information,
        rather than one very wide one for each line. This means that they
        line up when the WIMP font is proportionally spaced.
    Double-click on a prntdefn file => load it into printers, if it is
        runnng. If not, it starts up PrintEdit as before (user interface
        improvement).
    Load only files that are needed for the current configuration. This
        means that start-up time off a network is much less.
    Load all files at start up, into ResourceFS if necessary. This means
        that you do not have to keep on swapping floppy discs.
    Optimisations to more than double printing speed for all background
        printing.
    Printer$Temp now implemented in the "short-circuit" protocol as well: on
        a Message_PrintTypeOdd, you can write a file called <Printer$Temp>,
        with any type, and reply with Message_DataSaveAck: the file will get
        printed instead of the original (programme interface improvement).
    Append to file option: when output is to a file, the file may be
        extended instead of overwritten. Subsequently dragging this file
        back to Printers causes all the output to be done (in the
        background).
    Added background printing for non-text files: output is done to a
        temporary file, then sent to the printer in the background. (This
        means that that the file length changes in the queue window.)

    11th June 1993 PJC:
    Made extra icon bar entries an option
    Made loading double-clicked definition files an option (#def LoadDoubleClickedDefns)
    Fixed removing of connection details for back-end supplied connections

    10th June 1994 SMC:
    Added support for locale specific decimal point character.

    9th Aug 1994 SMC:
    Fixed MED-03395: connection box file name now canonicalised.

    21st Oct 1994 MJS (Project Black)
    Changes for putting !Printers in ROM (#ifndef DISC).
    - 'Back ends' for dp,lj,ps included in RunImage
    - file reading writing paths changed; reading from choices followed by Resources (ROM
      stuff) ; writing to Choices

    30th May 1995 PJC:
    Uncommented FNprinter_read_list_string_entry. Needed by ps back-end.

    20 May 1999 RJW:
    Put turbodriver fixes through.
    
  */

  #include "h.Values"
  #include "h.Trace"

  #define TRUE -1
  #define FALSE 0

  /* if you change these values, you MUST change them in SuppSrcZZ as well */
  #define PrinterBufferSize 1024
  #define PrinterBufferSize2 PrinterBufferSize/2
  #define PrinterBufferSize4 PrinterBufferSize/4

/* TEMP */
#define LoadDoubleClickedDefns

/*#undef ReportErrorLineNumber*/
#define ReportErrorLineNumber

#if defined(DISC) && !defined(UseChoices)
#  define PrintersChoicesWriteDir "<Printers$Dir>"
#else
#  define PrintersChoicesWriteDir "<Choices$Write>.Printers2"
#endif


/* whether strict checking of printer definition files is performed (non-strict means limited support
   of older PDF's with missing fields) */
#define StrictValidatePDF FALSE

  #define BetaWarning FALSE
  #if BetaWarning
  SYS"Wimp_ReportError",CHR$0+CHR$0+CHR$0+CHR$0+"This is a beta-test copy of !Printers. Do not distribute or copy without the written permission of RISCOS Ltd", \
    %110001, "Please note!"
  /* 543210 */
  /* close the error box */
  SYS"Wimp_ReportError",CHR$0+CHR$0+CHR$0+CHR$0+"",%1010010,"Please note!"
  /*                                                6543210 */
  #endif

  #define ExtraIconMenuEntries FALSE
  #define Menu_Info 0
  #if ExtraIconMenuEntries
  # define Menu_PrinterConfigure 1
  # define Menu_PrinterConnection 2
  # define Menu_PrinterControl 3
  # define Menu_QueueControl 4
  # define Menu_EditPaper 5
  # define Menu_SaveChoices 6
  # define Menu_Quit 7
  #else
  # define Menu_PrinterControl 1
  # define Menu_QueueControl 2
  # define Menu_EditPaper 3
  # define Menu_SaveChoices 4
  # define Menu_Quit 5
  #endif

#ifdef Trace
    SYS "XOS_ReadVarVal","Printers$Trace",,-1,,3 TO,,exists%
    IF exists% TRACE TO "<Printers$Trace>"
    /* TRACE 9999 */
    TRACE PROC
    LIBRARY "<Printers$SrcDir>.Unsquished.FTrace"
    PROCftrace_on
    PROCftracef("!Printers")
    trace_back_ends%=TRUE
    ON ERROR ERROR EXT ERR,REPORT$+" ("+STR$ ERL+")"
#else
#  ifdef ReportErrorLineNumber
    ON ERROR ERROR EXT ERR,REPORT$+" ("+STR$ ERL+")"
#  else
    ON ERROR ERROR EXT ERR,REPORT$
#  endif
#endif

  SYS "Hourglass_On"
  Ftracef("DIM A% "+STR$ CONST_interface_MAX+\
      ", A%!CONST_interface_scratch 256, win_buff% 256, "+\
      "evaluation_buff% 256, buff1% 512, task_buff% PrinterBufferSize, "+\
      "icon_buffer% 256, msg_text% 256")
  DIM A% CONST_interface_MAX,A%!CONST_interface_scratch 256,win_buff% 256,\
    evaluation_buff% 256,buff1% 512,task_buff% PrinterBufferSize,icon_buffer% 256,\
    msg_text% 256
  Ftracef("A% = &"+STR$~(A%))
  /*JRC keep interface% in A% at all times (checked in task_poll)*/
  Ftracef("DIM prntctrl_icdf%(4)")
  DIM prntctrl_icdf%(4)
  PROCmsg_initialise("Printers:Messages",A%!CONST_interface_host_desc)

#ifdef Trace
    ON ERROR PROCmsg_end(A%!CONST_interface_host_desc): \
        ERROR EXT ERR,REPORT$+" ("+STR$ ERL+")"
#else
#  ifdef ReportErrorLineNumber
    ON ERROR PROCmsg_end(A%!CONST_interface_host_desc): \
        ERROR EXT ERR,REPORT$+" ("+STR$ ERL+")"
#  else
    ON ERROR PROCmsg_end(A%!CONST_interface_host_desc): \
        ERROR EXT ERR,REPORT$
#  endif
#endif

  PROCinitialise_code

  #ifdef Trace
    Ftracef("DIM test% 64")
    DIM test% 64
    trace_test$=""

    Ftracef("pointer: &"+STR$~test%)

    $(test%+1)="Tested counted string conversion"
    ?test%=LEN $(test%+1)

    CALL Y%,test%,trace_test$ /*convert counted string*/
    Ftracef("ctoz: """+trace_test$+"""")

    $test%="Tested 0-terminated string conversion"
    test%?LEN $test%=0

    CALL Z%,test%,trace_test$ /*convert 0-terminated string*/
    Ftracef("rtoz: """+trace_test$+"""")
  #endif

  #ifdef Trace
  poll_level%=0
  #endif

  PROCtask_initialise(FNmsg_0(A%!CONST_interface_host_desc,"ID"))
  PROCerror_initialise
  PROCicon_initialise
  PROCwin_initialise
  PROCmenu_initialise
  /* SMC: initialise locale specific information */
  PROClocale_initialise

  PROCinitialise_support_libraries /*Now only gets workspace*/
  CALL code_entry%+CONST_entry_heap_initialise
  Ftracef("Heap start @ &"+STR$~(A%!CONST_interface_heap_start))
  PROCsave_initialise
  PROCinitialise /*moved to above the new error handler JRC 8 Mar '92*/

  #ifdef Sparrow
    PROCenumerate_queue_directory
  #endif
  SYS "Hourglass_Off"

  ON ERROR PROCerror

  IF PDF_loading% THEN
    $(task_buff%+44)=PDF_to_load$
    ?(task_buff%+44+LEN(PDF_to_load$))=0:REM 0-terminate it
    PROCadd_to_prdata
  ENDIF

  IF quit_immediately% THEN
    PROCdestroy_queue
    PROChost_shutdown
  ENDIF

  REPEAT
    PROCdespatch_poll(A%!CONST_interface_global_mask)
  UNTIL FALSE
END

DEF PROCdespatch_poll(mask%)
  LOCAL r%,t%,prnt%,cnct%
  Ftracef("PROCdespatch_poll: level "+STR$ poll_level%)
  #ifdef Trace
  poll_level%+=1
  #endif
  r%=FNtask_poll(mask%)
  CASE r% OF
    WHEN 0
      PROCprocess_queue
      PROCdespatch_null
    WHEN 1
      PROCredraw_window
    WHEN 2
      SYS "Wimp_OpenWindow",,task_buff%
    WHEN 3
      PROCclose_window
    WHEN 6
      PROCmouseclick
    WHEN 7
      IF save_dragging% THEN
        PROCsave_decodedrag
      ELSE
        PROCbroadcast_reason_code(selected_prnt%,7,task_buff%)
      ENDIF
    WHEN 8
      PROCkeypress
    WHEN 9
      PROCmenuaction
#ifdef Sparrow
    WHEN 13 /* Pollword non-zero */
      !(task_buff%!0) = 0 /* Change poll word back to zero as soon as poss */
      PROCpollword_changed /* Now go and find out the new state of the world */
#endif
    WHEN 17,18
      Ftrace_Receive(r%,task_buff%)
      PROCreceive(r%)
    WHEN 19
      Ftrace_Receive(19,task_buff%)
      PROCack
    OTHERWISE
      PROCbroadcast_reason_code(selected_prnt%,r%,task_buff%)
  ENDCASE

  /*Get the new timeout value*/
  timeout%=-1
  prnt%=A%!CONST_interface_printer_installed
  WHILE prnt%
    t%=prnt%!CONST_prnt_timeout
    IF NOT t% THEN
      /*This prnt requires nulls - get new timeout% value*/
      IF timeout%=-1 timeout%=t% ELSE IF t%<timeout% timeout%=t%
    ENDIF
    IF timeout%=-1 OR timeout%>100 THEN
      cnct%=prnt%!CONST_prnt_cnct
      IF (cnct%!CONST_cnct_flags AND CONST_cnct_flags_parallel_errors) AND FNparallel_error_detect_possible THEN timeout%=100
    ENDIF
    prnt%=prnt%!CONST_prnt_next
  ENDWHILE
  Ftracef("new timeout is "+STR$ timeout%)
#ifdef Sparrow
  /*
   * We do this operation on the next poll, NOT immediately when we get the
   * service call since ShareFS needs time to get going also!
   */
  CASE freeway_just_started% OF
    WHEN 1
      timeout% += 500
      freeway_just_started% = 2
    WHEN 2
      PROCfreeway_starting
      freeway_just_started% = 0
  ENDCASE
#endif
  #ifdef Trace
  poll_level%-=1
  #endif
ENDPROC

DEF PROCinitialise
#ifdef Sparrow
  LOCAL path$
#endif
  Ftracef("PROCinitialise")
  task_buff%!0=24
  task_buff%!12=0
  task_buff%!16=&80143 /*PrintInit*/
  task_buff%!20=34 /*version*/
  SYS "Wimp_SendMessage",18,task_buff%
  Ftrace_Send(18,task_buff%,0)
  task_your_ref%=task_buff%!8
  PROCinitialise_constants
  PROCinitialise_globals
  PROCcheck_cmdline_args
#ifdef Sparrow
  PROCinitialise_sparrow (TRUE)
#endif

  /*
   * PrinterChoices: path is set as *one* directory (can write to path as well), such that
   * reading/writing choices is appropriate for ordinary or remote printers
   */
  path$ = PrintersChoicesWriteDir
#ifdef Sparrow
  IF multiple_choices% THEN
    path$ += ".Remote"
    SYS "XOS_File", 8, path$
    path$ += ".ID"+unique_string$
    SYS "XOS_File", 8, path$
  ENDIF
#endif
  path$ += "."
  SYS "OS_SetVarVal", "PrinterChoices$Path", path$, LENpath$, 0, 0 /* GSTrans'd NOW! */

  PROCread_paper_file("Printers:PaperRO",CONST_psze_flag_cannotdelete)
  PROCread_paper_file("PrinterChoices:PaperRW",CONST_psze_flag_userdefined)

  IF psize_head%=0 ERROR CONST_error_fatal, FNmsg_0(A%!CONST_interface_host_desc,"FAK")

  PROCinitialise_windows
  /*Get the timeout for Wimp_PollIdle*/
  timeout%=-1: SYS "OS_ReadMonotonicTime" TO time_before%
  PROCinit_detect_protocols
  PROCinitialise_settings
  Ftracef("PROCinitialise done")
ENDPROC

DEF PROCinitialise_constants
  /*define poll masks*/
  Ftracef("PROCinitialise_constants")

#ifdef Sparrow

  /*
   * We *ALWAYS* want to know about poll changed, bits 22 & 23
   *  which includes fast scanning
   */
  /*                              22221111111111
   *                              321098765432109876543210 */
  A%!CONST_interface_global_mask=%110000000001100000110001
  /*             22221111111111
   *             321098765432109876543210*/
  message_mask%=%110000000001100101110011
  click_mask%=  %110000000001100100110001

#else

  A%!CONST_interface_global_mask=%00000001100000110001
  /*                              1111111111
                                  98765432109876543210*/
                   message_mask%=%00000001100101110011
                     click_mask%=%00000001100100110001
#endif

ENDPROC

DEF PROCinitialise_code
  LOCAL h%,l%,a%,w%
  Ftracef("PROCinitialise_code")
  SYS "XOS_File", 8, PrintersChoicesWriteDir
  h%=OPENIN "Printers:Code"
  l%=EXT#h%
  SYS "OS_FSControl",21,h% TO,a%,w%
  CLOSE#h%
  IF(w% AND &FF)=46 THEN
    code_entry%=a%
  ELSE
    Ftracef("DIM code_entry% "+STR$(l%+1))
    DIM code_entry% l%+1
    SYS "OS_File",16,"Printers:Code",code_entry% /*LoadNoPath*/
  ENDIF
  Z%=code_entry%+CONST_entry_rtoz
  Y%=code_entry%+CONST_entry_ctoz
ENDPROC

DEF FNstring(a%)
LOCAL a$
a$=""
WHILE ?a%>=32 AND LEN a$<254
 a$+=CHR$(?a%)
 a%+=1
ENDWHILE
=a$

DEF FNupper(a$)
LOCAL b$,c%
b$=""
WHILE a$<>""
 c%=ASCLEFT$(a$,1)
 a$=MID$(a$,2)
 IF c%>=ASC"a" AND c%<=ASC"z" THEN c%+=ASC"A"-ASC"a"
 b$+=CHR$(c%)
ENDWHILE
=b$

DEF FNskipspace(a%)
WHILE ?a%=32
 a%+=1
ENDWHILE
=a%

DEF PROCcheck_cmdline_args
  LOCAL args%,args1%
  SYS"OS_GetEnv" TO args%
  REM syntax is BASIC -quit progname -pdf filename
  args%=FNskipspace(args%)
  IF FNupper(LEFT$(FNstring(args%),5))="BASIC" THEN
   args%=FNskipspace(args%+5)
   IF FNupper(LEFT$(FNstring(args%),5))="-QUIT" THEN
    args%=FNskipspace(args%+5)
    /* Skip the next thing */
    WHILE ?args%>32
     args%+=1
    ENDWHILE
    args%=FNskipspace(args%)
   ENDIF
  ENDIF
  SYS"OS_ReadArgs","quit/s,pdf/s,/g",args%,buff1%,256
  IF buff1%!4=0 THEN
    PDF_loading%=FALSE
  ELSE
    PDF_loading%=TRUE
  ENDIF
  PDF_to_load$=""
  quit_immediately%=(!buff1%)<>0
  args%=buff1%!8
  IF args%<>0 THEN
    args1%=!args% AND &FFFF
    args%+=2
    WHILE args1%
      PDF_to_load$+=CHR$(?args%)
      args%+=1
      args1%-=1
    ENDWHILE
  ENDIF
ENDPROC

DEF PROCinitialise_globals
  Ftracef("PROCinitialise_globals")
  mm_to_72000=1814.4*72000/(180<<8)
  in_to_72000=72000
  line_space%=44 /*same as a menu*/
  claim_state%=0
  claim_ref%=0
  query_state%=0
  type_state%=0
  psup_head%=0
  printer_count%=0 /*number of actual printers installed*/
  A%!CONST_interface_printer_installed=0
      /*pointer to first installed printer*/
  A%!CONST_interface_printer_active=0 /*number of active printers*/
  selected_prnt%=0
  select_all%=FALSE
  menu_chsn$=""
  menu_prnt%=0
  menued_y%=0
  menued_prnt%=0
  menued_queu%=0
  A%!CONST_interface_nudged_prnt=0
  A%!CONST_interface_nudged_queu=0
  printer_output$="null:"
  prnt_edit%=0
  psup_edit%=0
  A%!CONST_interface_queue_entries=0
  queue_leafname$=""
  A%!CONST_interface_queue_tempfile=FALSE
  queue_temphand%=0
  queue_tempref%=0
  psize_head%=0
  psize_edit%=0
  temp_count%=0
  SYS "OS_Byte",&CC,,255 TO,old_ignore_state%
  file_to_delete$=""
  last_scrap$ = ""
  A%!CONST_interface_serial_buffer=0
  A%!CONST_interface_parallel_buffer=0
#ifdef Sparrow
  sparrow_present%   = FALSE
  remote_printers%  = 0      /* Add into interface structure? FIXME! */
  pollword_location% = 0
  remote_printer_count% = 0
  unique_string$ = ""
  remote_jobno% = 0
  printer_prefix$ = ""
  last_application$ = ""
  last_leafname$ = ""
  dealing_with_a_protocol% = FALSE
  directories_shared% = FALSE
  freeway_just_started% = 0
  multiple_choices% = FALSE
#endif
ENDPROC

DEF PROCinitialise_support_libraries
#if FALSE

  /* this is now done a different way */

  LOCAL needed%

  Ftracef("PROCinitialise_support_libraries")
  basic_count%=0
  utility_count%=0
  baslim%=FNevaluate(FNmsg_0(A%!CONST_interface_host_desc,"BASLIM"))
  mclim%=FNevaluate(FNmsg_0(A%!CONST_interface_host_desc,"MCLIM"))
  wslim%=FNevaluate(FNmsg_0(A%!CONST_interface_host_desc,"WSLIM"))
  Ftracef("DIM utility%("+STR$ mclim%+"),utility$("+STR$ mclim%+\
      "),overlay$("+STR$ baslim%+")")
  DIM utility%(mclim%),utility$(mclim%),overlay$(baslim%)
      /*these waste 1 entry each, but save more than that in source size!*/

  needed%=HIMEM+wslim%
  END=needed%
  IF HIMEM+wslim%<needed% THEN
    /*Not enough memory*/
    needed%=needed%/1024
    needed%=needed%-needed% MOD 8+8
    ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,\
        "FA4",STR$ needed%)
  ENDIF
#endif

LOCAL c%,d%,load%,size%,basic_size%,utility_size%,needed%
LOCAL basname$():DIM basname$(255)

/* 255 BASIC back-ends should be plenty :-) */

basic_size%=0     /* the size of the largest BASIC back-end */
utility_size%=0   /* the total size of ARM code back-ends */

baslim%=0
mclim%=0

basic_count%=0    /* no BASIC back-ends yet */
utility_count%=0  /* no ARM back-ends yet */

c%=-1
REPEAT
  PROCget_next_directory(path$,currdir$,name$,c%)
  /* returns the name of the directory in name$ */
  IF name$<>"" THEN
    SYS"OS_File",17,"Printers:"+name$+".Resources.Support" TO d%,,load%,,size%
    IF d%=1 AND (load% AND &FFF00000) = &FFF00000 THEN
      size%=size%+3 AND NOT 3
      CASE (load% AND &FFF00)>>8 OF
        WHEN &FFB
          IF size% > basic_size% basic_size% = size%
          IFbaslim%<255 basname$(baslim%)=name$
          baslim% += 1
        WHEN &FFC
          utility_size% += size%
          mclim% += 1
      ENDCASE
    ENDIF
  ENDIF
UNTIL name$=""

IF mclim% > 0 DIM utility%(mclim%-1), utility$(mclim%-1)
needed%=HIMEM+utility_size%+basic_size%+16*1024
END=needed%
IF (HIMEM+utility_size%+basic_size%+16*1024) < needed% THEN
  needed%=needed%/1024
  needed%=needed%-needed% MOD 8+8
  ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA4",STR$ needed%)
ENDIF
IF baslim% > 0 THEN
 DIM overlay$(baslim%-1)
 FORd%=0 TO baslim%-1
  overlay$(d%)="Printers:"+basname$(d%)+".Resources.Support"
 NEXT
 OVERLAY overlay$()
ENDIF
ENDPROC

DEF PROCget_next_directory(RETURN path$,RETURN currdir$,RETURN name$,RETURN offset%)
  LOCAL i%,num_read%,flags%
  Ftracef("PROCget_next_directory")
  IF offset%=-1 path$=FNtask_read_env("Printers$Path",msg_text%)
  REPEAT
   /* if offset%=-1, initialise everything */
   IF offset%=-1 THEN
    IF path$="" THEN
     /* out of entries */
     name$=""
     ENDPROC
    ENDIF
    i%=INSTR(path$,",")
    IF i%=0 i%=LEN path$+1
    currdir$=LEFT$(path$,i%-1)
    IF RIGHT$(currdir$)="." currdir$=LEFT$(currdir$)
    currdir$+=CHR$ 0
    path$=MID$(path$,i%+1)
    offset%=0
   ENDIF
   SYS "XOS_GBPB",10,currdir$,msg_text%,1,offset%,256,"*" TO,,,num_read%,offset%;flags%
   IF (flags% AND 1) num_read% = 0 /* probably, directory does not exist */
   IF num_read%=1 THEN
    IF msg_text%!16=2 THEN
      i%=msg_text%+20:CALL Z%,i%,name$
      ENDPROC
    ENDIF
    /* if we haven't got a directory, loop around for the next entry */
   ELSE
    /* out of entries, try the next directory */
    offset%=-1
   ENDIF
  UNTIL FALSE
ENDPROC

DEF PROCinitialise_one_support_library(name$)
  /* Globals updated only in this function: utility_count%, utility%(), utility$() */
  LOCAL load%,size%,f$

  Ftracef("PROCinitialise_one_support_library")

  f$="Printers:"+name$+".Resources.Support"
  SYS "OS_File",17,f$ TO d%,,load%,,size% /*ReadNoPath*/
  size%=size%+3 AND NOT 3
  IF d%<>1 SYS "OS_File",19,f$,d% /*MakeError*/

  /*we've got a file called Support*/
  IF(load% AND &FFF00000)<>&FFF00000 \
    ERROR CONST_error_ok,FNmsg_1("FA3",name$)

  /*It's a typed file*/
  CASE(load% AND &FFF00)>>8 OF
    WHEN &FFB
#if FALSE
    /* BASIC back-ends have already been put into the array */
      /*BASIC*/
      IF basic_count%<baslim% THEN
        overlay$(basic_count%)=f$
        basic_count%+=1
        OVERLAY overlay$()
      ENDIF
#endif
    WHEN &FFC
      /*Utility*/
      IF utility_count%<mclim% THEN
        /*Load this file and remember where we've put it*/
        Ftracef("DIM u% "+STR$ size%)
        DIM u% size%
        utility%(utility_count%)=u%
        utility$(utility_count%)=name$
        SYS "OS_File",16,f$,u% /*LoadNoPath*/
        utility_count%+=1
      ENDIF
    OTHERWISE
      ERROR CONST_error_ok,FNmsg_1("FA3",name$)
  ENDCASE
ENDPROC

DEF PROCinitialise_one_psup(name$,RETURN this_psup%)
  /*This is the main initialisation of the printer support routines.
    If the support code is a module, we load it into a claimed block.
    We then try to open a messages file for it, and then load all the
    windows.*/

  /*For both types of code (BASIC/module), we initialise it.*/
  LOCAL d%,load%,f$,h%,this_wind%,last_wind%,psup%
#ifdef Sparrow
  LOCAL tmpt%
#endif

  Ftracef("PROCinitialise_one_psup")
  /* make sure directory exists for possible future choices save */
  SYS "XOS_File", 8, "PrinterChoices:"+name$
  f$="Printers:"+name$+".Resources.Support"
  SYS "OS_File",17,f$ TO d%,,load% /*ReadNoPath*/
  IF d%<>1 SYS "OS_File",19,f$,d% /*MakeError*/

  /*we've got a file called Support*/
  IF(load% AND &FFF00000)<>&FFF00000 \
    ERROR CONST_error_ok,FNmsg_1("FA3",name$)

  B%=CONST_ident_PSUP
  C%=CONST_psup_MAX
  this_psup%=USR(code_entry%+CONST_entry_heap_claim)
  IF this_psup%=0 ERROR CONST_error_fatal, FNmsg_1(A%!CONST_interface_host_desc,"FA5","PSUP")

  /*Typed file*/
  CASE(load% AND &FFF00)>>8 OF
    WHEN &FFB
      /*BASIC*/
      this_psup%!CONST_psup_flags=CONST_psup_flags_BASIC
    WHEN &FFC
      /*Utility*/
      this_psup%!CONST_psup_flags=0
    OTHERWISE
      B%=CONST_ident_PSUP
      C%=this_psup%
      CALL code_entry%+CONST_entry_heap_free
      ERROR CONST_error_ok,FNmsg_1(A%!CONST_interface_host_desc,\
          "FA3",name$)
  ENDCASE

  this_psup%!CONST_psup_next=0
  $task_buff%=name$
  B%=task_buff%
  C%=2
  this_psup%!CONST_psup_class=USR(code_entry%+CONST_entry_store_string)
  this_psup%!CONST_psup_tmpt=0
  this_psup%!CONST_psup_head=0
  SYS "OS_File",17,FNpsup_res(this_psup%,"Resources.!Sprites")TO d%
      /*ReadNoPath*/
  IF d%=1 THEN
    SYS "XOS_CLI","IconSprites "+FNpsup_res(this_psup%,"Resources.!Sprites") TO C%;d%
    IF(d%AND1) !C%=CONST_error_fatal:SYS"OS_GenerateError",C%
  ENDIF
  SYS "OS_File",17,FNpsup_res(this_psup%,"Resources.Messages")TO d%
      /*ReadNoPath*/
  IF d%=1 THEN
    PROCmsg_initialise(FNpsup_res(this_psup%,"Resources.Messages"),d%)
    this_psup%!CONST_psup_msg=d%
  ELSE
    this_psup%!CONST_psup_msg=0
  ENDIF
  SYS "OS_File",17,FNpsup_res(this_psup%,"Resources.Templates")TO d%
      /*ReadNoPath*/
  IF d%<>1 ERROR CONST_error_ok,FNmsg_1(A%!CONST_interface_host_desc,"FA2",name$)
  PROCwin_template_open(FNpsup_res(this_psup%,"Resources.Templates"),FNpsup_res(this_psup%,"Resources.Template3D"))
  d%=0
  last_wind%=this_psup%+CONST_psup_wind
  REPEAT
    PROCwin_get_next_name("",d%,name$)
    IF d% THEN
      Ftracef("Got template "+name$)
      PROCwin_load_create("",name$,1,h%)
      B%=CONST_ident_WIND
      C%=CONST_wind_name+1+LEN name$
      this_wind%=USR(code_entry%+CONST_entry_heap_claim)
      IF this_wind%=0 ERROR CONST_error_fatal, FNmsg_1(A%!CONST_interface_host_desc,"FA5","WIND")
      this_wind%!CONST_wind_next=0
      this_wind%!CONST_wind_hand=h%
      this_wind%!CONST_wind_psup=0
      this_wind%!CONST_wind_prnt=0
      $(this_wind%+CONST_wind_name)=name$
      !last_wind%=this_wind%
      last_wind%=this_wind%+CONST_wind_next
    ENDIF
  UNTIL d%=0
  PROCwin_template_close

  /*Tell the psup it's been started.*/
  PROCprinter_reason_code(this_psup%,0,-1,0)

  /*Load the Template and PrData files for this psup.*/
  IF NOT FNload_file(FNpsup_res(this_psup%,"Template")) \
    ERROR CONST_error_ok,FNmsg_1(A%!CONST_interface_host_desc,"OK1a",\
        $this_psup%!CONST_psup_class)
  PROCprocess_template(this_psup%)
  PROCrelease_file

#ifdef Sparrow
  IF multiple_choices% THEN
Ftracef ("MULTIPLE CHOICES: yes")
    IF NOT FNload_file(FNpsup_multiple_res(this_psup%,unique_string$,"PrData")) THEN
      f$ = PrintersChoicesWriteDir+".Remote.ID"+unique_string$+"."+$this_psup%!CONST_psup_class
      SYS "XOS_File", 8, f$
      f$ = PrintersChoicesWriteDir+".Remote.ID"+unique_string$+"."+$this_psup%!CONST_psup_class+".PrData"
Ftracef ("No file, therefore trying "+f$)
      d% = OPENOUT(f$)
Ftracef ("File handle is "+STR$d%)
      IF d% = 0 THEN
        ERROR CONST_error_ok,FNmsg_1(A%!CONST_interface_host_desc,"OK1",\
            $this_psup%!CONST_psup_class)
      ELSE
        /* Fake an empty PrData file */
        tmpt% = this_psup%!CONST_psup_tmpt
        WHILE tmpt%
          BPUT#d%, $(tmpt%+CONST_tmpt_name)+":"
Ftracef ("Writing "+$(tmpt%+CONST_tmpt_name)+":")
          BPUT#d%,"#"
          tmpt% = tmpt%!CONST_tmpt_next
        ENDWHILE

        CLOSE#d%

        SYS "OS_File", 18, f$, &FC6 /* Settype */

        IF NOT FNload_file(FNpsup_multiple_res(this_psup%,unique_string$,"PrData")) \
          ERROR CONST_error_ok,FNmsg_1(A%!CONST_interface_host_desc,"OK1",\
             $this_psup%!CONST_psup_class)
      ENDIF
    ENDIF
  ELSE
#endif

  IF NOT FNload_file(FNpsup_res(this_psup%,"PrData")) \
    ERROR CONST_error_ok,FNmsg_1(A%!CONST_interface_host_desc,"OK1",\
        $this_psup%!CONST_psup_class)

#ifdef Sparrow
  ENDIF
#endif

  PROCprocess_file(this_psup%)
  PROCrelease_file

  /* load the paper file for this class */
  PROCread_paper_file(FNpsup_res(this_psup%,"Resources.PaperRO"),CONST_psze_flag_candelete)

  /*If everything went o k, link this psup into the list.*/
  IF psup_head% THEN
    psup%=psup_head%
    WHILE psup%!CONST_psup_next
      psup%=psup%!CONST_psup_next
    ENDWHILE

    psup%!CONST_psup_next=this_psup%
  ELSE
    psup_head%=this_psup%
  ENDIF
ENDPROC

DEF PROCtimeout_reinitialise
  /*Calculates the global values 'timeout%,' 'time_before%' and also sets up
    each prnt block with the time that it wants the next null.
    timeout% = -1: No Null_Reason_Code needed. Call Wimp_Poll with no nulls
    timeout% = 0:  Null_Reason_Code needed, min time is 0. Call Wimp_Poll
    timeout% > 0:  Call Wimp_PollIdle with given timeout (in ds)*/
  LOCAL prnt%,psup%,t%,cnct%
  Ftracef("PROCtimeout_initialise")
  timeout%=-1
  prnt%=A%!CONST_interface_printer_installed
  WHILE prnt%
    psup%=prnt%!CONST_prnt_psup
    IF psup%!CONST_psup_flags AND CONST_psup_flags_null_events THEN
      t%=10*psup%?(CONST_psup_flags+1)
      Ftracef("The psup requires nulls every "+STR$ t%+"cs")
      IF timeout%=-1 timeout%=t% ELSE IF t%<timeout% timeout%=t%
      prnt%!CONST_prnt_timeout=t%
    ELSE
      /*No nulls required*/
      prnt%!CONST_prnt_timeout=-1
    ENDIF
    /* Now check for it being a parallel connection with error detection on */
    IF timeout%=-1 OR timeout%>100 THEN
      cnct%=prnt%!CONST_prnt_cnct
      IF (cnct%!CONST_cnct_flags AND CONST_cnct_flags_parallel_errors) AND FNparallel_error_detect_possible THEN timeout%=100
    ENDIF
    prnt%=prnt%!CONST_prnt_next
  ENDWHILE
  SYS "OS_ReadMonotonicTime" TO time_before%
ENDPROC

DEF FNinitialise_scrap
  LOCAL new_scrap$,f%,r0%,s$
#ifdef Sparrow
  LOCAL prnt%, psup%, name$
#endif

  new_scrap$=FNtask_read_env("Wimp$ScrapDir", msg_text%)
  IF new_scrap$="" := FALSE
  IF new_scrap$<>last_scrap$ THEN
    SYS "XOS_File", 8,"<Wimp$ScrapDir>.Printers" TO r0%;f% /*CreateDir*/
    IF(f%AND1) THEN
      r0%+=4:CALL Z%,r0%,s$
      PROCerror_warning(FNmsg_2(A%!CONST_interface_host_desc,"WA13","<Wimp$ScrapDir>.Printers",s$))

    ELSE
      last_scrap$ = new_scrap$
#ifdef Sparrow
      IF sparrow_present% THEN
        SYS "XOS_File", 8, "<Wimp$ScrapDir>.Printers.RemQueue" TO r0%;f%
        IF(f%AND1)=0 SYS "XOS_File", 8, "<Wimp$ScrapDir>.Printers.RemSpool" TO r0%;f%
        IF(f%AND1) THEN
          r0%+=4:CALL Z%,r0%,s$
          PROCerror_warning(FNmsg_2(A%!CONST_interface_host_desc,"WA13","<Wimp$ScrapDir>.Printers",s$))
        ENDIF
      ENDIF

      prnt% = A%!CONST_interface_printer_installed
      WHILE prnt%
        IF prnt%!CONST_prnt_flags AND CONST_prnt_flags_shared THEN
          IF (prnt%!CONST_prnt_name = 0) THEN
            psup% = prnt%!CONST_prnt_psup
            name$ = $(psup%!CONST_psup_class)
          ELSE
            name$ = $(prnt%!CONST_prnt_name)
          ENDIF

          PROCshare_one_printer (prnt%)
        ENDIF
        prnt% = prnt%!CONST_prnt_next
      ENDWHILE
#endif
    ENDIF
  ENDIF

= TRUE

#ifdef Sparrow

DEF PROCinitialise_settings
  LOCAL c%,d%,s$,ts%,name$,psup%,cnfg%,t%,name%,found_psup%, dosel%, err%
  LOCAL flags%, thing%, rmtp%, found%, odp%, idx%, str$, prnt%, side%, icon%, spr$, p%, sel%, s$, tmp%

  LOCAL odp%, odl%

  Ftracef("PROCinitialise_settings")
  #ifdef Trace
    main_icon%=FNiconbar_tands(FNmsg_0(A%!CONST_interface_host_desc,"NNE"),\
        "s"+FNmsg_0(A%!CONST_interface_host_desc,"IC")+"d",-5,&0F000000)
  #else
    main_icon%=FNiconbar_tands(FNmsg_0(A%!CONST_interface_host_desc,"NNE"),\
        "s"+FNmsg_0(A%!CONST_interface_host_desc,"IC"),-5,&0F000000)
  #endif
  got_icon%=TRUE
#ifdef False
  SYS "OS_File",8,"<Wimp$ScrapDir>.Printers" /*CreateDir*/

  SYS "OS_File", 8, "<Wimp$ScrapDir>.Printers.RemQueue"
  SYS "OS_File", 8, "<Wimp$ScrapDir>.Printers.RemSpool"
#endif
  IF multiple_choices% THEN
    s$ = PrintersChoicesWriteDir+".Remote.ID"+unique_string$+".Settings"
    Ftracef ("About to look for remote settings")
    SYS "OS_File",17,s$ TO c% /*ReadNoPath*/
    Ftracef (PrintersChoicesWriteDir+".Remote settings SWI returns "+STR$c%)
  ELSE
    SYS "OS_File",17,PrintersChoicesWriteDir+".Settings" TO c% /*ReadNoPath*/
  ENDIF

  IF c%=1 THEN

    IF multiple_choices% THEN
      IF NOT FNload_file (s$) \
        ERROR CONST_error_ok,FNmsg_0(A%!CONST_interface_host_desc,"OKD")
    ELSE
      IF NOT FNload_file(PrintersChoicesWriteDir+".Settings")\
        ERROR CONST_error_ok,FNmsg_0(A%!CONST_interface_host_desc,"OKD")
    ENDIF
    ts%=FNmatch_line("fv:")
    IF ts%=0 THEN
      PROCerror_box(FNmsg_0(A%!CONST_interface_host_desc,"OKV"),1)
    ELSE
      /*currently accepted file version number is *****1******/
      IF FNevaluate($ts%)<>1 THEN
        PROCerror_box(FNmsg_0(A%!CONST_interface_host_desc,"OKV"),1)
      ELSE

        PROCsparrow_local_file /* First, init all local printers */

          /*
           * First, get flags to see if it's remote.
           */

        REPEAT
          ts%=FNmatch_line("cl:")

          PROCsparrow_local_file_2

          flags% = 0
          thing% = FNmatch_line("fg:")
          IF thing% THEN
            flags% = FNevaluate ($thing%)
          ENDIF
          Ftracef ("*******WAHOOO! Checking flags:- "+STR$~flags%)

          name%=FNmatch_line("sn:")
          IF name% name$=$name% ELSE name$=""

          Ftracef ("*******WAHOOO! Checking name:- "+name$)

          PROCsparrow_restore_file_2

          IF (ts% > 0) AND ((flags% AND CONST_prnt_flags_remote) = 0) AND (thing% > 0) THEN

           Ftracef ("Found a local printer in settings file")

            d%=INSTR($ts%,":")
            IF d%=0 d%=LEN $ts%+1
            s$=MID$($ts%,d%+1)
            $ts%=LEFT$($ts%,d%-1)

            /*match the class specified*/
            psup%=psup_head%
            found_psup%=FALSE
            WHILE psup% AND NOT found_psup%
              IF $psup%!CONST_psup_class=$ts% found_psup%=TRUE
              IF NOT found_psup% psup%=psup%!CONST_psup_next
            ENDWHILE

            IF NOT found_psup% THEN
              /*Try to load the psup% from disc.*/
              Ftracef("Looking for "+$ts%+" support class")
              PROClocal_file
              PROCinitialise_one_support_library($ts%) /*doesn't return if error*/
              PROCinitialise_one_psup($ts%,psup%)
              PROCrestore_file
              found_psup%=TRUE
            ENDIF

            IF NOT found_psup% THEN
              /*not found this class - get the name of the printer*/
              name%=FNmatch_line("nm:")
              IF name% name$=$name% ELSE name$=""
              PROCerror_warning(FNmsg_2(A%!CONST_interface_host_desc,"WA1",$ts%,name$))
            ELSE
              PROCinitialise_one_printer(psup%)
            ENDIF
          ENDIF
        UNTIL ts%=0

        PROCsparrow_restore_file /* Back to start of file, let's do remote ones */

        REPEAT
Ftracef ("Starting second settings pass")
          ts%=FNmatch_line("cl:")

          /*
           * First, get flags to see if it's remote.
           */

          odp% = !data_ptr%
          odl% = data_line%

          PROCsparrow_local_file

          flags% = 0
          thing% = FNmatch_line("fg:")
Ftracef ("Getting flags")
          IF thing% THEN
            flags% = FNevaluate ($thing%)
          ENDIF

Ftracef ("Getting paper size")
          thing% = FNmatch_line("pn:")
          IF thing% str$=$thing% ELSE str$=""

          name%=FNmatch_line("sn:")
          IF name% name$=$name% ELSE name$=""

          Ftracef ("Checking flags: "+STR$~flags%+" paper size: "+str$+" name: "+name$)

          PROCsparrow_restore_file

          Ftracef ("ts% = "+STR$ts%+" thing% = "+STR$thing%+" flags% = "+STR$flags%)

          IF (ts% > 0) AND ((flags% AND CONST_prnt_flags_remote) > 0) AND (thing% > 0) THEN

            Ftracef ("Found a remote printer in settings file")

            /*
             * It's a saved remote printer, arrrgh
             */
            found% = FALSE
            rmtp% = remote_printers%
            WHILE rmtp% AND NOT found%
              IF name$ = $rmtp%!CONST_rmtp_name THEN
                found% = TRUE
              ELSE
                rmtp% = rmtp%!CONST_rmtp_next
              ENDIF
            ENDWHILE

            IF NOT found% OR NOT sparrow_present% THEN
              /*
               * Bad news, must fake up an inactive, unavailable printer
               */
              Ftracef("Bad news ... faking inactive unavailable printer")
              p% = INSTR($ts%, ":")
              IF p% = 0 THEN
                p% = LEN$ts%
              ENDIF
              PROCadd_unavailable_printer (name$, MID$($t%,1,p%-1)," ")
            ELSE
              IF flags% AND CONST_prnt_flags_active THEN
                Ftracef("Flags say it is an active printer ...")
                PROCsparrow_local_file
                prnt% = FNensure_printer (rmtp%, flags%, TRUE, FALSE, err%)
                PROCsparrow_restore_file

                PROCsparrow_local_file
                !data_ptr% = odp%
                data_line% = odl%
                PROCinitialise_one_remote_printer (prnt%)

                PROCsparrow_restore_file

                PROCremove_from_list (remote_printers%, $rmtp%!CONST_rmtp_name)

                IF flags% AND CONST_prnt_flags_selected THEN
                  prnt%!CONST_prnt_flags = prnt%!CONST_prnt_flags OR CONST_prnt_flags_selected
                ELSE
                  prnt%!CONST_prnt_flags = prnt%!CONST_prnt_flags AND NOT CONST_prnt_flags_selected
                ENDIF

                d%=psize_head%
                WHILE d%
                  IF $d%!CONST_psze_name=str$ THEN
                    Ftracef("Matched paper size ("+str$+"), set address to "+STR$~(d%))
                    prnt%!CONST_prnt_psze=d%
                    d%=0
                  ELSE
                    d%=d%!CONST_psze_next
                    IF d%=0 THEN
                      d%=psize_head%
                      prnt%!CONST_prnt_psze=d%
                      PROCerror_warning(FNmsg_3(A%!CONST_interface_host_desc,"WA11",str$,$d%!CONST_psze_name,name$))
                      d%=0
                    ENDIF
                  ENDIF
                ENDWHILE

              ENDIF
            ENDIF /* NOT found% */
          ENDIF /* If it's a remote printer */

        UNTIL ts% = 0 /* End of file */

      ENDIF /* File version is correct */
    ENDIF /* File has anything in it at all!! */

    PROCrelease_file
  ENDIF /* c% = 1 */

  /*give the back-ends a chance to tidy up after all
    of the printers have been initialised*/
  PROCbroadcast_reason_code(A%!CONST_interface_printer_installed,-5,0)


  sel% = FALSE
  prnt% = A%!CONST_interface_printer_installed
  WHILE prnt%
    IF prnt%!CONST_prnt_flags AND CONST_prnt_flags_selected THEN
      sel% = TRUE
      dosel% = prnt%
      prnt% = 0
    ELSE
      prnt% = prnt%!CONST_prnt_next
    ENDIF
  ENDWHILE
  prnt% = A%!CONST_interface_printer_installed
  IF (NOT sel%) AND (prnt%) THEN
    PROCdo_select_printer (prnt%, TRUE, FALSE,FALSE)
  ELSE
    IF sel% AND dosel% THEN
      PROCdo_select_printer (dosel%, TRUE, FALSE,FALSE)
    ENDIF
  ENDIF

  Ftracef("PROCinitialise_settings done")
ENDPROC

#else

DEF PROCinitialise_settings
  LOCAL c%,d%,s$,ts%,name$,psup%,cnfg%,t%,name%,found_psup%
  Ftracef("PROCinitialise_settings")
  #ifdef Trace
    main_icon%=FNiconbar_tands(FNmsg_0(A%!CONST_interface_host_desc,"NNE"),\
        "s"+FNmsg_0(A%!CONST_interface_host_desc,"IC")+"d",-5,&0F000000)
  #else
    main_icon%=FNiconbar_tands(FNmsg_0(A%!CONST_interface_host_desc,"NNE"),\
        "s"+FNmsg_0(A%!CONST_interface_host_desc,"IC"),-5,&0F000000)
  #endif
  got_icon%=TRUE

  SYS "OS_File",17,"Printers:Settings" TO c% /*ReadNoPath*/
  IF c%=1 THEN
    IF NOT FNload_file("Printers:Settings")\
      ERROR CONST_error_ok,FNmsg_0(A%!CONST_interface_host_desc,"OKD")
    ts%=FNmatch_line("fv:")
    IF ts%=0 THEN
      PROCerror_box(FNmsg_0(A%!CONST_interface_host_desc,"OKV"),1)
    ELSE
      /*currently accepted file version number is *****1******/
      IF FNevaluate($ts%)<>1 THEN
        PROCerror_box(FNmsg_0(A%!CONST_interface_host_desc,"OKV"),1)
      ELSE
        REPEAT
          ts%=FNmatch_line("cl:")

          IF ts% THEN

            d%=INSTR($ts%,":")
            IF d%=0 d%=LEN $ts%+1
            s$=MID$($ts%,d%+1)
            $ts%=LEFT$($ts%,d%-1)

            /*match the class specified*/
            psup%=psup_head%
            found_psup%=FALSE
            WHILE psup% AND NOT found_psup%
              IF $psup%!CONST_psup_class=$ts% found_psup%=TRUE
              IF NOT found_psup% psup%=psup%!CONST_psup_next
            ENDWHILE

            IF NOT found_psup% THEN
              /*Try to load the psup% from disc.*/
              Ftracef("Looking for "+$ts%+" support class")
              PROClocal_file
              PROCinitialise_one_support_library($ts%) /*doesn't return if error*/
              PROCinitialise_one_psup($ts%,psup%)
              PROCrestore_file
              found_psup%=TRUE
            ENDIF

            IF NOT found_psup% THEN
              /*not found this class - get the name of the printer*/
              name%=FNmatch_line("nm:")
              IF name% name$=$name% ELSE name$=""
              PROCerror_warning(FNmsg_2(A%!CONST_interface_host_desc,"WA1",$ts%,name$))
            ELSE
              PROCinitialise_one_printer(psup%)
            ENDIF
          ENDIF
        UNTIL ts%=0
      ENDIF
    ENDIF
    PROCrelease_file
  ENDIF

  /*give the back-ends a chance to tidy up after all
    of the printers have been initialised*/
  PROCbroadcast_reason_code(A%!CONST_interface_printer_installed,-5,0)
  Ftracef("PROCinitialise_settings done")
ENDPROC

#endif

DEF PROCinitialise_one_printer(psup%)
  LOCAL ts%,prdt%,prnt%,d%,cnct%,h%,nm$,head%
  Ftracef("PROCinstall_one_printer")

  ts%=FNmatch_line_or_error("nm:")
  nm$=$ts%
  IF psup%!CONST_psup_dvsn>100 THEN
    /*the version numbers don't match, so give an error.*/
    PROCerror_warning(FNmsg_1(A%!CONST_interface_host_desc,"WA7",nm$))
    ENDPROC
  ENDIF
  /*got a match on the class, so install the printer*/

  /*find the prdata block and increment its usage*/
  head%=psup%!CONST_psup_head
  prdt%=head%!CONST_head_prdt
  WHILE prdt%>0
    IF $prdt%!CONST_prdt_1st=nm$ THEN
      prdt%!(prdt%!CONST_prdt_num*4+CONST_prdt_1st)+=1
      prdt%=-1
    ELSE
      prdt%=prdt%!CONST_prdt_next
    ENDIF
  ENDWHILE

  IF prdt%=0 THEN
    /*failed to find the data - don't install*/
    PROCerror_warning(FNmsg_1(A%!CONST_interface_host_desc,"WA8",nm$))
    ENDPROC
  ENDIF

  B%=CONST_ident_PRNT
  C%=CONST_prnt_MAX
  prnt%=USR(code_entry%+CONST_entry_heap_claim)
  IF prnt%=0 ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","PRNT")
  B%=ts%
  C%=2
  prnt%!CONST_prnt_type=USR(code_entry%+CONST_entry_store_string)
  Ftracef("Set prnt type to "+$(prnt%!CONST_prnt_type)+", "+STR$~(prnt%!CONST_prnt_type))

  /*Fill in all the details*/
  prnt%!CONST_prnt_next=0
  prnt%!CONST_prnt_psup=psup%

  IF psup%!CONST_psup_flags AND CONST_psup_flags_null_events \
    prnt%!CONST_prnt_timeout=10*psup%?(CONST_psup_flags+1) \
  ELSE \
    prnt%!CONST_prnt_timeout=-1
  Ftracef("prnt initialised at "+STR$ prnt%!CONST_prnt_timeout)

  /*Connection details*/
  IF psup%!CONST_psup_flags AND CONST_psup_flags_backend_connections THEN
    /*Back end supplies own connections window*/
    h%=FNevaluate($FNmatch_line_or_error("cn:"))

    B%=CONST_ident_CNCT
    C%=h%*4
    cnct%=USR(code_entry%+CONST_entry_heap_claim)
    IF cnct%=0 ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","CNCT")
    prnt%!CONST_prnt_cnct=cnct%
    cnct%!0=FNevaluate($FNmatch_line_or_error("ct:"))
    IF 1<=h%-1 THEN
      FOR d%=1 TO h%-1
        ts%=FNmatch_any_line
        IF ts% THEN
          ss%=FNmatch_string(ts%,"nl:")
          IF ss% THEN
            cnct%!(d%*4)=0
          ELSE
            ss%=FNmatch_string(ts%,"in:")
            IF ss% THEN
              cnct%!(d%*4)=FNstore_integer(FNevaluate($ss%))
            ELSE
              ss%=FNmatch_string(ts%,"st:")
              IF ss% THEN
                B%=ss%
                C%=2
                cnct%!(d%*4)=USR(code_entry%+CONST_entry_store_string)
              ELSE
                ss%=FNmatch_string(ts%,"s0:")
                IF ss% THEN
                  B%=ss%
                  C%=3
                  cnct%!(d%*4)=USR(code_entry%+CONST_entry_store_string)
                ELSE
                  ss%=FNmatch_string(ts%,"gs:")
                  IF ss% THEN
                    B%=ss%
                    C%=4
                    cnct%!(d%*4)=USR(code_entry%+CONST_entry_store_string)
                  ELSE
                    ss%=FNmatch_string(ts%,"pt:")
                    IF ss% THEN
                      B%=CONST_ident_POTR
                      C%=4
                      cnct%!(d%*4)=USR(code_entry%+CONST_entry_heap_claim)
                      IF cnct%!(d%*4)=0 \
                        ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","POTR")
                      !cnct%!(d%*4)=FNfix_up_pointer($ss%,FALSE)
                    ELSE
                      PROCsettings_error(FNmsg_1(A%!CONST_interface_host_desc,"OKH",$ts%))
                    ENDIF
                  ENDIF
                ENDIF
              ENDIF
            ENDIF
          ENDIF
        ENDIF
      NEXT
    ENDIF
  ELSE
    /*Normal connections window*/
    B%=CONST_ident_CNCT
    C%=CONST_cnct_MAX
    cnct%=USR(code_entry%+CONST_entry_heap_claim)
    IF cnct%=0 \
      ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","CNCT")
    prnt%!CONST_prnt_cnct=cnct%

    cnct%!CONST_cnct_type=FNevaluate($FNmatch_line_or_error("ct:"))

    /*
       PLEASE NOTE!

       Although the baud rate value is only 1 byte, the xon/xoff flag is also
       1 byte and follows directly on in memory from the baud rate value, so
       by saving and loading the baud rate value as a word, we get to save
       and load the xon/xoff value as well
    */
    cnct%!CONST_cnct_baud=FNevaluate($FNmatch_line_or_error("bd:"))
    IFNOTFNsupport_higher_baudrates AND (cnct%?CONST_cnct_baud > 15) THEN
      PROCerror_box(FNmsg_1(A%!CONST_interface_host_desc,"OKAM",FNmsg_0(A%!CONST_interface_host_desc,"BR"+STR$(cnct%?CONST_cnct_baud))),1)
      cnct%?CONST_cnct_baud = 0
    ENDIF

    cnct%!CONST_cnct_data=FNevaluate($FNmatch_line_or_error("ft:"))

    C%=2
    B%=FNmatch_line_or_error("et:")
    cnct%!CONST_cnct_econet=USR(code_entry%+CONST_entry_store_string)

    B%=FNmatch_line_or_error("fl:")
    cnct%!CONST_cnct_file=USR(code_entry%+CONST_entry_store_string)

    B%=FNmatch_line_or_error("ns:")
    cnct%!CONST_cnct_nfss=USR(code_entry%+CONST_entry_store_string)

    B%=FNmatch_line_or_error("np:")
    cnct%!CONST_cnct_nfsp=USR(code_entry%+CONST_entry_store_string)

    B%=FNmatch_line_or_error("nu:")
    cnct%!CONST_cnct_nfsu=USR(code_entry%+CONST_entry_store_string)

    B%=FNmatch_line_or_error("no:")
    cnct%!CONST_cnct_nfso=USR(code_entry%+CONST_entry_store_string)

    ts%=FNmatch_line("cf:")
    IF ts% THEN
      cnct%?CONST_cnct_flags=FNevaluate($ts%)
    ELSE
      /*Do not give error if absent.*/
      cnct%?CONST_cnct_flags=0
    ENDIF

    B%=FNmatch_line("nps:")
    IF B% THEN
      cnct%!CONST_cnct_nfsps=USR(code_entry%+CONST_entry_store_string)
    ELSE
      h%=?buff1%
      B%=buff1%
      ?buff1%=13
      cnct%!CONST_cnct_nfsps=USR(code_entry%+CONST_entry_store_string)
      ?buff1%=h%
    ENDIF

    /*check that the connect type is still valid*/
    CASE cnct%!CONST_cnct_type OF
      WHEN 1
        IF NOT parallel_possible% THEN
          cnct%!CONST_cnct_type=0
          PROCerror_warning(FNmsg_2(A%!CONST_interface_host_desc,"WA9",\
              $prnt%!CONST_prnt_type,FNmsg_0(A%!CONST_interface_host_desc,"CN1")))
          ENDIF
      WHEN 4
        IF NOT FNeconet_installed THEN
          cnct%!CONST_cnct_type=0
          PROCerror_warning(FNmsg_2(A%!CONST_interface_host_desc,"WA9",\
              $prnt%!CONST_prnt_type,FNmsg_0(A%!CONST_interface_host_desc,"CN4")))
        ENDIF
      WHEN 6
        IF NOT FNnfs_installed THEN
          cnct%!CONST_cnct_type=0
          PROCerror_warning(FNmsg_2(A%!CONST_interface_host_desc,"WA9",\
              $prnt%!CONST_prnt_type,FNmsg_0(A%!CONST_interface_host_desc,"CN6")))
        ENDIF
      WHEN 10
        IF NOT lpr_possible% THEN
          cnct%!CONST_cnct_type=0
          PROCerror_warning(FNmsg_2(A%!CONST_interface_host_desc,"WA9",\
              $prnt%!CONST_prnt_type,FNmsg_0(A%!CONST_interface_host_desc,"CN10")))
        ENDIF
      WHEN 11
        IF NOT FNlanman_installed THEN
          cnct%!CONST_cnct_type=0
          PROCerror_warning(FNmsg_2(A%!CONST_interface_host_desc,"WA9",\
              $prnt%!CONST_prnt_type,FNmsg_0(A%!CONST_interface_host_desc,"CN11")))
        ENDIF
      WHEN 12
        IF NOT FNlanman98_installed THEN
          cnct%!CONST_cnct_type=0
          PROCerror_warning(FNmsg_2(A%!CONST_interface_host_desc,"WA9",\
              $prnt%!CONST_prnt_type,FNmsg_0(A%!CONST_interface_host_desc,"CN12")))
        ENDIF
      WHEN 10
        IF NOT jetdirect_possible% THEN
          cnct%!CONST_cnct_type=0
          PROCerror_warning(FNmsg_2(A%!CONST_interface_host_desc,"WA9",\
              $prnt%!CONST_prnt_type,FNmsg_0(A%!CONST_interface_host_desc,"CN13")))
        ENDIF
    ENDCASE
  ENDIF

  /*Configuration details*/
  h%=FNevaluate($FNmatch_line_or_error("cs:"))
  B%=CONST_ident_CNFG
  C%=h%*4
  cnfg%=USR(code_entry%+CONST_entry_heap_claim)
  IF cnfg%=0 \
    ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","CNFG")
  prnt%!CONST_prnt_cnfg=cnfg%
  IF 0<=h%-1 THEN
    FOR d%=0 TO h%-1
      ts%=FNmatch_any_line
      IF ts% THEN
        ss%=FNmatch_string(ts%,"nl:")
        IF ss% THEN
          cnfg%!(d%*4)=0
        ELSE
          ss%=FNmatch_string(ts%,"in:")
          IF ss% THEN
            cnfg%!(d%*4)=FNstore_integer(FNevaluate($ss%))
          ELSE
            ss%=FNmatch_string(ts%,"st:")
            IF ss% THEN
              B%=ss%
              C%=2
              cnfg%!(d%*4)=USR(code_entry%+CONST_entry_store_string)
            ELSE
              ss%=FNmatch_string(ts%,"s0:")
              IF ss% THEN
                B%=ss%
                C%=3
                cnfg%!(d%*4)=USR(code_entry%+CONST_entry_store_string)
              ELSE
                ss%=FNmatch_string(ts%,"gs:")
                IF ss% THEN
                  B%=ss%
                  C%=4
                  cnfg%!(d%*4)=USR(code_entry%+CONST_entry_store_string)
                ELSE
                  ss%=FNmatch_string(ts%,"pt:")
                  IF ss% THEN
                    B%=CONST_ident_POTR
                    C%=4
                    cnfg%!(d%*4)=USR(code_entry%+CONST_entry_heap_claim)
                    IF cnfg%!(d%*4)=0 \
                      ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","POTR")
                    !cnfg%!(d%*4)=FNfix_up_pointer($ss%,FALSE)
                  ELSE
                    PROCsettings_error(FNmsg_1(A%!CONST_interface_host_desc,"OKH",$ts%))
                  ENDIF
                ENDIF
              ENDIF
            ENDIF
          ENDIF
        ENDIF
      ENDIF
    NEXT
  ENDIF

  /*Print panel details*/
  prnt%!CONST_prnt_icon=-1
  prnt%!CONST_prnt_flags=FNevaluate($FNmatch_line_or_error("fg:"))
  prnt%!CONST_prnt_pane=-1
  prnt%!CONST_prnt_queu=0

  ts%=FNmatch_line_or_error("pn:")
  d%=psize_head%
  WHILE d%
    IF $d%!CONST_psze_name=$ts% THEN
      Ftracef("Matched paper size ("+$ts%+"), set address to "+STR$~(d%))
      prnt%!CONST_prnt_psze=d%
      d%=0
    ELSE
      d%=d%!CONST_psze_next
      IF d%=0 THEN
        d%=psize_head%
        prnt%!CONST_prnt_psze=d%
        PROCerror_warning(FNmsg_3(A%!CONST_interface_host_desc,"WA11",$ts%,$d%!CONST_psze_name,nm$))
        d%=0
      ENDIF
    ENDIF
  ENDWHILE

  C%=2
  B%=FNmatch_line_or_error("sn:")
  prnt%!CONST_prnt_name=USR(code_entry%+CONST_entry_store_string)

  B%=FNmatch_line_or_error("ic:")
  prnt%!CONST_prnt_sprt=USR(code_entry%+CONST_entry_store_string)

  /*if page pausing is required, so is a window*/
  IF psup%!CONST_psup_text AND %100 \
    prnt%!CONST_prnt_pause=FNallocate_pause_window \
  ELSE \
    prnt%!CONST_prnt_pause=0

  prnt%!CONST_prnt_fonts=0
  IF prnt%!CONST_prnt_flags AND CONST_prnt_flags_active THEN
    PROCcreate_printer_icon(prnt%)
    IF prnt%!CONST_prnt_flags AND CONST_prnt_flags_selected THEN
      /*this is the selected printer*/
      Ftracef("PROCdo_select_printer loc 1")
      PROCdo_select_printer(prnt%,TRUE,FALSE,FALSE)
    ENDIF
  ENDIF

#ifdef Sparrow
  /*
   * This is what happens at startup time; shame we need to
   * do this in two places really, I don't want to try and
   * fix (break) it right now tho'
   */
  IF prnt%!CONST_prnt_flags AND CONST_prnt_flags_shared AND sparrow_present% THEN
    PROCshare_one_printer (prnt%)
  ENDIF
#endif /* Sparrow */

  /*Printer installed - link it into the list*/
  d%=A%+CONST_interface_printer_installed
  WHILE !d%
    d%=!d%+CONST_prnt_next
  ENDWHILE
  !d%=prnt%

  printer_count%+=1

  /*Last bits of initialisation for printer.*/
  PROCtimeout_reinitialise
ENDPROC

DEF FNmatch_line_or_error(ts$)
  LOCAL ts%
  Ftracef("FNmatch_line_or_error")
  ts%=FNmatch_line(ts$)
  IF ts%=0 PROCsettings_error(FNmsg_1(A%!CONST_interface_host_desc,"OKG",ts$))
=ts%

DEF PROCsettings_error(e$)
  Ftracef("PROCsettings_error")
  PROCram_file_error(FNmsg_1(A%!CONST_interface_host_desc,"OKE",e$))
ENDPROC

DEF FNpsup_res(psup%,s$)
  Ftracef("FNpsup_res")
="Printers:"+$psup%!CONST_psup_class+"."+s$

DEF FNone_of_ours(h%)
  LOCAL p%
  Ftracef("FNone_of_ours - handle = "+STR$(h%))
  IF h%=-2 THEN =TRUE /*icon bar*/
  IF h%=save_wind% THEN =TRUE
  IF h%=shutdown% THEN =TRUE
  IF h%=howquery% THEN =TRUE
  IF h%=papersize% THEN =TRUE
  IF h%=query% THEN =TRUE
  IF h%=A%!CONST_interface_queue THEN =TRUE
  IF h%=connections% THEN =TRUE
  IF h%=prntctrl% THEN =TRUE
  IF h%=info% THEN =TRUE
  /*could be a pause window*/
  p%=A%!CONST_interface_printer_installed
  WHILE p%
    IF p%!CONST_prnt_pause=h% THEN =TRUE
    p%=p%!CONST_prnt_next
  ENDWHILE
=FALSE

DEF PROCinitialise_windows
  /*
    WARNING! If you add or remove any windows from the following list,
             don't forget to update FNone_of_ours (see above)
  */
  LOCAL i%,fmt$,tr$,p1%,p2%,p3%,p4%,j%
  Ftracef("PROCinitialise_windows")
  PROCwin_template_open("Printers:Templates","Printers:Template3D")
  PROCwin_load_create("","info",1,info%)
  PROCwin_load_create("","prntctrl",1,prntctrl%)
  PROCwin_load_create("","connections",1,connections%)
  PROCwin_load_create("","queue",1,A%!CONST_interface_queue)
  PROCwin_load_create("","query",1,query%)
  PROCwin_load_create("","papersize",1,papersize%)
  PROCwin_load_create("","howquery",1,howquery%)
  PROCwin_load_create("","shutdown",1,shutdown%)
  PROCwin_load_create("","save",1,save_wind%)
  PROCwin_template_close

  PROCicon_write(info%,3,FNmsg_0(A%!CONST_interface_host_desc,"VSN"))
  /*Read the icon definitions from the queue window and keep them safe.*/
  FOR j%=0 TO 5
    B%=CONST_ident_ICDF
    C%=40
    i%=USR(code_entry%+CONST_entry_heap_claim)
    IF i%=0 \
      ERROR CONST_error_fatal,\
          FNmsg_1(A%!CONST_interface_host_desc,"FA5","ICDF")
    !i%=A%!CONST_interface_queue
    i%!4=j%
    SYS "Wimp_GetIconState",,i%
    SYS "Wimp_DeleteIcon",,i%
    A%!(CONST_interface_queue_0+4*j%)=i%+8
  NEXT

  /*Fill in the fields of the prntctrl window. JRC 30 Mar '92*/
  /*Icons 0-3 are NAME, TYPE, CN and ST. Copies of them are used to do
    Wimp_PlotIcons of the printer control entries, as well. The click
    detection is done by making one ("real") copy of icon 4 for each entry
    in the list. So we need copies of icons 0-4.*/
  FOR j%=0 TO 4
    B%=CONST_ident_ICDF
    C%=40
    i%=USR(code_entry%+CONST_entry_heap_claim)
    IF i%=0 \
      ERROR CONST_error_fatal,\
          FNmsg_1(A%!CONST_interface_host_desc,"FA5","ICDF")
    !i%=prntctrl%
    i%!4=j%
    SYS "Wimp_GetIconState",,i%
    IF j%=4 THEN
      SYS "Wimp_DeleteIcon",,i%
    ELSE
      /*Allocate space for the indirected data.*/
      B%=CONST_ident_XXXX
      C%=i%!36+1
      i%!28=USR(code_entry%+CONST_entry_heap_claim)
      IF i%!28=0 \
        ERROR CONST_error_fatal,\
            FNmsg_1(A%!CONST_interface_host_desc,"FA5","XXXX")
    ENDIF
    prntctrl_icdf%(j%)=i%+8
  NEXT

  /* PJC. Copy the icon flags from icon 4 into icons 0 to 3 */
  FOR j%=0 TO 3
    prntctrl_icdf%(j%)!16 = prntctrl_icdf%(4)!16
  NEXT

  /*Translate icons 0-3.*/
  FOR j%=0 TO 3
    PROCicon_write(prntctrl%,j%,\
        FNmsg_0(A%!CONST_interface_host_desc,\
        FNicon_read(prntctrl%,j%)))
  NEXT
ENDPROC

DEF FNmax(a,b): IF a>b THEN =a ELSE =b

DEF FNallocate_pause_window
  LOCAL p%
  Ftracef("FNallocate_pause_window")
  PROCwin_template_open("Printers:Templates","Printers:Template3D")
  PROCwin_load_create("","pause",1,p%)
  PROCwin_template_close
=p%

DEF PROCdeallocate_pause_window(handle%)
  /*because of the way windows are created from template files,
    all of the indirected data is held in one block, with the
    title string being first. So, if we get the address of the
    title string, we can free the block then delete the window*/
  Ftracef("PROCdeallocate_pause_window")
  !buff1%=handle%
  SYS "Wimp_GetWindowInfo",,buff1% OR 1
  B%=CONST_ident_BUFF
  C%=buff1%!76
  CALL code_entry%+CONST_entry_heap_free
  SYS "Wimp_DeleteWindow",,buff1%
ENDPROC

DEF PROCredraw_window
  LOCAL more%,i%,t$,con$,prnt%,psup%,wind%
#ifdef Sparrow
  LOCAL rmtp%
#endif
  Ftracef("PROCredraw_window")
  CASE !task_buff% OF
    WHEN A%!CONST_interface_queue
      SYS "Wimp_RedrawWindow",,task_buff% TO more%
      B%=task_buff%
      C%=more%
      CALL code_entry%+CONST_entry_update_queue_window
    WHEN prntctrl%
      /*Lots of PlotIcons for the various installed printers*/
      SYS "Wimp_RedrawWindow",,task_buff% TO more%
      WHILE more%
        /*Set the y-coord of the top icons.*/
        FOR i%=0 TO 3
          /* take the values from the icon defined in the template file */
          prntctrl_icdf%(i%)!4=prntctrl_icdf%(4)!4
          prntctrl_icdf%(i%)!12=prntctrl_icdf%(4)!12
        NEXT

        prnt%=A%!CONST_interface_printer_installed
        prnt_count%=0
        WHILE prnt%
          prnt_count%+=1

          /*Get the name.*/
          IF prnt%!CONST_prnt_name THEN
            $prntctrl_icdf%(0)!20=$prnt%!CONST_prnt_name
          ELSE
            ?prntctrl_icdf%(0)!20=13
          ENDIF

          /*Get the type.*/
          $prntctrl_icdf%(1)!20=$prnt%!CONST_prnt_type

          /*Get the connection.*/
          t$=STR$ !(prnt%!CONST_prnt_cnct+CONST_cnct_type)
          con$=FNmsg_0(A%!CONST_interface_host_desc,"IC"+t$)
          IF con$="IC"+t$ \
              con$=FNmsg_1(A%!CONST_interface_host_desc,"ICx",t$)
          $prntctrl_icdf%(2)!20=con$

          /*Get the status.*/
#ifdef Sparrow
          /*
           * Printer control window entries
           */
          IF prnt%!CONST_prnt_flags AND CONST_prnt_flags_shared THEN
             t$ = "SHA"
          ELSE
            IF prnt%!CONST_prnt_flags AND CONST_prnt_flags_active THEN
              t$="ACT"
            ELSE
              t$="INA"
            ENDIF
          ENDIF
#else
          IF prnt%!CONST_prnt_flags AND CONST_prnt_flags_active t$="ACT" ELSE t$="INA"
#endif
          $prntctrl_icdf%(3)!20=FNmsg_0(A%!CONST_interface_host_desc,t$)

          FOR i%=0 TO 3
            SYS "Wimp_PlotIcon",,prntctrl_icdf%(i%)

            /*y-coords for next line*/
            prntctrl_icdf%(i%)!12=prntctrl_icdf%(i%)!4
            prntctrl_icdf%(i%)!4-=(prntctrl_icdf%(4)!12 - prntctrl_icdf%(4)!4)
          NEXT

          prnt%=prnt%!CONST_prnt_next
        ENDWHILE

#ifdef Sparrow
        rmtp% = remote_printers%
        WHILE rmtp%
          $prntctrl_icdf%(0)!20 = $rmtp%!CONST_rmtp_name
          $prntctrl_icdf%(1)!20 = $rmtp%!CONST_rmtp_descriptor
          $prntctrl_icdf%(2)!20 = FNmsg_0 (A%!CONST_interface_host_desc, "IC9")
          /*
           * If icon is non zero (or >0) then it's an unavailable printer
           */
          IF rmtp%!CONST_rmtp_icon > 0 THEN
            $prntctrl_icdf%(3)!20 = FNmsg_0 (A%!CONST_interface_host_desc, "UNA")
          ELSE
            $prntctrl_icdf%(3)!20 = FNmsg_0 (A%!CONST_interface_host_desc, "INA")
          ENDIF

          FOR i%=0 TO 3
            SYS "Wimp_PlotIcon",,prntctrl_icdf%(i%)

            /*y-coords for next line*/
            prntctrl_icdf%(i%)!12=prntctrl_icdf%(i%)!4
            prntctrl_icdf%(i%)!4-=(prntctrl_icdf%(4)!12 - prntctrl_icdf%(4)!4)
          NEXT

          rmtp% = rmtp%!CONST_rmtp_next
        ENDWHILE
#endif

        SYS "Wimp_GetRectangle",,task_buff% TO more%
      ENDWHILE
    OTHERWISE
      PROCprinter_find_handle(!task_buff%,wind%,psup%,prnt%)
      PROCprinter_reason_code(psup%,prnt%,1,task_buff%)
  ENDCASE
ENDPROC

DEF PROCopen_pause_window(prnt%)
  /*open the window just above the icon*/
  LOCAL y%,s$
  Ftracef("PROCopen_pause_window")
  /*ensure that the title is correct*/
  IF prnt%!CONST_prnt_name s$=$prnt%!CONST_prnt_name ELSE s$=$prnt%!CONST_prnt_type
  PROCwin_title(prnt%!CONST_prnt_pause,FNmsg_1(A%!CONST_interface_host_desc,"PAU",s$))
  !buff1%=-2
  SYS "Wimp_GetWindowState",,buff1%
  y%=buff1%!4-buff1%!20
  buff1%!4=prnt%!CONST_prnt_icon
  SYS "Wimp_GetIconState",,buff1%
  y%+=buff1%!16-680 /*width of the window*/
  !buff1%=prnt%!CONST_prnt_pause
  SYS "Wimp_GetWindowState",,buff1%
  buff1%!12=(buff1%!12-buff1%!4)+y%
  buff1%!16=140+240 /*height of the window*/
  buff1%!4=y%
  buff1%!8=buff1%!16-240
  buff1%!28=-1
  SYS "Wimp_OpenWindow",,buff1%
ENDPROC

DEF PROCtell_pinboard(handle%)
/*
   broadcast Message_WindowClosed for the window
   this removes any iconised icon that may exist
   this proc should be called just before an OpenWindow
*/
!buff1%=24
buff1%!12=0
buff1%!16=&400CB
buff1%!20=handle%
SYS"Wimp_SendMessage",17,buff1%,0
ENDPROC

DEF PROCclose_window
  LOCAL i%,j%,prnt%,psup%,wind%
  Ftracef("PROCclose_window")
  PROCtell_pinboard(!task_buff%)
  IF FNone_of_ours(!task_buff%)THEN
    SYS "Wimp_CloseWindow",,task_buff%
  ELSE
    PROCprinter_find_handle(!task_buff%,wind%,psup%,prnt%)
    PROCprinter_reason_code(psup%,prnt%,3,task_buff%)
  ENDIF
ENDPROC

DEF PROCfree_structure(p%)
  /*For most structures, we can just free the memory occupied. However, for
      booleans and lists, we need to do a little more.*/
  LOCAL i%
  #ifdef Trace
    LOCAL ty$
    IF p% ty$=CHR$ p%?-4+CHR$ p%?-3+CHR$ p%?-2+CHR$ p%?-1 ELSE ty$="NULL"
    PROCftracef("PROCfree_structure("+ty$+")")
    PROCftracef("A% = &"+STR$~(A%)+", heap start @ &"+STR$~(A%!CONST_interface_heap_start))
  #endif
  IF p%=0 ENDPROC
  CASE p%!-4 OF
    WHEN CONST_ident_LSTD
      WHILE p%
        IF 0<=p%!CONST_lstd_num-1 THEN
          FOR i%=0 TO p%!CONST_lstd_num-1
            PROCfree_structure(p%!(i%*4+CONST_lstd_1st))
          NEXT
        ENDIF
        i%=p%!CONST_lstd_next
        B%=CONST_ident_LSTD
        C%=p%
        CALL code_entry%+CONST_entry_heap_free
        p%=i%
      ENDWHILE
    WHEN CONST_ident_BOOL
      PROCfree_structure(p%!CONST_bool_false)
      PROCfree_structure(p%!CONST_bool_true)
      B%=CONST_ident_BOOL
      C%=p%
      CALL code_entry%+CONST_entry_heap_free
    WHEN CONST_ident_INTG,CONST_ident_STRG,CONST_ident_STR0,CONST_ident_GSTR,CONST_ident_POTR
      B%=p%!-4
      C%=p%
      CALL code_entry%+CONST_entry_heap_free
  #ifdef Trace
      ty$=CHR$ p%?-4+CHR$ p%?-3+CHR$ p%?-2+CHR$ p%?-1 ELSE ty$="NULL"
      PROCftracef("After freeing, type is set to "+ty$)
  #endif
    WHEN CONST_ident_CHAR
      WHILE p%
        i%=!p%
        B%=CONST_ident_CHAR
        C%=p%
        CALL code_entry%+CONST_entry_heap_free
        p%=i%
      ENDWHILE
    OTHERWISE
      ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FAA",STR$~(p%-4))
  ENDCASE
ENDPROC

DEF PROCreceive(r%)
  /*WARNING! Message numbers here must be listed in PROCtask_initialise*/
  LOCAL s$,prnt%,psup%,wind%,to%,i%,mess_task%,mess_ref%
  Ftracef("PROCreceive")
  to%=task_buff%!4
  CASE task_buff%!16 OF
    WHEN 0 /*Quit*/
      PROCdestroy_queue
      PROChost_shutdown
    WHEN 1 /*DataSave*/
      PROCdatasave
    WHEN 2 /*DataSaveAck*/
      IF NOT task_buff%!36 THEN
        SYS "Wimp_CreateMenu",,-1
        i%=task_buff%+44
        CALL Z%,i%,s$ /*convert 0-terminated string*/
        PROCicon_write(connections%,CONST_conn_fname,s$)
      ENDIF
    WHEN 3 /*DataLoad*/
      PROCdataload
    WHEN 5 /*DataOpen*/
      /*Catch data open on PrntDefn files and load the data.*/
#ifdef LoadDoubleClickedDefns
      IF task_buff%!40=&FC6 THEN
        task_buff%!12=task_buff%!8
        task_buff%!16=4
        SYS "Wimp_SendMessage",17,task_buff%,to%
        Ftrace_Send(19,task_buff%,to%)
        PROCadd_to_prdata
      ENDIF
#endif
    WHEN 8 /*Prequit*/
      IF A%!CONST_interface_queue_entries THEN
        IF!task_buff%<>20 THEN
          IF(task_buff%!20 AND 1)=0 shutdown_type%=1 ELSE shutdown_type%=2
        ELSE
          shutdown_type%=1
        ENDIF
        task_buff%!12=task_buff%!8
        SYS "Wimp_SendMessage",19,task_buff%,to%
        Ftrace_Send(19,task_buff%,to%)
        A%!CONST_interface_global_mask=A%!CONST_interface_global_mask OR 1
        PROCmenu_window_centre(shutdown%)
      ENDIF
    WHEN 10 /*DesktopSave*/
      BPUT#task_buff%!20,"/"+FNtask_read_env("Printers$Dir",buff1%)
    WHEN 11 /*DeviceClaim*/
      /*Check all printing printers to see if they are using this device*/
      prnt%=A%!CONST_interface_printer_installed
      WHILE prnt%
        IF(prnt%!CONST_prnt_flags AND CONST_prnt_flags_printing)<>0 AND prnt%<>claim_ref% THEN
          /*if printer is printing*/
          r%=prnt%!CONST_prnt_cnct
          IF r%!CONST_cnct_type=task_buff%!20 AND task_buff%!24<=0 THEN
            s$=FNmsg_0(A%!CONST_interface_host_desc,"INU")
            !task_buff%=32+LEN s$ AND NOT 3
            task_buff%!12=task_buff%!8
            task_buff%!16=12 /*DeviceInUse*/
            $(task_buff%+28)=s$+CHR$ 0
            SYS "Wimp_SendMessage",17,task_buff%,to%
            Ftrace_Send(17,task_buff%,to%)
            prnt%=0
          ENDIF
        ENDIF
        IF prnt% prnt%=prnt%!CONST_prnt_next
      ENDWHILE
    WHEN 12 /*DeviceInUse*/
      claim_state%=2
    WHEN &502 /*HelpRequest*/
      IF FNone_of_ours(task_buff%!32)THEN
        PROCdetermine_help
      ELSE
        PROCprinter_find_handle(task_buff%!32,wind%,psup%,prnt%)
        IF wind% THEN
          PROCprinter_reason_code(psup%,prnt%,r%,task_buff%)
        ELSE
          /*it could be a menu*/
          IF NOT task_buff%!36 THEN
            IF menu_prnt% \
              PROCprinter_reason_code (menu_prnt%!CONST_prnt_psup,\
                  menu_prnt%,r%,task_buff%) \
            ELSE \
              PROCdetermine_help
          ENDIF
        ENDIF
      ENDIF
    WHEN &400C9
      /*menus deleted*/
      IF task_buff%!20=shutdown% THEN
        IFA%!CONST_interface_queue_entries>0  A%!CONST_interface_global_mask = A%!CONST_interface_global_mask AND NOT 1
      ELSE
        PROCcancel_menued_item
      ENDIF
    WHEN &80141
      /*WillPrint*/
      A%!CONST_interface_queue_tempfile=FALSE
    WHEN &80142
      /*PrintSave*/
      /*need to fake an icon drop, but only if there is a selected printer*/
      IF selected_prnt% THEN
        task_buff%!20=-2
        task_buff%!24=selected_prnt%!CONST_prnt_icon
        PROCdatasave
      ELSE
        prnt%=A%!CONST_interface_printer_installed
        IFprnt% THEN
          task_buff%!20=1
          s$=FNmsg_0(A%!CONST_interface_host_desc,"OKU")+CHR$ 0
        ELSE
          task_buff%!20=2
          s$=FNmsg_0(A%!CONST_interface_host_desc,"OKW")+CHR$ 0
        ENDIF
        !task_buff%=28+LEN s$ AND NOT 3
        task_buff%!12=task_buff%!8
        task_buff%!16=&80144 /*PrintError (used to be PrintFile!!)*/
        $(task_buff%+24)=s$+CHR$ 0
        SYS "Wimp_SendMessage",17,task_buff%,to%
        Ftrace_Send(17,task_buff%,to%)
      ENDIF
    WHEN &80143
      /*PrintInit*/
      /*Modified behaviour. On startup, broadcast a PrintInit (UserMessage-
        Recorded). If this bounces, carry on: if it is replied to, die.*/
      IF task_buff%!4<>task_handle% THEN
        IF task_buff%!0=20 THEN
          /*This is an old-style PrintInit: behave as before and quit.*/
          PROCdestroy_queue
          PROChost_shutdown
        ELSE
          /*It's from another one like me.*/
          IF task_buff%!12=task_your_ref% THEN
            /*This means there is a Printers already running: die!*/
            PROCerror_warning(FNmsg_0(A%!CONST_interface_host_desc,"FAJ"))
            PROCdestroy_queue
            PROChost_shutdown
          ELSE
            /*Reply to the message, and it won't start up.*/
            task_buff%!12=task_buff%!8
            task_buff%!20=34 /*version*/
            SYS "Wimp_SendMessage",17,task_buff%,to%
            Ftrace_Send(17,task_buff%,to%)
          ENDIF
        ENDIF
      ENDIF
/*
    WHEN &80145
 */
      /*PrintTypeOdd*/
      /*
        this is probably from us.
        ignore it.
        it saves us passing it around the back-ends
        NO! Let's try passing it about so that LaserDirect might work
      */
    WHEN &80146
      /*PrintTypeKnown*/
      type_state%=2
    WHEN &80152
      /*ResetPrinter*/
      IF selected_prnt% THEN
        Ftracef("PROCdo_select_printer loc 2")
        PROCdo_select_printer(selected_prnt%,TRUE,FALSE,FALSE)
      ENDIF
    WHEN &8014A
      /*PrintConfigure*/
      mess_task%=task_buff%!4
      mess_ref%=task_buff%!8
      CASE task_buff%!20 OF
      WHEN 0
        i%=task_buff%+24
        CALL Z%,i%,s$ /*convert 0-terminated string*/
        PROCread_paper_file(s$,CONST_psze_flag_userdefined)
        PROCsave_user_defined_paper_sizes
        i%=TRUE
      OTHERWISE
        i%=FALSE
      ENDCASE
      IF i% THEN
        /* Ack the message */
        task_buff%!12=mess_ref%
        SYS "Wimp_SendMessage",19,task_buff%,mess_task%
      ENDIF
    OTHERWISE
      /* a message required by a back-end: pass it around the houses */
      /* before we do so, however, ensure that we've initialised the */
      /* scrap setup.                                                */
      IFFNinitialise_scrap
      PROCbroadcast_reason_code(selected_prnt%,r%,task_buff%)
  ENDCASE
  Ftracef("ENDPROCreceive")
ENDPROC

DEF PROCdetermine_help
  LOCAL s$,prnt%,token$
  Ftracef("PROCdetermine_help")
  CASE task_buff%!32 OF
    WHEN -2
      IF A%!CONST_interface_printer_installed=0 THEN
        PROCinteractive_help(FNmsg_0(A%!CONST_interface_host_desc,"ICON0"))
        ENDPROC
      ENDIF
      PROCmatch_icon(task_buff%!36,prnt%)
      IF prnt%!CONST_prnt_name \
          s$=$prnt%!CONST_prnt_name ELSE s$=$prnt%!CONST_prnt_type
      PROCinteractive_help(FNmsg_1(A%!CONST_interface_host_desc,"ICON1",s$))
    WHEN save_wind%
      s$=FNmsg_0(A%!CONST_interface_host_desc,"SAVE"+STR$ task_buff%!36)
      IF s$="SAVE"+STR$ task_buff%!36 s$=FNmsg_0(A%!CONST_interface_host_desc,"SAVE")
      PROCinteractive_help(s$)
    WHEN shutdown%
      s$=FNmsg_0(A%!CONST_interface_host_desc,"SHTDWN"+STR$ task_buff%!36)
      IF s$="SHTDWN"+STR$ task_buff%!36 s$=FNmsg_0(A%!CONST_interface_host_desc,"SHTDWN")
      PROCinteractive_help(s$)
    WHEN howquery%
      s$=FNmsg_0(A%!CONST_interface_host_desc,"HWQRY"+STR$ task_buff%!36)
      IF s$="HWQRY"+STR$ task_buff%!36 s$=FNmsg_0(A%!CONST_interface_host_desc,"HWQRY")
      PROCinteractive_help(s$)
    WHEN papersize%
      s$=FNmsg_0(A%!CONST_interface_host_desc,"PAPER"+STR$ task_buff%!36)
      IF s$="PAPER"+STR$ task_buff%!36 s$=FNmsg_0(A%!CONST_interface_host_desc,"PAPER")
      PROCinteractive_help(s$)
    WHEN query%
      s$=FNmsg_0(A%!CONST_interface_host_desc,"QUERY"+STR$ task_buff%!36)
      IF s$="QUERY"+STR$ task_buff%!36 s$=FNmsg_0(A%!CONST_interface_host_desc,"QUERY")
      PROCinteractive_help(s$)
    WHEN A%!CONST_interface_queue
      PROCinteractive_help(FNmsg_0(A%!CONST_interface_host_desc,"QUEUE"))
    WHEN connections%
      token$="CNCT"+STR$ task_buff%!36
      IF task_buff%!36=CONST_conn_xon THEN
        IF FNicon_set(connections%,CONST_conn_xon)token$+="b" ELSE token$+="a"
      ENDIF
      IF task_buff%!36=CONST_conn_fappend THEN
        IF FNicon_set(connections%,CONST_conn_fappend) token$+="b" ELSE token$+="a"
      ENDIF
      IF task_buff%!36=CONST_conn_background THEN
        IF FNicon_set(connections%,CONST_conn_background) token$+="b" ELSE token$+="a"
      ENDIF
      s$=FNmsg_0(A%!CONST_interface_host_desc,token$)
      IF s$=token$ s$=FNmsg_0(A%!CONST_interface_host_desc,"CNCT")
      PROCinteractive_help(s$)
    WHEN prntctrl%
      PROCinteractive_help(FNmsg_0(A%!CONST_interface_host_desc,"PRCTRL"))
    WHEN info%
      PROCinteractive_help(FNmsg_0(A%!CONST_interface_host_desc,"INFO"))
    OTHERWISE /*must be menu help*/
      SYS "Wimp_GetMenuState",1,win_buff%,task_buff%!32,task_buff%!36
      CASE menu_chsn$ OF
        WHEN "ME1"
          IF!win_buff%<>2 THEN
            PROCinteractive_help(FNmsg_0(A%!CONST_interface_host_desc,"HME1-"+STR$!win_buff%))
          ELSE
            IF A%!CONST_interface_printer_active=0 THEN
              PROCinteractive_help(FNmsg_0(A%!CONST_interface_host_desc,"HME1-2a"))
            ELSE
              PROCinteractive_help(FNmsg_0(A%!CONST_interface_host_desc,"HME1-2"))
            ENDIF
          ENDIF
        WHEN "ME2","ME3","ME4","ME5","ME6","MP1"
          PROCinteractive_help(FNmsg_0(A%!CONST_interface_host_desc,"H"+menu_chsn$))
        WHEN "MQ1"
          IF FNmenu_shade(menu_top%,!win_buff%)THEN
            IF !win_buff%>3 AND menued_queu%=0 THEN
              PROCinteractive_help(FNmsg_0(A%!CONST_interface_host_desc,"SMQ1-7"))
            ELSE
              PROCinteractive_help(FNmsg_0(A%!CONST_interface_host_desc,"SMQ1-"+STR$(!win_buff%)))
            ENDIF
          ELSE
            IF !win_buff%<>4 THEN
              PROCinteractive_help(FNmsg_0(A%!CONST_interface_host_desc,"HMQ1-"+STR$(!win_buff%)))
            ELSE
              IF menued_queu%!CONST_queu_handle_in THEN
                PROCinteractive_help(FNmsg_0(A%!CONST_interface_host_desc,"HMQ1-4a"))
              ELSE
                PROCinteractive_help(FNmsg_0(A%!CONST_interface_host_desc,"HMQ1-4b"))
              ENDIF
            ENDIF
          ENDIF
        WHEN "MC1"
          IF FNmenu_shade(menu_top%,!win_buff%)THEN
            IF !win_buff%=6 THEN
              PROCinteractive_help(FNmsg_0(A%!CONST_interface_host_desc,"SMC1-6"))
              ENDPROC
            ENDIF
            SYS "Wimp_WhichIcon",prntctrl%,buff1%,1<<21,1<<21
            IF !buff1%=-1 THEN
              PROCinteractive_help(FNmsg_0(A%!CONST_interface_host_desc,"SMC1-2"))
            ELSE
              PROCinteractive_help(FNmsg_0(A%!CONST_interface_host_desc,"SMC1-0"))
            ENDIF
          ELSE
            PROCinteractive_help(FNmsg_0(A%!CONST_interface_host_desc,"HMC1-"+STR$!win_buff%))
          ENDIF
#ifdef Sparrow
        WHEN "MC1s"
          IF FNmenu_shade(menu_top%,!win_buff%)THEN
            IF !win_buff%=7 THEN
              PROCinteractive_help(FNmsg_0(A%!CONST_interface_host_desc,"SMC1s-7"))
              ENDPROC
            ENDIF
            IF !win_buff%=2 AND sparrow_present%=FALSE THEN
              PROCinteractive_help(FNmsg_0(A%!CONST_interface_host_desc,"SMC1s-2"))
              ENDPROC
            ENDIF
            SYS "Wimp_WhichIcon",prntctrl%,buff1%,1<<21,1<<21
            IF !buff1%=-1 THEN
              PROCinteractive_help(FNmsg_0(A%!CONST_interface_host_desc,"SMC1s-3"))
            ELSE
              PROCinteractive_help(FNmsg_0(A%!CONST_interface_host_desc,"SMC1s-0"))
            ENDIF
          ELSE
            PROCinteractive_help(FNmsg_0(A%!CONST_interface_host_desc,"HMC1s-"+STR$!win_buff%))
          ENDIF
#endif
      ENDCASE
  ENDCASE
ENDPROC


DEF PROCinteractive_help(m$)
  LOCAL to%
  Ftracef("PROCinteractive_help")
  !task_buff%=24+LEN m$ AND NOT 3
  task_buff%!12=task_buff%!8
  task_buff%!16=&503 /*HelpReply*/
  $(task_buff%+20)=m$+CHR$ 0
  to%=task_buff%!4
  SYS "Wimp_SendMessage",17,task_buff%,to%
  Ftrace_Send(17,task_buff%,to%)
ENDPROC

DEF PROCdatasave
  /*reply, quoting some scrap filename*/
  LOCAL s$,i%,y%,prnt%,queu%
  Ftracef("PROCdatasave")

  IF task_buff%!20=A%!CONST_interface_queue THEN
    /*fake this into a drop onto the appropriate icon*/
    !win_buff%=A%!CONST_interface_queue
    SYS "Wimp_GetWindowState",,win_buff%
    B%=task_buff%!32-win_buff%!16+win_buff%!24 /*was -! JRC 14 Apr '92*/
    y%=USR(code_entry%+CONST_entry_locate_entry_a)
    i%=A%!CONST_interface_scratch
    prnt%=!i%
    queu%=i%!4
    IF prnt% THEN
      task_buff%!20=-2
      task_buff%!24=prnt%!CONST_prnt_icon
    ENDIF
  ELSE
    PROCmatch_icon(task_buff%!24, prnt%)
  ENDIF

  IF task_buff%!20<>-2 \
      ERROR CONST_error_ok,FNmsg_0(A%!CONST_interface_host_desc,"OKN")

  /*we want to preserve the suggested leafname, making sure it is JUST a
    leaf*/
  i%=task_buff%+44
  CALL Z%,i%,s$ /*convert 0-terminated string*/

  i%=LEN s$
  WHILE i%>0
   IF MID$(s$,i%,1)="." OR MID$(s$,i%,1)=":" THEN
     s$=MID$(s$,i%+1)
     i%=0
   ENDIF
   i%-=1
  ENDWHILE
  queue_leafname$=s$
  A%!CONST_interface_queue_tempfile=FALSE
  queue_temphand%=task_buff%!4

  /* HUGE bug-fix

     If the printer is paused or suspended or the queue is not empty,
     reply with a DataSaveAck instead of a PrintFile
  */
  s$=FNtemporary_name(TRUE)
  IF (prnt%!CONST_prnt_queu)<>0 OR (prnt%!CONST_prnt_flags AND CONST_prnt_flags_suspaused)<>0 THEN
    SYS "XOS_SetVarVal","Printer$Temp",,-1
    task_buff%!0=48+LEN s$ AND NOT 3
    task_buff%!12=task_buff%!8
    task_buff%!16=2 /*DataSaveAck*/
    task_buff%!36=-1 /*we are not the Filer!*/
    $(task_buff%+44)=s$+CHR$ 0
    SYS "Wimp_SendMessage",17,task_buff%,queue_temphand%
    /* temporary file so remember reference */
    queue_tempref%=task_buff%!8
  ELSE
    /* for all those of you who hate the window manager almost as much as I do ... */
    /* here is another shitty bug fix */
    /* the problem is that the printer manager might need to issue Wimp messages to */
    /* do the device claiming, which then causes any pending recorded message received */
    /* to bounce. */
    /* the solution (hopefully) is to ACKNOWLEDGE the message first */
    task_buff%!12=task_buff%!8
    SYS "Wimp_SendMessage",19,task_buff%,queue_temphand%
    /* that now stops the Wimp bouncing the message, while we can now claim the device */

    /* select the appropriate printer before allowing printing */
    PROCdo_select_printer(prnt%,FALSE,FALSE,FALSE)

    /*Reply with a PrintFile (was "broadcast a PrintFile" Don't know why ...
      J R C 31st March 1993)*/
    Ftracef("Set Printer$Temp "+s$)
    SYS "OS_SetVarVal","Printer$Temp",s$,LEN s$
    /* offset 12 set above */
    task_buff%!16=&80140 /*PrintFile*/
    SYS "Wimp_SendMessage",18,task_buff%,queue_temphand%
    Ftrace_Send(18,task_buff%,queue_temphand%)
#ifdef Sparrow
    PROCsave_sender_info (queue_temphand%, queue_leafname$)
#endif
  ENDIF
ENDPROC

DEF FNtemporary_name(generate_error%)
  LOCAL c%
  Ftracef("FNtemporary_name")

  /*Ensure directory exists*/
  IFNOTFNinitialise_scrap THEN
    IFgenerate_error% THEN
      ERROR CONST_error_ok, FNmsg_0(A%!CONST_interface_host_desc, "OKAO")
    ELSE
      PROCerror_box(FNmsg_0(A%!CONST_interface_host_desc, "OKAO"),1)
      =""
    ENDIF
  ENDIF

  REPEAT
    /*Now always increments temp_count%: this ensures that the same name is
      not generated twice running - very important!!*/
    temp_count%+=1
    SYS "OS_File",17,"<Wimp$ScrapDir>.Printers."+STR$ temp_count% TO c%
        /*ReadNoPath*/
  UNTIL c%=0

  Ftracef("  -> "+FNgstrans("<Wimp$ScrapDir>.Printers."+STR$ temp_count%))
=FNgstrans("<Wimp$ScrapDir>.Printers."+STR$ temp_count%)

DEF PROCdataload
  LOCAL s$,i%,prnt%,sender$,leaf$,type%,to%
  Ftracef("PROCdataload")

  IF task_buff%!40=&FC6 AND task_buff%!20=prntctrl% THEN
    PROCadd_to_prdata
    ENDPROC
  ENDIF

  /* just double-check the object type */
  i%=task_buff%+44
  CALL Z%,i%,leaf$ /*convert 0-terminated string*/
  SYS"OS_File",17,leaf$ TO type%
  /* turn image files into directories */
  IF(type%AND2) AND (task_buff%!40<&1000) task_buff%!40=&1000

  IF task_buff%!20=A%!CONST_interface_queue THEN
    /*fake this into a drop onto the appropriate icon*/
    !win_buff%=A%!CONST_interface_queue
    SYS "Wimp_GetWindowState",,win_buff%
    B%=task_buff%!32-win_buff%!16+win_buff%!24 /*was -! JRC 14 Apr '92*/
    y%=USR(code_entry%+CONST_entry_locate_entry_a)
    i%=A%!CONST_interface_scratch
    prnt%=!i%
    queu%=i%!4
    IF prnt% THEN
      task_buff%!20=-2
      task_buff%!24=prnt%!CONST_prnt_icon
    ENDIF
  ENDIF

  IF task_buff%!20<>-2 \
      ERROR CONST_error_ok,FNmsg_0(A%!CONST_interface_host_desc,"OKN")

  /*acknowledge the file*/
  A%!CONST_interface_queue_tempfile=\
      queue_tempref%<>0 AND queue_tempref%=task_buff%!12
  task_buff%!12=task_buff%!8
  task_buff%!16=4 /*DataLoadAck*/
  to%=task_buff%!4
  SYS "Wimp_SendMessage",17,task_buff%,to%
  Ftrace_Send(17,task_buff%,to%)
  queue_tempref%=0

  PROCmatch_icon(task_buff%!24,prnt%)
  type%=task_buff%!40
  IF prnt%=0 THEN
    /*If no printer is selected, allow loading of a new prnt defn file.*/
    IF type%<>&FC6 ERROR CONST_error_ok,FNmsg_0(A%!CONST_interface_host_desc,"OKW")
    PROCadd_to_prdata
    ENDPROC
  ENDIF

  /*now create the queue entry*/
  IF A%!CONST_interface_queue_tempfile THEN
    SYS "TaskManager_TaskNameFromHandle",queue_temphand% TO i%
    CALL Z%,i%,sender$ /*convert 0-terminated string*/
    leaf$=queue_leafname$
    s$=FNtask_read_env("Printer$Temp",buff1%)
    IF s$="" i%=task_buff%+44: CALL Z%,i%,s$ /*convert 0-terminated string*/
  ELSE
    /*create the various strings*/
    i%=task_buff%+44: CALL Z%,i%,s$ /*convert 0-terminated string*/
    i%=LEN s$: WHILE MID$(s$,i%,1)<>".": i%-=1: ENDWHILE
    leaf$=MID$(s$,i%+1)
    i%=1: WHILE MID$(s$,i%,1)<>".": i%+=1: ENDWHILE
    sender$=LEFT$(s$,i%-1)
  ENDIF
  PROCadd_queue_entry(A%!CONST_interface_queue_tempfile,sender$,s$,leaf$,\
      prnt%,type%)
ENDPROC

DEF PROCcancel_menued_item
  Ftracef("PROCcancel_menued_item")
  CASE menu_chsn$ OF
    WHEN "MQ1"
      IF menued_prnt% THEN
        /*cancel the appropriate highlight flag*/
        IF menued_queu% \
          menued_queu%?CONST_queu_status=\
              menued_queu%?CONST_queu_status AND NOT 8 \
        ELSE \
          menued_prnt%!CONST_prnt_flags=\
              menued_prnt%!CONST_prnt_flags AND NOT CONST_prnt_flags_highlighted
        PROCredraw_queue_entry(-1,menued_prnt%,menued_queu%)
        menued_y%=0
        menued_prnt%=0
        menued_queu%=0
      ENDIF
    WHEN "MC1", "MC1s"
      SYS "Wimp_WhichIcon",prntctrl%,buff1%,1<<21,1<<21
      IF NOT !buff1% AND buff1%!4=-1 AND select_all%=FALSE PROCicon_deselect(prntctrl%,!buff1%)
  ENDCASE
  menu_chsn$=""
ENDPROC

DEF PROCack
  LOCAL s$,prnt%,queu%,cnct%,spooling%,spool_file$,psup%,ptmp$,t%,load%,\
    size%,from%,leaf$
#ifdef Sparrow
  LOCAL qname$, prnt%, found%, sname$, name$, application$
#endif
  Ftracef("PROCack")
  CASE task_buff%!16 OF
    WHEN 11 /*DeviceClaim*/
      claim_state%=1
    WHEN &80140 /*PrintFile*/
      /*PrintFile bounced. If the queue is empty, issue a PrintTypeOdd by
        recorded delivery. If we get PrintTypeKnown, stop now; otherwise, we
        have to queue it anyway for a later broadcast PrintTypeOdd (this
        corresponds to an application sending us a file that it cannot print
        itself). If the queue is not empty, issue a DataSaveAck.*/

      Ftracef("{Data,Print}Save on icon "+STR$ task_buff%!24)
      PROCmatch_icon(task_buff%!24,prnt%)
      IF prnt%=0 \
          ERROR CONST_error_ok,FNmsg_0(A%!CONST_interface_host_desc,"OKW")

      queu%=prnt%!CONST_prnt_queu
      psup%=prnt%!CONST_prnt_psup
      cnct%=prnt%!CONST_prnt_cnct

      /*Is the queue empty and not paused?*/
      IF queu%=0 AND(prnt%!CONST_prnt_flags AND CONST_prnt_flags_suspaused)=0 THEN
        /*Yes - issue a PrintTypeOdd to the application. N B the file name
            in this is irrelevant and undefined.*/
        Ftracef("Print queue is EMPTY - shortcircuit protocol is GO")

        i%=task_buff%+44: CALL Z%,i%,leaf$

        /*First, redirect the output to a spool file if necessary, i e: if
          printing to file, spool if output is to be appended. If not, spool
          if this is a background queue.*/
#ifdef Sparrow
        CASE cnct%!CONST_cnct_type OF
         WHEN 5
          spooling%=(cnct%?CONST_cnct_flags AND 2)<>0
         WHEN 9
          spooling% = FALSE
         OTHERWISE
          spooling%=(cnct%?CONST_cnct_flags AND 1)<>0
        ENDCASE
#else
        IF cnct%!CONST_cnct_type=5 THEN
          spooling%=(cnct%?CONST_cnct_flags AND CONST_cnct_flags_append)<>0
        ELSE
          spooling%=(cnct%?CONST_cnct_flags AND CONST_cnct_flags_background)<>0
        ENDIF
#endif
        IF spooling% THEN
          printer_output$=FNtemporary_name(TRUE)
          IFcnct%!CONST_cnct_type=5 THEN
           Ftracef("%Set PrinterType$5 "+printer_output$)
           SYS "OS_SetVarVal","PrinterType$5",printer_output$,LEN printer_output$
           PROCfx5(5)
          ELSE
           Ftracef("%Set PrinterType$10 "+printer_output$)
           SYS "OS_SetVarVal","PrinterType$10",printer_output$,LEN printer_output$
           PROCfx5(10)
          ENDIF
          Ftracef("***SPOOLING via "+printer_output$)
          spool_file$=printer_output$
        ENDIF

        /*Can the application print this file now?*/
        ptmp$=FNtemporary_name(TRUE)
        Ftracef("%Set Printer$Temp "+ptmp$)
        SYS "OS_SetVarVal","Printer$Temp",ptmp$,LEN ptmp$

        task_buff%!0=20
        /*task_buff%!12=task_buff%!8 Not wanted here either.*/
        task_buff%!16=&80145 /*PrintTypeOdd*/
        SYS "Wimp_SendMessage",18,task_buff%,queue_temphand%
        Ftrace_Send(18,task_buff%,queue_temphand%)
        type_state%=0
        REPEAT
          PROCdespatch_poll(message_mask%)
        UNTIL type_state%

        b%=(type_state%=2)
        from%=task_buff%!4
          /*If b%, either the file has been printed or saved to Printer$Temp
            by an application. Otherwise, the application is not interested
            in the file, so we have to queue it anyway.
          */

        IF spooling% THEN
          Ftracef("Reset the connection to what it should be")
          s$=FNselect_connection(prnt%,TRUE,FALSE)
          IF s$<>"" THEN
            PROCerror_warning(s$)
            IF prnt%!CONST_prnt_queu THEN
              prnt%!CONST_prnt_flags = prnt%!CONST_prnt_flags OR CONST_prnt_flags_paused
              PROCprinter_status(prnt%)
              PROCredraw_queue_entry(-1,prnt%,0)
            ENDIF
          ENDIF
        ENDIF

        Ftracef("reply is "+STR$ type_state%+\
            " from task &"+STR$~task_buff%!4)
        IF b% THEN
          Ftracef("PrintTypeOdd replied to: file has been printed")

          SYS "OS_File",17,ptmp$ TO t%,,load%,,size% /*ReadNoPath*/
          IF t% THEN
            Ftracef("Printer$Temp found: queuing it")

            /*if the previous file was temporary, delete it*/
#if FALSE
  /*
     PJC: this code looks DODGY! code above checks for queu% being ZERO
          so the value can't be referenced
  */
            IF queu%?CONST_queu_status AND 2 THEN
              IF file_to_delete$<>"" SYS "XOS_File",6,file_to_delete$
                    /*Delete*/ /*Just in case*/
              file_to_delete$=$queu%!CONST_queu_path
            ENDIF
#endif

            /*Set things up so that this file is added to the queue.*/
            s$=ptmp$
            SYS "OS_File",23,ptmp$ TO,,,,,,type% /*ReadStampedNoPath*/
          ELSE
            Ftracef("No Printer$Temp - file has actually been printed")
            IF spooling% THEN
              /*What we do now depends on why we were spooling.*/
              IF cnct%!CONST_cnct_type=5 THEN
                /*It was because the stuff we've just got has to be appended
                  to a file - so do it.*/
                PROCappend_file($cnct%!CONST_cnct_file,spool_file$)
                Ftracef("ENDPROCack")
                ENDPROC
              ELSE
                /*It was because the file is to be printed in background.
                  Set things up so that the spooled file is added to the
                  queue.*/
                Ftracef("add spooled file to queue")
                s$=spool_file$
                type%=psup%!CONST_psup_type
              ENDIF
            ELSE
              Ftracef("nothing else to do apart from restore the correct connection")
#ifdef Sparrow
              IF cnct%!CONST_cnct_type = 9 AND printer_prefix$<>"" THEN
                Ftracef("End of job for connection type 9")
                name$ = $(prnt%!CONST_prnt_name)
                ptr% = INSTR(name$, " ")
                WHILE ptr%
                  MID$(name$,ptr%,1) = CHR$160
                  ptr% = INSTR(name$, " ", ptr%+1)
                ENDWHILE
                sname$ = printer_prefix$+"RemSpool."+unique_string$+"."+name$
                qname$ = printer_prefix$+"RemQueue."+unique_string$+"."+STR$(remote_jobno%)

                SYS"XOS_File",17,sname$ TO t%,,,,l%;f%
                /* check that there is something there to print */
                IF (l% > 0) AND ((f% AND 1) = 0) AND (t% = 1) THEN
                  SYS "TaskManager_TaskNameFromHandle",queue_temphand% TO i%
                  CALL Z%,i%,application$
                  IF FNwrite_information_file (prnt%, application$, leaf$) THEN
                    Ftracef ("Trying to rename from "+sname$+" to "+qname$)
                    lpsup% = selected_prnt%!CONST_prnt_psup
                    /*SYS "XOS_File", 18, sname$, lpsup%!CONST_psup_type*/
                    SYS "XOS_FSControl", 25, sname$, qname$
                  ELSE
                    Ftracef ("Deleting "+sname$+" because of an error")
                    SYS "XOS_File", 6, sname$
                  ENDIF
                ENDIF
              ENDIF
#endif
              PROCdo_select_printer(selected_prnt%,FALSE,TRUE,FALSE)
              Ftracef("ENDPROCack")
              ENDPROC
            ENDIF
          ENDIF

          SYS "TaskManager_TaskNameFromHandle",from% TO sender$

          /*we want to preserve the suggested leafname, making sure it is
            JUST a leaf*/
          i%=LEN leaf$
          WHILE i%>0
            IF MID$(leaf$,i%,1)="." OR MID$(leaf$,i%,1)=":" THEN
              leaf$=MID$(leaf$,i%+1)
              i%=0
            ENDIF
            i%-=1
          ENDWHILE

          Ftracef("Queuing "+s$+" as "+leaf$+" from "+sender$)
          PROCadd_queue_entry(TRUE,sender$,s$,leaf$,prnt%,type%)
          Ftracef("ENDPROCack")
          ENDPROC
          /*end of code for a printed file*/
        ENDIF
        /*end of code for an active, empty queue*/
      ENDIF

      /*
         restore the selected printer as originally diverted in PROCdatasave
         ... we hope :-)
      */
      PROCdo_select_printer(prnt%,FALSE,TRUE,FALSE)
      Ftracef("Queue not empty, or PrintTypeOdd bounced")
      /*Issue DataSaveAck to queue the file*/
      SYS "OS_SetVarVal","Printer$Temp",,-1
      Ftracef("%Unset Printer$Temp")
      s$=FNtemporary_name(TRUE)
      Ftracef("replacing name for DataSaveAck message with "+s$)
      task_buff%!0=48+LEN s$ AND NOT 3
      /*task_buff%!12=task_buff%!8: REM Not wanted here.*/
      task_buff%!16=2 /*DataSaveAck*/
      task_buff%!36=-1 /*we are not the Filer!*/
      $(task_buff%+44)=s$+CHR$ 0
      SYS "Wimp_SendMessage",17,task_buff%,queue_temphand%
      Ftrace_Send(17,task_buff%,queue_temphand%)
      /*Save the your_ref of the message - it indicates a temporary file*/
      queue_tempref%=task_buff%!8
    WHEN &80145 /*PrintTypeOdd*/
      type_state%=1
    OTHERWISE
      PROCbroadcast_reason_code(selected_prnt%,19,task_buff%)
  ENDCASE
  Ftracef("ENDPROCack")
ENDPROC

DEF PROChost_shutdown
  LOCAL psup%
#ifdef Sparrow
  LOCAL prnt%, name$, type%, name$, ip%, f%, cnct%
#endif
  Ftracef("PROChost_shutdown")

  /*in case !FontPrint is active, let it know that we are dying*/
  PROCtell_the_world

#ifdef Sparrow

  IF selected_prnt% THEN

    name$ = $selected_prnt%!CONST_prnt_name
    cnct% = selected_prnt%!CONST_prnt_cnct
    psup% = selected_prnt%!CONST_prnt_psup
    type% = psup%!CONST_psup_type

    IF cnct%!CONST_cnct_type = 9 THEN
      SYS "XFreeway_Read", 0, CONST_freewaytype_printers, name$, 0, 0 TO ,,,,,ip% ; f%

      IF (ip% > 0) AND ((f% AND 0) = 0) THEN
        SYS "XRemotePrinterSupport_Enable", 0, ip%, name$, type%
      ENDIF

    ENDIF

  ENDIF

  /*
   * Tell the world all those printers are going away
   */

  IF sparrow_present% THEN
    prnt% = A%!CONST_interface_printer_installed

    WHILE prnt%
      IF (prnt%!CONST_prnt_flags) AND CONST_prnt_flags_shared THEN
        IF (prnt%!CONST_prnt_name = 0) THEN
          psup% = prnt%!CONST_prnt_psup
          name$ = $psup%!CONST_psup_class
        ELSE
          name$ = $prnt%!CONST_prnt_name
        ENDIF
        PROCunshare_one_printer (prnt%)
      ENDIF
      prnt% = prnt%!CONST_prnt_next
    ENDWHILE
/*
    IF directories_shared% THEN
      PROCunshare_directories
    ENDIF
*/
  ENDIF
#endif

  /*ensure that we have left the scrap system clean*/
#ifdef SparrowNotAnyMore
  /*
   * But leave RemQueue & RemSpool there!
   */
  SYS "XOS_CLI","%Wipe <Wimp$ScrapDir>.Printers.* F~C~V"
  IF sparrow_present% THEN
    SYS "XOS_CLI","%Wipe <Wimp$ScrapDir>.Printers.RemSpool."+unique_string$+" RF~C~V"
    SYS "XOS_CLI","%Wipe <Wimp$ScrapDir>.Printers.RemQueue."+unique_string$+" RF~C~V"
  ENDIF
#else
  SYS "XOS_CLI","%Wipe <Wimp$ScrapDir>.Printers.* RF~C~V"
#endif

  /*shutdown all the message files*/
  psup%=psup_head%
  WHILE psup%
    PROCmsg_end(psup%!CONST_psup_msg)
    psup%=psup%!CONST_psup_next
  ENDWHILE
  PROCmsg_end(A%!CONST_interface_host_desc)

  /*for all module support libraries, call the finalisation routine.
    No need to free the block occupied since it is in our private heap*/
  PROCbroadcast_reason_code(0,-2,0)
  PROCtask_shutdown
ENDPROC

DEF PROCkeypress
  LOCAL psup%,prnt%,wind%,old_name$,new_name$,old_selected_prnt%
  Ftracef("PROCkeypress")
  IF NOT FNone_of_ours(!task_buff%) THEN
    Ftracef("foreign key press")
    PROCprinter_find_handle(!task_buff%,wind%,psup%,prnt%)
    /*
       Before we pass the key press on, get the current printer name
    */
    IF prnt%!CONST_prnt_name old_name$=$prnt%!CONST_prnt_name ELSE old_name$=""
    old_selected_prnt%=selected_prnt%
    PROCprinter_reason_code(psup%,prnt%,8,task_buff%)
    IF $(wind%+CONST_wind_name)="configure" THEN
      IF prnt%!CONST_prnt_name new_name$=$prnt%!CONST_prnt_name ELSE new_name$=""
      IF new_name$<>old_name$ THEN
#ifdef Sparrow
       IF NOT (prnt%!CONST_prnt_flags AND CONST_prnt_flags_shared) THEN
        /* If we're not a shared printer */
#endif
        PROCredraw_prntctrl_entry(prnt%)
        PROCprinter_status(prnt%)
        PROCredraw_queue_entry(-1,prnt%,0)
        /*
           If the back end uses our connection window and it is open,
           reopen it to update the name in the window
        */
        IF(psup%!CONST_psup_flags AND CONST_psup_flags_backend_connections)=0 \
          IF FNwindow_open(connections%) \
            PROCopen_connections_window(prnt%)
#ifdef Sparrow
       ELSE
        PROCerror_warning (FNmsg_0(A%!CONST_interface_host_desc,"OKAP"))
        new_name$ = old_name$
        PROCfree (CONST_ident_STRG, prnt%!CONST_prnt_name)
        PROCstrcpy (prnt%!CONST_prnt_name, old_name$)
       ENDIF
#endif
      ENDIF
      IF prnt%!CONST_prnt_icon<>-1 AND old_selected_prnt%<>selected_prnt% THEN
        /* back-end has selected its printer ... reselect old printer */
        PROCdo_select_printer(old_selected_prnt%,TRUE,FALSE,FALSE)
      ENDIF
    ENDIF
  ELSE
    IF task_buff%!24=13 THEN
      CASE !task_buff% OF
        WHEN connections%
          PROCsave_connection
          IF menu_chsn$="ME6" SYS "Wimp_CreateMenu",,-1
          !task_buff%=connections%
          PROCclose_window
        WHEN papersize%
          PROCsave_papersize
          !task_buff%=papersize%
          PROCclose_window
        WHEN save_wind%
          SYS "Wimp_CreateMenu",,-1
          /* SMC: pathname is now canonicalised before being stored */
          PROCicon_write(connections%,CONST_conn_fname,\
              FNcanonicalise(FNicon_read(save_wind%,CONST_save_nm)))
      ENDCASE
    ELSE
      SYS "Wimp_ProcessKey",task_buff%!24
    ENDIF
  ENDIF
ENDPROC

DEF PROCunset_selection(window%)
  LOCAL i%
  Ftracef("PROCunset_selection")
  !win_buff%=window%
  SYS "Wimp_GetWindowInfo",,win_buff% OR 1
  i%=win_buff%!88
  WHILE i%
    PROCicon_deselect(window%,i%-1)
    i%-=1
  ENDWHILE
ENDPROC

DEF PROCmouseclick
  LOCAL prnt%,icon%,queu%,tpub%,psup%,wind%,new_name$,old_name$,B%,C%,old_selected_prnt%
#ifdef Sparrow
  LOCAL rmtp%
#endif
  Ftracef("PROCmouseclick")
  IF FNone_of_ours(task_buff%!12)=FALSE THEN
    Ftracef("foreign mouseclick")
    PROCprinter_find_handle(task_buff%!12,wind%,psup%,prnt%)
    /*
       Before we pass the key press on, get the current printer name
    */
    IF prnt%!CONST_prnt_name old_name$=$prnt%!CONST_prnt_name ELSE old_name$=""
    old_selected_prnt%=selected_prnt%
    PROCprinter_reason_code(wind%!CONST_wind_psup,wind%!CONST_wind_prnt,6,task_buff%)
    IF $(wind%+CONST_wind_name)="configure" THEN
      IF prnt%!CONST_prnt_name new_name$=$prnt%!CONST_prnt_name ELSE new_name$=""
      IF new_name$<>old_name$ THEN
#ifdef Sparrow
       IF NOT (prnt%!CONST_prnt_flags AND CONST_prnt_flags_shared) THEN
        /* If we're not a shared printer */
#endif
        PROCredraw_prntctrl_entry(prnt%)
        PROCprinter_status(prnt%)
        PROCredraw_queue_entry(-1,prnt%,0)
        /*
           If the back end uses our connection window and it is open,
           reopen it to update the name in the window
        */
        IF(psup%!CONST_psup_flags AND CONST_psup_flags_backend_connections)=0 \
          IF FNwindow_open(connections%) \
            PROCopen_connections_window(prnt%)
#ifdef Sparrow /* This code shouldn't happen anymore, but is here just in case */
       ELSE
        PROCerror_warning (FNmsg_0(A%!CONST_interface_host_desc,"OKAP"))
        new_name$ = old_name$
        PROCfree (CONST_ident_STRG, prnt%!CONST_prnt_name)
        PROCstrcpy (prnt%!CONST_prnt_name, old_name$)
       ENDIF
#endif
      ENDIF
      IF prnt%!CONST_prnt_icon<>-1 AND old_selected_prnt%<>selected_prnt% THEN
        /* back-end has selected its printer ... reselect old printer */
        PROCdo_select_printer(old_selected_prnt%,TRUE,FALSE,FALSE)
      ENDIF
    ENDIF
  ELSE
    CASE task_buff%!8 OF
      WHEN 1024 /*SELECT*/
        CASE task_buff%!12 OF
          WHEN prntctrl%
            IF NOT task_buff%!16 THEN
              IF NOT FNicon_set(task_buff%!12,task_buff%!16)THEN
                PROCunset_selection(task_buff%!12)
                PROCicon_select(task_buff%!12,task_buff%!16)
              ENDIF
            ELSE
              PROCunset_selection(task_buff%!12)
            ENDIF
        ENDCASE
      WHEN 256 /*ADJUST*/
        CASE task_buff%!12 OF
          WHEN prntctrl%
            IF NOT task_buff%!16 THEN
              IF FNicon_set(task_buff%!12,task_buff%!16)THEN
                PROCicon_deselect(task_buff%!12,task_buff%!16)
              ELSE
                PROCicon_select(task_buff%!12,task_buff%!16)
              ENDIF
            ENDIF
        ENDCASE
      WHEN 64 /*Drag SELECT*/
        IF task_buff%!12=save_wind% \
          PROCsave_dragicon(!task_buff%,task_buff%!4)
      WHEN 2 /*MENU*/
        CASE task_buff%!12 OF
          WHEN -2
            PROCmenu("ME1",TRUE,FALSE)
          WHEN A%!CONST_interface_queue
            PROCmenu("MQ1",TRUE,FALSE)
          WHEN prntctrl%
#ifdef Sparrow
            PROCmenu("MC1s",TRUE,FALSE)
#else
            PROCmenu("MC1",TRUE,FALSE)
#endif
          WHEN connections%
            CASE task_buff%!16 OF
              WHEN CONST_conn_bmenu
                PROCmenu("ME2",TRUE,TRUE)
              WHEN CONST_conn_dmenu
                PROCmenu("ME3",TRUE,TRUE)
              WHEN CONST_conn_pmenu
                PROCmenu("ME4",TRUE,TRUE)
              WHEN CONST_conn_smenu
                PROCmenu("ME5",TRUE,TRUE)
              WHEN CONST_conn_emenu
                PROCmenu("ME6",TRUE,TRUE)
              WHEN CONST_conn_fmenu
                PROCmenu("SVE",TRUE,TRUE)
            ENDCASE
          WHEN papersize%
            IF task_buff%!16=CONST_paper_menu PROCmenu("MP1",TRUE,TRUE)
        ENDCASE
      WHEN 4 /*(Double-click?) SELECT*/
        CASE task_buff%!12 OF
          WHEN -2
            PROCprinter_selection
          WHEN query%
            query_state%=task_buff%!16
          WHEN howquery%
            query_state%=task_buff%!16
          WHEN save_wind%
            IF task_buff%!16=CONST_save_ok THEN
              SYS "Wimp_CreateMenu",,-1
              /* SMC: pathname is now canonicalised before being stored */
              PROCicon_write(connections%,CONST_conn_fname,\
                  FNcanonicalise(FNicon_read(save_wind%,CONST_save_nm)))
            ENDIF
          WHEN shutdown%
            SYS "Wimp_CreateMenu",,-1
            IF task_buff%!16=CONST_shutdown_abandon THEN
              !task_buff%=A%!CONST_interface_queue
              PROCclose_window
              PROCdestroy_queue
              CASE shutdown_type% OF
                WHEN 1 /*received a message*/
                  SYS "Wimp_ProcessKey",&1FC
                WHEN 2 /*quit or cancelled fatal error*/
                  PROChost_shutdown
              ENDCASE
            ELSE
              /*re-enable nulls*/
              A%!CONST_interface_global_mask=\
                  A%!CONST_interface_global_mask AND NOT 1
            ENDIF
          WHEN prntctrl%
            IF NOT task_buff%!16 THEN
              /*turn a double-click into configuration*/
              IFNOTFNicon_set(task_buff%!12,task_buff%!16) THEN
                PROCunset_selection(task_buff%!12)
                PROCicon_select(task_buff%!12,task_buff%!16)
              ENDIF
#ifdef Sparrow
              PROCfind_prnt(prnt%,rmtp%,icon%)
              IF prnt% THEN
                PROCprinter_reason_code(prnt%!CONST_prnt_psup,prnt%,-3,0)
                PROCprinter_open_window(prnt%,"configure")
              ENDIF
              /*
               * If an rmtp is returned - do nothing. We can't open the
               * configuration window of a printer *until* we make it
               * active, at which point it becomes a prnt%
               */
#else
              PROCfind_prnt(prnt%,icon%)
              PROCprinter_reason_code(prnt%!CONST_prnt_psup,prnt%,-3,0)
              PROCprinter_open_window(prnt%,"configure")
#endif
            ENDIF
          WHEN connections%
            CASE task_buff%!16 OF
              WHEN CONST_conn_parallel,CONST_conn_serial,CONST_conn_econet,\
                  CONST_conn_nfs,CONST_conn_file,CONST_conn_direct,CONST_conn_lpr,\
                  CONST_conn_lanman,CONST_conn_lanman98,CONST_conn_jetdirect
                PROCcheck_shaded_connections
              WHEN CONST_conn_ok
                PROCsave_connection
                !task_buff%=connections%
                PROCclose_window
              WHEN CONST_conn_bmenu
                PROCmenu("ME2",TRUE,TRUE)
              WHEN CONST_conn_dmenu
                PROCmenu("ME3",TRUE,TRUE)
              WHEN CONST_conn_pmenu
                PROCmenu("ME4",TRUE,TRUE)
              WHEN CONST_conn_smenu
                PROCmenu("ME5",TRUE,TRUE)
              WHEN CONST_conn_emenu
                PROCmenu("ME6",TRUE,TRUE)
              WHEN CONST_conn_fmenu
                PROCmenu("SVE",TRUE,TRUE)
              WHEN CONST_conn_cancel
                !task_buff%=connections%
                PROCclose_window
            ENDCASE
          WHEN papersize%
            CASE task_buff%!16 OF
              WHEN CONST_paper_save
                PROCsave_papersize
                !task_buff%=papersize%
                PROCclose_window
              WHEN CONST_paper_delete
                PROCdelete_papersize
                !task_buff%=papersize%
                PROCclose_window
              WHEN CONST_paper_cancel
                B%=CONST_ident_PSZE
                C%=psize_edit%
                CALL code_entry%+CONST_entry_heap_free
                psize_edit%=0
                !task_buff%=papersize%
                PROCclose_window
              WHEN CONST_paper_mm,CONST_paper_in
                PROCicon_select(papersize%,task_buff%!16)
                PROCreview_papersize_units
              WHEN CONST_paper_menu
                PROCmenu("MP1",TRUE,TRUE)
            ENDCASE
          OTHERWISE
            /*probably a pause window, but find it anyway!*/
            prnt%=A%!CONST_interface_printer_installed
            WHILE prnt%
              IF prnt%!CONST_prnt_pause=task_buff%!12 THEN
                /*got it! now deal with the click*/
                queu%=prnt%!CONST_prnt_queu
                tpub%=queu%!CONST_queu_tpub
                IF tpub% THEN
                  IF tpub%!CONST_tpub_pause_flag THEN
                    IF  task_buff%!16=4 THEN
                      PROCdelete_queue_entry(prnt%,queu%,TRUE)
                    ELSE
                      prnt%!CONST_prnt_flags=prnt%!CONST_prnt_flags AND NOT CONST_prnt_flags_suspaused
                      tpub%!CONST_tpub_pause_flag=0
                      PROCprinter_status(prnt%) /*redraw icon string*/
                      PROCredraw_queue_entry(-1,prnt%,0) /*redraw queue text*/
                      !task_buff%=prnt%!CONST_prnt_pause
                      PROCclose_window
                    ENDIF
                  ENDIF
                ENDIF
                prnt%=0
              ELSE
                prnt%=prnt%!CONST_prnt_next
              ENDIF
            ENDWHILE
        ENDCASE
      WHEN 1 /*(Double-click?) ADJUST*/
        CASE task_buff%!12 OF
          WHEN -2
            PROCprinter_selection
          WHEN connections%
            CASE task_buff%!16 OF
              WHEN CONST_conn_parallel,CONST_conn_serial,CONST_conn_econet,\
                  CONST_conn_nfs,CONST_conn_file,CONST_conn_direct,CONST_conn_lpr,\
                  CONST_conn_lanman,CONST_conn_lanman98,CONST_conn_jetdirect
                PROCcheck_shaded_connections
              WHEN CONST_conn_ok
                PROCsave_connection
            ENDCASE
          WHEN papersize%
            CASE task_buff%!16 OF
              WHEN CONST_paper_save
                PROCsave_papersize
              WHEN CONST_paper_delete
                PROCdelete_papersize
              WHEN CONST_paper_mm,CONST_paper_in
                PROCicon_select(papersize%,task_buff%!16)
                PROCreview_papersize_units
            ENDCASE
        ENDCASE
    ENDCASE
  ENDIF
ENDPROC

DEF PROCcheck_shaded_connections
  LOCAL c%,h%,i%,n%
  Ftracef("PROCcheck_shaded_connections")
  c%=-1
  IF FNicon_set(connections%,CONST_conn_parallel) AND FNparallel_error_detect_possible THEN
   PROCicon_unshade(connections%,CONST_conn_perrors)
   PROCicon_unshade(connections%,CONST_conn_perrors_lbl)
  ELSE
   PROCicon_shade(connections%,CONST_conn_perrors)
   PROCicon_shade(connections%,CONST_conn_perrors_lbl)
  ENDIF
  IF FNicon_set(connections%,CONST_conn_serial)THEN
   PROCicon_unshade(connections%,CONST_conn_baud)
   PROCicon_unshade(connections%,CONST_conn_bmenu)
   PROCicon_unshade(connections%,CONST_conn_data)
   PROCicon_unshade(connections%,CONST_conn_dmenu)
   PROCicon_unshade(connections%,CONST_conn_parity)
   PROCicon_unshade(connections%,CONST_conn_pmenu)
   PROCicon_unshade(connections%,CONST_conn_stop)
   PROCicon_unshade(connections%,CONST_conn_smenu)
   PROCicon_unshade(connections%,CONST_conn_xon)
   PROCicon_unshade(connections%,CONST_conn_baud_lbl)
   PROCicon_unshade(connections%,CONST_conn_data_lbl)
   PROCicon_unshade(connections%,CONST_conn_parity_lbl)
   PROCicon_unshade(connections%,CONST_conn_stop_lbl)
   PROCicon_unshade(connections%,CONST_conn_xon_lbl)
  ELSE
   PROCicon_shade(connections%,CONST_conn_baud)
   PROCicon_shade(connections%,CONST_conn_bmenu)
   PROCicon_shade(connections%,CONST_conn_data)
   PROCicon_shade(connections%,CONST_conn_dmenu)
   PROCicon_shade(connections%,CONST_conn_parity)
   PROCicon_shade(connections%,CONST_conn_pmenu)
   PROCicon_shade(connections%,CONST_conn_stop)
   PROCicon_shade(connections%,CONST_conn_smenu)
   PROCicon_shade(connections%,CONST_conn_xon)
   PROCicon_shade(connections%,CONST_conn_baud_lbl)
   PROCicon_shade(connections%,CONST_conn_data_lbl)
   PROCicon_shade(connections%,CONST_conn_parity_lbl)
   PROCicon_shade(connections%,CONST_conn_stop_lbl)
   PROCicon_shade(connections%,CONST_conn_xon_lbl)
  ENDIF
  IF FNicon_set(connections%,CONST_conn_econet)THEN
   PROCicon_unshade(connections%,CONST_conn_ename)
   PROCicon_unshade(connections%,CONST_conn_emenu)
   c%=CONST_conn_ename
  ELSE
   PROCicon_shade(connections%,CONST_conn_ename)
   PROCicon_shade(connections%,CONST_conn_emenu)
  ENDIF
  CASE TRUE OF
  WHEN FNicon_set(connections%,CONST_conn_nfs)
   PROCicon_unshade(connections%,CONST_conn_nfss)
   PROCicon_unshade(connections%,CONST_conn_nfsp)
   PROCicon_unshade(connections%,CONST_conn_nfsu)
   PROCicon_unshade(connections%,CONST_conn_nfso)
   PROCicon_unshade(connections%,CONST_conn_nfsps)
   PROCicon_unshade(connections%,CONST_conn_nfss_lbl)
   PROCicon_unshade(connections%,CONST_conn_nfsp_lbl)
   PROCicon_unshade(connections%,CONST_conn_nfsu_lbl)
   PROCicon_unshade(connections%,CONST_conn_nfso_lbl)
   PROCicon_unshade(connections%,CONST_conn_nfsps_lbl)
   c%=CONST_conn_nfss
  WHEN FNicon_set(connections%,CONST_conn_lpr)
   PROCicon_unshade(connections%,CONST_conn_nfss)
   PROCicon_unshade(connections%,CONST_conn_nfsp)
   PROCicon_shade(connections%,CONST_conn_nfsu)
   PROCicon_unshade(connections%,CONST_conn_nfso)
   PROCicon_shade(connections%,CONST_conn_nfsps)
   PROCicon_unshade(connections%,CONST_conn_nfss_lbl)
   PROCicon_unshade(connections%,CONST_conn_nfsp_lbl)
   PROCicon_shade(connections%,CONST_conn_nfsu_lbl)
   PROCicon_unshade(connections%,CONST_conn_nfso_lbl)
   PROCicon_shade(connections%,CONST_conn_nfsps_lbl)
   c%=CONST_conn_nfss
  WHEN FNicon_set(connections%,CONST_conn_lanman)
   PROCicon_unshade(connections%,CONST_conn_nfss)
   PROCicon_unshade(connections%,CONST_conn_nfsp)
   PROCicon_unshade(connections%,CONST_conn_nfsu)
   PROCicon_unshade(connections%,CONST_conn_nfso)
   PROCicon_unshade(connections%,CONST_conn_nfsps)
   PROCicon_unshade(connections%,CONST_conn_nfss_lbl)
   PROCicon_unshade(connections%,CONST_conn_nfsp_lbl)
   PROCicon_unshade(connections%,CONST_conn_nfsu_lbl)
   PROCicon_unshade(connections%,CONST_conn_nfso_lbl)
   PROCicon_unshade(connections%,CONST_conn_nfsps_lbl)
   c%=CONST_conn_nfss
  WHEN FNicon_set(connections%,CONST_conn_lanman98)
   PROCicon_unshade(connections%,CONST_conn_nfss)
   PROCicon_unshade(connections%,CONST_conn_nfsp)
   PROCicon_unshade(connections%,CONST_conn_nfsu)
   PROCicon_unshade(connections%,CONST_conn_nfso)
   PROCicon_unshade(connections%,CONST_conn_nfsps)
   PROCicon_unshade(connections%,CONST_conn_nfss_lbl)
   PROCicon_unshade(connections%,CONST_conn_nfsp_lbl)
   PROCicon_unshade(connections%,CONST_conn_nfsu_lbl)
   PROCicon_unshade(connections%,CONST_conn_nfso_lbl)
   PROCicon_unshade(connections%,CONST_conn_nfsps_lbl)
   c%=CONST_conn_nfss
  WHEN FNicon_set(connections%,CONST_conn_jetdirect)
   PROCicon_shade(connections%,CONST_conn_nfss)
   PROCicon_unshade(connections%,CONST_conn_nfsp)
   PROCicon_shade(connections%,CONST_conn_nfsu)
   PROCicon_shade(connections%,CONST_conn_nfso)
   PROCicon_shade(connections%,CONST_conn_nfsps)
   PROCicon_shade(connections%,CONST_conn_nfss_lbl)
   PROCicon_unshade(connections%,CONST_conn_nfsp_lbl)
   PROCicon_shade(connections%,CONST_conn_nfsu_lbl)
   PROCicon_shade(connections%,CONST_conn_nfso_lbl)
   PROCicon_shade(connections%,CONST_conn_nfsps_lbl)
   c%=CONST_conn_nfsp
  OTHERWISE
   PROCicon_shade(connections%,CONST_conn_nfss)
   PROCicon_shade(connections%,CONST_conn_nfsp)
   PROCicon_shade(connections%,CONST_conn_nfsu)
   PROCicon_shade(connections%,CONST_conn_nfso)
   PROCicon_shade(connections%,CONST_conn_nfsps)
   PROCicon_shade(connections%,CONST_conn_nfss_lbl)
   PROCicon_shade(connections%,CONST_conn_nfsp_lbl)
   PROCicon_shade(connections%,CONST_conn_nfsu_lbl)
   PROCicon_shade(connections%,CONST_conn_nfso_lbl)
   PROCicon_shade(connections%,CONST_conn_nfsps_lbl)
  ENDCASE
  IF FNicon_set(connections%,CONST_conn_file)THEN
   PROCicon_unshade(connections%,CONST_conn_fname)
   PROCicon_unshade(connections%,CONST_conn_fmenu)
   PROCicon_unshade(connections%,CONST_conn_fappend)
   PROCicon_unshade(connections%,CONST_conn_fappend_lbl)
   c%=CONST_conn_fname
  ELSE
   PROCicon_shade(connections%,CONST_conn_fname)
   PROCicon_shade(connections%,CONST_conn_fmenu)
   PROCicon_shade(connections%,CONST_conn_fappend)
   PROCicon_shade(connections%,CONST_conn_fappend_lbl)
  ENDIF
  IF c%=-1 THEN
   PROCcaret_info(h%,i%,n%)
   IF h%=connections% SYS "Wimp_SetCaretPosition",-1
  ELSE
   PROCcaret_set(connections%,c%)
  ENDIF
ENDPROC

DEF PROCmatch_icon(handle%,RETURN prnt%)
  /*given an icon handle from the icon bar, match it to a PRNT block*/
  Ftracef("PROCmatch_icon")
  prnt%=A%!CONST_interface_printer_installed
  WHILE prnt%
   IF prnt%!CONST_prnt_icon=handle% ENDPROC
   prnt%=prnt%!CONST_prnt_next
  ENDWHILE
ENDPROC

DEF FNexternal_config_app(prnt%)
  LOCAL psup%,name$
  IF (prnt%!CONST_prnt_name<>0) THEN
    IF FNtry_ext_conf_app($(prnt%!CONST_prnt_name)) THEN =-1
  ENDIF
  psup% = prnt%!CONST_prnt_psup
=FNtry_ext_conf_app($(psup%!CONST_psup_class))

DEF FNtry_ext_conf_app(name$)
  LOCAL i%
  IF name$="" THEN =FALSE
  FOR i%=1 TO LEN name$
   IF ASC(MID$(name$,i%,1))<=32 OR ASC(MID$(name$,i%,1))>127 OR INSTR("<>",MID$(name$,i%,1))>0 THEN
    MID$(name$,i%,1)="_"
   ENDIF
  NEXT
  SYS"XOS_ReadVarVal","Alias$@PrinterConfigRun_"+name$,0,-1,0 TO ,,i%
  IF i%>=0 THEN =FALSE
  SYS"Wimp_StartTask","<Alias$@PrinterConfigRun_"+name$+"> "+RIGHT$("00000000"+STR$~prnt%,8)
=TRUE

DEF FNhas_external_config_app(prnt%)
  LOCAL psup%,name$
  IF (prnt%!CONST_prnt_name<>0) THEN
    IF FNhas_ext_cfg($(prnt%!CONST_prnt_name)) THEN =-1
  ENDIF
  psup% = prnt%!CONST_prnt_psup
=FNhas_ext_cfg($(psup%!CONST_psup_class))

DEF FNhas_ext_cfg(name$)
  LOCAL i%
  IF name$="" THEN =FALSE
  FOR i%=1 TO LEN name$
   IF ASC(MID$(name$,i%,1))<=32 OR ASC(MID$(name$,i%,1))>127 OR INSTR("<>",MID$(name$,i%,1))>0 THEN
    MID$(name$,i%,1)="_"
   ENDIF
  NEXT
  SYS"XOS_ReadVarVal","Alias$@PrinterConfigRun_"+name$,0,-1,0 TO ,,i%
=(i%<0)

DEF PROCprinter_selection
  LOCAL prnt%,adjust%,shift%,ctrl%
  Ftracef("PROCprinter_selection")
  shift%=INKEY -1
  ctrl%=INKEY -2
  adjust%=(task_buff%!8=1)
  PROCmatch_icon(task_buff%!16,prnt%)
  IF prnt% THEN
   /*matched on the icon - was it adjust or select, and was SHIFT held down?*/
   IF adjust% THEN
    IF shift% PROCopen_connections_window(prnt%)ELSE PROCopen_queue_window
   ELSE
    CASE TRUE OF
    WHEN shift%
     Ftracef("trying to open configuration window")
     PROCprinter_reason_code(prnt%!CONST_prnt_psup,prnt%,-3,0)
     PROCprinter_open_window(prnt%,"configure")
    WHEN ctrl%
     IF NOT FNexternal_config_app(prnt%) THEN
       PROCprinter_reason_code(prnt%!CONST_prnt_psup,prnt%,-3,0)
       PROCprinter_open_window(prnt%,"configure")
     ENDIF
    OTHERWISE
     Ftracef("PROCdo_select_printer loc 3")
     PROCdo_select_printer(prnt%,TRUE,FALSE,FALSE)
     IF FNwindow_open(prntctrl%)PROCdo_select_printer_control(prnt%)
    ENDCASE
   ENDIF
   ENDPROC
  ENDIF
  /*if we get to here, we haven't got an icon to match*/
  PROCprinter_control(prnt%)
ENDPROC

/* Just to avoid changing the prototype in case any external backends have used it */

DEF PROCselect_printer(prnt%,permanent%,restore%)
  PROCdo_select_printer(prnt%,permanent%,restore%,FALSE)
ENDPROC

DEF PROCdo_select_printer(prnt%,permanent%,restore%,tryharder%)
  /*permanent implies the icon gets highlighted
    restore ensures that the permanent connection is valid*/
  LOCAL old_prnt%,i%,s$
  Ftracef("PROCdo_select_printer")

  /*remember what WAS selected*/
  old_prnt%=selected_prnt%
  IF NOT restore% selected_prnt%=prnt% /*overwrite the preserved value*/
  IF selected_prnt%=0 ENDPROC /*no connection to make*/

  /*try to make the connection*/
  s$=FNselect_connection(selected_prnt%,FALSE,tryharder%)
  IF s$<>"" THEN
    /*ensure that the "selected" flag is clear (if we were trying to make a
      permanent connection)*/
    IF permanent% THEN
     selected_prnt%!CONST_prnt_flags = selected_prnt%!CONST_prnt_flags AND NOT CONST_prnt_flags_selected
    ENDIF
    IF selected_prnt%!CONST_prnt_queu THEN
      selected_prnt%!CONST_prnt_flags = selected_prnt%!CONST_prnt_flags OR CONST_prnt_flags_paused
      PROCprinter_status(selected_prnt%)
      PROCredraw_queue_entry(-1,selected_prnt%,0)
    ENDIF
    IF selected_prnt%=old_prnt% THEN
      /* we have to deselect the printer - connection has failed totally */
      PROCicon_deselect(-1,old_prnt%!CONST_prnt_icon)
      /* and ensure that there is no selected printer driver either */
      SYS"PDriver_SelectDriver",-1
      old_prnt%=0
    ENDIF
    selected_prnt%=old_prnt%
    /*ERROR CONST_error_ok,s$: REM Just give a warning for now. JRC 21 Mar*/
    IF selected_prnt%<>0 THEN PROCprinter_status(selected_prnt%) /* Added by RJW - reflect status in icon bar text */
    PROCerror_warning(s$)
    ENDPROC
  ENDIF
  PROCprinter_reason_code(selected_prnt%!CONST_prnt_psup,selected_prnt%,-6,0)
  PROCset_page_size(selected_prnt%)
  PROCtell_the_world

  IF permanent% THEN
    Ftracef("now, deselect the current printer")
    IF old_prnt% THEN
      PROCicon_deselect(-1,old_prnt%!CONST_prnt_icon)
      old_prnt%!CONST_prnt_flags=old_prnt%!CONST_prnt_flags AND NOT CONST_prnt_flags_selected
    ENDIF
    Ftracef("finally, select this printer")
    selected_prnt%!CONST_prnt_flags=selected_prnt%!CONST_prnt_flags OR CONST_prnt_flags_selected
    PROCicon_select(-1,selected_prnt%!CONST_prnt_icon)
    /*and export the printer type in Printer$*/
    SYS "PDriver_Info" TO,,,,i%
    IF ?i% \
      CALL Z%,i%,s$: /*convert 0-terminated string*/ \
      SYS "OS_SetVarVal","Printer$",i%,LEN s$
  ELSE
    Ftracef("put back the values, even though the connection is now invalid (but it won't be for long: honest!)")
    selected_prnt%=old_prnt%
  ENDIF
  Ftracef("PROCdo_select_printer done")
ENDPROC

DEF PROCset_page_size(prnt%)
  LOCAL psize%
  Ftracef("PROCset_page_size")
  psize%=prnt%!CONST_prnt_psze
  SYS "PDriver_SetPageSize",,psize%!CONST_psze_pwidth,psize%!CONST_psze_pheight,psize%!CONST_psze_lmargin,psize%!CONST_psze_bmargin,psize%!CONST_psze_rmargin,psize%!CONST_psze_tmargin
  Ftracef("PROCset_page_size done")
ENDPROC

DEF PROCtell_the_world
  /*that the printer has changed*/
  Ftracef("PROCtell_the_world")
  !msg_text%=20
  msg_text%!12=0
  msg_text%!16=&80147 /*SetPrinter*/
  SYS "Wimp_SendMessage",17,msg_text%
  Ftrace_Send(17,msg_text%,0)
  Ftracef("PROCtell_the_world done")
ENDPROC

DEF FNdevice_claim(dev%,prnt%)
  LOCAL claim$,r%,s$,i%
  Ftracef("FNdevice_claim")
  claim$=FNmsg_0(A%!CONST_interface_host_desc,"CLM")
  !task_buff%=32+LEN claim$ AND NOT 3
  task_buff%!12=0
  task_buff%!16=11 /*DeviceClaim*/
  task_buff%!20=dev%
  task_buff%!24=0
  $(task_buff%+28)=claim$+CHR$ 0
  SYS "Wimp_SendMessage",18,task_buff%
  Ftrace_Send(18,task_buff%,0)
  claim_state%=0
  claim_ref%=prnt%
  REPEAT
    Ftracef("waiting for reply")
    PROCdespatch_poll(message_mask%)
  UNTIL claim_state%
  Ftracef("got reply")
  claim_ref%=0
  IF claim_state%=2 i%=task_buff%+28: CALL Z%,i%,s$: =s$ /*convert 0-terminated string*/
=""

DEF FNselect_connection(prnt%,reselection%,tryharder%)
  LOCAL cnct%,claim$,psup%,r0%,f%,s$,buf%
#ifdef Sparrow
  LOCAL dir$, r0%, flags%, ip%, name$, ptr%
#endif
  Ftracef("FNselect_connection")

  /*
     preserve the contents of the task buffer since we may be about
     to use it to do device claiming with
  */
  FORr0%=0 TO 255
    evaluation_buff%?r0%=task_buff%?r0%
  NEXT

  psup%=prnt%!CONST_prnt_psup
  cnct%=prnt%!CONST_prnt_cnct
  printer_output$=\
      FNtask_read_env("PrinterType$"+STR$ cnct%!CONST_cnct_type,msg_text%)

  /*restore old state (in case we aren't using the serial port)*/
  SYS "OS_Byte",&CC,old_ignore_state%
#ifdef Sparrow
  SYS "XRemotePrinterSupport_Disable"
#endif
  OSCLI("Set PrinterSpecifics$Path """"")
  CASE cnct%!CONST_cnct_type OF
    WHEN 1 /*Parallel*/
      IF NOT reselection% THEN
        claim$=FNdevice_claim(1,prnt%)
        IF claim$<>"" THEN =FNmsg_1(A%!CONST_interface_host_desc,"OKI",claim$)
      ENDIF
      IF FNparallel_error_detect_possible THEN
        IF (cnct%!CONST_cnct_flags AND CONST_cnct_flags_parallel_errors) THEN
          IF FNparallel_paper_out THEN =FNmsg_0(A%!CONST_interface_host_desc,"OKBD")
          IF FNparallel_error THEN =FNmsg_0(A%!CONST_interface_host_desc,"OKBE")
        ELSE
          REM XParallel_IgnoreErrors
          SYS 405186,1
        ENDIF
      ENDIF
      buf%=FNbuffer(1)
      IF buf%=0 buf%=3
      IF prnt%!CONST_prnt_flags AND CONST_prnt_flags_fastpar THEN
        printer_output$="devices#buffer"+STR$buf%+":$."+FNsupport_fast_parallel
      ELSE
        printer_output$="devices#buffer"+STR$ buf%+":$.Parallel"
      ENDIF
    WHEN 2 /*Serial*/
      IF NOT reselection% THEN
        claim$=FNdevice_claim(2,prnt%)
        IF claim$<>"" THEN =FNmsg_1(A%!CONST_interface_host_desc,"OKJ",claim$)
      ENDIF
      SYS "OS_SerialOp",5,cnct%?CONST_cnct_baud
      SYS "OS_SerialOp",6,cnct%?CONST_cnct_baud
      SYS "OS_SerialOp",1,cnct%!CONST_cnct_data
      SYS "OS_SerialOp",0,cnct%?CONST_cnct_xon,NOT 1
      SYS "OS_Byte",&CC,1 TO,old_ignore_state% /*ignore all serial input*/
      buf%=FNbuffer(2)
      IF buf%=0 buf%=3
      printer_output$="devices#buffer"+STR$ buf%+":$.Serial"
    WHEN 4 /*Econet*/
      IF $cnct%!CONST_cnct_econet="" THEN =FNmsg_0(A%!CONST_interface_host_desc,"OKAG")
      printer_output$="NetPrint#"+$cnct%!CONST_cnct_econet+":"
      SYS "Hourglass_On"
      SYS "NetPrint_SetPSName",$cnct%!CONST_cnct_econet
      SYS "Hourglass_Off"
    WHEN 5 /*To file*/
      /*Bug fix for RP-2442*/
      printer_output$="null:"
      IF cnct%!CONST_cnct_file <> 0 THEN
        IF ?(cnct%!CONST_cnct_file) > 32 AND ?(cnct%!CONST_cnct_file) < 127 \
           printer_output$=$cnct%!CONST_cnct_file
      ENDIF
      SYS "XOS_File",17,printer_output$ TO r0%;f% /*ReadNoPath*/
      IF f% AND 1 r0%=0
      IF r0% THEN
        /* file exists: just ensure the file type... */
        SYS"XOS_Find",&43,printer_output$ TO r0%;f%
        IF (f%AND1)=0 CLOSE#r0%:SYS "XOS_File",18,printer_output$,psup%!CONST_psup_type /*SetType*/
      ELSE
        SYS "XOS_File",11,printer_output$,psup%!CONST_psup_type TO r0%;f% /*CreateStamped*/
        /* catch stupid filenames here ... */
        IF (f%AND1) THEN
          r0%+=4
          CALL Z%,r0%,s$
          =s$
        ENDIF
      ENDIF
    WHEN 6 /*N F S*/
      s$=FNselect_nfs(cnct%,printer_output$,tryharder%)
      IF s$<>"" THEN =s$
    WHEN 8 /*Direct drive*/
      SYS"XOS_ReadVarVal","PrinterType$8",buff1%,256,,3 TO ,,f%
      buff1%?f%=13:printer_output$=$buff1%
      IFprinter_output$="" printer_output$="null:"
#ifdef Sparrow
    WHEN 9 /* Remote */
     IF sparrow_present% THEN
      name$ = $prnt%!CONST_prnt_name

      SYS "XFreeway_Read", 0, CONST_freewaytype_printers, name$, 0, 0 TO r0%,,,dlen%,,ip% ; flags%
      IF (flags% AND 1) THEN
        =FNmsg_1 (A%!CONST_interface_host_desc, "OKAR", name$)
      ENDIF

      SYS "XRemotePrinterSupport_Enable", 1, ip%, name$ TO r0% ; flags%
      IF (flags% AND 1) THEN
        =FNmsg_1 (A%!CONST_interface_host_desc, "OKAR", name$)
      ENDIF

      printer_prefix$ = "Share::_S"+FNip_string(ip%)+"."

      dir$ = "Share::_S"+FNip_string(ip%)+".RemSpool."+unique_string$
      SYS "RemotePrinterSupport_DisableUpcalls"
      SYS "XOS_File", 8, dir$,,,0 TO r0% ; flags%
      SYS "RemotePrinterSupport_EnableUpcalls"
      IF (flags% AND 1) THEN
        =FNmsg_1 (A%!CONST_interface_host_desc, "OKAR", name$)
      ENDIF

      dir$ = "Share::_S"+FNip_string(ip%)+".RemQueue."+unique_string$
      SYS "RemotePrinterSupport_DisableUpcalls"
      SYS "XOS_File", 8, dir$,,,0 TO r0% ; flags%
      SYS "RemotePrinterSupport_EnableUpcalls"
      IF (flags% AND 1) THEN
        =FNmsg_1 (A%!CONST_interface_host_desc, "OKAR", name$)
      ENDIF

      s$ = FNset_jobno
      IF s$ <> "" THEN
        =FNmsg_1 (A%!CONST_interface_host_desc, "OKAR", name$)
      ENDIF

      ptr% = INSTR(name$, " ") /* space */
      WHILE ptr%
        MID$(name$,ptr%,1) = CHR$160
        ptr% = INSTR(name$, " ", ptr%+1)
      ENDWHILE

      printer_output$ = "Share::_S"+FNip_string(ip%)+".RemSpool."+unique_string$+"."+name$

      /* if the file already exists, just retype it, otherwise create it */
      /* Chris didn't *really* f**k up - he just didn't know better, the poor sod! */
      SYS "RemotePrinterSupport_DisableUpcalls"
      SYS "XOS_File",17,printer_output$ TO r0%;f% /*ReadNoPath*/
      IF f% AND 1 r0%=0
      IF r0% THEN
        /* file exists: just ensure the file type... */
        SYS"XOS_Find",&43,printer_output$ TO r0%;f%
        IF (f%AND1)=0 CLOSE#r0%:SYS "XOS_File",18,printer_output$,psup%!CONST_psup_type /*SetType*/
        SYS "RemotePrinterSupport_EnableUpcalls"
      ELSE
        SYS "XOS_File",11,printer_output$,psup%!CONST_psup_type TO r0%;f% /*CreateStamped*/
        SYS "RemotePrinterSupport_EnableUpcalls"
        /* catch stupid filenames here ... */
        IF (f%AND1) THEN
          =FNmsg_1 (A%!CONST_interface_host_desc, "OKAR", name$)
        ENDIF
      ENDIF
     ELSE
      =FNmsg_1 (A%!CONST_interface_host_desc, "OKAR", name$)
     ENDIF
Ftracef ("Just set up remote filename of "+printer_output$+" with filetype "+STR$psup%!CONST_psup_type)
     /* Now we make sure that the appropriate choices can be seen */
     r0%=0
     REPEAT
      name$="_P"+FNip_string(ip%)+"_"+STR$(r0%)
      SYS "XFreeway_Read", 0, CONST_freewaytype_discs, name$, 0, 0 TO ; flags%
      IF (flags% AND 1)=0 THEN
       SYS"XOS_CLI","AppPath PrinterSpecifics$Path Share::"+name$+".$."
      ENDIF
      r0%+=1
     UNTIL (flags% AND 1)=1
#endif
    WHEN 10 /* LPR */
      IF NOT reselection% THEN
        s$=FNselect_lpr(cnct%,printer_output$,tryharder%)
        IF s$<>"" THEN =s$
      ENDIF
    WHEN 11 /* LanManFS */
      IF NOT reselection% THEN
        s$=FNselect_lanman(cnct%,printer_output$,tryharder%)
        IF s$<>"" THEN =s$
      ENDIF
    WHEN 12 /* LanMan98 */
      IF NOT reselection% THEN
        s$=FNselect_lanman98(cnct%,printer_output$,tryharder%)
        IF s$<>"" THEN =s$
      ENDIF
    WHEN 13 /* JetDirect */
      IF NOT reselection% THEN
        s$=FNselect_jetdirect(cnct%,printer_output$,tryharder%)
        IF s$<>"" THEN =s$
      ENDIF
  ENDCASE

  SYS "OS_SetVarVal","PrinterType$"+STR$ cnct%!CONST_cnct_type,printer_output$,LEN printer_output$
  PROCfx5(cnct%!CONST_cnct_type)

  /* Now put it back again */
  FORr0%=0 TO 255
    task_buff%?r0%=evaluation_buff%?r0%
  NEXT
=""

DEF PROCflush(buf%)
  Ftracef("PROCflush")
  IF buf% SYS "OS_Byte",21,buf%
ENDPROC

DEF PROCfx5(new_fx5%)
  LOCAL x%
  LOCAL ERROR

  #ifdef Trace
    ON ERROR LOCAL RESTORE ERROR: PROCesc_off: PROCflush(FNbuffer(x%)): SYS "OS_Byte",5,new_fx5%: ERROR 0,"OOOPS!": ENDPROC
  #else
    ON ERROR LOCAL RESTORE ERROR: PROCesc_off: PROCflush(FNbuffer(x%)): SYS "OS_Byte",5,new_fx5%: ENDPROC
  #endif

  Ftracef("PROCfx5")
  SYS "OS_Byte",245,,255 TO,x%
  IF x%<>new_fx5% THEN
    PROCesc_on
    SYS "OS_Byte",5,new_fx5%
    PROCesc_off
  ENDIF
ENDPROC

DEF PROCesc_on
  Ftracef("PROCesc_on")
  SYS "OS_Byte",229
ENDPROC

DEF PROCesc_off
  Ftracef("PROCesc_off")
  SYS "OS_Byte",229,1
ENDPROC

DEF FNselect_nfs(cnct%,RETURN a$,tryharder%)
  LOCAL c%,f%,s$
  Ftracef("FNselect_nfs")
  /*Error 204 - Bad filename (incorrect options)*/
  IF NOT FNnfs_installed THEN =FNmsg_0(A%!CONST_interface_host_desc,"OKL")
  IF cnct%!CONST_cnct_nfss=0 THEN =FNmsg_0(A%!CONST_interface_host_desc,"OKK")
  a$="NFS#Printer::"+$cnct%!CONST_cnct_nfss
  IF cnct%!CONST_cnct_nfsp=0 a$+=".lp" ELSE a$+="."+$cnct%!CONST_cnct_nfsp
  IF cnct%!CONST_cnct_nfsu=0 a$+=".nobody" ELSE a$+="."+$cnct%!CONST_cnct_nfsu
  IF cnct%!CONST_cnct_nfso a$+="."+$cnct%!CONST_cnct_nfso
  SYS "XOS_Find",&8F,a$ TO c%;f%
  IF f% AND 1 THEN
    CASE !c% OF
      WHEN 204
        =FNmsg_0(A%!CONST_interface_host_desc,"OKM")
      OTHERWISE
        f%=c%+4
        CALL Z%,f%,s$ /*convert 0-terminated string*/
        =s$+" ("+STR$ !c%+")"
    ENDCASE
  ENDIF
  SYS "XOS_Find",,c%
=""

DEF FNselect_lpr(cnct%,RETURN a$,tryharder%)
  LOCAL c%,f%,s$
  Ftracef("FNselect_lpr")
  /*Error 204 - Bad filename (incorrect options)*/
  IF lpr_possible% THEN PROCload_lpr
  IF NOT lpr_possible% THEN =FNmsg_0(A%!CONST_interface_host_desc,"OKLb")
  IF cnct%!CONST_cnct_nfss=0 THEN =FNmsg_0(A%!CONST_interface_host_desc,"OKKb")
  a$="LPR#"+FNstr(cnct%!CONST_cnct_nfss)
  a$+="/"+FNstr(cnct%!CONST_cnct_nfsp)
  a$+="/"+FNstr(cnct%!CONST_cnct_nfso)+":"
  IF tryharder% THEN
    SYS "XOS_File",17,a$ TO c%;f% /*ReadNoPath*/
    IF f% AND 1 THEN
      /* Error! */
      f%=c%+4
      CALL Z%,f%,s$ /*convert 0-terminated string*/
      =s$+" ("+STR$ !c%+")"
    ELSE
      IF c%=1 THEN
        /* File exists */
      ELSE
        SYS "XOS_Find",&8F,a$ TO c%;f%
        IF f% AND 1 THEN
          CASE !c% OF
            /* RJW: Handle error messages here! */
            OTHERWISE
              f%=c%+4
              CALL Z%,f%,s$ /*convert 0-terminated string*/
              =s$+" ("+STR$ !c%+")"
          ENDCASE
        ENDIF
        SYS "XOS_Find",,c%
      ENDIF
    ENDIF
  ENDIF
=""

DEF FNselect_jetdirect(cnct%,RETURN a$,tryharder%)
  LOCAL c%,f%,s$
  Ftracef("FNselect_jetdirect")
  /*Error 204 - Bad filename (incorrect options)*/
  IF jetdirect_possible% THEN PROCload_jetdirect
  IF NOT jetdirect_possible% THEN =FNmsg_0(A%!CONST_interface_host_desc,"OKLe")
  IF cnct%!CONST_cnct_nfsp=0 THEN =FNmsg_0(A%!CONST_interface_host_desc,"OKKe")
  a$="JetDirectFS:"+FNstr(cnct%!CONST_cnct_nfsp)
  IF tryharder% THEN
    SYS "XOS_Find",&8F,a$ TO c%;f%
    IF f% AND 1 THEN
      CASE !c% OF
        /* RJW: Handle error messages here! */
        OTHERWISE
          f%=c%+4
          CALL Z%,f%,s$ /*convert 0-terminated string*/
          =s$+" ("+STR$ !c%+")"
      ENDCASE
    ENDIF
    SYS "XOS_Find",,c%
  ENDIF
=""

DEF FNselect_lanman(cnct%,RETURN a$,tryharder%)
  LOCAL c%,f%,s$
  Ftracef("FNselect_lanman")
  /*Error 204 - Bad filename (incorrect options)*/
  IF NOT FNlanman_installed THEN =FNmsg_0(A%!CONST_interface_host_desc,"OKLc")
  IF cnct%!CONST_cnct_nfss=0 THEN =FNmsg_0(A%!CONST_interface_host_desc,"OKKc")
  a$="OmniPrint#LanMan;"+FNstr(cnct%!CONST_cnct_nfss)
  a$+=";"+FNstr(cnct%!CONST_cnct_nfsp)
  a$+=";"+FNstr(cnct%!CONST_cnct_nfsu)
  a$+=";"+FNstr(cnct%!CONST_cnct_nfsps)
  a$+=";"+FNstr(cnct%!CONST_cnct_nfso)
  a$+=":"
  IF tryharder% THEN
    SYS "XOS_Find",&8F,a$ TO c%;f%
    IF f% AND 1 THEN
      CASE !c% OF
        /* RJW: Handle error messages here! */
        OTHERWISE
          f%=c%+4
          CALL Z%,f%,s$ /*convert 0-terminated string*/
          =s$+" ("+STR$ !c%+")"
      ENDCASE
    ENDIF
    SYS "XOS_Find",,c%
  ENDIF
=""

DEF FNselect_lanman98(cnct%,RETURN a$,tryharder%)
  LOCAL c%,f%,s$
  Ftracef("FNselect_lanman98")
  /*Error 204 - Bad filename (incorrect options)*/
  IF NOT FNlanman98_installed THEN =FNmsg_0(A%!CONST_interface_host_desc,"OKLd")
  IF cnct%!CONST_cnct_nfss=0 THEN =FNmsg_0(A%!CONST_interface_host_desc,"OKKd")
  a$="LanMan98#printer;"+FNstr(cnct%!CONST_cnct_nfss)
  a$+=";"+FNstr(cnct%!CONST_cnct_nfsp)
  a$+=";"+FNstr(cnct%!CONST_cnct_nfsu)
  a$+=";"+FNstr(cnct%!CONST_cnct_nfsps)
  a$+=":"
  IF tryharder% THEN
    SYS "XOS_Find",&8F,a$ TO c%;f%
    IF f% AND 1 THEN
      CASE !c% OF
        /* RJW: Handle error messages here! */
        WHEN &100C2
          /* File Open: Already open - assume its by us! At any rate the path is valid */
          =""
        OTHERWISE
          f%=c%+4
          CALL Z%,f%,s$ /*convert 0-terminated string*/
          =s$+" ("+STR$ !c%+")"
      ENDCASE
    ENDIF
    SYS "XOS_Find",,c%
  ENDIF
=""

DEF FNstr(a%)
IF a%=0 THEN =""
=$a%

DEF PROCmenu(top$,rebuild%,iconpos%)
  LOCAL y%,i%,ix%,iy%,indirected_title%
#ifdef Sparrow
  LOCAL prnt%, rmtp%, icon%
#endif
  Ftracef("PROCmenu")
  IF rebuild% THEN
    menu_xpos%=task_buff%!0-64
    menu_ypos%=task_buff%!4
  ENDIF
  IF iconpos% THEN
    !buff1%=task_buff%!12
    buff1%!4=task_buff%!16
    SYS "Wimp_GetIconState",,buff1%
    ix%=buff1%!16
    iy%=buff1%!20
    SYS "Wimp_GetWindowState",,buff1%
    menu_xpos%=buff1%!20+buff1%!4+ix%+2
    menu_ypos%=buff1%!24+buff1%!16+iy%-2
  ENDIF
  IF top$="SVE" THEN
    PROCsave_setup(psup_edit%!CONST_psup_type,FNmsg_0(A%!CONST_interface_host_desc,"OP"))
    SYS "Wimp_CreateMenu",,save_wind%,menu_xpos%,menu_ypos%
  ELSE
    CASE top$ OF
      WHEN "ME1"
        PROCmenu_create(menu%,FNmsg_0(A%!CONST_interface_host_desc,"ME1"))
        PROCmenu_attach(menu%,Menu_Info,info%,FALSE)
#if ExtraIconMenuEntries
        PROCmenu_shade(menu%,Menu_PrinterConfigure,A%!CONST_interface_printer_active=0)
        PROCmenu_shade(menu%,Menu_PrinterConnection,A%!CONST_interface_printer_active=0)
#endif
        PROCmenu_shade(menu%,Menu_QueueControl,A%!CONST_interface_printer_active=0)
        menu_ypos%=96+(Menu_Quit+1)*line_space%
        IF got_icon% \
          menued_prnt%=0 \
        ELSE \
          PROCmatch_icon(task_buff%!16,menued_prnt%)
      WHEN "ME2"
        IFFNsupport_higher_baudrates THEN
          PROCmenu_create(menu%,FNmsg_0(A%!CONST_interface_host_desc,"ME2")+FNmsg_0(A%!CONST_interface_host_desc,"ME2a")+FNmsg_0(A%!CONST_interface_host_desc,"ME2b"))
        ELSE
          PROCmenu_create(menu%,FNmsg_0(A%!CONST_interface_host_desc,"ME2")+FNmsg_0(A%!CONST_interface_host_desc,"ME2b"))
        ENDIF
        PROCmenu_tick_match(menu%,FNicon_read(connections%,CONST_conn_baud))
      WHEN "ME3"
        PROCmenu_create(menu%,FNmsg_0(A%!CONST_interface_host_desc,"ME3"))
        PROCmenu_tick_match(menu%,FNicon_read(connections%,CONST_conn_data))
      WHEN "ME4"
        PROCmenu_create(menu%,FNmsg_0(A%!CONST_interface_host_desc,"ME4"))
        PROCmenu_tick_match(menu%,FNicon_read(connections%,CONST_conn_parity))
      WHEN "ME5"
        PROCmenu_create(menu%,FNmsg_0(A%!CONST_interface_host_desc,"ME5"))
        indirected_title%=(menu%!28 AND &100)<>0
        IF NOT(FNnew_databits=0 AND FNnew_parity<>0)THEN
          IF FNnew_databits=3 AND FNnew_parity=0 THEN
            PROCmenu_item(menu%,1,FNmsg_0(A%!CONST_interface_host_desc,"ME5c"),indirected_title%)
          ELSE
            PROCmenu_item(menu%,1,FNmsg_0(A%!CONST_interface_host_desc,"ME5a"),indirected_title%)
          ENDIF
        ENDIF
        PROCmenu_tick_match(menu%,FNicon_read(connections%,CONST_conn_stop))
      WHEN "ME6"
        IF rebuild% PROCbuild_printer_menu
        PROCmenu_tick_match(menu%,\
            FNicon_read(connections%,CONST_conn_ename))
      WHEN "MQ1"
        IF rebuild% THEN
          PROCcancel_menued_item
          menued_y%=menu_ypos%
          !task_buff%=A%!CONST_interface_queue
          SYS "Wimp_GetWindowState",,task_buff%
          B%=menued_y%-task_buff%!16+task_buff%!24 /*was -! JRC 14/2/'92*/
          menued_y%=USR(code_entry%+CONST_entry_locate_entry_a)
          i%=A%!CONST_interface_scratch
          menued_prnt%=!i%
          menued_queu%=i%!4
          /*for the purposes of menuing, we can treat the cases of queu=0
            (hit on the header) and queu=-1 (hit on the footer) as being
            identical*/
          IF menued_queu%=-1 menued_queu%=0

          IF menued_queu%=0 THEN
            PROCmenu_create(menu%,FNmsg_1(A%!CONST_interface_host_desc,\
                "MQ1",FNmsg_0(A%!CONST_interface_host_desc,"MQ1a")))
            /*highlight this entry*/
            IF menued_prnt% menued_prnt%!CONST_prnt_flags=\
                menued_prnt%!CONST_prnt_flags OR CONST_prnt_flags_highlighted
          ELSE
            IF menued_queu%!CONST_queu_handle_in THEN
              PROCmenu_create(menu%,FNmsg_1(A%!CONST_interface_host_desc,\
                  "MQ1",FNmsg_0(A%!CONST_interface_host_desc,"MQ1a")))
            ELSE
              PROCmenu_create(menu%,FNmsg_1(A%!CONST_interface_host_desc,\
                  "MQ1",FNmsg_0(A%!CONST_interface_host_desc,"MQ1b")))
            ENDIF
            menued_queu%?CONST_queu_status=\
                menued_queu%?CONST_queu_status OR 8 /*highlight this entry*/
          ENDIF
          PROCredraw_queue_entry(-1,menued_prnt%,menued_queu%)
        ENDIF
        PROCmenu_shade(menu%,0,FALSE)
        PROCmenu_shade(menu%,1,FALSE)
        PROCmenu_shade(menu%,2,FALSE)
        PROCmenu_shade(menu%,3,FALSE)
        PROCmenu_shade(menu%,4,FALSE)
        PROCmenu_shade(menu%,5,FALSE)
        PROCmenu_shade(menu%,6,FALSE)
        IF menued_queu%=0 THEN
          PROCmenu_shade(menu%,4,TRUE)
          PROCmenu_shade(menu%,5,TRUE)
          PROCmenu_shade(menu%,6,TRUE)
        ELSE
          IF menued_queu%?CONST_queu_status AND 5 \
              PROCmenu_shade(menu%,4,TRUE)ELSE PROCmenu_shade(menu%,5,TRUE)
        ENDIF
        IF menued_prnt%!CONST_prnt_flags AND CONST_prnt_flags_suspaused THEN
          PROCmenu_shade(menu%,0,TRUE)
          PROCmenu_shade(menu%,1,TRUE)
        ELSE
          PROCmenu_shade(menu%,2,TRUE)
        ENDIF
      WHEN "MP1"
        PROCcreate_paper_menu(menu%,papersize%,CONST_paper_name)
      WHEN "MC1", "MC1s"
#ifdef Sparrow
        PROCmenu_create(menu%,FNmsg_0(A%!CONST_interface_host_desc,"MC1s"))
        /*
         * Sorry Guv, no sparrow s/w therefore no share menu entry
         */
        IF sparrow_present% = FALSE THEN
          PROCmenu_shade(menu%, 2, TRUE)
        ENDIF
#else
        PROCmenu_create(menu%,FNmsg_0(A%!CONST_interface_host_desc,"MC1"))
#endif
        SYS "Wimp_WhichIcon",prntctrl%,buff1%,1<<21,1<<21
        IF (!buff1%=-1 OR buff1%!4=-1) AND select_all%=FALSE THEN
          /*if there is already a selected one, clear it*/
          IF NOT !buff1% PROCicon_deselect(prntctrl%,!buff1%)
          /*one or no icons selected - can we select one?*/
          IF task_buff%!12=prntctrl% AND task_buff%!16>3 THEN
            /*if we menued over an icon, select it*/
            PROCicon_select(prntctrl%,task_buff%!16)
            i%=1
          ELSE
            i%=0
          ENDIF
        ELSE
          i%=2
        ENDIF
        CASE i% OF
          WHEN 0
#ifdef Sparrow
            /*
             * Wonderful how menu entry numbers change. There must be a better way...
             */
            PROCmenu_shade(menu%,0,TRUE)
            PROCmenu_shade(menu%,1,TRUE)
            PROCmenu_shade(menu%,2,TRUE)
            PROCmenu_shade(menu%,3,TRUE)
            PROCmenu_shade(menu%,4,TRUE)
            PROCmenu_shade(menu%,5,TRUE)
            PROCmenu_shade(menu%,7,TRUE)
            IF A%!CONST_interface_printer_installed=0 \
                PROCmenu_shade(menu%,6,TRUE)
#else
            PROCmenu_shade(menu%,0,TRUE)
            PROCmenu_shade(menu%,1,TRUE)
            PROCmenu_shade(menu%,2,TRUE)
            PROCmenu_shade(menu%,3,TRUE)
            PROCmenu_shade(menu%,4,TRUE)
            PROCmenu_shade(menu%,6,TRUE)
            IF A%!CONST_interface_printer_installed=0 \
                PROCmenu_shade(menu%,5,TRUE)
#endif
#ifdef Sparrow
          WHEN 1
            /*
             * One selected printer, is it a remote one?
             */
            PROCfind_prnt (prnt%, rmtp%, icon%)
            IF rmtp% THEN
              PROCmenu_shade (menu%, 0, TRUE) /* Configure... */
              PROCmenu_shade (menu%, 1, TRUE) /* Connection... */
              PROCmenu_shade (menu%, 2, TRUE) /* Share */
              IF rmtp%!CONST_rmtp_icon > 0 THEN /* Unavailable printer */
                PROCmenu_shade (menu%, 3, TRUE) /* Active */
              ELSE                                        /* Available printer */
                PROCmenu_shade (menu%, 4, TRUE) /* Inactive */
              ENDIF
              PROCmenu_shade (menu%, 5, TRUE) /* Remove */
            ENDIF
            IF prnt% THEN
              IF prnt%!CONST_prnt_flags AND CONST_prnt_flags_remote THEN
                PROCmenu_shade (menu%, 1, TRUE) /* Connection... */
                PROCmenu_shade (menu%, 2, TRUE) /* Share */
                PROCmenu_shade (menu%, 3, TRUE) /* Active */
                PROCmenu_shade (menu%, 5, TRUE) /* Remove */
              ENDIF
            ENDIF
          /*
           * Many selected printers... may include remote one, but remove/share will
           * not affect those
           */
#endif
          WHEN 2
            PROCmenu_shade(menu%,0,TRUE)
            PROCmenu_shade(menu%,1,TRUE)
        ENDCASE
    ENDCASE
    menu_chsn$=top$
    PROCdisplay_menu(0,menu%,menu_xpos%,menu_ypos%)
  ENDIF
ENDPROC

DEF PROCcreate_paper_menu(RETURN handle%,window%,icon%)
  LOCAL psize%,i%,indirected_title%
  Ftracef("PROCcreate_paper_menu")
  PROCmenu_create(handle%,FNmsg_0(A%!CONST_interface_host_desc,"MP1"))
  indirected_title%=(handle%!28 AND &100)<>0
  #ifdef Trace
    IF indirected_title% PROCftracef("*** YES ***")ELSE PROCftracef("*** NO ***")
  #endif
  psize%=psize_head%
  i%=0
  WHILE psize%
   PROCmenu_item(handle%,i%,$psize%!CONST_psze_name,indirected_title%)
   i%+=1
   psize%=psize%!CONST_psze_next
  ENDWHILE
  PROCmenu_tick_match(handle%,FNicon_read(window%,icon%))
ENDPROC

DEF PROCdisplay_menu(prnt%,menu%,xp%,yp%)
  Ftracef("PROCdisplay_menu")
  Ftracef("menu is at &"+STR$~menu%)
  menu_prnt%=prnt%
  SYS "Wimp_CreateMenu",,menu%,xp%,yp%
ENDPROC

DEF FNwas_adjust_used
  SYS "Wimp_GetPointerInfo",,buff1%
=(buff1%!8 AND 1)<>0

DEF PROCmenuaction
  LOCAL adjust%,redraw%,psize%,i%,h%,n%,prnt%,icon%
#ifdef Sparrow
  LOCAL rmtp%
#endif
  Ftracef("PROCmenu_action")
  IF menu_prnt% THEN
    PROCprinter_reason_code(menu_prnt%!CONST_prnt_psup,menu_prnt%,9,task_buff%)
    ENDPROC
  ENDIF
  adjust%=FNwas_adjust_used
  CASE menu_chsn$ OF
    WHEN "ME1"
      CASE !task_buff% OF
#if ExtraIconMenuEntries
        WHEN Menu_PrinterConfigure
          PROCprinter_reason_code(menued_prnt%!CONST_prnt_psup,menued_prnt%,-3,0)
          PROCprinter_open_window(menued_prnt%,"configure")
        WHEN Menu_PrinterConnection
          PROCopen_connections_window(menued_prnt%)
#endif
        WHEN Menu_PrinterControl
          PROCprinter_control(menued_prnt%)
        WHEN Menu_QueueControl
          PROCopen_queue_window
        WHEN Menu_EditPaper
          PROCopen_papersize_window(menued_prnt%)
        WHEN Menu_SaveChoices
          PROCsave_settings
          PROCsave_prdata
        WHEN Menu_Quit
          IF A%!CONST_interface_queue_entries THEN
            /*disable the nulls*/
            A%!CONST_interface_global_mask=A%!CONST_interface_global_mask OR 1
            shutdown_type%=2
            PROCmenu_window_centre(shutdown%)
          ELSE
            PROChost_shutdown
          ENDIF
      ENDCASE
    WHEN "ME2"
      PROCicon_write(connections%,CONST_conn_baud,$(!task_buff%*24+40+menu%))
    WHEN "ME3"
      PROCicon_write(connections%,CONST_conn_data,$(!task_buff%*24+40+menu%))
      PROCensure_new_stopbits(-1)
    WHEN "ME4"
      PROCicon_write(connections%,CONST_conn_parity,$(!task_buff%*24+40+menu%))
      PROCensure_new_stopbits(-1)
    WHEN "ME5"
      PROCensure_new_stopbits(!task_buff%)
    WHEN "ME6"
      /*turn tick off*/
      PROCmenu_tick_match(menu%,FNicon_read(connections%,CONST_conn_ename))
      PROCicon_write(connections%,CONST_conn_ename,$(!task_buff%*24+40+menu%))
    WHEN "MQ1"
      redraw%=TRUE
      CASE !task_buff% OF
        WHEN 0
          menued_prnt%!CONST_prnt_flags=menued_prnt%!CONST_prnt_flags OR CONST_prnt_flags_paused
        WHEN 1
          menued_prnt%!CONST_prnt_flags=menued_prnt%!CONST_prnt_flags OR CONST_prnt_flags_suspended
        WHEN 2
          menued_prnt%!CONST_prnt_flags=menued_prnt%!CONST_prnt_flags AND NOT CONST_prnt_flags_suspaused
          /*was the pausing caused by printing?*/
          i%=menued_prnt%!CONST_prnt_queu
          IF i% THEN
            /*we've got a queue entry*/
            i%=i%!CONST_queu_tpub
            IF i% THEN
              /*we've got a TPUB block*/
              IF i%!CONST_tpub_pause_flag THEN
                /*we've got pub_page_pause set*/
                i%!CONST_tpub_pause_flag=0
                IF menued_prnt%!CONST_prnt_pause THEN
                  !task_buff%=menued_prnt%!CONST_prnt_pause
                  PROCclose_window
                ENDIF
              ENDIF
            ENDIF
          ENDIF
        WHEN 3
          PROCflush_queue(menued_prnt%)
          redraw%=FALSE
        WHEN 4
          IF menued_queu%!CONST_queu_handle_in THEN
            menued_queu%?CONST_queu_status=menued_queu%?CONST_queu_status OR 1
          ELSE
            menued_queu%?CONST_queu_status=menued_queu%?CONST_queu_status OR 4
          ENDIF
        WHEN 5
          menued_queu%?CONST_queu_status=menued_queu%?CONST_queu_status AND NOT 5
        WHEN 6
          PROCdelete_queue_entry(menued_prnt%,menued_queu%,TRUE)
          redraw%=FALSE
      ENDCASE
      IF redraw% THEN
        PROCprinter_status(menued_prnt%)
        IF !task_buff%<3 THEN
          PROCredraw_queue_entry(-1,menued_prnt%,0)
        ELSE
          PROCredraw_queue_entry(menued_y%,menued_prnt%,menued_queu%)
        ENDIF
      ENDIF
    WHEN "MP1"
      psize%=psize_head%
      i%=!task_buff%
      WHILE i%
        psize%=psize%!CONST_psze_next
        i%-=1
      ENDWHILE
      FOR i%=CONST_psze_next TO CONST_psze_flag STEP 4
        psize_edit%!i%=psize%!i%
      NEXT
      PROCinitialise_papersize_window
    WHEN "MC1", "MC1s"
      CASE !task_buff% OF
        WHEN 0
          /*Configure*/
#ifdef Sparrow
          PROCfind_prnt(prnt%,rmtp%,icon%)
          IF prnt% THEN
            PROCprinter_reason_code(prnt%!CONST_prnt_psup,prnt%,-3,0)
            PROCprinter_open_window(prnt%,"configure")
          ENDIF
          /*
           * Don't open configure window for a remote but inactive printer
           * THIS SHOULD NEVER HAPPEN ANYWAY, GREY OUT MENU ITEM!
           */
#else
          PROCfind_prnt(prnt%,icon%)
          PROCprinter_reason_code(prnt%!CONST_prnt_psup,prnt%,-3,0)
          PROCprinter_open_window(prnt%,"configure")
#endif
        WHEN 1
          /*Connection*/
#ifdef Sparrow
          PROCfind_prnt(prnt%,rmtp%,icon%)
          IF prnt% THEN
            PROCopen_connections_window(prnt%)
          ENDIF
          /*
           * No other case shoule occur here, since connection entry should be
           * greyed out.
           */
#else
          PROCfind_prnt(prnt%,icon%)
          PROCopen_connections_window(prnt%)
#endif

#ifdef Sparrow
        /*
         * Arrgh.
         */
        WHEN 2
          /*Share*/
          PROCshare_printer
        WHEN 3
          /*Active*/
          PROCactivate_printer
          PROCcreate_installed_printer_icons
        WHEN 4
          /*Inactive*/
          PROCdeactivate_printer
          PROCcreate_installed_printer_icons
        WHEN 5
          /*Remove*/
          PROCremove_printer
          PROCcreate_installed_printer_icons
        WHEN 6
          /*Select all*/
          IF A%!CONST_interface_printer_installed THEN
            IF 0<=printer_count%-1 THEN
              FOR i%=0 TO printer_count%-1
                PROCicon_select(prntctrl%,i%+4)
              NEXT
            ENDIF
          ENDIF
          IF remote_printers% THEN
            IF 0<=remote_printer_count%-1 THEN
              FOR i% = printer_count% TO printer_count%+remote_printer_count%
                PROCicon_select(prntctrl%,i%+4)
              NEXT
            ENDIF
          ENDIF
          select_all%=TRUE
        WHEN 7
          /*Clear selection*/
          PROCunset_selection(prntctrl%)
#else
        WHEN 2
          /*Active*/
          PROCactivate_printer
        WHEN 3
          /*Inactive*/
          PROCdeactivate_printer
        WHEN 4
          /*Remove*/
          PROCremove_printer
        WHEN 5
          /*Select all*/
          IF A%!CONST_interface_printer_installed THEN
            IF 0<=printer_count%-1 THEN /* CSDM: lacked a THEN - not very well protected! */
              FOR i%=0 TO printer_count%-1
                PROCicon_select(prntctrl%,i%+4)
              NEXT
            ENDIF
          ENDIF
          select_all%=TRUE
        WHEN 6
          /*Clear selection*/
          PROCunset_selection(prntctrl%)
#endif
      ENDCASE
  ENDCASE
  IF adjust% THEN
    SYS "Wimp_GetPointerInfo",,task_buff%
    PROCmenu(menu_chsn$,FALSE,FALSE)
  ELSE
    PROCcancel_menued_item
  ENDIF
ENDPROC

DEF PROCsave_settings
  LOCAL c%,f%,psup%,prnt%,ptr%,p%,size%,s$,f$
#ifdef Sparrow
  LOCAL attr%, rmtp%
#endif
  Ftracef("PROCsave_settings")
  SYS "Hourglass_On"
#ifdef Sparrow
  IF multiple_choices% THEN
    f$ = PrintersChoicesWriteDir+".Remote.ID"+unique_string$+".Settings1"
  ELSE
#endif
  f$ = PrintersChoicesWriteDir+".Settings1"
#ifdef Sparrow
  ENDIF
#endif
  SYS "XOS_Find",&8F,f$ TO c%;f%
  IF f% AND 1 \
    f%=c%+4: \
    CALL Z%,f%,s$: /*convert 0-terminated string*/ \
    ERROR CONST_error_ok,FNmsg_1(A%!CONST_interface_host_desc,"OKB",s$)

  LOCAL ERROR
  ON ERROR LOCAL RESTORE ERROR: \
    SYS"XOS_Find",0,c%: \
    SYS"XOS_File",6,f$: \
    ERROR CONST_error_ok, FNmsg_1(A%!CONST_interface_host_desc,"OKB",REPORT$)

  BPUT#c%,"fv: 1"
  prnt%=A%!CONST_interface_printer_installed
  WHILE prnt%
   psup%=prnt%!CONST_prnt_psup
   BPUT#c%,"cl: "+$psup%!CONST_psup_class+":"+STR$ psup%!CONST_psup_vsn
   BPUT#c%,"nm: "+$prnt%!CONST_prnt_type

   /*Connection details*/
   ptr%=prnt%!CONST_prnt_cnct
   IF psup%!CONST_psup_flags AND CONST_psup_flags_backend_connections THEN
    /*Back end supplies connection window*/
    size%=psup%!CONST_psup_cnct
    BPUT#c%,"cn: "+STR$ size%
    BPUT#c%,"ct: 16_"+STR$~ptr%!0:ptr%+=4
    IF 2<=size% THEN
     FOR f%=2 TO size%
      p%=!ptr%
      ptr%+=4
      CASE TRUE OF
       WHEN p%=0
        BPUT#c%,"nl: "
       WHEN p%!-4=CONST_ident_INTG
        BPUT#c%,"in: "+STR$ !p%
       WHEN p%!-4=CONST_ident_STRG
        BPUT#c%,"st: "+$p%
       WHEN p%!-4=CONST_ident_STR0
        CALL Z%,p%,s$ /*convert 0-terminated string*/
        BPUT#c%,"s0: "+s$
       WHEN p%!-4=CONST_ident_GSTR
        CALL Y%,p%,s$ /*convert counted string*/
        BPUT#c%,"gs: "+FNungstrans(s$)
       WHEN p%!-4=CONST_ident_POTR
        BPUT#c%,"pt: "+FNdiscover_ptr(!p%,psup%)
       OTHERWISE
        SYS "XOS_Find",,c% /*Close*/
        ERROR CONST_error_ok,FNmsg_1(A%!CONST_interface_host_desc,"OKC",$prnt%!CONST_prnt_type)
      ENDCASE
     NEXT
    ENDIF
   ELSE
    /*Normal connection window*/
    BPUT#c%,"ct: 16_"+STR$~ptr%!CONST_cnct_type
    /*
       PLEASE NOTE!

       Although the baud rate value is only 1 byte, the xon/xoff flag is also
       1 byte and follows directly on in memory from the baud rate value, so
       by saving and loading the baud rate value as a word, we get to save
       and load the xon/xoff value as well
    */
    BPUT#c%,"bd: 16_"+STR$~ptr%!CONST_cnct_baud
    /*CSDM: Also save the enable parity bit - not just the parity setting.
        Fixes RP-1622.*/
    IF ptr%!CONST_cnct_data AND %110000 ptr%!CONST_cnct_data=ptr%!CONST_cnct_data OR %1000
    BPUT#c%,"ft: 16_"+STR$~ptr%!CONST_cnct_data
    BPUT#c%,"et: ";
    IF ptr%!CONST_cnct_econet=0 BPUT#c%,10 ELSE BPUT#c%,$ptr%!CONST_cnct_econet
    BPUT#c%,"fl: ";
    IF ptr%!CONST_cnct_file=0 BPUT#c%,10 ELSE BPUT#c%,$ptr%!CONST_cnct_file
    BPUT#c%,"ns: ";
    IF ptr%!CONST_cnct_nfss=0 BPUT#c%,10 ELSE BPUT#c%,$ptr%!CONST_cnct_nfss
    BPUT#c%,"np: ";
    IF ptr%!CONST_cnct_nfsp=0 BPUT#c%,10 ELSE BPUT#c%,$ptr%!CONST_cnct_nfsp
    BPUT#c%,"nu: ";
    IF ptr%!CONST_cnct_nfsu=0 BPUT#c%,10 ELSE BPUT#c%,$ptr%!CONST_cnct_nfsu
    BPUT#c%,"no: ";
    IF ptr%!CONST_cnct_nfso=0 BPUT#c%,10 ELSE BPUT#c%,$ptr%!CONST_cnct_nfso
    /*Output connection flags too (append, background printing).*/
    BPUT#c%,"cf: 16_"+STR$~ptr%?CONST_cnct_flags
    /* Output nfs password - encryption issues... */
    BPUT#c%,"nps: ";
    IF ptr%!CONST_cnct_nfsps=0 BPUT#c%,10 ELSE BPUT#c%,$ptr%!CONST_cnct_nfsps
   ENDIF

   /*Configuration details*/
   ptr%=prnt%!CONST_prnt_cnfg
   size%=psup%!CONST_psup_cnfg
   BPUT#c%,"cs: "+STR$ size%
   IF 1<=size% THEN
     FOR f%=1 TO size%
       p%=!ptr%
       ptr%+=4
       CASE TRUE OF
         WHEN p%=0
           BPUT#c%,"nl: "
         WHEN p%!-4=CONST_ident_INTG
           BPUT#c%,"in: "+STR$ !p%
         WHEN p%!-4=CONST_ident_STRG
           BPUT#c%,"st: "+$p%
         WHEN p%!-4=CONST_ident_STR0
           CALL Z%,p%,s$ /*convert 0-terminated string*/
           BPUT#c%,"s0: "+s$
         WHEN p%!-4=CONST_ident_GSTR
           CALL Y%,p%,s$ /*convert counted string*/
           BPUT#c%,"gs: "+FNungstrans(s$)
         WHEN p%!-4=CONST_ident_POTR
           BPUT#c%,"pt: "+FNdiscover_ptr(!p%,psup%)
         OTHERWISE
           SYS "XOS_Find",,c% /*Close*/
           ERROR CONST_error_ok,FNmsg_1(A%!CONST_interface_host_desc,"OKC",$prnt%!CONST_prnt_type)
       ENDCASE
     NEXT
   ENDIF
   REM save the following flags:
   REM bit 0: whether or not the printer is active
   REM bit 1: whether or not the printer is selected
   REM bit 7: whether or not the printer supports fast parallel
#ifdef Sparrow
   REM bit 16: whether the printer is shared
   REM bit 17: whether the printer is remote
#endif
   BPUT#c%,"fg: 16_"+STR$~(prnt%!CONST_prnt_flags AND CONST_prnt_flags_savemask)
   f%=prnt%!CONST_prnt_psze
   BPUT#c%,"pn: "+$f%!CONST_psze_name
   BPUT#c%,"sn: "+FNprinter_read_string(prnt%!CONST_prnt_name)
   BPUT#c%,"ic: "+FNprinter_read_string(prnt%!CONST_prnt_sprt)
   prnt%=prnt%!CONST_prnt_next
  ENDWHILE
#ifdef Sparrow
  rmtp% = remote_printers%
  WHILE rmtp%
    IF rmtp%!CONST_rmtp_icon > 0 THEN
      BPUT#c%, "cl:"
      BPUT#c%, "nm: "+$rmtp%!CONST_rmtp_descriptor /* Might be blank */
      BPUT#c%, "ct: 16_9"
      BPUT#c%, "bd: 16_8"
      BPUT#c%, "ft: 16_5"
      BPUT#c%, "et:"
      BPUT#c%, "fl:"
      BPUT#c%, "ns:"
      BPUT#c%, "np:"
      BPUT#c%, "nu:"
      BPUT#c%, "no:"
      BPUT#c%, "cf: 16_0"
      BPUT#c%, "cs: 2"
      BPUT#c%, "in: 25600"
      BPUT#c%, "in: 6"
      BPUT#c%, "fg: 16_20000"
      BPUT#c%, "pn:"
      BPUT#c%, "sn: "+$rmtp%!CONST_rmtp_name
      BPUT#c%, "ic:"
    ENDIF
    rmtp% = rmtp%!CONST_rmtp_next
  ENDWHILE
#endif
  CLOSE#c% /* allowed to generate an error here */
  SYS "XOS_File",18,f$,&FC6 /*SetType*/

  SYS "XOS_File",6,LEFT$(f$)
  SYS "XOS_FSControl", 25, f$, LEFT$(f$)
  SYS "XOS_File",4,LEFT$(f$),,,,&13 /*attributes to WR/r*/

  SYS "Hourglass_Off"
ENDPROC

DEF PROCsave_prdata
  LOCAL psup%,head%,prdt%,c%,tmpt%,ntry%,list%,i%,j%,k%,l%,s$,f%,f$

  /* HORRIBLE fix-up note (bug in 1.52; shows on RO 3.60):
      dp and lj class backends may have set bit 23 of any palette
      numbers in their prdata structure, as a 'seen before' flag. We must clear that
      flag, so that on restart after save choices, palettes are not regarded as
      seen already (allows correct overloading of old palettes, eg. in ROM)
      We actually clear whole top 9 bits (to allow for any other flags in future).
     ASSUMES that "palette" field name implies force bits 23-31 clear (eg. don't add
     field called "palette" to PS class, please...)
     Mea culpa! mjs */

  Ftracef("PROCsave_prdata")
  SYS "Hourglass_On"
  psup%=psup_head%
  WHILE psup%
   IF psup%!CONST_psup_tmpt THEN
    /*we have a template to guide us*/
    Ftracef("Found psup class "+$psup%!CONST_psup_class)
    IF psup%!CONST_psup_flags AND CONST_psup_flags_modified_psup THEN
     Ftracef("Data has been modified - saving it")
#ifdef Sparrow
     IF multiple_choices% THEN
       f$ = PrintersChoicesWriteDir+".Remote.ID"+unique_string$+"."+$psup%!CONST_psup_class
       SYS "OS_File", 8, f$ /* Ensure Directory */
       f$ += ".PrData1"
     ELSE
#endif
       f$ = PrintersChoicesWriteDir+"."+$psup%!CONST_psup_class+".PrData1"
#ifdef Sparrow
     ENDIF
#endif

     /*the data has been modified so save it
       first of all, ensure the file attributes are OK (user WR)*/
     SYS "XOS_File",4,LEFT$(f$),,,,3 /*WriteAttr*/

     SYS "XOS_Find",&8F,f$ TO c%;f%
     IF f% AND 1 \
       f%=c%+4: \
       CALL Z%,f%,s$: /*convert 0-terminated string*/ \
       ERROR CONST_error_ok,FNmsg_1(A%!CONST_interface_host_desc,"OKB",s$)

     LOCAL ERROR
     ON ERROR LOCAL RESTORE ERROR: \
       SYS"XOS_Find",0,c%: \
       SYS"XOS_File",6,f$: \
       ERROR CONST_error_ok, FNmsg_1(A%!CONST_interface_host_desc,"OKB",REPORT$)

     tmpt%=psup%!CONST_psup_tmpt
     head%=psup%!CONST_psup_head
     WHILE tmpt%
      BPUT#c%,$(tmpt%+CONST_tmpt_name)+":"
      BPUT#c%,"#"
      prdt%=head%!CONST_head_prdt
      WHILE prdt%
       IF prdt%!(prdt%!CONST_prdt_num*4+CONST_prdt_1st)THEN
        BPUT#c%,"# Usage: "+STR$ prdt%!(prdt%!CONST_prdt_num*4+CONST_prdt_1st)
        ntry%=tmpt%!CONST_tmpt_ntry
        i%=prdt%+CONST_prdt_1st
        WHILE ntry%
         BPUT#c%,$(ntry%+CONST_ntry_name)+" ";
         IF !i%=0 THEN
          IF ntry%!CONST_ntry_type=6 THEN
            BPUT#c%,48 /*zero list entries*/
          ELSE
            IF ntry%!CONST_ntry_type=1 THEN
              BPUT#c%,48 /* no integer => zero */
            ENDIF
          ENDIF
          BPUT#c%,10
         ELSE
          j%=!i% /*j% points to record of value*/
          CASE ntry%!CONST_ntry_type OF
           WHEN 1
            /* horrible fix-up - see remarks at top of procedure */
            IF $(ntry%+CONST_ntry_name) = "palette:" THEN
              BPUT#c%,STR$((!j%) AND &7FFFFF)
            ELSE
              BPUT#c%,STR$ !j%
            ENDIF
           WHEN 2
            BPUT#c%,FNprinter_read_string(j%)
           WHEN 3
            BPUT#c%,FNprinter_read_string(j%)
           WHEN 4
            BPUT#c%,FNungstrans(FNprinter_read_string(j%))
           WHEN 5
            BPUT#c%,10
            CASE ntry%!CONST_ntry_extra OF
             WHEN 1
              BPUT#c%," "+STR$ !j%!CONST_bool_false+", "+STR$ !j%!CONST_bool_true
             WHEN 2
              BPUT#c%," "+FNprinter_read_string(j%!CONST_bool_false)
              BPUT#c%," "+FNprinter_read_string(j%!CONST_bool_true)
             WHEN 3
              BPUT#c%," "+FNprinter_read_string(j%!CONST_bool_false)
              BPUT#c%," "+FNprinter_read_string(j%!CONST_bool_true)
             WHEN 4
              BPUT#c%," "+FNungstrans(FNprinter_read_string(j%!CONST_bool_false))
              BPUT#c%," "+FNungstrans(FNprinter_read_string(j%!CONST_bool_true))
             WHEN 7
              BPUT#c%," "+FNdiscover_ptr(!j%!CONST_bool_false,psup%)+", "+FNdiscover_ptr(!j%!CONST_bool_true,psup%)
            ENDCASE
           WHEN 6
            k%=j%
            l%=0
            WHILE k%
             l%+=1
             k%=!k%
            ENDWHILE
            BPUT#c%,STR$ l%
            WHILE j%
             IF 0<=j%!CONST_lstd_num-1 THEN
               FOR k%=0 TO j%!CONST_lstd_num-1
                l%=j%!(k%*4+CONST_lstd_1st)
                CASE l%!-4 OF
                 WHEN CONST_ident_INTG
                  BPUT#c%," "+STR$ !l%+", ";
                 WHEN CONST_ident_STRG
                  BPUT#c%," "+$l%+", ";
                 WHEN CONST_ident_STR0
                  CALL Z%,l%,s$ /*convert 0-terminated string*/
                  BPUT#c%," "+s$+", ";
                 WHEN CONST_ident_GSTR
                  CALL Y%,l%,s$ /*convert counted string*/
                  BPUT#c%," "+FNungstrans(s$)+", ";
                 WHEN CONST_ident_POTR
                  BPUT#c%," "+FNdiscover_ptr(!l%,psup%)+", ";
                ENDCASE
               NEXT
             ENDIF
             PTR#c%=PTR#c%-2
             BPUT#c%,10
             j%=!j%
            ENDWHILE
           WHEN 7
            BPUT#c%,FNdiscover_ptr(!j%,psup%)
           WHEN 8
            k%=j%
            l%=0
            WHILE k%
             l%+=1
             k%=!k%
            ENDWHILE
            BPUT#c%,STR$ l%
            WHILE j%
             s$=CHR$ j%?4
             IF 1<=j%?5 THEN
              FOR k%=1 TO j%?5
               s$+=CHR$ j%?(k%+5)
              NEXT
             ENDIF
             BPUT#c%," "+FNungstrans(s$)
             j%=!j%
            ENDWHILE
          ENDCASE
         ENDIF
         ntry%=ntry%!CONST_ntry_next
         i%+=4
        ENDWHILE
        BPUT#c%,"#"
       ENDIF
       prdt%=prdt%!CONST_prdt_next
      ENDWHILE
      tmpt%=tmpt%!CONST_tmpt_next
      head%=head%!CONST_head_next
     ENDWHILE
     CLOSE#c% /* allowed to generate an error here */
     SYS "XOS_File",18,f$,&FC6 /*SetType*/

     SYS "XOS_File",6,LEFT$(f$)
     SYS "XOS_FSControl",25,f$,LEFT$(f$)
     SYS "XOS_File",4,LEFT$(f$),,,,&13 /*attributes to WR/r*/

     Ftracef("Clearing modified flag bit")
     psup%!CONST_psup_flags=psup%!CONST_psup_flags AND NOT CONST_psup_flags_modified_psup
    ELSE
     Ftracef("Data hasn't been modified")
    ENDIF
   ENDIF
   psup%=psup%!CONST_psup_next
  ENDWHILE
  SYS "Hourglass_Off"
ENDPROC

DEF FNdiscover_ptr(p%,psup%)
  /*given a pointer, find the template it is in and the entry number*/
  LOCAL head%,prdt%,tmpt%,head_count%,prdt_count%
  Ftracef("FNdiscover_ptr")
  head%=psup%!CONST_psup_head
  WHILE head%
    prdt%=head%!CONST_head_prdt
    prdt_count%=0
    WHILE prdt%
      IF prdt%!(prdt%!CONST_prdt_num*4+CONST_prdt_1st)THEN
        prdt_count%+=1
        IF p%=prdt% THEN
          tmpt%=psup%!CONST_psup_tmpt
          WHILE head_count%
            tmpt%=tmpt%!CONST_tmpt_next
            head_count%-=1
          ENDWHILE
          =$(tmpt%+CONST_tmpt_name)+":"+STR$ prdt_count%
        ENDIF
      ENDIF
      prdt%=prdt%!CONST_prdt_next
    ENDWHILE
    head_count%+=1
    head%=head%!CONST_head_next
  ENDWHILE
  PROCerror_warning(FNmsg_0(A%!CONST_interface_host_desc,"FAF"))
=""

DEF FNwindow_open(h%)
  Ftracef("FNwindow_open")
  !win_buff%=h%
  SYS "Wimp_GetWindowState",,win_buff%
=(win_buff%!32 AND 1<<16)<>0

DEF PROCprinter_control(prnt%)
  /*is the window already open?*/
  Ftracef("PROCprinter_control")
#ifdef Sparrow
  IF NOT FNwindow_open(prntctrl%) THEN
    IF A%!CONST_interface_printer_installed OR remote_printers% THEN
      PROCcreate_installed_printer_icons
    ENDIF
  ENDIF /* There isn't that easier to read than the below? */
#else
  IF NOT FNwindow_open(prntctrl%) IF A%!CONST_interface_printer_installed PROCcreate_installed_printer_icons
#endif
  PROCtell_pinboard(prntctrl%)
  PROCwin_open(prntctrl%)
  PROCdo_select_printer_control(prnt%)
ENDPROC

DEF PROCdo_select_printer_control(prnt%)
  LOCAL p%
  Ftracef("PROCdo_select_printer_control")
  IF prnt% THEN
    SYS "Wimp_WhichIcon",prntctrl%,buff1%,1<<21,1<<21
    p%=buff1%
    WHILE NOT !p%
      IF !p%<>prnt%!CONST_prnt_pane PROCicon_deselect(prntctrl%,!p%)
      p%+=4
    ENDWHILE
    IF(prnt%!CONST_prnt_flags AND CONST_prnt_flags_spcmask)=0 \
      PROCicon_select(prntctrl%,prnt%!CONST_prnt_pane)
  ENDIF
ENDPROC

DEF PROCcheck_prdata_ptr(p%)
  /*if p% is a pointer, or is a boolean/list containing a pointer
    then the thing that it is pointing to has its usage count
    decremented.

    if *that* thing's usage count has reached zero, then *it* is
    checked to see if it has any pointers, etc, etc, etc.

    things with usage counts of zero are not saved.*/
  LOCAL ptr%,i%,tmp%
  Ftracef("PROCcheck_prdata_ptr")
  IF p%=0 ENDPROC
  CASE p%!-4 OF
    WHEN CONST_ident_POTR
      ptr%=!p% /*pointer to a PRDT block*/
      tmp%=ptr%+ptr%!CONST_prdt_num*4+CONST_prdt_1st
      !tmp%-=1
      IF !tmp%=0 THEN
        tmp%=ptr%+CONST_prdt_1st
        IF 1<=ptr%!CONST_prdt_num THEN
          FOR i%=1 TO ptr%!CONST_prdt_num
            PROCcheck_prdata_ptr(!tmp%)
            tmp%+=4
          NEXT
        ENDIF
      ENDIF
    WHEN CONST_ident_BOOL
      PROCcheck_prdata_ptr(p%!CONST_bool_false)
      PROCcheck_prdata_ptr(p%!CONST_bool_true)
    WHEN CONST_ident_LSTD
      WHILE p%
        IF 0<=p%!CONST_lstd_num-1 THEN
          FOR ptr%=0 TO p%!CONST_lstd_num-1
            PROCcheck_prdata_ptr(p%!(ptr%*4+CONST_lstd_1st))
          NEXT
        ENDIF
        p%=p%!CONST_lstd_next
      ENDWHILE
  ENDCASE
ENDPROC

DEF PROCdelete_prdata_entry(printer_type$)
  LOCAL psup%,head%,old_prdt%,prdt%,i%,j%,k%,l%,tmp%
  Ftracef("PROCdelete_prdata_entry: "+printer_type$)
  psup%=psup_head%
  WHILE psup%
    Ftracef("Checking psup class "+$psup%!CONST_psup_class)
    old_prdt%=0
    head%=psup%!CONST_psup_head /*ptr to head of data for first template*/
    prdt%=head%!CONST_head_prdt /*ptr to first data record for first template*/
    WHILE prdt%
      Ftracef("Got printer type "+$prdt%!CONST_prdt_1st)
      IF $prdt%!CONST_prdt_1st=printer_type$ THEN
        /*OK - prdt% points to the record to kill*/
        Ftracef("Usage count = "+STR$(prdt%!(prdt%!CONST_prdt_num*4+CONST_prdt_1st)))
        IF (prdt%!(prdt%!CONST_prdt_num*4+CONST_prdt_1st)) = 0 THEN
          /*can only kill it if no other users*/
          Ftracef("Setting modified flag")
          psup%!CONST_psup_flags=psup%!CONST_psup_flags OR CONST_psup_flags_modified_psup
          IF 0<=prdt%!CONST_prdt_num-1 THEN
            FOR i%=0 TO prdt%!CONST_prdt_num-1
              tmp%=prdt%!(i%*4+CONST_prdt_1st)
              PROCcheck_prdata_ptr(tmp%)
              PROCfree_structure(tmp%)
            NEXT
          ENDIF
          IF old_prdt% THEN
            old_prdt%!CONST_prdt_next=prdt%!CONST_prdt_next
          ELSE
            head%!CONST_head_prdt=prdt%!CONST_prdt_next
          ENDIF
          Ftracef("Freeing PRDT block")
          B%=CONST_ident_PRDT
          C%=prdt%
          CALL code_entry%+CONST_entry_heap_free
        ENDIF
        prdt%=0
        psup%=0
      ELSE
        old_prdt%=prdt%
        prdt%=prdt%!CONST_prdt_next
      ENDIF
    ENDWHILE
    IF psup% psup%=psup%!CONST_psup_next
  ENDWHILE
ENDPROC

DEF PROCvalidate_error(err$)
  Ftracef("PROCvalidate_error")
  PROCram_file_error(FNmsg_1(A%!CONST_interface_host_desc,"OKZ",err$))
ENDPROC

DEF PROCvalidate_prdata_file(RETURN psup%)
  /*checks the ram loaded printer definition file so that
    no blocks are claimed before knowing that the file is kosher.*/
  LOCAL ptr%,ts%,c%,d%
  Ftracef("PROCvalidate_prdata_file")

  /*match the class first*/
  ts%=FNmatch_line("cl:")
  IF ts%=0 PROCvalidate_error(FNmsg_0(A%!CONST_interface_host_desc,"OKZa"))

  /*now match the class*/
  psup%=psup_head%
  WHILE psup%
    IF $psup%!CONST_psup_class=$ts% THEN
      /* matched on the printer class                         */
      /* see if the class needs to be able to write, and that */
      /* we CAN write to PrinterChoices$Path                  */
      IF psup%!CONST_psup_flags AND CONST_psup_flags_needs_to_write THEN
        SYS"XOS_File",7,"PrinterChoices:"+$ts%+".WriteTest" TO ;c%
        IF(c%AND1) PROCrelease_file:ERROR CONST_error_ok,FNmsg_1(A%!CONST_interface_host_desc,"OKAN",$ts%)
        /* delete it now :-) */
        SYS"XOS_File",6,"PrinterChoices:"+$ts%+".WriteTest" TO d%;c%
      ENDIF

      ptr%=!data_ptr%
      PROCvalidate_one_entry(psup%,psup%!CONST_psup_tmpt)
      !data_ptr%=ptr%
      ENDPROC
    ELSE
      psup%=psup%!CONST_psup_next
    ENDIF
  ENDWHILE

  IF psup%=0 THEN
#if FALSE
    /* psups don't need write access when they are being loaded */
    /* if they need write access when PDFs are installed, this  */
    /* is now checked below, so this bit of code 'ere is no     */
    /* longer needed.                                           */

    /* ensure we've got write access */

    c%=OPENUP("PrinterChoices:"+$ts%+".PrData")
    IFc%<>0 THEN
      SYS"OS_Args",254,c% TO d%
      CLOSE#c%
      IF(d%AND(1<<7))=0 PROCrelease_file:ERROR CONST_error_ok,FNmsg_1(A%!CONST_interface_host_desc,"OKAN",$ts%)
    ENDIF
#endif
    PROClocal_file
    PROCinitialise_one_support_library($ts%)
    PROCinitialise_one_psup($ts%,psup%) /* also loads the paper definitions */
    PROCrestore_file
    PROCtimeout_reinitialise
    /* see if the class needs to be able to write, and that */
    /* we CAN write to PrinterChoices$Path                  */
    IF psup%!CONST_psup_flags AND CONST_psup_flags_needs_to_write THEN
      SYS"XOS_File",7,"PrinterChoices:"+$ts%+".WriteTest" TO ;c%
      IF(c%AND1) PROCrelease_file:ERROR CONST_error_ok,FNmsg_1(A%!CONST_interface_host_desc,"OKAN",$ts%)
      SYS"XOS_File",6,"PrinterChoices:"+$ts%+".WriteTest"
    ENDIF
    /*
       since we've just loaded the class code, we should give it a code -5
       to allow it to tidy up.
    */
    PROCprinter_reason_code(psup%,A%!CONST_interface_printer_installed,-5,0)
  ENDIF
  IF psup%=0 PROCvalidate_error(FNmsg_1(A%!CONST_interface_host_desc,"OKZb",$ts%))

ENDPROC

DEF PROCvalidate_one_entry(psup%,tmpt%)
  LOCAL ntry%,ts%
  Ftracef("PROCvalidate_one_entry")
  ntry%=tmpt%!CONST_tmpt_ntry
  REPEAT
    ts%=FNmatch_line($(ntry%+CONST_ntry_name))
    IF ts% THEN
      /*matched the entry - validate lists and char lists
        also validate pointers*/
      CASE ntry%!CONST_ntry_type OF
        WHEN 5
          PROCvalidate_one_boolean(psup%,tmpt%,$ts%)
        WHEN 6
          IF ?ts%=13 PROCvalidate_error(FNmsg_1(A%!CONST_interface_host_desc,"OK7a",$(ntry%+CONST_ntry_name)))
          PROCvalidate_one_list(psup%,tmpt%,$ts%)
        WHEN 7
          PROCvalidate_one_pointer(psup%,tmpt%,$ts%)
        WHEN 8
          IF ?ts%=13 PROCvalidate_error(FNmsg_1(A%!CONST_interface_host_desc,"OK7a",$(ntry%+CONST_ntry_name)))
          PROCvalidate_one_charlist(psup%,tmpt%,$ts%)
      ENDCASE
#if StrictValidatePDF
    ELSE
      /*failed to match the entry*/
      IF !data_ptr%<data_size% PROCvalidate_error(FNmsg_1(A%!CONST_interface_host_desc,"OKZc",$(ntry%+CONST_ntry_name)))
#endif
    ENDIF
    ntry%=ntry%!CONST_ntry_next
  UNTIL ntry%=0
ENDPROC

DEF PROCvalidate_one_boolean(psup%,tmpt%,t$)
  LOCAL ts%,int$,str$
  Ftracef("PROCvalidate_one_boolean")
  ts%=FNmatch_any_line
  IF ts% THEN
    CASE ntry%!CONST_ntry_extra OF
      WHEN 1
        ts%=FNsplit_integer(ts%,int%)
        IF ?ts%=13 ts%=FNmatch_any_line
      WHEN 2,3,4
        ts%=FNsplit_string(ts%,str$)
        IF ?ts%=13 ts%=FNmatch_any_line
      WHEN 7
        ts%=FNsplit_string(ts%,str$)
        PROCvalidate_one_pointer(psup%,tmpt%,str$)
        IF ?ts%=13 ts%=FNmatch_any_line
        PROCvalidate_one_pointer(psup%,tmpt%,$ts%)
    ENDCASE
  ENDIF
ENDPROC

DEF PROCvalidate_one_list(psup%,tmpt%,t$)
  LOCAL i%,p%,ned%,ts%
  Ftracef("PROCvalidate_one_list")
  ned%=VAL t$
  IF 1<=ned% THEN
    FOR i%=1 TO ned%
      ts%=FNmatch_any_line
      IF ts% THEN
        p%=ntry%!CONST_ntry_extra
        WHILE p%
          IF p%!CONST_list_type=7 PROCvalidate_one_pointer(psup%,tmpt%,$ts%)
          p%=!p%
        ENDWHILE
      ENDIF
    NEXT
  ENDIF
ENDPROC

DEF PROCvalidate_one_pointer(psup%,tmpt%,name$)
  LOCAL i%,s$,t$
  Ftracef("PROCvalidate_one_pointer")
  i%=INSTR(name$,":")
  IF i%=0 PROCvalidate_error(FNmsg_1(A%!CONST_interface_host_desc,"OKAA",name$))
  s$=LEFT$(name$,i%-1)
  t$=MID$(name$,i%+1)
  tmpt%=psup%!CONST_psup_tmpt
  WHILE tmpt%
    IF $(tmpt%+CONST_tmpt_name)=s$ THEN
      IF VAL t$>0 THEN
        /*number provided - pointer is OK*/
        ENDPROC
      ELSE
        PROCvalidate_one_entry(psup%,tmpt%)
        ENDPROC
      ENDIF
    ELSE
      tmpt%=tmpt%!CONST_tmpt_next
    ENDIF
  ENDWHILE
  PROCvalidate_error(FNmsg_1(A%!CONST_interface_host_desc,"OKAB",s$))
ENDPROC

DEF PROCvalidate_one_charlist(psup%,tmpt%,t$)
  LOCAL i%,ned%
  Ftracef("PROCvalidate_one_charlist")
  ned%=VAL t$
  IF 1<=ned% THEN
    FOR i%=1 TO ned%
      IF FNmatch_any_line
    NEXT
  ENDIF
ENDPROC

DEF PROCadd_to_prdata
  /*called when someone drops a file onto the printer control window*/
  LOCAL ts%,psup%,ptr%,s$,ntry%,prdata%,last_prdata%,this_prhead%,matched%,fix_up%
  Ftracef("PROCadd_to_prdata")
  ts%=task_buff%+44
  CALL Z%,ts%,s$ /*convert 0-terminated string*/
  IF NOT FNload_multiple_file(s$) \
    ERROR CONST_error_ok,FNmsg_1(A%!CONST_interface_host_desc,"OKX",s$)
  SYS "Hourglass_On"
  /*the following proc does not return if there is an error*/
  PROCvalidate_prdata_file(psup%)
  this_prhead%=psup%!CONST_psup_head
  IF this_prhead% THEN
    /*already got something here*/
    prdata%=this_prhead%!CONST_head_prdt
    IF prdata% THEN
      /*need to see if this printer type has already been loaded
        if it has, we don't need to load it again: we can just get
        the printer to refer to the data*/
      ptr%=!data_ptr%
      ntry%=psup%!CONST_psup_tmpt
      ntry%=ntry%!CONST_tmpt_ntry
      ts%=FNmatch_line($(ntry%+CONST_ntry_name))
      IF ts% THEN
        /*ok, found the printer name, now look it up in the prdata*/
        WHILE prdata%
          IF $prdata%!CONST_prdt_1st=$ts% THEN
            PROCrelease_file
            SYS "Hourglass_Off"
            PROCinstall_printer(psup%,prdata%)
            ENDPROC
          ENDIF
          last_prdata%=prdata%
          prdata%=prdata%!CONST_prdt_next
        ENDWHILE
        /*if we get to here, we didn't match against an existing
          entry, so we proceed to load the definition*/
      ELSE
        /*this is a real error*/
        PROCvalidate_error(FNmsg_1(A%!CONST_interface_host_desc,"OKZc",\
            $(ntry%+CONST_ntry_name)))
      ENDIF
      !data_ptr%=ptr%
    ELSE
      last_prdata%=0
    ENDIF
  ELSE
    last_prdata%=0
  ENDIF

  Ftracef("last_prdata%=&"+STR$~last_prdata%)
  PROCprocess_one_entry(psup%!CONST_psup_tmpt,last_prdata%,this_prhead%,0,\
      matched%,fix_up%,psup%)
  PROCrelease_file
  Ftracef("Psup modified flag set")
  psup%!CONST_psup_flags=psup%!CONST_psup_flags OR CONST_psup_flags_modified_psup
      /*mark PSUP info as modified*/

  PROCinstall_printer(psup%,last_prdata%)
  SYS "Hourglass_Off"
ENDPROC

  /*DEF PROCread_printer_defn(database%)
    IF NOT(FNload_file(FNpsup_res(database%,"PrData")))THEN
     ERROR CONST_error_ok,FNmsg_1(A%!CONST_interface_host_desc,"OK1",$database%!CONST_psup_class)
    ENDIF
    PROCprocess_template(database%)
    PROCprocess_file(database%)
    PROCrelease_file
    ENDPROC*/

DEF PROCram_file_error(s$)
  Ftracef("PROCram_file_error")
  PROCrelease_file
  ERROR CONST_error_ok,FNmsg_3(A%!CONST_interface_host_desc,"OK0",STR$ data_line%,data_file$,s$)
ENDPROC

DEF PROCprdata_error(psup%,s$,tag$)
  Ftracef("PROCprdata_error")
  PROCram_file_error(FNmsg_2(A%!CONST_interface_host_desc,tag$,$psup%!CONST_psup_class,s$))
ENDPROC

DEF PROCprocess_template(database%)
  /*the purpose of this procedure is to process the template definition*/
  LOCAL ts%,ss%,depth%,i%,this_template%,last_template%,this_entry%,last_entry%
  Ftracef("PROCprocess_template")
  ts%=FNmatch_line("tp:")
  IF ts%=0 PROCprdata_error(database%,FNmsg_0(A%!CONST_interface_host_desc,"OK3"),"OK2a")
  REPEAT
    ts%=FNmatch_any_line
    IF ts% THEN
      ss%=FNmatch_string(ts%,"tp:")
      IF ss% THEN
        /* starting a new sub-template so increase the depth */
        depth%+=1
        B%=CONST_ident_TMPT
        C%=CONST_tmpt_name+1+LEN $ss%
        this_template%=USR(code_entry%+CONST_entry_heap_claim)
        IF this_template%=0 PROCprdata_error(database%,FNmsg_1(A%!CONST_interface_host_desc,"FA5","TMPT"),"OK2a")
        IF last_template% THEN
          last_template%!CONST_tmpt_next=this_template%
        ELSE
          database%!CONST_psup_tmpt=this_template%
        ENDIF
        this_template%!CONST_tmpt_next=0
        this_template%!CONST_tmpt_ntry=0
        this_template%!CONST_tmpt_size=0
        $(this_template%+CONST_tmpt_name)=$ss%
        last_entry%=0
      ELSE
        /* have we reached the end of the definition yet? */
        ss%=FNmatch_string(ts%,"end:")
        IF ss% THEN
          IF ?ss%<>13 PROCprdata_error(database%,FNmsg_0(A%!CONST_interface_host_desc,"OK3a"),"OK2a")
          depth%-=1
          last_template%=this_template%
        ELSE
          /* if not, add this additional entry */
          i%=INSTR($ts%,":")
          IF i%=0 PROCprdata_error(database%,FNmsg_1(A%!CONST_interface_host_desc,"OK4",$ts%),"OK2a")
          IF depth%<>1 PROCprdata_error(database%,FNmsg_1(A%!CONST_interface_host_desc,"OK4a",$ts%),"OK2a")
          this_template%!CONST_tmpt_size+=1
          B%=CONST_ident_NTRY
          C%=CONST_ntry_name+1+i%
          this_entry%=USR(code_entry%+CONST_entry_heap_claim)
          IF this_entry%=0 PROCprdata_error(database%,FNmsg_1(A%!CONST_interface_host_desc,"FA5","NTRY"),"OK2a")
          IF last_entry% last_entry%!CONST_ntry_next=this_entry% ELSE this_template%!CONST_tmpt_ntry=this_entry%
          this_entry%!CONST_ntry_next=0
          this_entry%!CONST_ntry_type=0
          this_entry%!CONST_ntry_extra=0
          this_entry%!CONST_ntry_size=0
          $(this_entry%+CONST_ntry_name)=LEFT$($ts%,i%)
          ts%+=i%+1

          CASE TRUE OF
            WHEN FNmatch_string(ts%,"in")<>0
              this_entry%!CONST_ntry_type=1
            WHEN FNmatch_string(ts%,"st")<>0
              this_entry%!CONST_ntry_type=2
            WHEN FNmatch_string(ts%,"s0")<>0
              this_entry%!CONST_ntry_type=3
            WHEN FNmatch_string(ts%,"gs")<>0
              this_entry%!CONST_ntry_type=4
            WHEN FNmatch_string(ts%,"bl")<>0
              this_entry%!CONST_ntry_type=5
              ss%=FNmatch_string(ts%,"bl") /*I don't want another nested IF!*/
              WHILE ?ss%=32
                ss%+=1
              ENDWHILE
              IF ?ss%=ASC "," ss%+=1

              CASE TRUE OF
                WHEN FNmatch_string(ss%,"in")<>0
                  this_entry%!CONST_ntry_extra=1
                WHEN FNmatch_string(ss%,"st")<>0
                  this_entry%!CONST_ntry_extra=2
                WHEN FNmatch_string(ss%,"s0")<>0
                  this_entry%!CONST_ntry_extra=3
                WHEN FNmatch_string(ss%,"gs")<>0
                  this_entry%!CONST_ntry_extra=4
                WHEN FNmatch_string(ss%,"ptr")<>0
                  this_entry%!CONST_ntry_extra=7
                OTHERWISE
                  PROCprdata_error(database%,FNmsg_1(A%!CONST_interface_host_desc,"OK5",$ss%),"OK2a")
              ENDCASE
            WHEN FNmatch_string(ts%,"ls")<>0
              this_entry%!CONST_ntry_type=6
              ss%=FNmatch_string(ts%,"ls")
              PROCmatch_list(ss%,this_entry%,database%)
            WHEN FNmatch_string(ts%,"ptr")<>0
              this_entry%!CONST_ntry_type=7
            WHEN FNmatch_string(ts%,"ch")<>0
              this_entry%!CONST_ntry_type=8
            OTHERWISE
              PROCprdata_error(database%,FNmsg_1(A%!CONST_interface_host_desc,"OK6",$ts%),"OK2a")
          ENDCASE
          last_entry%=this_entry%
        ENDIF
      ENDIF
    ENDIF
  UNTIL depth%=-1
ENDPROC

DEF PROCmatch_list(rs%,ntry%,database%)
  LOCAL list%,ptr%,t%
  Ftracef("PROCmatch_list")
  ptr%=ntry%+CONST_ntry_extra
  REPEAT
    WHILE ?rs%=32
      rs%+=1
    ENDWHILE

    IF ?rs%=44 rs%+=1 /*","*/

    WHILE ?rs%=32
      rs%+=1
    ENDWHILE

    IF ?rs%<>13 THEN
      ntry%!CONST_ntry_size+=1 /*increment the list size*/
      B%=CONST_ident_LIST
      C%=CONST_list_MAX
      list%=USR(code_entry%+CONST_entry_heap_claim)
      IF list%=0 ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","LIST")
      !ptr%=list%
      ptr%=list%
      list%!CONST_list_next=0
      t%=FNmatch_string(rs%,"in")
      IF t% THEN
        rs%=t%
        list%!CONST_list_type=1
      ELSE
        t%=FNmatch_string(rs%,"st")
        IF t% THEN
          rs%=t%
          list%!CONST_list_type=2
        ELSE
          t%=FNmatch_string(rs%,"s0")
          IF t% THEN
            rs%=t%
            list%!CONST_list_type=3
          ELSE
            t%=FNmatch_string(rs%,"gs")
            IF t% THEN
              rs%=t%
              list%!CONST_list_type=4
            ELSE
              t%=FNmatch_string(rs%,"ptr")
              IF t% THEN
                rs%=t%
                list%!CONST_list_type=7
              ELSE
                PROCprdata_error(database%,FNmsg_1(A%!CONST_interface_host_desc,"OK7",$rs%),"OK2a")
              ENDIF
            ENDIF
          ENDIF
        ENDIF
      ENDIF
    ENDIF
  UNTIL ?rs%=13
ENDPROC

DEF FNmatch_line(m$)
  LOCAL tail%,i%
  /*Spec: global !data_ptr% updated, data_block%, data_size% used.
    Starting at data_block%?!data_ptr%,
    skipping leading spaces
    and comments
    IF    argument is the same as the line prefix
    THEN  update !data_ptr% to refer to the next line
          return a pointer to the line postfix with leading spaces removed
    ELSE  update !data_ptr% to refer to the next line
    FI
    If no match, return 0*/

  Ftracef("FNmatch_line("""+m$+""")")

  /*Loop through each line.*/
  i%=data_block%+!data_ptr%
  WHILE i%<data_block%+data_size%
    /*Skip leading spaces*/
    Ftracef("i% = "+STR$~(i%)+", data_block%+data_size% = "+STR$~(data_block%+data_size%))
    Ftracef("Got "+STR$(?i%))
    WHILE ?i%=32
      i%+=1
      Ftracef("Got "+STR$(?i%))
    ENDWHILE

    IF ?i%=35 OR ?i%=13 THEN
      /*Comment - skip to e o l*/
      Ftracef("Got comment")
      i%+=LEN $i%+1
      data_line%+=1
    ELSE
      /*Does the line match?*/
      Ftracef("Seeing if the line matches")
      IF m$=LEFT$($i%,LEN m$)THEN
        /*Yes! - skip leading spaces in the tail*/
        tail%=i%+LEN m$
        WHILE ?tail%=32
          tail%+=1
        ENDWHILE

        /*Skip to e o l*/
        i%+=LEN $i%+1
        !data_ptr%=i%-data_block%
        data_line%+=1
        /*Ftracef("   -> """+$tail%+"""")*/
        =tail%
      ELSE
        /*No! - skip to e o l*/
        /*DON'T write back data_ptr in this case - this allows failing matches*/
        Ftracef("Failed to match")
        i%+=LEN $i%+1
        data_line%+=1
      ENDIF
    ENDIF
    #ifdef Trace
      IF i%?-1<>13 ERROR CONST_error_fatal,"Assertion failure"
    #endif
  ENDWHILE
=0

DEF FNmatch_any_line
  LOCAL tail%,i%

  Ftracef("FNmatch_any_line")

  /*Loop through each line.*/
  i%=data_block%+!data_ptr%
  WHILE i%<data_block%+data_size%
    /*Skip leading spaces*/
    WHILE ?i%=32
      i%+=1
    ENDWHILE

    IF ?i%=35 OR ?i%=13 THEN
      /*Comment - skip to e o l*/
      i%+=LEN $i%+1
      !data_ptr%=i%-data_block% /*???*/
      data_line%+=1
    ELSE
      /*The line always matches*/
      tail%=i%

      /*Skip to e o l*/
      i%+=LEN $i%+1
      !data_ptr%=i%-data_block%
      data_line%+=1
      /*Ftracef("   -> """+$tail%+"""")*/
      =tail%
    ENDIF
    #ifdef Trace
      IF i%?-1<>13 ERROR CONST_error_fatal,"Assertion failure"
    #endif
  ENDWHILE
=0

DEF FNmatch_string(ts%,m$)
  #ifdef Trace
    IF INSTR(m$,CHR$ 13)ERROR CONST_error_fatal,STR$ ERL
  #endif

  /*Skip leading spaces*/
  WHILE ?ts%=32
    ts%+=1
  ENDWHILE

  /*Does it match?*/
  IF m$=LEFT$($ts%,LEN m$)THEN
    /*Yes! - skip leading spaces in the tail*/
    ts%+=LEN m$
    WHILE ?ts%=32
      ts%+=1
    ENDWHILE
    =ts%
  ENDIF
=0

DEF PROCprocess_one_entry(tmpt%,RETURN last_prdata%,this_prhead%,last_prhead%,RETURN matched%,RETURN fix_up%,psup%)
  LOCAL offset%,this_prdata%,file_ptr%,ts%,ss%,ntry%,i%,size%
  Ftracef("PROCprocess_one_entry")
  ntry%=tmpt%!CONST_tmpt_ntry
  offset%=-1
  REPEAT
    file_ptr%=!data_ptr%
    matched%=0
    ts%=FNmatch_any_line:Ftracef("Matched: "+$ts%+" (@ &"+STR$~(ts%)+")")
    IF ts% THEN
      IF offset%=-1 THEN
        /*we've actually found something to read and we
          need to claim a new block for this record*/
        Ftracef("Claiming new block for "+STR$(tmpt%!CONST_tmpt_size)+" entries")
        size%=4*tmpt%!CONST_tmpt_size+CONST_prdt_1st
        B%=CONST_ident_PRDT
        C%=size%+8
        this_prdata%=USR(code_entry%+CONST_entry_heap_claim)
        Ftracef("Block @ &"+STR$~this_prdata%)
        IF this_prdata%=0 \
          ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","PRDT")
        IF 0<=size%+7 THEN
          FOR i%=0 TO size%+7 STEP 4
            this_prdata%!i%=0
          NEXT
        ENDIF
        IF last_prdata% last_prdata%!CONST_prdt_next=this_prdata% ELSE this_prhead%!CONST_head_prdt=this_prdata%
        this_prdata%!CONST_prdt_num=tmpt%!CONST_tmpt_size
        offset%=8
      ENDIF
      REPEAT
        ss%=FNmatch_string(ts%,$(ntry%+CONST_ntry_name)):Ftracef("Matched: "+$ss%+" (@ &"+STR$~(ss%)+")")
        IF ss% THEN
          matched%=1
          CASE ntry%!CONST_ntry_type OF
            WHEN 1
              this_prdata%!offset%=FNstore_integer(FNevaluate($ss%))
            WHEN 2,3,4
              B%=ss%
              C%=ntry%!CONST_ntry_type
              this_prdata%!offset%=USR(code_entry%+CONST_entry_store_string)
            WHEN 5
              this_prdata%!offset%=FNretrieve_boolean(ntry%,fix_up%)
            WHEN 6
              IF ?ss%=13 PROCprdata_error(psup%,FNmsg_1(A%!CONST_interface_host_desc,"OK7a",$ts%),"OK2")
              this_prdata%!offset%=FNretrieve_list(ntry%,FNevaluate($ss%),fix_up%)
            WHEN 7
              IF ?ss%<>13 PROCretrieve_ptr(psup%,$ss%,this_prdata%+offset%,fix_up%)
            WHEN 8
              IF ?ss%=13 PROCprdata_error(psup%,FNmsg_1(A%!CONST_interface_host_desc,"OK7a",$ts%),"OK2")
              this_prdata%!offset%=FNretrieve_charlist(ntry%,FNevaluate($ss%))
          ENDCASE
        ENDIF
        /* PJC: not matching on entries no longer causes prdt blocks to be freed */
        /*
          B%=CONST_ident_PRDT
          C%=this_prdata%
          CALL code_entry%+CONST_entry_heap_free
          this_prdata%=0
          IF last_prdata% last_prdata%!CONST_prdt_next=0 ELSE this_prhead%!CONST_head_prdt=0
          WHILE ntry%!CONST_ntry_next
            ntry%=ntry%!CONST_ntry_next
          ENDWHILE
        */
        offset%+=4
        ntry%=ntry%!CONST_ntry_next
      UNTIL ntry%=0 OR matched%
    ENDIF
    IF matched%=0 THEN
      /*failed to match the string against the template entries*/
      IF !data_ptr%>=data_size% matched%=3
      /*restore the file ptr*/
      !data_ptr%=file_ptr%
      /*then try to re-match it against the first entry*/
      ntry%=tmpt%!CONST_tmpt_ntry
      ss%=FNmatch_string(ts%,$(ntry%+CONST_ntry_name))
      IF ss% THEN
        matched%=1
      ELSE
        /*try to advise the caller if it doesn't match the next template*/
        tmpt%=tmpt%!CONST_tmpt_next
        ss%=FNmatch_string(ts%,$(tmpt%+CONST_tmpt_name)+":")
        IF ss% matched%=2
      ENDIF
      ntry%=0
    ENDIF
  UNTIL ntry%=0
  Ftracef("Setting last_prdata% to &"+STR$~this_prdata%)
  last_prdata%=this_prdata%
ENDPROC

DEF PROCprocess_file(psup%)
  LOCAL tmpt%,s$,ts%,file_ptr%,ntry%,matched%,this_prdata%,last_prdata%,this_prhead%,last_prhead%,fix_up%,i%
  Ftracef("PROCprocess_file")
  tmpt%=psup%!CONST_psup_tmpt
  REPEAT
    /*look for the start of this sub-template*/
    ts%=FNmatch_line($(tmpt%+CONST_tmpt_name)+":")
    IF ts%=0 PROCprdata_error(psup%,FNmsg_1(A%!CONST_interface_host_desc,"OK8",$(tmpt%+CONST_tmpt_name)),"OK2")
    B%=CONST_ident_HEAD
    C%=CONST_head_MAX
    this_prhead%=USR(code_entry%+CONST_entry_heap_claim)
    IF this_prhead%=0 PROCprdata_error(psup%,FNmsg_1(A%!CONST_interface_host_desc,"FA5","HEAD"),"OK2")
    this_prhead%!CONST_head_next=0
    this_prhead%!CONST_head_prdt=0
    IF last_prhead% last_prhead%!CONST_head_next=this_prhead% ELSE psup%!CONST_psup_head=this_prhead%
    last_prdata%=0
    REPEAT
      ntry%=tmpt%!CONST_tmpt_ntry
      Ftracef("*** LOOKING FOR """+$(ntry%+CONST_ntry_name)+""" ***")
      PROCprocess_one_entry(tmpt%,last_prdata%,this_prhead%,last_prhead%,matched%,fix_up%,psup%)
      /*matched = 0 => no match at all
        matched = 1 => matched on this template
        matched = 2 => matched on next template
        matched = 3 => ran out of data to match on*/
      IF matched%=0 THEN
        ts%=FNmatch_any_line
        PROCprdata_error(psup%,FNmsg_1(A%!CONST_interface_host_desc,"OK9",$ts%),"OK2")
      ENDIF
    UNTIL matched%<>1
    tmpt%=tmpt%!CONST_tmpt_next
    last_prhead%=this_prhead%
  UNTIL tmpt%=0
  WHILE fix_up%
    i%=fix_up%!4
    s$=$!i%
    B%=CONST_ident_POTR
    C%=!i%
    CALL code_entry%+CONST_entry_heap_free
    B%=CONST_ident_POTR
    C%=4
    !i%=USR(code_entry%+CONST_entry_heap_claim)
    IF !i%=0 PROCprdata_error(psup%,FNmsg_1(A%!CONST_interface_host_desc,"FA5","POTR"),"OK2")
    !!i%=FNfix_up_pointer(s$,TRUE)
    i%=fix_up%
    fix_up%=!fix_up%
    B%=CONST_ident_XXXX
    C%=i%
    CALL code_entry%+CONST_entry_heap_free
  ENDWHILE
ENDPROC

DEF FNfix_up_pointer(s$,inc_count%)
  LOCAL j%,k%,t$
  Ftracef("FNfix_up_pointer: '"+s$+"'")
  j%=INSTR(s$,":")
  t$=MID$(s$,j%+1)
  s$=LEFT$(s$,j%-1)
  j%=psup%!CONST_psup_tmpt
  k%=0
  /*match the template name against the given name*/
  WHILE j%
   IF$(j%+CONST_tmpt_name)=s$ THEN
    /*matched - now find the data*/
    j%=psup%!CONST_psup_head
    WHILE k%
     j%=j%!CONST_head_next
     k%-=1
    ENDWHILE
    /*found - now find the required entry*/
    k%=VAL t$-1
    j%=j%!CONST_head_prdt
    WHILE k%
     j%=j%!CONST_prdt_next
     k%-=1
    ENDWHILE
    /*found - if inc_count% is TRUE then increment the count of usage - this
      is for PRDT usage rather than settings usage*/
    IF inc_count% j%!(j%!CONST_prdt_num*4+CONST_prdt_1st)+=1
    /*return the pointer*/
    =j%
   ELSE
    j%=j%!CONST_tmpt_next
    k%+=1
   ENDIF
  ENDWHILE
  PROCerror_warning(FNmsg_2(A%!CONST_interface_host_desc,"FAG",s$,t$))
=0

DEF FNstore_integer(v%)
  LOCAL b%
  Ftracef("FNstore_integer")
  B%=CONST_ident_INTG
  C%=4
  b%=USR(code_entry%+CONST_entry_heap_claim)
  IF b%=0 ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","INTG")
  !b%=v%
=b%

DEF FNgstrans(s$)
  LOCAL t$,i%,len%
  SYS "OS_GSTrans",s$,buff1%,256 TO,,len%
  IF len%=0 THEN =""
  FOR i%=0 TO len%-1
    t$+=CHR$ buff1%?i%
  NEXT
  /*Ftracef("FNgstrans("""+s$+""") -> """+t$+"""")*/
=t$

DEF FNungstrans(s$)
  LOCAL t$,i%,c%
  IF s$="" THEN =""
  FOR i%=1 TO LEN s$
    c%=ASC MID$(s$,i%,1)
    #ifdef Trace
      IF NOT(0<=c% AND c%<256)ERROR CONST_error_fatal,"Assertion failure"
    #endif
    IF c%>=128 c%-=128: t$+="|!"
    IF c%<32 c%+=64: t$+="|"
    IF c%=127 c%=63: t$+="|" /*"?"*/
    IF INSTR("|<""",CHR$ c%)THEN t$+="|"
    t$+=CHR$ c%
  NEXT
=t$

DEF FNretrieve_boolean(ntry%,RETURN fix_up%)
  LOCAL ts%,int%,b%,str$
  Ftracef("FNretrieve_boolean")
  B%=CONST_ident_BOOL
  C%=CONST_bool_MAX
  b%=USR(code_entry%+CONST_entry_heap_claim)
  IF b%=0 ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","BOOL")
  ts%=FNmatch_any_line
  IF ts% THEN
    CASE ntry%!CONST_ntry_extra OF
      WHEN 1
        ts%=FNsplit_integer(ts%,int%)
        b%!CONST_bool_false=FNstore_integer(int%)
        IF ?ts%=13 ts%=FNmatch_any_line
        b%!CONST_bool_true=FNstore_integer(FNevaluate($ts%))
      WHEN 2,3,4
        ts%=FNsplit_string(ts%,str$)
        $task_buff%=str$
        B%=task_buff%
        C%=ntry%!CONST_ntry_extra
        b%!CONST_bool_false=USR(code_entry%+CONST_entry_store_string)
        IF ?ts%=13 ts%=FNmatch_any_line
        B%=ts%
        C%=ntry%!CONST_ntry_extra
        b%!CONST_bool_true=USR(code_entry%+CONST_entry_store_string)
      WHEN 7
        ts%=FNsplit_string(ts%,str$)
        PROCretrieve_ptr(psup%,s$,b%+CONST_bool_false,fix_up%)
        IF ?ts%=13 ts%=FNmatch_any_line
        PROCretrieve_ptr(psup%,$ts%,b%+CONST_bool_true,fix_up%)
    ENDCASE
  ENDIF
=b%

DEF FNretrieve_list(ntry%,num%,RETURN fix_up%)
  LOCAL i%,ptr%,this_rec%,last_rec%,ts%,list_ptr%,list_off%,int%,str$
  Ftracef("FNretrieve_list")
  IF 1<=num% THEN
    FOR i%=1 TO num%
      B%=CONST_ident_LSTD
      C%=4*ntry%!CONST_ntry_size+CONST_lstd_1st
      this_rec%=USR(code_entry%+CONST_entry_heap_claim)
      IF this_rec%=0 ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","LSTD")
      IF last_rec% last_rec%!CONST_lstd_next=this_rec% ELSE ptr%=this_rec%
      this_rec%!CONST_lstd_next=0
      this_rec%!CONST_lstd_num=ntry%!CONST_ntry_size
      list_off%=8
      ts%=FNmatch_any_line
      IF ts% THEN
        list_ptr%=ntry%!CONST_ntry_extra
        WHILE list_ptr%
          CASE list_ptr%!CONST_list_type OF
            WHEN 1
             ts%=FNsplit_integer(ts%,int%)
             this_rec%!list_off%=FNstore_integer(int%)
            WHEN 2,3,4
             ts%=FNsplit_string(ts%,str$)
             $task_buff%=str$
             B%=task_buff%
             C%=list_ptr%!CONST_list_type
             this_rec%!list_off%=USR(code_entry%+CONST_entry_store_string)
            WHEN 7
             ts%=FNsplit_string(ts%,str$)
             PROCretrieve_ptr(psup%,str$,this_rec%+list_off%,fix_up%)
          ENDCASE
          list_ptr%=!list_ptr%
          list_off%+=4
        ENDWHILE
      ENDIF
      last_rec%=this_rec%
    NEXT
  ENDIF
=ptr%

DEF FNretrieve_charlist(ntry%,num%)
  LOCAL i%,this_rec%,ts%,last_rec%,ptr%,j%,t$
  Ftracef("FNretrieve_charlist")
  IF 1<=num% THEN
    FOR i%=1 TO num%
      ts%=FNmatch_any_line
      IF ts% THEN
        t$=FNgstrans($ts%)
        B%=CONST_ident_CHAR
        C%=5+LEN t$
        this_rec%=USR(code_entry%+CONST_entry_heap_claim)
        IF this_rec%=0 ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","CHAR")
        this_rec%!0=0
        this_rec%?4=ASC t$
        this_rec%?5=LEN t$-1
        t$=MID$(t$,2)
        IF 1<=LEN t$ THEN
          FOR j%=1 TO LEN t$
            this_rec%?(j%+5)=ASC MID$(t$,j%,1)
          NEXT
        ENDIF
        IF last_rec% last_rec%!0=this_rec% ELSE ptr%=this_rec%
      ENDIF
      last_rec%=this_rec%
    NEXT
  ENDIF
=ptr%

DEF PROCretrieve_ptr(psup%,name$,addr%,RETURN fix_up%)
  LOCAL i%,s$,t$,xxxx%,old_last_prdata%,last_prhead%,tmpt%,last_prdata%,prhead%,matched%,this_prdata%,t$
  Ftracef("PROCretrieve_ptr")
  i%=INSTR(name$,":"): IF i%=0 PROCprdata_error(psup%,FNmsg_1(A%!CONST_interface_host_desc,"OKAA",name$),"OK2")
  s$=LEFT$(name$,i%-1)
  t$=MID$(name$,i%+1)
  /*try to match the template name*/
  tmpt%=psup%!CONST_psup_tmpt
  prhead%=psup%!CONST_psup_head
  last_prhead%=0
  WHILE tmpt%
   IF $(tmpt%+CONST_tmpt_name)=s$ THEN
    /*was a number provided? If so, store the name and return*/
    IF VAL t$>0 THEN
     B%=CONST_ident_POTR
     C%=LEN name$+1
     i%=USR(code_entry%+CONST_entry_heap_claim)
     IF i%=0 ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","POTR")
     $i%=name$
     !addr%=i%
     B%=CONST_ident_XXXX
     C%=8
     xxxx%=USR(code_entry%+CONST_entry_heap_claim)
     IF xxxx%=0 ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","XXXX")
     !xxxx%=fix_up%
     xxxx%!4=addr%
     fix_up%=xxxx%
     ENDPROC
    ELSE
     /*no number provided, so the real data must follow, so recurse*/
     IF prhead% THEN
      last_prdata%=prhead%!CONST_head_prdt
      IF last_prdata% THEN
       WHILE last_prdata%!CONST_prdt_next
        last_prdata%=last_prdata%!CONST_prdt_next
       ENDWHILE
      ENDIF
     ELSE
      last_prdata%=0
     ENDIF
     old_last_prdata%=last_prdata%
     PROCprocess_one_entry(tmpt%,last_prdata%,prhead%,last_prhead%,matched%,fix_up%,psup%)
     IF matched%=0 AND last_prdata%=0 THEN
      ts%=FNmatch_any_line
      IF ts% t$=$ts% ELSE t$=""
      PROCprdata_error(psup%,FNmsg_1(A%!CONST_interface_host_desc,"OK9",t$),"OK2")
     ENDIF
     /*when process_one_entry returns, last_prdata% points to the PRDT block
       that has just been added. What needs to be done now is to see if
       this is actually a duplicate of one already present. If it is,
       release this block and use the matched one instead.*/
     this_prdata%=prhead%!CONST_head_prdt
     WHILE this_prdata%<>last_prdata%
      /*compare two PRDT blocks*/
      IF this_prdata%!(this_prdata%!4*4+8)THEN
       matched%=TRUE
       IF 0<=this_prdata%!CONST_prdt_num-1 THEN
         FOR i%=0 TO this_prdata%!CONST_prdt_num-1
          IF NOTFNmatch_prdata_entry(this_prdata%,last_prdata%,i%*4+CONST_prdt_1st)THEN
           matched%=FALSE
           i%=this_prdata%!CONST_prdt_num
          ENDIF
         NEXT
       ENDIF
       IF matched% THEN
        IF 0<=last_prdata%!CONST_prdt_num-1 THEN
          FOR i%=0 TO last_prdata%!CONST_prdt_num-1
           xxxx%=last_prdata%!(i%*4+CONST_prdt_1st)
           PROCcheck_prdata_ptr(xxxx%)
           PROCfree_structure(xxxx%)
          NEXT
        ENDIF
        old_last_prdata%!CONST_prdt_next=0
        B%=CONST_ident_PRDT
        C%=last_prdata%
        CALL code_entry%+CONST_entry_heap_free
        last_prdata%=this_prdata%
       ELSE
        this_prdata%=!this_prdata%
       ENDIF
      ELSE
       this_prdata%=!this_prdata%
      ENDIF
     ENDWHILE
     B%=CONST_ident_POTR
     C%=4
     i%=USR(code_entry%+CONST_entry_heap_claim)
     IF i%=0 ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","POTR")
     !i%=last_prdata%
     !addr%=i%
     /*and so some usage*/
     last_prdata%!(last_prdata%!CONST_prdt_num*4+CONST_prdt_1st)+=1
     ENDPROC
    ENDIF
   ELSE
    tmpt%=tmpt%!CONST_tmpt_next
    /*we only keep an accurate track of the HEAD ptr
      if we are going to be loading real data*/
    IF VAL t$=0 THEN
     last_prhead%=prhead%
     prhead%=prhead%!CONST_head_next
    ENDIF
   ENDIF
  ENDWHILE
  PROCprdata_error(psup%,FNmsg_1(A%!CONST_interface_host_desc,"OKAB",s$),"OK2")
ENDPROC

DEF FNmatch_prdata_entry(s%,d%,o%)
  LOCAL s$,d$
  Ftracef("FNmatch_prdata")
  s%=s%!o%
  d%=d%!o%
  IF s%=0 OR d%=0 THEN
   /*if one or both is missing, then if both are missing, we've got a match*/
   =(s%=d%)
  ELSE
   CASE s%!-4 OF
    WHEN CONST_ident_INTG
     =!s%=!d%
    WHEN CONST_ident_STRG
     =$s%=$d%
    WHEN CONST_ident_STR0
      CALL Z%,s%,s$ /*convert 0-terminated string*/
      CALL Z%,d%,d$ /*convert 0-terminated string*/
     =s$=d$
    WHEN CONST_ident_GSTR
      CALL Y%,s%,s$ /*convert counted string*/
      CALL Y%,d%,d$ /*convert counted string*/
     =s$=d$
    WHEN CONST_ident_BOOL
     =FNmatch_prdata_bool(s%,d%)
    WHEN CONST_ident_LSTD
     =FNmatch_prdata_list(s%,d%)
    WHEN CONST_ident_POTR
     =!s%=!d%
    WHEN CONST_ident_CHAR
     =FNmatch_prdata_char(s%,d%)
    OTHERWISE
     PROCerror_warning(FNmsg_1(A%!CONST_interface_host_desc,"WA10",STR$~s%!-4))
   ENDCASE
  ENDIF
=FALSE

DEF FNmatch_prdata_bool(s%,d%)
  Ftracef("FNmatch_prdata_bool")
IF FNmatch_prdata_entry(s%,d%,CONST_bool_false)THEN =FNmatch_prdata_entry(s%,d%,CONST_bool_true)ELSE =FALSE

DEF FNmatch_prdata_list(s%,d%)
  LOCAL i%
  Ftracef("FNmatch_prdata_list")
  WHILE s%
    IF 0<=s%!CONST_lstd_num-1 THEN
      FOR i%=0 TO s%!CONST_lstd_num-1
        IF NOT FNmatch_prdata_entry(s%,d%,i%*4+CONST_lstd_1st)THEN =FALSE
      NEXT
    ENDIF
    s%=s%!CONST_lstd_next
    d%=d%!CONST_lstd_next
  ENDWHILE
=TRUE

DEF FNmatch_prdata_char(s%,d%)
  LOCAL i%
  Ftracef("FNmatch_prdata_char")
  WHILE s%
   IF s%?4<>d%?4 THEN =FALSE
   IF s%?5<>d%?5 THEN =FALSE
   i%=s%?5
   WHILE i%
     IF s%?(i%+5)<>d%?(i%+5)THEN =FALSE
     i%-=1
   ENDWHILE
   s%=!s%
   d%=!d%
  ENDWHILE
=TRUE

DEF FNsplit_integer(input%,RETURN int%)
  LOCAL i%,output%
  /*Look for ","*/
  i%=INSTR($input%,",")
  IF i%=0 THEN
    int%=FNevaluate($input%)
    output%=input%+LEN $input%
  ELSE
    int%=FNevaluate(LEFT$($input%,i%-1))
    output%=input%+i%
    WHILE ?output%=32
      output%+=1
    ENDWHILE
  ENDIF
=output%

DEF FNsplit_string(input%,RETURN str$)
  LOCAL i%,output$,outside%,quoted%
  /*Build the output string in str$*/
  str$=""
  i%=0
  WHILE input%?i%=32
    i%+=1
  ENDWHILE
  outside%=TRUE
  quoted%=(input%?i%=34)
  /*Find a comma not in quotes*/
  WHILE NOT(input%?i%=13 OR(outside% AND input%?i%=44))
    /*The only things that do not get copied into str$ are the second of two
        adjacent quotes in a quoted string*/
    IF NOT quoted% OR input%?i%<>34 OR outside% str$+=CHR$ input%?i%

    IF quoted% AND input%?i%=34 outside%=NOT outside%
    i%+=1
  ENDWHILE
  #ifdef Trace
    IF NOT(input%?i%=13 OR(outside% AND input%?i%=44))ERROR CONST_error_fatal,"Assertion failure"
  #endif

  IF input%?i%=13 THEN
    output%=input%+i%
  ELSE
    output%=input%+i%+1
    WHILE ?output%=32
      output%+=1
    ENDWHILE
  ENDIF
=output%

DEF PROCensuredir(root$,ext$)
LOCAL p%,err%
WHILE INSTR(ext$,".")>0
 p%=INSTR(ext$,".")
 root$+=LEFT$(ext$,p%-1)
 SYS"XOS_File",8,root$
 root$+="."
 ext$=MID$(ext$,p%+1)
ENDWHILE
ENDPROC

DEF FNcopy_section(to$,from%,ptr%,size%)
  LOCAL out%,end$,err%,l%,ft%,dblock%
  WHILE LEFT$(to$,1)=" " OR LEFT$(to$,1)=CHR$(9)
    to$=MID$(to$,2)
  ENDWHILE
  l%=INSTR(to$," ")
  IF l%=0 THEN
    ft%=&FFD
  ELSE
    ft%=VALMID$(to$,l%+1)
    to$=LEFT$(to$,l%-1)
  ENDIF
  PROCensuredir(PrintersChoicesWriteDir+".",to$)
  SYS"XOS_Find",&8f,PrintersChoicesWriteDir+"."+to$ TO out%;err%
  IF err% AND 1 THEN
    ERROR CONST_error_ok,FNmsg_1(A%!CONST_interface_host_desc,"OKBH",to$)
  ELSE
    B%=CONST_ident_DATA
    C%=2048
    dblock%=USR(code_entry%+CONST_entry_heap_claim)
    IF dblock%=0 THEN SYS"OS_Find",0,out%:ERROR CONST_error_ok,FNmsg_1(A%!CONST_interface_host_desc,"FAI","2")
    REPEAT
      l%=size%
      IF size%>2048 THEN l%=2048
      SYS"OS_GBPB",3,c%,dblock%,l%,ptr%
      ptr%+=l%
      SYS"OS_GBPB",2,out%,dblock%,l%
      size%-=l%
    UNTIL size%=0
    SYS"XOS_Find",0,out%
    B%=CONST_ident_DATA
    C%=dblock%
    CALL code_entry%+CONST_entry_heap_free
    SYS"XOS_File",18,PrintersChoicesWriteDir+"."+to$,ft%
  ENDIF
=to$

DEF FNload_multiple_file(name$)
  LOCAL c%,load_addr%,file_type%,err%,d$,e$,dptr%,paper%
  Ftracef("FNload_multiple_file")
  paper%=FALSE
  SYS "OS_File",17,name$ TO c%,,load_addr%,,dsize% /*ReadNoPath*/
  IF NOT(c%=0 OR c%=1)THEN SYS "OS_File",19,name$,c% /*MakeError*/
  IF c%=0 THEN =FALSE
  IF(load_addr%>>>20)=&FFF file_type%=load_addr%>>8 AND &FFF ELSE file_type%=-1
  IF file_type%<>&FC6 ERROR CONST_error_ok,FNmsg_1(A%!CONST_interface_host_desc,"OKAL",name$)
  c%=OPENIN(name$)
  d$=GET$#c%
  IF d$="PrinterDefinitionFile" THEN
    d$=GET$#c%
    IF VALd$<1 OR VALd$>1 THEN CLOSE#c%:ERROR CONST_error_ok,FNmsg_1(A%!CONST_interface_host_desc,"OKBF",d$)
    WHILE NOT EOF#c%
      d$=GET$#c%
      dsize%=VALGET$#c%
      IF dsize%<=0 THEN CLOSE#c%:ERROR CONST_error_ok,FNmsg_1(A%!CONST_interface_host_desc,"OKBG",d$)
      dptr%=PTR#c%
      CASE TRUE OF
      WHEN LEFT$(d$,4)="PDF:"
        B%=CONST_ident_DATA
        /*Keep the file pointer in the noughth word of dblock%*/
        C%=4+dsize%+1
        Ftracef("allocating "+STR$ C%+" bytes for file data")
        dblock%=USR(code_entry%+CONST_entry_heap_claim)+4
        IF dblock%=4 ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","DATA")
        SYS "OS_GBPB",3,c%,dblock%,dsize%,dptr%
        PROCload_pdf_section(dblock%,dsize%)
        data_file$=name$
      WHEN LEFT$(d$,5)="File:"
        to$=FNcopy_section(MID$(d$,6),c%,dptr%,dsize%)
      WHEN LEFT$(d$,6)="Paper:"
        to$=FNcopy_section(MID$(d$,7),c%,dptr%,dsize%)
        PROCread_paper_file("PrinterChoices:"+to$,CONST_psze_flag_userdefined)
        SYS"XOS_File",6,"PrinterChoices:"+to$
        paper%=TRUE
      ENDCASE
      PTR#c%=dptr%+dsize%
    ENDWHILE
    CLOSE#c%
    IF paper% THEN PROCsave_user_defined_paper_sizes
  ELSE
    CLOSE#c%
    B%=CONST_ident_DATA
    /*Keep the file pointer in the noughth word of dblock%*/
    C%=4+dsize%+1
    Ftracef("allocating "+STR$ C%+" bytes for file data")
    dblock%=USR(code_entry%+CONST_entry_heap_claim)+4
    IF dblock%=4 ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","DATA")
    SYS "OS_File",16,name$,dblock% /*LoadNoPath*/
    PROCload_pdf_section(dblock%,dsize%)
    data_file$=name$
  ENDIF
=TRUE

DEF FNload_file(name$)
  LOCAL c%,load_addr%,file_type%
  Ftracef("FNload_file")
  SYS "OS_File",17,name$ TO c%,,load_addr%,,data_size% /*ReadNoPath*/
  IF NOT(c%=0 OR c%=1)THEN SYS "OS_File",19,name$,c% /*MakeError*/
  IF c%=0 THEN =FALSE
  IF(load_addr%>>>20)=&FFF file_type%=load_addr%>>8 AND &FFF ELSE file_type%=-1
  IF file_type%<>&FC6 ERROR CONST_error_ok,FNmsg_1(A%!CONST_interface_host_desc,"OKAL",name$)
  B%=CONST_ident_DATA
  /*Keep the file pointer in the noughth word of data_block%*/
  C%=4+data_size%+1
  Ftracef("allocating "+STR$ C%+" bytes for file data")
  data_block%=USR(code_entry%+CONST_entry_heap_claim)+4
  IF data_block%=4 ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","DATA")
  SYS "OS_File",16,name$,data_block% /*LoadNoPath*/

  PROCload_pdf_section(data_block%,data_size%)

  data_file$=name$
  Ftracef("File """+data_file$+""" loaded, first line: """+$data_block%+"""")
=TRUE

DEF PROCload_pdf_section(dblock%,dsize%)
  LOCAL ws%,ws_size%,output_size%,output%,status%,err%
  data_block%=dblock%
  data_size%=dsize%
  /*Check if it is a squashed defn file*/
  IF data_size%>=20 AND data_block%!0=&48535153 THEN
    /*Yes - unsquash it. First find out how much workspace and how much output
        buffer space will be needed.*/
    SYS "Squash_Decompress",%1000,-1 TO ws_size%
    output_size%=data_block%!4

    /*Allocate it*/
    B%=CONST_ident_DATA
    C%=4+output_size%+1
    Ftracef("allocating "+STR$ C%+" bytes for Squash output")
    output%=USR(code_entry%+CONST_entry_heap_claim)+4
    IF output%=4 ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","DATA")

    Ftracef("allocating "+STR$ C%+" bytes for Squash workspace")
    SYS "XOS_Module",6,,,ws_size% TO C%,,ws%;err%
    IF(err%AND1) ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","squash")

    /*Decompress the file*/
    SYS "Squash_Decompress",%100,ws%,data_block%+20,data_size%-20,output%,output_size% TO status%

    /*Free relevant buffers (the workspace and the input)*/
    Ftracef("freeing Squash workspace")
    SYS "OS_Module",7,,ws%

    Ftracef("freeing unsquashed file data")
    B%=CONST_ident_DATA
    C%=data_block%-4
    CALL code_entry%+CONST_entry_heap_free

    /*Finally, point data_block% at the real truth*/
    data_block%=output%
    data_size%=output_size%
  ENDIF

  data_ptr%=data_block%-4
  !data_ptr%=0
  data_line%=1

  /*Make sure lines are 13-terminated (including the last)*/
  B%=data_block%
  C%=data_size%
  CALL code_entry%+CONST_entry_terminate_lines
  IF data_block%?(data_size%-1)<>13 data_size%+=1: data_block%?(data_size%-1)=13
ENDPROC

DEF PROCrelease_file
  Ftracef("PROCrelease_file")
  B%=CONST_ident_DATA
  C%=data_block%-4
  Ftracef("freeing file data")
  CALL code_entry%+CONST_entry_heap_free
  data_block%=0
  data_size%=0
ENDPROC

DEF PROClocal_file
  /*Saves the context away so that you can nest calls to FNload_file/PROCrelease_file.
    There is only one level of nesting.*/
  Ftracef("PROClocal_file")
  saved_data_block%=data_block%
  saved_data_ptr%=data_ptr%
  saved_data_size%=data_size%
  saved_data_line%=data_line%
  saved_data_file$=data_file$
ENDPROC

DEF PROCrestore_file
  /*Restore the context as above.*/
  Ftracef("PROCrestore_file")
  data_block%=saved_data_block%
  data_ptr%=saved_data_ptr%
  data_size%=saved_data_size%
  data_line%=saved_data_line%
  data_file$=saved_data_file$
ENDPROC

DEF PROCinstall_printer(psup%,prdt%)
  LOCAL s%,t%,s$,prnt%,cnct%
  Ftracef("PROCinstall_printer")
  /*show some usage of the printer's prdata*/

  Ftracef("prdt%=&"+STR$~prdt%)
  Ftracef("prdt%!CONST_prdt_num="+STR$prdt%!CONST_prdt_num)
  Ftracef("prdt%!CONST_prdt_num*4+CONST_prdt_1st="+STR$(prdt%!CONST_prdt_num*4+CONST_prdt_1st))
  Ftracef("prdt%!(prdt%!CONST_prdt_num*4+CONST_prdt_1st)="+STR$(prdt%!(prdt%!CONST_prdt_num*4+CONST_prdt_1st)))

  prdt%!(prdt%!CONST_prdt_num*4+CONST_prdt_1st)+=1
  B%=CONST_ident_PRNT
  C%=CONST_prnt_MAX
  prnt%=USR(code_entry%+CONST_entry_heap_claim)
  IF prnt%=0 \
    ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","PRNT")
  IF A%!CONST_interface_printer_installed THEN
    s%=A%!CONST_interface_printer_installed
    WHILE s%!CONST_prnt_next
      s%=s%!CONST_prnt_next
    ENDWHILE
    s%!CONST_prnt_next=prnt%
  ELSE
    A%!CONST_interface_printer_installed=prnt%
  ENDIF
  prnt%!CONST_prnt_next=0
  prnt%!CONST_prnt_psup=psup%
  B%=prdt%!CONST_prdt_1st
  C%=2
  prnt%!CONST_prnt_type=USR(code_entry%+CONST_entry_store_string)
  B%=CONST_ident_CNCT
  C%=CONST_cnct_MAX
  cnct%=USR(code_entry%+CONST_entry_heap_claim)
  IF cnct%=0 \
    ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","CNCT")
  SYS "OS_Byte",161,15 TO,,s%
  cnct%!CONST_cnct_type=(s% AND %11100000)>>5
  IF cnct%!CONST_cnct_type=1 AND NOT parallel_possible% THEN cnct%!CONST_cnct_type=0
  cnct%?CONST_cnct_baud=1+((s% AND %11100)>>2)
  cnct%?CONST_cnct_xon=0
  SYS "OS_Byte",161,16 TO,,s%
  cnct%!CONST_cnct_data=(s% AND %11100000)>>5
  IF NOT FNeconet_installed THEN
    cnct%!CONST_cnct_econet=0
  ELSE
    SYS "OS_Byte",161,3 TO,,s%
    SYS "OS_Byte",161,4 TO,,t%
    IF s% THEN
      /*numeric form*/
      $task_buff%=STR$ t%+"."+STR$ s%
      B%=task_buff%
      C%=2
      cnct%!CONST_cnct_econet=USR(code_entry%+CONST_entry_store_string)
    ELSE
      s$=CHR$ t%
      FOR s%=1 TO 5
        SYS "OS_Byte",161,152+s% TO,,t%
        IF t% s$+=CHR$ t% ELSE s%=5
      NEXT
      $task_buff%=s$
      B%=task_buff%
      C%=2
      cnct%!CONST_cnct_econet=USR(code_entry%+CONST_entry_store_string)
    ENDIF
  ENDIF
  SYS "XOS_ReadVarVal","PrinterType$5",buff1%,256,,3 TO,,t%
  buff1%?t%=13
  B%=buff1%
  C%=2
  cnct%!CONST_cnct_file=USR(code_entry%+CONST_entry_store_string)
  cnct%!CONST_cnct_nfss=0
  cnct%!CONST_cnct_nfsp=0
  cnct%!CONST_cnct_nfsu=0
  cnct%!CONST_cnct_nfso=0
  cnct%!CONST_cnct_nfsps=0
  cnct%?CONST_cnct_flags=0
  prnt%!CONST_prnt_cnct=cnct%
  B%=CONST_ident_CNFG
  C%=4*psup%!CONST_psup_cnfg
  s%=USR(code_entry%+CONST_entry_heap_claim)
  IF s%=0 ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","CNFG")
  IF 0<=psup%!CONST_psup_cnfg-1 THEN
    FOR t%=0 TO psup%!CONST_psup_cnfg-1
      s%!(t%*4)=0
    NEXT
  ENDIF
  prnt%!CONST_prnt_cnfg=s%
  prnt%!CONST_prnt_icon=-1 /*no icon yet*/
  prnt%!CONST_prnt_flags=0 /*inactive*/
  prnt%!CONST_prnt_pane=-1 /*no icon yet*/
  prnt%!CONST_prnt_queu=0 /*no queue*/

  /*create a default paper size*/
  prnt%!CONST_prnt_psze=0 /*no paper size yet*/
  prnt%!CONST_prnt_name=0 /*no short-form name yet*/
  prnt%!CONST_prnt_sprt=0 /*no sprite name yet*/
  IF psup%!CONST_psup_text AND %100 THEN
    /*page pausing is required: so is a window*/
    prnt%!CONST_prnt_pause=FNallocate_pause_window
  ELSE
    prnt%!CONST_prnt_pause=0
  ENDIF
  prnt%!CONST_prnt_fonts=0
  PROCprinter_reason_code(psup%,prnt%,-4,0)
  IF psup%!CONST_psup_flags AND CONST_psup_flags_backend_connections PROCprinter_reason_code(psup%,prnt%,-12,0)
  PROCcreate_installed_printer_icons /*increments printer_count%*/

  IF psup%!CONST_psup_flags AND CONST_psup_flags_null_events THEN
    prnt%!CONST_prnt_timeout=10*psup%?(CONST_psup_flags+1)
  ELSE
    prnt%!CONST_prnt_timeout=-1
  ENDIF
  Ftracef("prnt initialised at "+STR$ prnt%!CONST_prnt_timeout)

  /*activate all printers*/
  PROCactivate_this_printer(prnt%)
ENDPROC

#ifdef Sparrow
DEF PROCfind_prnt(RETURN prnt%, RETURN rmtp%, RETURN icon%)
  /*
   * given a selected icon in printer pane 1, return the
   * matching PRNT block, or an RMTP block, but not both
   */
  Ftracef("PROCfind_prnt")
  SYS "Wimp_WhichIcon",prntctrl%,buff1%,1<<21,1<<21
  icon%=!buff1%
  rmtp% = 0
  prnt%=A%!CONST_interface_printer_installed

  WHILE prnt%
    IF prnt%!CONST_prnt_pane=icon% THEN
      ENDPROC
    ELSE
      prnt%=prnt%!CONST_prnt_next
    ENDIF
  ENDWHILE

  rmtp% = remote_printers%
  WHILE rmtp%
    IF rmtp%!CONST_rmtp_pane = icon% THEN
      ENDPROC
    ELSE
      rmtp% = rmtp%!CONST_rmtp_next
    ENDIF
  ENDWHILE

ENDPROC

DEF PROCfind_only_prnt (RETURN prnt%,RETURN icon%)

  Ftracef("PROCfind_prnt")
  SYS "Wimp_WhichIcon",prntctrl%,buff1%,1<<21,1<<21
  icon%=!buff1%
  rmtp% = 0
  prnt%=A%!CONST_interface_printer_installed

  WHILE prnt%
    IF prnt%!CONST_prnt_pane=icon% THEN
      ENDPROC
    ELSE
      prnt%=prnt%!CONST_prnt_next
    ENDIF
  ENDWHILE

ENDPROC

DEF PROCfind_only_rmtp (RETURN rmtp%, RETURN icon%)

  Ftracef("PROCfind_prnt")
  SYS "Wimp_WhichIcon",prntctrl%,buff1%,1<<21,1<<21
  icon%=!buff1%

  rmtp% = remote_printers%
  WHILE rmtp%
    IF rmtp%!CONST_rmtp_pane = icon% THEN
      ENDPROC
    ELSE
      rmtp% = rmtp%!CONST_rmtp_next
    ENDIF
  ENDWHILE

ENDPROC

#else
DEF PROCfind_prnt(RETURN prnt%,RETURN icon%)
  /*given a selected icon in printer pane 1, return the
    matching PRNT block*/
  Ftracef("PROCfind_prnt")
  SYS "Wimp_WhichIcon",prntctrl%,buff1%,1<<21,1<<21
  icon%=!buff1%
  prnt%=A%!CONST_interface_printer_installed
  WHILE prnt%
    IF prnt%!CONST_prnt_pane=icon% ENDPROC ELSE prnt%=prnt%!CONST_prnt_next
  ENDWHILE
ENDPROC
#endif

DEF PROCopen_connections_window(prnt%)
  LOCAL cnct%,i%,databits%,parity%,stopbits%
  Ftracef("PROCopen_connections_window")
  IF prnt%!CONST_prnt_flags AND CONST_prnt_flags_printing \
    ERROR CONST_error_ok,FNmsg_0(A%!CONST_interface_host_desc,"OKAJ")
  prnt_edit%=prnt%
  psup_edit%=prnt%!CONST_prnt_psup
  cnct%=prnt%!CONST_prnt_cnct

#ifdef Sparrow
  IF prnt%!CONST_prnt_flags AND CONST_prnt_flags_remote THEN
    ENDPROC /* Give up now, not allowed */
  ENDIF
#endif

  IF psup_edit%!CONST_psup_flags AND CONST_psup_flags_backend_connections THEN
    Ftracef("Back end supplies connections window")
    PROCprinter_reason_code(psup_edit%,prnt_edit%,-11,0)
    PROCtell_pinboard(FNprinter_find_window(prnt_edit%,"connections"))
    PROCwin_open(FNprinter_find_window(prnt_edit%,"connections"))
  ELSE
    Ftracef("Printer uses standard connections window")
    IF prnt%!CONST_prnt_name \
      PROCicon_write(connections%,CONST_conn_name,$prnt%!CONST_prnt_name) \
    ELSE \
      PROCicon_write(connections%,CONST_conn_name,$prnt%!CONST_prnt_type)
    IF cnct%?CONST_cnct_flags AND CONST_cnct_flags_background \
      PROCicon_select(connections%,CONST_conn_background) \
    ELSE \
      PROCicon_deselect(connections%,CONST_conn_background)
    PROCicon_deselect(connections%,CONST_conn_parallel)
    PROCicon_deselect(connections%,CONST_conn_serial)
    PROCicon_deselect(connections%,CONST_conn_econet)
    PROCicon_deselect(connections%,CONST_conn_nfs)
    PROCicon_deselect(connections%,CONST_conn_lpr)
    PROCicon_deselect(connections%,CONST_conn_lanman)
    PROCicon_deselect(connections%,CONST_conn_lanman98)
    PROCicon_deselect(connections%,CONST_conn_lpr)
    PROCicon_deselect(connections%,CONST_conn_jetdirect)
    PROCicon_deselect(connections%,CONST_conn_file)
    PROCicon_deselect(connections%,CONST_conn_direct)
    i%=-1
    CASE cnct%!CONST_cnct_type OF
      WHEN 1
        IF parallel_possible% i%=CONST_conn_parallel
      WHEN 2
        i%=CONST_conn_serial
      WHEN 4
        IF FNeconet_installed i%=CONST_conn_econet
      WHEN 5
        i%=CONST_conn_file
      WHEN 6
        IF FNnfs_installed i%=CONST_conn_nfs
      WHEN 8
        IF psup_edit%!CONST_psup_flags AND CONST_psup_flags_direct_drive i%=CONST_conn_direct
      WHEN 10
        IF lpr_possible% i%=CONST_conn_lpr
      WHEN 11
        IF FNlanman_installed i%=CONST_conn_lanman
      WHEN 12
        IF FNlanman98_installed i%=CONST_conn_lanman98
      WHEN 13
        IF jetdirect_possible% i%=CONST_conn_jetdirect
    ENDCASE
    IF NOT i% PROCicon_select(connections%,i%)
    PROCicon_write(connections%,CONST_conn_baud,\
        FNmsg_0(A%!CONST_interface_host_desc,\
        "BR"+STR$ cnct%?CONST_cnct_baud))
    i%=cnct%!CONST_cnct_data
    databits%=i% AND %11
    stopbits%=(i% AND %100)>>2
    parity%=(i% AND %110000)>>4
    IF(i% AND %1000)=0 parity%=0 ELSE parity%+=1
    PROCicon_write(connections%,CONST_conn_data,\
        FNmsg_0(A%!CONST_interface_host_desc,"DA"+STR$ databits%))
    PROCicon_write(connections%,CONST_conn_parity,\
        FNmsg_0(A%!CONST_interface_host_desc,"PA"+STR$ parity%))
    IF stopbits%=0 THEN
      PROCicon_write(connections%,CONST_conn_stop,\
          FNmsg_0(A%!CONST_interface_host_desc,"SB0"))
    ELSE
      IF databits%=0 AND parity%<>0 THEN
        PROCicon_write(connections%,CONST_conn_stop,\
            FNmsg_0(A%!CONST_interface_host_desc,"SB1b"))
      ELSE
        IF databits%=3 AND parity%=0 THEN
          PROCicon_write(connections%,CONST_conn_stop,\
              FNmsg_0(A%!CONST_interface_host_desc,"SB1c"))
        ELSE
          PROCicon_write(connections%,CONST_conn_stop,\
              FNmsg_0(A%!CONST_interface_host_desc,"SB1a"))
        ENDIF
      ENDIF
    ENDIF
    IF cnct%?CONST_cnct_xon \
      PROCicon_select(connections%,CONST_conn_xon) \
    ELSE \
      PROCicon_deselect(connections%,CONST_conn_xon)
    IF cnct%?CONST_cnct_flags AND CONST_cnct_flags_append \
      PROCicon_select(connections%,CONST_conn_fappend) \
    ELSE \
      PROCicon_deselect(connections%,CONST_conn_fappend)
    IF (cnct%?CONST_cnct_flags AND CONST_cnct_flags_parallel_errors) AND FNparallel_error_detect_possible \
      PROCicon_select(connections%,CONST_conn_perrors) \
    ELSE \
      PROCicon_deselect(connections%,CONST_conn_perrors)

    PROCset_string(connections%,CONST_conn_ename,cnct%,CONST_cnct_econet)
    PROCset_string(connections%,CONST_conn_nfss,cnct%,CONST_cnct_nfss)
    PROCset_string(connections%,CONST_conn_nfsp,cnct%,CONST_cnct_nfsp)
    PROCset_string(connections%,CONST_conn_nfsu,cnct%,CONST_cnct_nfsu)
    PROCset_string(connections%,CONST_conn_nfso,cnct%,CONST_cnct_nfso)
    PROCset_string(connections%,CONST_conn_nfsps,cnct%,CONST_cnct_nfsps)

    /*Bug Fix for RP-2442*/
    IF cnct%!CONST_cnct_file <> 0 THEN
      IF ?(cnct%!CONST_cnct_file) > 32 AND ?(cnct%!CONST_cnct_file) < 127 \
        PROCset_string(connections%,CONST_conn_fname,cnct%,CONST_cnct_file) \
      ELSE \
        PROCicon_write(connections%,CONST_conn_fname,"null:")
    ELSE
        PROCicon_write(connections%,CONST_conn_fname,"null:")
    ENDIF

    IF parallel_possible% \
       PROCicon_unshade(connections%,CONST_conn_parallel) \
    ELSE \
       PROCicon_shade(connections%,CONST_conn_parallel)
       
    IF FNeconet_installed \
       PROCicon_unshade(connections%,CONST_conn_econet) \
    ELSE \
       PROCicon_shade(connections%,CONST_conn_econet)

    IF FNnfs_installed \
      PROCicon_unshade(connections%,CONST_conn_nfs) \
    ELSE \
      PROCicon_shade(connections%,CONST_conn_nfs)

    IF lpr_possible% \
      PROCicon_unshade(connections%,CONST_conn_lpr) \
    ELSE \
      PROCicon_shade(connections%,CONST_conn_lpr)

    IF FNlanman_installed \
      PROCicon_unshade(connections%,CONST_conn_lanman) \
    ELSE \
      PROCicon_shade(connections%,CONST_conn_lanman)

    IF FNlanman98_installed \
      PROCicon_unshade(connections%,CONST_conn_lanman98) \
    ELSE \
      PROCicon_shade(connections%,CONST_conn_lanman98)

    IF jetdirect_possible% \
      PROCicon_unshade(connections%,CONST_conn_jetdirect) \
    ELSE \
      PROCicon_shade(connections%,CONST_conn_jetdirect)

    /*Allow for Direct drive icon*/
    !win_buff%=connections%
    SYS "Wimp_GetWindowInfo",,win_buff% OR 1 /*no icon info*/
    win_buff%!28=-1
    #ifdef Trace
      IF psup_edit%!CONST_psup_flags AND CONST_psup_flags_direct_drive PROCftracef("Opening window WITH dd icon")ELSE PROCftracef("Opening window WITHOUT dd icon")
    #endif
    /*Shade DD*/
    IF psup_edit%!CONST_psup_flags AND CONST_psup_flags_direct_drive \
      PROCicon_unshade(connections%,CONST_conn_direct) \
    ELSE \
      PROCicon_shade(connections%,CONST_conn_direct)

    PROCtell_pinboard(connections%)
    SYS "Wimp_OpenWindow",,win_buff%
    PROCcheck_shaded_connections
  ENDIF
ENDPROC

DEF PROCset_string(wind%,icon%,block%,offset%)
  Ftracef("PROCset_string")
  PROCicon_write(wind%,icon%,FNprinter_read_string(block%!offset%))
ENDPROC

DEF PROCreset_string(block%,offset%,icon%)
  /*since this routine is only used for the connections window
    we can be sure that the strings are CR terminated (ie type 2)*/
  Ftracef("PROCreset_string")
  IF block%!offset% THEN
   B%=CONST_ident_STRG
   C%=block%!offset%
   CALL code_entry%+CONST_entry_heap_free
   block%!offset%=0
  ENDIF
  !icon_buffer%=connections%
  icon_buffer%!4=icon%
  SYS "Wimp_GetIconState",,icon_buffer%
  B%=icon_buffer%!28
  C%=2
  block%!offset%=USR(code_entry%+CONST_entry_store_string)
ENDPROC

DEF FNnew_databits
  Ftracef("FNnew_databits")
=FNmatch_option(connections%,CONST_conn_data,3,"DA",A%!CONST_interface_host_desc)

DEF FNnew_parity
  Ftracef("FNnew_parity")
=FNmatch_option(connections%,CONST_conn_parity,4,"PA",A%!CONST_interface_host_desc)

DEF FNnew_stopbits
  Ftracef("FNnew_stopbits")
IF FNicon_read(connections%,CONST_conn_stop)=FNmsg_0(A%!CONST_interface_host_desc,"SB0")THEN =0 ELSE =1

DEF PROCensure_new_stopbits(new%)
  Ftracef("PROCensure_new_stopbits")
  IF new%=-1 new%=FNnew_stopbits
  IF new%=0 THEN
    PROCicon_write(connections%,CONST_conn_stop,FNmsg_0(A%!CONST_interface_host_desc,"SB0"))
  ELSE
    IF FNnew_databits=0 AND FNnew_parity<>0 THEN
      PROCicon_write(connections%,CONST_conn_stop,FNmsg_0(A%!CONST_interface_host_desc,"SB1b"))
    ELSE
      IF FNnew_databits=3 AND FNnew_parity=0 THEN
        PROCicon_write(connections%,CONST_conn_stop,FNmsg_0(A%!CONST_interface_host_desc,"SB1c"))
      ELSE
        PROCicon_write(connections%,CONST_conn_stop,FNmsg_0(A%!CONST_interface_host_desc,"SB1a"))
      ENDIF
    ENDIF
  ENDIF
ENDPROC

DEF FNmatch_option(wind%,icon%,limit%,prefix$,desc%)
  LOCAL i%,s$
  Ftracef("FNmatch_option")
  s$=FNicon_read(wind%,icon%)
  IF 0<=limit% THEN
    FOR i%=0 TO limit%
      IF s$=FNmsg_0(desc%,prefix$+STR$ i%)THEN =i%
    NEXT
  ENDIF
=0

DEF PROCsave_connection
  LOCAL cnct%,i%,claim$,s$
  Ftracef("PROCsave_connection")
  cnct%=prnt_edit%!CONST_prnt_cnct
  cnct%!CONST_cnct_type=0
  IF FNicon_set(connections%,CONST_conn_background) THEN
    cnct%?CONST_cnct_flags=cnct%?CONST_cnct_flags OR CONST_cnct_flags_background
  ELSE
    cnct%?CONST_cnct_flags=cnct%?CONST_cnct_flags AND NOT CONST_cnct_flags_background
  ENDIF
  IF FNicon_set(connections%,CONST_conn_parallel)THEN
    claim$=FNdevice_claim(1,prnt_edit%)
    IF claim$="" \
      cnct%!CONST_cnct_type=1 \
    ELSE \
      ERROR CONST_error_ok,FNmsg_1(A%!CONST_interface_host_desc,"OKI",claim$)
  ENDIF
  IF FNicon_set(connections%,CONST_conn_serial)THEN
    claim$=FNdevice_claim(2,prnt_edit%)
    IF claim$="" \
      cnct%!CONST_cnct_type=2 \
    ELSE \
      ERROR CONST_error_ok,FNmsg_1(A%!CONST_interface_host_desc,"OKJ",claim$)
  ENDIF
  IF FNicon_set(connections%,CONST_conn_econet)cnct%!CONST_cnct_type=4
  IF FNicon_set(connections%,CONST_conn_nfs)cnct%!CONST_cnct_type=6
  IF FNicon_set(connections%,CONST_conn_lpr)cnct%!CONST_cnct_type=10
  IF FNicon_set(connections%,CONST_conn_lanman)cnct%!CONST_cnct_type=11
  IF FNicon_set(connections%,CONST_conn_lanman98)cnct%!CONST_cnct_type=12
  IF FNicon_set(connections%,CONST_conn_jetdirect)cnct%!CONST_cnct_type=13
  IF FNicon_set(connections%,CONST_conn_file)cnct%!CONST_cnct_type=5
  IF FNicon_set(connections%,CONST_conn_direct)cnct%!CONST_cnct_type=8
  s$=FNicon_read(connections%,CONST_conn_baud)
  FOR i%=0 TO 18
    IF FNmsg_0(A%!CONST_interface_host_desc,"BR"+STR$ i%)=s$ THEN
      cnct%?CONST_cnct_baud=i%
      i%=18
    ENDIF
  NEXT
  i%=FNnew_databits OR FNnew_stopbits<<2
  /*CSDM: Remember to add in 'enable parity' bit when setting parity value*/
  IF FNnew_parity i%=i% OR FNnew_parity-1<<4 OR %1000
  cnct%!CONST_cnct_data=i%
  IF FNicon_set(connections%,CONST_conn_xon) THEN
   cnct%?CONST_cnct_xon=1
  ELSE
   cnct%?CONST_cnct_xon=0
  ENDIF
  IF FNicon_set(connections%,CONST_conn_fappend) THEN
   cnct%?CONST_cnct_flags=cnct%?CONST_cnct_flags OR CONST_cnct_flags_append
  ELSE
   cnct%?CONST_cnct_flags=cnct%?CONST_cnct_flags AND NOT CONST_cnct_flags_append
  ENDIF
  IF FNicon_set(connections%,CONST_conn_perrors) THEN
   cnct%?CONST_cnct_flags=cnct%?CONST_cnct_flags OR CONST_cnct_flags_parallel_errors
  ELSE
   cnct%?CONST_cnct_flags=cnct%?CONST_cnct_flags AND NOT CONST_cnct_flags_parallel_errors
  ENDIF
  PROCreset_string(cnct%,CONST_cnct_econet,CONST_conn_ename)
  PROCreset_string(cnct%,CONST_cnct_nfss,CONST_conn_nfss)
  PROCreset_string(cnct%,CONST_cnct_nfsp,CONST_conn_nfsp)
  PROCreset_string(cnct%,CONST_cnct_nfsu,CONST_conn_nfsu)
  PROCreset_string(cnct%,CONST_cnct_nfso,CONST_conn_nfso)
  PROCreset_string(cnct%,CONST_cnct_file,CONST_conn_fname)
  PROCreset_string(cnct%,CONST_cnct_nfsps,CONST_conn_nfsps)
  PROCredraw_prntctrl_entry(prnt_edit%)
  PROCredraw_queue_entry(-1,prnt_edit%,0)
  IF NOT prnt_edit%!CONST_prnt_icon THEN
    /*
      this printer is ACTIVE! ensure that its details are correct and the icon is correct
      code used to do:
      PROCdo_select_printer(prnt_edit%,FALSE,FALSE)
      PROCdo_select_printer(0,TRUE,TRUE)
    */
    IF prnt_edit%!CONST_prnt_flags AND CONST_prnt_flags_selected THEN
      Ftracef("PROCdo_select_printer loc 4")
      PROCdo_select_printer(prnt_edit%,TRUE,FALSE,TRUE)
    ELSE
      /* Check that the connection is valid; try opening it */
      PROCdo_select_printer(prnt_edit%,FALSE,FALSE,TRUE)
      PROCdo_select_printer(0,TRUE,TRUE,FALSE)
    ENDIF
    PROCprinter_status(prnt_edit%)
  ENDIF
ENDPROC

DEF PROCprinter_status(prnt%)
  /*ensure that the string for this printer's icon is correct*/
  LOCAL new_text$,i%,sprite$,st$,icon_set%,psup%
  Ftracef("PROCprinter_status")
  IF prnt%!CONST_prnt_icon=-1 ENDPROC /*no icon to update!*/
  cnct%=prnt%!CONST_prnt_cnct
  psup%=prnt%!CONST_prnt_psup
  new_text$=FNiconbar_string(prnt%)
  IF prnt%!CONST_prnt_sprt sprite$=$prnt%!CONST_prnt_sprt ELSE sprite$=$psup%!CONST_psup_class
  st$="ss_"+sprite$+","+sprite$
  !buff1%=-1
  buff1%!4=prnt%!CONST_prnt_icon
  SYS "Wimp_GetIconState",,buff1%
  icon_set%=buff1%!24 AND 1<<21
  IF new_text$<>$buff1%!28 OR st$<>$buff1%!32 THEN
    i%=FNiconbar_tands(new_text$,sprite$,-4,prnt%!CONST_prnt_icon)
    PROCicon_delete(-1,prnt%!CONST_prnt_icon)
    prnt%!CONST_prnt_icon=i%
    IF icon_set% PROCicon_select(-1,i%)
  ENDIF
ENDPROC

DEF FNiconbar_string(prnt%)
  LOCAL cnct%,queu%
  Ftracef("FNiconbar_string")
  IF prnt%=0 THEN =""
  cnct%=prnt%!CONST_prnt_cnct
  IF prnt%!CONST_prnt_flags AND CONST_prnt_flags_paused THEN =FNmsg_0(A%!CONST_interface_host_desc,"QU1")
  IF prnt%!CONST_prnt_flags AND CONST_prnt_flags_printing THEN
    /*it thinks it is printing, but is the file paused?*/
    queu%=prnt%!CONST_prnt_queu
    IF queu%?CONST_queu_status AND 1 THEN =FNmsg_0(A%!CONST_interface_host_desc,"QU1")ELSE =FNmsg_0(A%!CONST_interface_host_desc,"QU2")
  ENDIF
  IF prnt%!CONST_prnt_flags AND CONST_prnt_flags_suspended THEN =FNmsg_0(A%!CONST_interface_host_desc,"QU3")
  cnct%=prnt%!CONST_prnt_cnct
  IF cnct%!CONST_cnct_type=1 AND (cnct%!CONST_cnct_flags AND CONST_cnct_flags_parallel_errors)<>0 AND FNparallel_error_detect_possible THEN
    IF FNparallel_paper_out THEN =FNmsg_0(A%!CONST_interface_host_desc,"QU4")
    IF FNparallel_error THEN =FNmsg_0(A%!CONST_interface_host_desc,"QU5")
  ENDIF
  IF prnt%!CONST_prnt_name THEN =$prnt%!CONST_prnt_name
  CASE cnct%!CONST_cnct_type OF
    WHEN 0,1,2,5
      =FNmsg_0(A%!CONST_interface_host_desc,"IC"+STR$cnct%!CONST_cnct_type)
    WHEN 4
      =$cnct%!CONST_cnct_econet
    WHEN 6
      =$cnct%!CONST_cnct_nfsp
    WHEN 10,11,12
      IF $cnct%!CONST_cnct_nfsp<>"" THEN
        =$cnct%!CONST_cnct_nfsp
      ELSE
        =$cnct%!CONST_cnct_nfss
      ENDIF
  ENDCASE
=""

DEF PROCbuild_printer_menu
  LOCAL offset%,status%,list%,i%,s$,indirected_title%
  B%=CONST_ident_LIST
  C%=2048
  list%=USR(code_entry%+CONST_entry_heap_claim)
  IF list%=0 ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","LIST")
  /*SWI NetPrint_ListServers
    R0 = format (1 -> names only, sorted, no duplicates)
    R1 = pointer to buffer
    R2 = size of buffer
    R3 = time to take
    On exit, R0 holds number of entries received*/
  SYS "XNetPrint_ListServers",1,list%,2048,500 TO offset%;i%
  IF i% AND 1 \
    i%=offset%+4: \
    CALL Z%,i%,s$: /*convert 0-terminated string*/ \
    ERROR CONST_error_ok,s$
  PROCmenu_create(menu%,FNmsg_0(A%!CONST_interface_host_desc,"ME6"))
  indirected_title%=(menu%!28 AND &100)<>0
  status%=list%
  i%=0
  WHILE i%<offset%
    CALL Z%,status%,s$
    status%+=LEN s$+1
    PROCmenu_item(menu%,i%,s$,indirected_title%)
    i%+=1
  ENDWHILE
  B%=CONST_ident_LIST
  C%=list%
  CALL code_entry%+CONST_entry_heap_free
ENDPROC

#ifdef Sparrow
DEF PROCactivate_printer
  LOCAL prnt%,cnct%,icon%, err%
  LOCAL rmtp%, junk%, tmplist%, thing%, othing%
  Ftracef("PROCactivate_printer")

  REPEAT
    PROCfind_only_prnt(prnt%, icon%)
    Ftracef ("PROCactivate_printer: prnt% = "+STR$prnt%+" rmtp% = "+STR$rmtp%)
    IF prnt% THEN
      PROCicon_deselect(prntctrl%,icon%)
      IF(prnt%!CONST_prnt_flags AND CONST_prnt_flags_active)=0 PROCactivate_this_printer(prnt%)
      /*
       * Activating a printer that is shared is basically the only way of
       * simulating (hacking up) an unshare menu entry. Should be an extra
       * entry really. Never mind.
       */
      IF (prnt%!CONST_prnt_flags AND CONST_prnt_flags_shared) THEN
        PROCunshare_one_printer (prnt%)
      ENDIF
    ENDIF
  UNTIL prnt% = 0

  tmplist% = 0

  SYS "Hourglass_On"

  REPEAT
    PROCfind_only_rmtp (rmtp%, icon%)
    IF rmtp% THEN
     IF rmtp%!CONST_rmtp_icon <= 0 THEN
      PROCicon_deselect(prntctrl%,icon%)
      Ftracef ("About to import")
      thing% = FNconstruct_rmtp (rmtp%!CONST_rmtp_name, rmtp%!CONST_rmtp_descriptor, rmtp%!CONST_rmtp_IP_address)
      PROCadd_to_list (tmplist%, thing%)

     ENDIF
    ENDIF
  UNTIL rmtp% = 0

  thing% = tmplist%

  WHILE thing%
    junk% = FNensure_printer(thing%, 0, FALSE, FALSE, err%)
    PROCremove_from_list (remote_printers%, $thing%!CONST_rmtp_name)
    othing% = thing%
    thing% = thing%!CONST_rmtp_next
    PROCfree (CONST_ident_RMTP, othing%)
  ENDWHILE

  SYS "Hourglass_Off"

ENDPROC

#else

DEF PROCactivate_printer
  LOCAL prnt%,cnct%,icon%
  Ftracef("PROCactivate_printer")
  REPEAT
    PROCfind_prnt(prnt%,icon%)
    IF prnt% THEN
      PROCicon_deselect(prntctrl%,icon%)
      IF(prnt%!CONST_prnt_flags AND CONST_prnt_flags_active)=0 PROCactivate_this_printer(prnt%)
    ENDIF
  UNTIL prnt%=0
ENDPROC
#endif

DEF PROCactivate_this_printer(prnt%)
  Ftracef("PROCactivate_this_printer")
  prnt%!CONST_prnt_flags=prnt%!CONST_prnt_flags OR CONST_prnt_flags_active
  cnct%=prnt%!CONST_prnt_cnct
  PROCcreate_printer_icon(prnt%)
  PROCflush_queue(prnt%)
  /*first active printer - select it*/
  IF A%!CONST_interface_printer_active=1 THEN
    Ftracef("PROCdo_select_printer loc 5")
    PROCdo_select_printer(prnt%,TRUE,FALSE,FALSE)
  ENDIF
ENDPROC

DEF PROCcreate_printer_icon(prnt%)
  LOCAL s$,i%,side%,psup%
  Ftracef("PROCcreate_printer_icon")
  psup%=prnt%!CONST_prnt_psup
  IF prnt%!CONST_prnt_sprt THEN
   s$=$prnt%!CONST_prnt_sprt
   Ftracef("... sprite name specified, "+s$)
  ELSE
   s$=$psup%!CONST_psup_class
   Ftracef("... using class name for sprite, "+s$)
  ENDIF
  i%=FNright_of(prnt%)
  side%=-4
  IF i%=-1 THEN
    i%=FNleft_of(prnt%)
    side%=-3
  ENDIF
  IF i%=-1 THEN
    i%=&0F000000
    side%=-5
  ENDIF
  prnt%!CONST_prnt_icon=FNiconbar_tands(FNiconbar_string(prnt%),s$,side%,i%)
  IF got_icon% THEN
    PROCicon_delete(-1,main_icon%)
    got_icon%=FALSE
  ENDIF
  A%!CONST_interface_printer_active+=1
ENDPROC

DEF FNright_of(prnt%)
  Ftracef("FNright_of")
  /*returns the icon number of the icon that we want to be right of*/
  LOCAL icon%,l_prnt%
  IF got_icon% THEN
    icon%=main_icon%
  ELSE
    /*find the last active icon that comes before the PRNT block we are
      interested in NB - there may not be one*/
    icon%=-1
    l_prnt%=A%!CONST_interface_printer_installed
    WHILE l_prnt%
      IF NOT l_prnt%!CONST_prnt_icon icon%=l_prnt%!CONST_prnt_icon
      IF l_prnt%=prnt% l_prnt%=0 ELSE l_prnt%=l_prnt%!CONST_prnt_next
    ENDWHILE
  ENDIF
=icon%

DEF FNleft_of(prnt%)
  /*OK, FNright_of failed, so find the first active
    icon AFTER the PSUP block we are interested in*/
  Ftracef("FNleft_of")
  WHILE prnt%!CONST_prnt_icon=-1
    prnt%=prnt%!CONST_prnt_next
    IF prnt%=0 THEN =-1
  ENDWHILE
=prnt%!CONST_prnt_icon

DEF PROCcreate_main_icon
  Ftracef("PROCcreate_main_icon")
  #ifdef Trace
    main_icon%=FNiconbar_tands(FNmsg_0(A%!CONST_interface_host_desc,"NNE"),\
        "s"+FNmsg_0(A%!CONST_interface_host_desc,"IC")+"d",-5,&0F000000)
  #else
    main_icon%=FNiconbar_tands(FNmsg_0(A%!CONST_interface_host_desc,"NNE"),\
        "s"+FNmsg_0(A%!CONST_interface_host_desc,"IC"),-5,&0F000000)
  #endif
  got_icon%=TRUE
  !task_buff%=A%!CONST_interface_queue
  PROCclose_window
ENDPROC

#ifdef Sparrow
DEF PROCdeactivate_printer
  LOCAL prnt%,icon%,doit%, name$, othing%
  LOCAL rmtp%, doit%, tmplist%, thing%, prnt%

  tmplist% = 0

  Ftracef("PROCdeactivate_printer")

  REPEAT
    PROCfind_prnt(prnt%, rmtp%, icon%)

    PROCicon_deselect(prntctrl%,icon%)

    IF prnt% THEN
      IF prnt%!CONST_prnt_flags AND CONST_prnt_flags_remote THEN
        thing% = FNconstruct_rmtp (0, 0, prnt%)
        PROCadd_to_list (tmplist%, thing%)
      ELSE
        PROCdeactivate_this_printer(prnt%)
      ENDIF
    ENDIF

    IF rmtp% AND rmtp%!CONST_rmtp_icon > 0 THEN
      PROCremove_unavailable_printer ($rmtp%!CONST_rmtp_name)
Ftracef ("**** just removed unavailable printer, count = "+STR$FNunavailable_count+" inst "+STR$A%!CONST_interface_printer_active)
      IF FNunavailable_count = 0 AND A%!CONST_interface_printer_active = 0 THEN
        PROCcreate_main_icon
      ENDIF
    ENDIF

  UNTIL prnt% = 0 AND rmtp% = 0

  thing% = tmplist%
  WHILE thing%
    prnt% = thing%!CONST_rmtp_IP_address
    name$ = $prnt%!CONST_prnt_name
    PROCremove_one_printer (prnt%)
    PROCadd_remote_printer (name$)
    othing% = thing%
    thing% = thing%!CONST_rmtp_next
    PROCfree (CONST_ident_RMTP, othing%)
  ENDWHILE

  PROCcreate_installed_printer_icons

  IF selected_prnt%=0 THEN
    IF A%!CONST_interface_printer_active THEN
      doit%=A%!CONST_interface_printer_installed
      WHILE doit%
        IF NOT doit%!CONST_prnt_icon THEN
          Ftracef("PROCdo_select_printer loc 6")
          PROCdo_select_printer(doit%,TRUE,FALSE,FALSE)
          doit%=0
        ELSE
          doit%=doit%!CONST_prnt_next
        ENDIF
      ENDWHILE
    ENDIF
  ENDIF
ENDPROC

#else
DEF PROCdeactivate_printer
  LOCAL prnt%,icon%,doit%

  Ftracef("PROCdeactivate_printer")

  REPEAT
    PROCfind_prnt(prnt%,icon%)

    IF prnt% THEN
      PROCicon_deselect(prntctrl%,icon%)
      PROCdeactivate_this_printer(prnt%)
    ENDIF

  UNTIL prnt% = 0

  IF selected_prnt%=0 THEN
    IF A%!CONST_interface_printer_active THEN
      doit%=A%!CONST_interface_printer_installed
      WHILE doit%
        IF NOT doit%!CONST_prnt_icon THEN
          Ftracef("PROCdo_select_printer loc 6")
          PROCdo_select_printer(doit%,TRUE,FALSE,FALSE)
          doit%=0
        ELSE
          doit%=doit%!CONST_prnt_next
        ENDIF
      ENDWHILE
    ENDIF
  ENDIF
ENDPROC

#endif

DEF PROCdeactivate_this_printer(prnt%)
  Ftracef("PROCdeactivate_this_printer")
#ifdef Sparrow
  LOCAL was_remote%


  IF prnt%!CONST_prnt_flags AND CONST_prnt_flags_shared THEN
    PROCunshare_one_printer (prnt%)
  ENDIF
  IF prnt%!CONST_prnt_flags AND CONST_prnt_flags_remote THEN
    was_remote% = TRUE
  ENDIF
#endif

  IF prnt%!CONST_prnt_flags AND CONST_prnt_flags_active THEN
#ifdef Sparrow
        IF prnt%!CONST_prnt_flags AND CONST_prnt_flags_remote THEN
          doit% = TRUE /* If it's a remote printer, vapourise the queue anyway */
        ELSE
          IF prnt%!CONST_prnt_queu THEN
            doit%=FNquery("WA2",$prnt%!CONST_prnt_type)
          ELSE
            doit%=TRUE
          ENDIF
        ENDIF
#else
    IF prnt%!CONST_prnt_queu doit%=FNquery("WA2",$prnt%!CONST_prnt_type)ELSE doit%=TRUE
#endif
    IF doit% THEN
      /*let the back-end know*/
      PROCprinter_reason_code(prnt%!CONST_prnt_psup,prnt%,-10,0)
      IF NOT prnt%!CONST_prnt_icon THEN
#ifdef Sparrow
        IF A%!CONST_interface_printer_active=1 AND FNunavailable_count=0 THEN
          PROCcreate_main_icon /* I.e. printer_active is about to become 0 */
        ENDIF
        IF A%!CONST_interface_printer_active=1 AND FNunavailable_count>0 THEN
          !task_buff%=A%!CONST_interface_queue
          PROCclose_window
        ENDIF
#else
        IF A%!CONST_interface_printer_active=1 PROCcreate_main_icon
#endif
        PROCicon_delete(-1,prnt%!CONST_prnt_icon)
        prnt%!CONST_prnt_icon=-1
        A%!CONST_interface_printer_active-=1
      ENDIF
      /*cancel all relevant flags*/
      prnt%!CONST_prnt_flags=prnt%!CONST_prnt_flags AND NOT CONST_prnt_flags_deactivate
      IF selected_prnt%=prnt% SYS"PDriver_SelectDriver",-1:selected_prnt%=0
      PROCflush_queue(prnt%)
    ENDIF
  ENDIF

ENDPROC

DEF PROCremove_printer
  LOCAL i%,prnt%,ptr%,last_prnt%,private_buff%,doit%,type$
  Ftracef("PROCremove_printer")
  /*first of all, remove all of the selected printers*/
  B%=CONST_ident_XXXX
  C%=256
  private_buff%=USR(code_entry%+CONST_entry_heap_claim)
  IF private_buff%=0 \
    ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","XXXX")
  SYS "Wimp_WhichIcon",prntctrl%,private_buff%,1<<21,1<<21
  ptr%=private_buff%
  SYS "Hourglass_On"
  WHILE NOT !ptr%
    i%=!ptr%
    prnt%=A%!CONST_interface_printer_installed
    last_prnt%=0
    WHILE prnt%
#ifdef Sparrow
     /*
      * Don't remove a remote printer - only deactivate is allowed
      */
     IF ((prnt%!CONST_prnt_flags AND CONST_prnt_flags_remote) = 0) AND prnt%!CONST_prnt_pane=i% THEN
#else
     IF prnt%!CONST_prnt_pane=i% THEN
#endif
       IF prnt%!CONST_prnt_queu THEN
          SYS "Hourglass_Off"
          doit%=FNquery("WA3",$prnt%!CONST_prnt_type)
          SYS "Hourglass_On"
          IFdoit% PROCflush_queue(prnt%)
       ELSE
         doit%=TRUE
       ENDIF
       IF doit% THEN
        type$=$prnt%!CONST_prnt_type
         PROCremove_this_printer(prnt%,last_prnt%)
         PROCdelete_prdata_entry(type$)
       ENDIF
       prnt%=0
     ELSE
       last_prnt%=prnt%
       prnt%=prnt%!CONST_prnt_next
     ENDIF
    ENDWHILE
    ptr%+=4
  ENDWHILE
  IF selected_prnt%=0 THEN
    /*we cancelled it - see if we can find a replacement*/
    IF A%!CONST_interface_printer_active THEN
      doit%=A%!CONST_interface_printer_installed
      WHILE doit%
        IF NOT doit%!CONST_prnt_icon THEN
          Ftracef("PROCdo_select_printer loc 7")
          PROCdo_select_printer(doit%,TRUE,FALSE,FALSE)
          doit%=0
        ELSE
          doit%=doit%!CONST_prnt_next
        ENDIF
      ENDWHILE
    ENDIF
  ENDIF
  /*if still not selected printer - let everyone know*/
  IF selected_prnt%=0 PROCtell_the_world
  B%=CONST_ident_XXXX
  C%=private_buff%
  CALL code_entry%+CONST_entry_heap_free
  /*now rebuild all of the remaining icons*/
  PROCcreate_installed_printer_icons
  PROCwin_open(prntctrl%)
  SYS "Hourglass_Off"
ENDPROC

DEF PROCremove_this_printer(prnt%,last_prnt%)
  LOCAL j%,i%,size%,psup%,prdt%
  Ftracef("PROCremove_this_printer")
  psup%=prnt%!CONST_prnt_psup
  prdt%=psup%!CONST_psup_head
  prdt%=prdt%!CONST_head_prdt
  /*let the back-end know*/
  PROCprinter_reason_code(psup%,prnt%,-9,0)
  PROCdeactivate_this_printer(prnt%)

  /*decrement the usage count on the prdata*/
  WHILE prdt%
    IF$prdt%!CONST_prdt_1st=$prnt%!CONST_prnt_type THEN
      /*matched*/
      prdt%!(prdt%!CONST_prdt_num*4+CONST_prdt_1st)-=1
      prdt%=0
    ELSE
      prdt%=prdt%!CONST_prdt_next
    ENDIF
  ENDWHILE

  /*are there any open windows for this printer?*/
  IF prnt_edit%=prnt% THEN
    !task_buff%=connections%
    PROCclose_window
  ENDIF

  i%=psup%!CONST_psup_wind
  WHILE i%
   IF i%!CONST_wind_prnt=prnt% THEN
     !task_buff%=i%!CONST_wind_hand
     PROCclose_window
   ENDIF
   i%=i%!CONST_wind_next
  ENDWHILE

  IF prnt%!CONST_prnt_pause \
    PROCdeallocate_pause_window(prnt%!CONST_prnt_pause)
  IF selected_prnt%=prnt% selected_prnt%=0
  Ftracef("Freeing name structure, "+$(prnt%!CONST_prnt_type)+", "+STR$~(prnt%!CONST_prnt_type))
  PROCfree_structure(prnt%!CONST_prnt_type) /*name*/

  /* free up the connection information */
  Ftracef("Freeing connection information")
  j%=prnt%!CONST_prnt_cnct
  IF (psup%!CONST_psup_flags AND CONST_psup_flags_backend_connections) THEN
    /* Back end supplies own connections details */
    size% = psup%!CONST_psup_cnct
    IF 2 <= size% THEN
      j%+=4
      FOR i%=2 TO size%
        PROCfree_structure(!j%)
        j%+=4
      NEXT
      j%=prnt%!CONST_prnt_cnct
    ENDIF
  ELSE
    PROCfree_structure(j%!CONST_cnct_econet) /*econet*/
    PROCfree_structure(j%!CONST_cnct_file) /*filename*/
    PROCfree_structure(j%!CONST_cnct_nfss) /*NFS server*/
    PROCfree_structure(j%!CONST_cnct_nfsp) /*NFS printer*/
    PROCfree_structure(j%!CONST_cnct_nfsu) /*NFS username*/
    PROCfree_structure(j%!CONST_cnct_nfso) /*NFS options*/
    PROCfree_structure(j%!CONST_cnct_nfsps) /*NFS password*/
  ENDIF
  B%=CONST_ident_CNCT
  C%=j%
  CALL code_entry%+CONST_entry_heap_free

  /* free up the configuration information */
  Ftracef("Freeing configuration information")
  j%=prnt%!CONST_prnt_cnfg
  IF j% THEN
    size%=psup%!CONST_psup_cnfg
    IF 0<=size%-1 THEN
      FOR i%=0 TO size%-1
        PROCfree_structure(j%!(i%*4))
      NEXT
    ENDIF
  ENDIF
  B%=CONST_ident_CNFG
  C%=j%
  CALL code_entry%+CONST_entry_heap_free

  !task_buff%=prntctrl%
  task_buff%!4=prnt%!CONST_prnt_pane
  SYS "Wimp_GetIconState",,task_buff%
  /*
     the icons in the printer control window now all share
     the same little bit of indirected workspace, so
     don't free it any more

     B%=CONST_ident_ICON
     C%=task_buff%!28
     CALL code_entry%+CONST_entry_heap_free
  */
  task_buff%!8=1<<7 OR 1<<23
  task_buff%!12=1<<7 OR 1<<23 OR 1<<21
  SYS "Wimp_SetIconState",,task_buff%
#if FALSE
  IF NOT prnt%!CONST_prnt_icon THEN
/* # ifdef Sparrow */
    IF A%!CONST_interface_printer_active=1 AND FNunavailable_count = 0 THEN
      PROCcreate_main_icon
    ENDIF
/* # else */
    IF A%!CONST_interface_printer_active=1 PROCcreate_main_icon
/* # endif */
    PROCicon_delete(-1,prnt%!CONST_prnt_icon)
    prnt%!CONST_prnt_icon=-1 /*a not very good fix to RP-2338*/
    A%!CONST_interface_printer_active-=1
    PROCflush_queue(prnt%)
  ENDIF
#endif

  j%=prnt%!CONST_prnt_fonts
  WHILE j%
    PROCfree_structure(j%!CONST_fonts_acorn)
    PROCfree_structure(j%!CONST_fonts_foreign)
    i%=j%!CONST_fonts_next
    B%=CONST_ident_FONT
    C%=j%
    CALL code_entry%+CONST_entry_heap_free
    j%=i%
  ENDWHILE
  j%=prnt%!CONST_prnt_next
  B%=CONST_ident_PRNT
  C%=prnt%
  CALL code_entry%+CONST_entry_heap_free

  IF last_prnt% THEN
    last_prnt%!CONST_prnt_next=j%
  ELSE
    A%!CONST_interface_printer_installed=j%
  ENDIF
  /*do NOT go printer_count%-=1
    'cos this get recalculated when
    the icons get rebuilt*/
ENDPROC

DEF FNquery(tag$,p1$)
  LOCAL x%,y%,w%,h%
  Ftracef("FNquery")
  PROCicon_write(query%,CONST_query_text,FNmsg_1(A%!CONST_interface_host_desc,tag$,p1$))
  PROCicon_write(query%,CONST_query_lose,FNmsg_0(A%!CONST_interface_host_desc,tag$+"a"))
  SYS "Wimp_GetPointerInfo",,task_buff%
  x%=!task_buff%
  y%=task_buff%!4
  !task_buff%=query%
  SYS "Wimp_GetWindowState",,task_buff%
  w%=task_buff%!12-task_buff%!4
  h%=task_buff%!16-task_buff%!8
  task_buff%!4=x%-340 /*half the width of the window*/
  task_buff%!8=y%-120 /*half the height of the window*/
  task_buff%!12=task_buff%!4+w%
  task_buff%!16=task_buff%!8+h%
  task_buff%!28=-1
  SYS "Wimp_OpenWindow",,task_buff%
  PROCbound_mouse(query%)
  query_state%=0
  REPEAT
    Ftracef("waiting for answer")
    PROCdespatch_poll(click_mask%)
  UNTIL query_state%
  Ftracef("got answer")
  !task_buff%=query%
  PROCclose_window
  PROCunbound_mouse
=(query_state%=CONST_query_lose)

DEF PROCbound_mouse(h%)
  /*bound the mouse to the specified window*/
  Ftracef("PROCbound_mouse")
  !task_buff%=h%
  SYS "Wimp_GetWindowOutline",,task_buff%
  ?task_buff%=1
  task_buff%!1=task_buff%!4
  task_buff%!3=task_buff%!8
  task_buff%!5=task_buff%!12
  task_buff%!7=task_buff%!16
  SYS "OS_Word",21,task_buff%
ENDPROC

DEF PROCunbound_mouse
  LOCAL mc_sw%,mc_dx%,mc_sh%,mc_dy%,scrx%,scry%
  Ftracef("PROCunbound_mouse")
  SYS "OS_ReadModeVariable",-1,4 TO,,mc_dx%
  mc_dx%=1<<mc_dx%
  SYS "OS_ReadModeVariable",-1,5 TO,,mc_dy%
  mc_dy%=1<<mc_dy%
  SYS "OS_ReadModeVariable",-1,11 TO,,mc_sw%
  mc_sw%+=1
  SYS "OS_ReadModeVariable",-1,12 TO,,mc_sh%
  mc_sh%+=1
  scrx%=mc_sw%*mc_dx%
  scry%=mc_sh%*mc_dy%
  ?task_buff%=1
  task_buff%!1=0
  task_buff%!3=0
  task_buff%!5=scrx%
  task_buff%!7=scry%
  SYS "OS_Word",21,task_buff%
ENDPROC

DEF PROCcreate_installed_printer_icons
  LOCAL prnt%,ptr%,i%
#ifdef Sparrow
  LOCAL rmtp%
#endif
  Ftracef("PROCcreate_installed_printer_icons")
  !buff1%=prntctrl%
  IF printer_count% THEN
    FOR i%=0 TO printer_count%-1
      buff1%!4=i%+4
      SYS "Wimp_DeleteIcon",,buff1%
    NEXT
  ENDIF
#ifdef Sparrow
  IF remote_printer_count% THEN
    FOR i% = printer_count% TO printer_count%+remote_printer_count%
      buff1%!4=i%+4
      SYS "Wimp_DeleteIcon",,buff1%
    NEXT
  ENDIF
#endif

/*
  i%=(printer_count%+1)*(prntctrl_icdf%(4)!12 - prntctrl_icdf%(4)!4)
  SYS "Wimp_ForceRedraw",prntctrl%,,-i%,986,-(prntctrl_icdf%(4)!12 - prntctrl_icdf%(4)!4)
  ... a general redraw gets done later, so we don't need to do this here
*/

  printer_count%=0
#ifdef Sparrow
  remote_printer_count% = 0
#endif
  !buff1%=prntctrl%
  buff1%!4=0
  buff1%!8=prntctrl_icdf%(4)!4 /* take these values from the defined icon */
  buff1%!12=1030
  buff1%!16=prntctrl_icdf%(4)!12
  buff1%!20=prntctrl_icdf%(4)!16
  buff1%!24=prntctrl_icdf%(4)!20
  buff1%!28=prntctrl_icdf%(4)!24
  buff1%!32=prntctrl_icdf%(4)!28
  prnt%=A%!CONST_interface_printer_installed
  WHILE prnt%
    SYS "Wimp_CreateIcon",,buff1% TO i%
    printer_count%+=1
    buff1%!16=buff1%!8
    buff1%!8-=(prntctrl_icdf%(4)!12 - prntctrl_icdf%(4)!4)
    prnt%!CONST_prnt_pane=i%
    /*and move on to the next installed printer*/
    prnt%=prnt%!CONST_prnt_next
  ENDWHILE

#ifdef Sparrow
  rmtp% = remote_printers%
  WHILE rmtp%
    SYS "Wimp_CreateIcon",,buff1% TO i%

    remote_printer_count% += 1
    buff1%!16=buff1%!8
    buff1%!8-=(prntctrl_icdf%(4)!12 - prntctrl_icdf%(4)!4)
    rmtp%!CONST_rmtp_pane=i%
    /*and move on to the next remote printer*/
    rmtp% = rmtp%!CONST_rmtp_next
  ENDWHILE
#endif

  SYS "Wimp_GetWindowInfo",,buff1% OR 1
  buff1%!0=0
#ifdef Sparrow
  buff1%!4=-(printer_count%+remote_printer_count%+1)*(prntctrl_icdf%(4)!12 - prntctrl_icdf%(4)!4)
#else
  buff1%!4=-(printer_count%+1)*(prntctrl_icdf%(4)!12 - prntctrl_icdf%(4)!4)
#endif
  buff1%!8=buff1%!52-buff1%!44
  buff1%!12=0
  SYS "Wimp_SetExtent",prntctrl%,buff1%
  /* redraw just a little bit more */
#ifdef Sparrow
  buff1%!4=-(printer_count%+remote_printer_count%+2)*(prntctrl_icdf%(4)!12 - prntctrl_icdf%(4)!4)
#else
  buff1%!4=-(printer_count%+2)*(prntctrl_icdf%(4)!12 - prntctrl_icdf%(4)!4)
#endif
  SYS "Wimp_ForceRedraw",prntctrl%,buff1%!0,buff1%!4,buff1%!8,buff1%!12
#ifdef Sparrow
  IF FNwindow_open (prntctrl%) THEN
    PROCwin_open(prntctrl%)
  ENDIF
#else
  PROCwin_open(prntctrl%)
#endif
ENDPROC

DEF FNnfs_installed
  LOCAL i%
  Ftracef("FNnfs_installed")
  SYS "XOS_SWINumberFromString",,"NFS_Mount" TO;i%
=((i% AND 1)=0)

DEF FNlanman_installed
  LOCAL i%
  Ftracef("FNlanman_installed")
  SYS "XOS_SWINumberFromString",,"LanMan_OmniOp" TO;i%
=((i% AND 1)=0)

DEF FNlanman98_installed
  LOCAL i%
  Ftracef("FNlanman98_installed")
  SYS "XOS_SWINumberFromString",,"LanMan98_OmniOp" TO;i%
=((i% AND 1)=0)

DEF FNeconet_installed
  LOCAL i%
  Ftracef("FNeconet_installed")
  SYS "XOS_SWINumberFromString",,"NetPrint_ReadPSName" TO;i%
=((i% AND 1)=0)

  /*DEF PROCeconet_printer(buff%,buffsize%,RETURN end_stop%)
    SYS "XNetPrint_ReadPSName",,buff%,buffsize% TO,end_stop%
    ENDPROC*/

DEF FNevaluate(s$)
  LOCAL t%,n%,f%
  Ftracef("FNevaluate")
  SYS "XOS_EvaluateExpression",s$,evaluation_buff%,256 TO,t%,n%;f%
  IF t% OR(f% AND 1)ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FAD",s$)
=n%

/* SMC: canonicalise the path name given in s$ */
DEF FNcanonicalise(s$)
  LOCAL unused%,f%
  Ftracef("FNcanonicalise")
  SYS "XOS_FSControl",37,s$,evaluation_buff%,0,0,256 TO ,,,,,unused%;f%
  IF (unused%<=0) OR (f% AND 1) : =s$
  evaluation_buff%?(256-unused%)=13
=$evaluation_buff%

DEF PROCbroadcast_reason_code(prnt%,reason%,task_buffer%)
LOCAL p%
p%=psup_head%
WHILE p%
  PROCprinter_reason_code(p%,prnt%,reason%,task_buffer%)
  p%=p%!CONST_psup_next
ENDWHILE
ENDPROC

DEF PROCprinter_reason_code(psup%,prnt%,reason%,extra_buffer%)
  LOCAL i%
  LOCAL ERROR
  ON ERROR LOCAL: RESTORE ERROR: PROCprinter_reason_error(psup%,prnt%,reason%): ENDPROC
  Ftracef("PROCprinter_reason_code")
  buff1%!0=reason%
  buff1%!4=psup%
  buff1%!8=prnt%
  buff1%!12=extra_buffer%
  buff1%!16=psize_head%
  buff1%!20=code_entry%
  buff1%!24=A%: /* Mostly for machine code routines */

  Ftracef("reason%       "+STR$ reason%)
  Ftracef("psup%         &"+STR$~psup%)
  Ftracef("prnt%         &"+STR$~prnt%)
  Ftracef("extra_buffer% &"+STR$~extra_buffer%)
  Ftracef("psize_head%   &"+STR$~psize_head%)
  Ftracef("code_entry%   &"+STR$~code_entry%)

  IF psup%!CONST_psup_flags AND CONST_psup_flags_BASIC THEN
    /*Call a BASIC support routine*/
    Ftracef("FN"+$psup%!CONST_psup_class+"_support(&"+STR$~buff1%+")")
    i%=EVAL("FN"+$psup%!CONST_psup_class+"_support("+STR$ buff1%+")")
    Ftracef("FN"+$psup%!CONST_psup_class+"_support done")
  ELSE
    /*Call a machine code support routine*/
    IF 0<=utility_count%-1 THEN
      FOR i%=0 TO utility_count%-1
        IF $psup%!CONST_psup_class=utility$(i%)THEN
          Ftracef("CALL "+$psup%!CONST_psup_class)
          B%=buff1%
          CALL utility%(i%)
          Ftracef("CALL "+$psup%!CONST_psup_class+" done")
        ENDIF
      NEXT
    ENDIF
  ENDIF
ENDPROC

DEF PROCprinter_reason_error(psup%,prnt%,reason%)
  /*if the error occured while the printer was printing, abort it*/
  Ftracef("PROCprinter_reason_error")
  IF (prnt%!CONST_prnt_flags AND CONST_prnt_flags_printing) ERROR CONST_error_ok,REPORT$
  /*if the error is a FATAL one, do it*/
  #ifdef Trace
    IF ERR=CONST_error_fatal ERROR CONST_error_fatal,REPORT$+" ("+STR$ ERL+")"
  #else
    IF ERR=CONST_error_fatal ERROR CONST_error_fatal,REPORT$
  #endif
  /*otherwise, just give a warning*/
  PROCerror_warning(FNmsg_4(A%!CONST_interface_host_desc,"WA6",$psup%!CONST_psup_class,STR$ reason%,REPORT$,STR$ ERL))
ENDPROC

DEF PROCpause_printer(prnt%)
  Ftracef("PROCpause_printer")
  prnt%!CONST_prnt_flags=prnt%!CONST_prnt_flags OR CONST_prnt_flags_paused
  PROCprinter_status(prnt%)
  PROCredraw_queue_entry(-1,prnt%,0)
ENDPROC

DEF PROCprinter_open_window(prnt%,name$)
  LOCAL handle%, num_icons%, i%
  Ftracef("PROCprinter_open_window")
  IF name$="configure" THEN
   IF prnt%!CONST_prnt_flags AND CONST_prnt_flags_printing ERROR CONST_error_ok,FNmsg_0(A%!CONST_interface_host_desc,"OKAI")
  ENDIF
  handle%=FNprinter_find_window(prnt%,name$)
  PROCtell_pinboard(handle%)
  PROCwin_open(handle%)
  /* try to find a writable icon */
  !buff1%=handle%
  SYS"Wimp_GetWindowInfo",,buff1% OR 1
  num_icons%=buff1%!88
  FOR i%=0 TO num_icons%
    !buff1%=handle%:buff1%!4=i%:SYS"Wimp_GetIconState",,buff1%
    IF (buff1%!24 AND (1<<23))=0 THEN
      /* not a deleted icon */
      IF (buff1%!24 AND (%1111<<12)) = (15<<12) THEN
#ifdef Sparrow /* If it's a remote or shared printer, grey out name writable (should shift caret to - FIXME!) */
        IF (prnt%!CONST_prnt_flags AND CONST_prnt_flags_shared) OR (prnt%!CONST_prnt_flags AND CONST_prnt_flags_remote) THEN
         PROCicon_shade (handle%, i%) : REM Is name always first icon?
         PROCcaret_set (-1, -1)
        ELSE
         PROCicon_unshade (handle%, i%) : REM Is name always first icon?
#endif
         PROCcaret_set(handle%,i%)
#ifdef Sparrow
        ENDIF
#endif
       ENDPROC
      ENDIF
    ENDIF
  NEXT
ENDPROC

DEF FNprinter_find_window(prnt%,name$)
  LOCAL psup%
  Ftracef("FNprinter_find_window")
  psup%=prnt%!CONST_prnt_psup
  i%=psup%!CONST_psup_wind
  WHILE i%
   IF $(i%+CONST_wind_name)=name$ THEN
    i%!CONST_wind_psup=psup%
    i%!CONST_wind_prnt=prnt%
    =i%!CONST_wind_hand
   ENDIF
   i%=i%!CONST_wind_next
  ENDWHILE
  ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FAE",name$)
=0

DEF PROCprinter_find_handle(handle%,RETURN wind%,RETURN psup%,RETURN prnt%)
  Ftracef("PROCprinter_find_handle")
  psup%=psup_head%
  WHILE psup%
    wind%=psup%!CONST_psup_wind
    WHILE wind%
      IF wind%!CONST_wind_hand=handle% THEN
        prnt%=wind%!CONST_wind_prnt
        ENDPROC
      ENDIF
      wind%=wind%!CONST_wind_next
    ENDWHILE
    psup%=psup%!CONST_psup_next
  ENDWHILE
  wind%=0
  psup%=0
  prnt%=0
ENDPROC

DEF FNprinter_find_prdata_entry(psup%,name$)
  LOCAL prdt%
  Ftracef("FNprinter_find_prdata_entry")
  IF psup%=0 THEN =0
  prdt%=psup%!CONST_psup_head
  IF prdt%=0 THEN =0
  prdt%=prdt%!CONST_head_prdt
  IF prdt%=0 THEN =0
  WHILE $prdt%!CONST_prdt_1st<>name$
    prdt%=prdt%!CONST_prdt_next
    IF prdt%=0 THEN =0
  ENDWHILE
=prdt%

DEF FNprinter_read_integer(ptr%)
  Ftracef("FNprinter_read_integer")
  IF ptr%=0 THEN =0
  IF ptr%!-4<>CONST_ident_INTG AND ptr%!-4<>CONST_ident_POTR THEN
    ERROR CONST_error_fatal,FNmsg_0(A%!CONST_interface_host_desc,"FA6")
  ENDIF
=!ptr%

DEF FNprinter_read_string(ptr%)
  LOCAL i%,s$
  Ftracef("FNprinter_read_string")
  IF ptr%=0 THEN =""
  CASE ptr%!-4 OF
    WHEN CONST_ident_STRG
/*      Ftracef("="""+$ptr%+"""") */
      =$ptr%
    WHEN CONST_ident_STR0
      CALL Z%,ptr%,s$ /*convert 0-terminated string*/
/*      Ftracef("="""+s$+"""") */
      =s$
    WHEN CONST_ident_GSTR
      CALL Y%,ptr%,s$ /*convert counted string*/
/*      Ftracef("="""+s$+"""") */
      =s$
  ENDCASE
  ERROR CONST_error_fatal,FNmsg_0(A%!CONST_interface_host_desc,"FA7")
=""

DEF FNprinter_read_integer_entry(prdt%,entry%)
  Ftracef("FNprinter_read_integer_entry")
  /*Bug fix for RP-2609*/
  IF prdt%=0 THEN =0
=FNprinter_read_integer(prdt%!(4+entry%*4))

REM wahay! write_entry? only used to set flag bit in dp/lj palette number at present
DEF PROCprinter_write_integer_entry(prdt%,entry%,value%)
  LOCAL ptr%
  IF prdt% <> 0 THEN
    ptr% = prdt%!(4+entry%*4)
    IF ptr%!-4<>CONST_ident_INTG AND ptr%!-4<>CONST_ident_POTR THEN
      ERROR CONST_error_fatal,FNmsg_0(A%!CONST_interface_host_desc,"FA6")
    ENDIF
    !ptr%=value%
  ENDIF
ENDPROC

DEF FNprinter_read_string_entry(prdt%,entry%)
  Ftracef("FNprinter_read_string_entry")
  /*Bug fix for RP-2609*/
  IF prdt%=0 THEN =""
=FNprinter_read_string(prdt%!(4+entry%*4))

  /*DEF FNprinter_read_boolean_integer_entry(prdt%,entry%,true%)
    LOCAL ptr%
    ptr%=prdt%!(4+entry%*4)
    IF ptr%=0 =0
    IF ptr%!-4<>CONST_ident_BOOL ERROR CONST_error_fatal,FNmsg_0(A%!CONST_interface_host_desc,"FA8")
    IF true% THEN
     =FNprinter_read_integer(ptr%!CONST_bool_true)
    ELSE
     =FNprinter_read_integer(ptr%!CONST_bool_false)
    ENDIF*/

DEF FNprinter_read_boolean_string_entry(prdt%,entry%,true%)
  LOCAL ptr%
  Ftracef("FNprinter_read_boolean_string_entry")
  /*Bug fix for RP-2609*/
  IF prdt%=0 =""
  ptr%=prdt%!(4+entry%*4)
  IF ptr%!-4<>CONST_ident_BOOL ERROR CONST_error_fatal,FNmsg_0(A%!CONST_interface_host_desc,"FA8")
  IF true% THEN
   =FNprinter_read_string(ptr%!CONST_bool_true)
  ELSE
   =FNprinter_read_string(ptr%!CONST_bool_false)
  ENDIF

DEF FNprinter_read_list_integer_entry(prdt%,entry%,list%,list_entry%)
  LOCAL ptr%
  Ftracef("FNprinter_read_list_integer_entry")
  /*Bug fix for RP-2609*/
  IF prdt%=0 THEN =0
  /*get a ptr to the entry required*/
  ptr%=prdt%!(4+entry%*4)
  IF ptr%=0 =0
  IF ptr%!-4<>CONST_ident_LSTD ERROR CONST_error_fatal,FNmsg_0(A%!CONST_interface_host_desc,"FA9")
  /*now find the nth list (ie list%)*/
  WHILE list%<>1 AND ptr%
    ptr%=ptr%!CONST_lstd_next
    list%-=1
  ENDWHILE
  IF ptr%=0 =0
  /*now find the nth entry in this list (ie list_entry%)*/
  ptr%+=8
  WHILE list_entry%<>1
    ptr%+=4
    list_entry%-=1
  ENDWHILE
=FNprinter_read_integer(!ptr%)

DEF FNprinter_read_list_string_entry(prdt%,entry%,list%,list_entry%)
  LOCAL ptr%
  Ftracef("FNprinter_read_list_string_entry")
  IF prdt%=0 THEN =""
  ptr%=prdt%!(4+entry%*4)
  IF ptr%=0 =""
  IF ptr%!-4<>CONST_ident_LSTD ERROR CONST_error_fatal,FNmsg_0(A%!CONST_interface_host_desc,"FA9")
  WHILE list%<>1 AND ptr%
    ptr%=ptr%!CONST_lstd_next
    list%-=1
  ENDWHILE
  IF ptr%=0 =""
  ptr%+=8
  WHILE list_entry%<>1
    ptr%+=4
    list_entry%-=1
  ENDWHILE
=FNprinter_read_string(!ptr%)

  /*Message handling routines*/

DEF PROCmsg_initialise(N$,RETURN msg_desc%)
  LOCAL ERROR
#ifdef ReportErrorLineNumber
  ON ERROR LOCAL RESTORE ERROR: ERROR 0,REPORT$
#else
  ON ERROR LOCAL RESTORE ERROR: ERROR 0,REPORT$+" ("+STR$(ERL)+")"
#endif
  /*DIM msg_text% 256: Now DIMMED at startup  */
  Ftracef("PROCmsg_initialise")
  SYS "OS_Module",6,,,17+LEN N$ TO,,msg_desc%
  $(msg_desc%+16)=N$
  SYS "MessageTrans_OpenFile",msg_desc%,msg_desc%+16
ENDPROC

DEF FNmsg_0(msg_desc%,T$)=FNmsg_4(msg_desc%,T$,"","","","")

DEF FNmsg_1(msg_desc%,T$,S$)=FNmsg_4(msg_desc%,T$,S$,"","","")

DEF FNmsg_2(msg_desc%,T$,S0$,S1$)=FNmsg_4(msg_desc%,T$,S0$,S1$,"","")

DEF FNmsg_3(msg_desc%,T$,S0$,S1$,S2$)=FNmsg_4(msg_desc%,T$,S0$,S1$,S2$,"")

DEF FNmsg_4(msg_desc%,T$,S0$,S1$,S2$,S3$)
  LOCAL F%,L%
  Ftracef("FNmsg")
  SYS "XMessageTrans_Lookup",msg_desc%,T$,msg_text%,256,S0$,S1$,S2$,S3$ TO,,,L%;F%
  IF F% AND 1 THEN =T$
  msg_text%?L%=13
  Ftracef(T$+" -> "+$msg_text%)
=$msg_text%

DEF PROCmsg_end(msg_desc%)
  Ftracef("PROCmsg_end")
  IF msg_desc% THEN
    SYS "MessageTrans_CloseFile",msg_desc%
    SYS "XOS_Module",7,,msg_desc%
  ENDIF
ENDPROC

  /*Task handling routines*/

DEF PROCtask_initialise(n$)
  Ftracef("PROCtask_initialise")
  task_id$=n$
  /*B%=CONST_ident_TASK: C%=256: task_buff%=USR(code_entry%+CONST_entry_heap_claim): Now DIMMED at startup  */
  task_buff%!0=&80152 /*ResetPrinter*/
  task_buff%!4=&80146 /*PrintTypeKnown*/
  task_buff%!8=&80145 /*PrintTypeOdd*/
  task_buff%!12=&80143 /*PrintInit*/
  task_buff%!16=&80142 /*PrintSave*/
  task_buff%!20=&80141 /*WillPrint*/
  task_buff%!24=&80140 /*PrintFile*/
  task_buff%!28=&400C9 /*MenusDeleted*/
  task_buff%!32=&502 /*HelpRequest*/
  task_buff%!36=12 /*DeviceInUse*/
  task_buff%!40=11 /*DeviceClaim*/
  task_buff%!44=10 /*SaveDesktop*/
  task_buff%!48=8 /*Prequit*/
  task_buff%!52=3 /*DataLoad*/
  task_buff%!56=2 /*DataSaveAck*/
  task_buff%!60=1 /*DataSave*/
  task_buff%!64=5 /*DataOpen*/
  task_buff%!68=&8014A /*PrintConfigure*/
  task_buff%!72=&8014B /*PrintInterrogate*/
  task_buff%!76=0 /*Quit*/
  SYS "Wimp_Initialise",300,&4B534154,n$,task_buff% TO wimp_version%,task_handle%
ENDPROC

DEF PROCtask_shutdown
  Ftracef("PROCtask_shutdown")
  SYS "Wimp_CloseDown"
  #ifdef Trace
    PROCftrace_off
    TRACE CLOSE
  #endif
  END

DEF FNtask_poll(mask%)
  /*Call Wimp_Poll with the given mask, but allowing for the timeout*/
  LOCAL task_action%,time_after%,prnt%,t%
  Ftracef("FNtask_poll")
  Ftracef("mask% &"+STR$~mask%)
  Ftracef("timeout% "+STR$ timeout%)
  Ftracef("ERL "+STR$ ERL)
  IF file_to_delete$<>"" mask%=mask% OR 1
  IF(mask% AND 1)=0 OR timeout%=-1 OR mask%<>A%!CONST_interface_global_mask THEN
    /*Nulls are needed anyway, or timeout% is "infinite" - use given mask*/
    Ftracef("calling Wimp_Poll (given mask)")
#ifdef Sparrow
    SYS "Wimp_Poll",mask%,task_buff%,,pollword_location% TO task_action%
#else
    SYS "Wimp_Poll",mask%,task_buff% TO task_action%
#endif
  ELSE
    /*Nulls are not needed otherwise, and there is a timeout*/
    IF timeout%=0 OR file_to_delete$<>"" THEN
      /*Timeout is nothing - get the earliest null available*/
      Ftracef("calling Wimp_Poll with nulls enabled")
#ifdef Sparrow
      SYS "Wimp_Poll",mask% AND NOT 1,task_buff%,, pollword_location% TO task_action%
#else
      SYS "Wimp_Poll",mask% AND NOT 1,task_buff% TO task_action%
#endif
    ELSE
      /*Big timeout*/
      Ftracef("calling Wimp_PollIdle "+STR$ timeout%+"cs")
#ifdef Sparrow
      SYS "Wimp_PollIdle",mask% AND NOT 1,task_buff%,time_before%+timeout%, pollword_location% TO task_action%
#else
      SYS "Wimp_PollIdle",mask% AND NOT 1,task_buff%,time_before%+timeout% TO task_action%
#endif
    ENDIF
  ENDIF
  Ftracef("")

  /*Calculate elapsed time*/
  SYS "OS_ReadMonotonicTime" TO time_after%
  elapsed_time%=time_after%-time_before%
  Ftracef("elapsed time is "+STR$ elapsed_time%)
  time_before%=time_after% /*For next time round the loop*/

  /*Take elapsed_time% off all prnts*/
  prnt%=A%!CONST_interface_printer_installed
  WHILE prnt%
    t%=prnt%+CONST_prnt_timeout /*Alias to save typing*/
    IF NOT !t% THEN
      Ftracef("modifying prnt from "+STR$!t%)
      IF elapsed_time%<!t% !t%-=elapsed_time% ELSE !t%=0
      Ftracef("   to "+STR$!t%)
    ENDIF
    cnct%=prnt%!CONST_prnt_cnct
    IF (cnct%!CONST_cnct_flags AND CONST_cnct_flags_parallel_errors) AND FNparallel_error_detect_possible THEN
      PROCprinter_status(prnt%)
    ENDIF
    prnt%=prnt%!CONST_prnt_next
  ENDWHILE
=task_action%

DEF PROCdespatch_null
  LOCAL prnt%,psup%,t%

  /*Delete the pending file, if there is one*/
  IF file_to_delete$<>"" THEN
    SYS "XOS_File",6,file_to_delete$
    file_to_delete$=""
  ENDIF

  /*Pass null events on to all those printers that have asked for them*/
  Ftracef("PROCdespatch_null")
  prnt%=A%!CONST_interface_printer_installed
  WHILE prnt%
    t%=prnt%+CONST_prnt_timeout /*Alias to save typing*/
    IF !t%=0 THEN
      /*This prnt requires nulls*/
      psup%=prnt%!CONST_prnt_psup
      /*Despatch null here*/
      PROCprinter_reason_code(psup%,prnt%,0,0)
      /*Reset timer back to default in psup block*/
      !t%=10*psup%?(CONST_psup_flags+1)
    ENDIF
    prnt%=prnt%!CONST_prnt_next
  ENDWHILE
ENDPROC

DEF FNtask_read_env(n$,buff%)
  LOCAL len%,flags%
  Ftracef("FNtask_read_env("""+n$+""")")
  SYS "XOS_ReadVarVal",n$,buff%,256,,3 TO,,len%;flags%
  IF flags% AND 1 len%=0
  buff%?len%=13
=$buff%

DEF FNtask_compare(a$,b$)
  /*Case-insensitive comparison*/
  LOCAL cmp%
  Ftracef("FNtask_compare")
  SYS "Territory_Collate",-1,a$,b$,%11 TO cmp%
=cmp%

DEF FNtask_lower(s$)
  LOCAL l$,table%,i%
  SYS "Territory_LowerCaseTable",-1 TO table%
  l$=""
  IF 1<=LEN s$ THEN
    FOR i%=1 TO LEN s$
      l$+=CHR$ table%?ASC MID$(s$,i%,i%)
    NEXT
  ENDIF
=l$

DEF FNtask_upper(s$)
  LOCAL u$,table%,i%
  SYS "Territory_UpperCaseTable",-1 TO table%
  u$=""
  IF 1<=LEN s$ THEN
    FOR i%=1 TO LEN s$
      u$+=CHR$ table%?ASC MID$(s$,i%,i%)
    NEXT
  ENDIF
=u$

  /*Error handling routines*/

DEF PROCerror_initialise
  Ftracef("DIM error_buff% 256")
  DIM error_buff% 256
  Ftracef("PROCerror_initialise")
ENDPROC

DEF PROCerror
  LOCAL r$,r%
  Ftracef("PROCerror")
  r$=REPORT$
  #ifdef Trace
    r$=REPORT$+" ("+STR$ ERL+")"
  #else
    #ifdef ReportErrorLineNumber
    r$=REPORT$+" ("+STR$ ERL+")"
    #else
    /*
       remove any part of the error string which may be
       caused by the error coming from a back-end
    */
    r%=INSTR(r$,"in "+CHR$34+"!")
    IF r% r$=LEFT$(r$,r%-1)
    #endif
  #endif
  CASE ERR OF
    WHEN CONST_error_ok
      PROCerror_box(r$,1)
    WHEN CONST_error_fatal
      PROCerror_box(r$,2)
    OTHERWISE
      /* PROCerror_box(FNmsg_3(A%!CONST_interface_host_desc,"ER1",r$,STR$~ERR,STR$ ERL),3) */
      /* PROCerror_box("Unexpected error: "+r$+" (error number &"+STR$~ERR+") at line "+STR$ERL,3) */
      PROCerror_box(r$+" (&"+STR$~ERR+") @"+STR$ERL,3)
  ENDCASE
ENDPROC

DEF PROCerror_box(r$,error_flag%)
  LOCAL r%
  Ftracef("PROCerror_box")
  SYS "Wimp_CreateMenu",,-1
  !error_buff%=ERR
  #ifdef Trace
    $(error_buff%+4)=r$+" ("+STR$ ERL+")"+CHR$ 0
  #else
    $(error_buff%+4)=r$+CHR$ 0
  #endif
  Ftracef("error is '"+r$+" ("+STR$ ERL+")"+"'")
  SYS "Wimp_ReportError",error_buff%,error_flag%,task_id$ TO,r%
  IF r%=2 THEN
    ON ERROR OFF
    shutdown_type%=2
    #ifdef Trace
      PROCheap_dump("$.Heap","")
    #endif
    PROCdestroy_queue
    PROChost_shutdown /*if heap dumping, never gets to here*/
  ENDIF
ENDPROC

DEF PROCerror_warning(r$)
  Ftracef("PROCerror_warning")
  !error_buff%=1
  #ifdef Trace
    $(error_buff%+4)=r$+" ("+STR$ ERL+")"+CHR$ 0
  #else
    $(error_buff%+4)=r$+CHR$ 0
  #endif
  Ftracef("warning is '"+r$+" ("+STR$ ERL+")"+"'")
  SYS "Wimp_ReportError",error_buff%,1 OR 1<<4,FNmsg_1(A%!CONST_interface_host_desc,"ER2",task_id$)
ENDPROC

  /*Heap debugging routines*/

#ifdef Trace
DEF PROCheap_dump(filename$,comment$)
LOCAL c%,free%,hwm%,end%,hpd%,ptr%,nfree%,nused%,tmp%
LOCAL ERROR
ON ERROR LOCAL BPUT#c%,REPORT$:CLOSE#c%:SYS"OS_File",18,filename$,&FFF:ENDPROC
hpd%=A%!CONST_interface_heap_start
c%=OPENUP(filename$)
IFc%=0 THEN
 c%=OPENOUT(filename$)
ELSE
 PTR#c%=EXT#c%
ENDIF
IFcomment$<>"" BPUT#c%,comment$
IFc% THEN
 IF!hpd%<>&70616548 ERROR 1,"No 'Heap' string"
 free%=hpd%+4+hpd%!4
 hwm%=hpd%+hpd%!8
 end%=hpd%+hpd%!12
 IFhwm%>end% ERROR 1,"Heap top > heap end"
 ptr%=hpd%+16
 BPUT#c%,"Describing heap at "+FNheap_hex(hpd%,8)
 BPUT#c%,"Free offset = "+FNheap_hex(hpd%!4,8)
 BPUT#c%," HWM offset = "+FNheap_hex(hpd%!8,8)
 BPUT#c%," END offset = "+FNheap_hex(hpd%!12,8)
 BPUT#c%,""
 REPEAT
  CASE TRUE OF
  WHEN ptr%=hwm%:
   nfree%+=1
   BPUT#c%,"Last block at "+FNheap_hex(ptr%,8)+"; "+FNheap_hex(end%-ptr%,8)+" free"
   ptr%=end%
  WHEN ptr%=free%:
   nfree%+=1
   BPUT#c%,"Free block at "+FNheap_hex(ptr%,8)+"; "+FNheap_hex(!ptr%,8)+" offset; "+FNheap_hex(ptr%!4,8)+" free"
   free%=ptr%+!ptr%
   ptr%+=ptr%!4
  OTHERWISE:
   nused%+=1
   BPUT#c%,"Used block at "+FNheap_hex(ptr%,8)+"; "+FNheap_hex(!ptr%,8)+" offset; "+FNheap_hex(!ptr%,8)+" used, ";
   tmp%=ptr%+4
   BPUT#c%,CHR$(tmp%?0)+CHR$(tmp%?1)+CHR$(tmp%?2)+CHR$(tmp%?3)
   ptr%+=!ptr%
  ENDCASE
  IF (ptr%>end%) OR (ptr%<hpd%+16) ERROR 1,"Link outside heap"
 UNTIL ptr%=end%
 PROCheap_show(c%,"used",nused%)
 PROCheap_show(c%,"free",nfree%)
 CLOSE#c%
 SYS"OS_File",18,filename$,&FFF
ENDIF
ENDPROC

DEF PROCheap_show(c%,n$,d%)
BPUT#c%,"There w";
IFd%=1 BPUT#c%,"as"; ELSE BPUT#c%,"ere";
BPUT#c%," "+STR$(d%)+" "+n$+" block";
IFd%=1 BPUT#c%,"." ELSE BPUT#c%,"s."
ENDPROC

DEF FNheap_hex(A%,B%)
=RIGHT$("00000000"+STR$~(A%),B%)
#endif

  /*Icon handling routines*/

DEF PROCicon_initialise
  Ftracef("PROCicon_initialise")
  icon_priority%=0
  /*B%=CONST_ident_ICON: C%=256: icon_buffer%=USR(code_entry%+CONST_entry_heap_claim): Now DIMMED at startup*/
ENDPROC

DEF FNiconbar_tands(text$,sprite$,side%,nextto%)
  LOCAL t%,s%,i%,v$,w%
  Ftracef("FNiconbar_tands")
  IF quit_immediately% THEN =-1
  IF sprite$="s"+FNmsg_0(A%!CONST_interface_host_desc,"IC") THEN
    v$="s"+sprite$
    SYS "Wimp_SpriteOp",40,,sprite$ TO,,,w%
  ELSE
    SYS "XWimp_SpriteOp",40,,sprite$ TO,,,w%;i%
    IF i% AND 1 THEN
      SYS "Wimp_SpriteOp",40,,"s"+FNmsg_0(A%!CONST_interface_host_desc,"IC") TO,,,w%
#ifdef Sparrow
      /* Dammit */
     IF LEFT$(sprite$, 3) = "su_" THEN
      v$ = "ssu"+FNmsg_0(A%!CONST_interface_host_desc,"IC")
     ELSE
#endif
      v$="ss"+FNmsg_0(A%!CONST_interface_host_desc,"IC")+","+FNmsg_0(A%!CONST_interface_host_desc,"IC")
#ifdef Sparrow
     ENDIF
#endif
    ELSE
#ifdef Sparrow
      /* Dammit */
      IF LEFT$(sprite$, 3) = "su_" THEN
       v$ = "s"+sprite$
      ELSE
#endif
       v$="ss_"+sprite$+","+sprite$
#ifdef Sparrow
      ENDIF
#endif
    ENDIF
  ENDIF
  B%=CONST_ident_IBFF
  C%=LEN text$+1
  t%=USR(code_entry%+CONST_entry_heap_claim)
  IF t%=0 ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","IBFF")
  $t%=text$
  B%=CONST_ident_IBFF
  C%=LEN v$+1
  s%=USR(code_entry%+CONST_entry_heap_claim)
  IF s%=0 ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","IBFF")
  $s%=v$
  SYS "OS_ReadModeVariable",-1,4 TO,,i%
  IF(w%<<i%)<LEN text$*16 w%=LEN text$*16 ELSE w%=w%<<i%
  /*JRC icon_buffer%!0=-6: REM Create on left, scanning from right. JRC 8 Apr '92*/
  icon_buffer%!0=side%
  icon_buffer%!4=0
  icon_buffer%!8=-16
  icon_buffer%!12=w%
  icon_buffer%!16=88
  icon_buffer%!20=&1700310B
    /* = %10111000000000011000100001011
       = 1<<0 OR 1<<1 OR 1<<3 OR 1<<8 OR 3<<12 OR 7<<24 OR 1<<28
       = Wimp_IconText | Wimp_IconSprite | Wimp_IconHCentred |
           Wimp_IconIndirected | Wimp_ButtonClick << Wimp_IconButtonType |
           Wimp_ColourBlack << Wimp_IconFGColour |
           Wimp_ColourVeryLightGrey << Wimp_IconBGColour
    */
    /* was &1700312B
       = %10111000000000011000100101011
       = 1<<0 OR 1<<1 OR 1<<3 OR 1<<5 OR 1<<8 OR 3<<12 OR 7<<24 OR 1<<28
       = Wimp_IconText | Wimp_IconSprite | Wimp_IconHCentred |
           Wimp_IconFilled | Wimp_IconIndirected |
           Wimp_ButtonClick << Wimp_IconButtonType |
           Wimp_ColourBlack << Wimp_IconFGColour |
           Wimp_ColourVeryLightGrey << Wimp_IconBGColour
    */
  icon_buffer%!24=t%
  icon_buffer%!28=s%
  icon_buffer%!32=LEN text$+1
  SYS "Wimp_CreateIcon",nextto%,icon_buffer% TO i%
=i%

DEF PROCicon_delete(a%,b%)
  Ftracef("PROCicon_delete")
  IF b%=-1 THEN ENDPROC
  !icon_buffer%=a%
  icon_buffer%!4=b%
  SYS "Wimp_GetIconState",,icon_buffer%
  SYS "Wimp_DeleteIcon",,icon_buffer%
  IF icon_buffer%!24 AND 1<<8 THEN
    /*some indirected buffers to reclaim*/
    IF icon_buffer%!24 AND 3 THEN
      /*if either text or sprite, there is one buffer to release*/
      B%=CONST_ident_IBFF
      C%=icon_buffer%!28
      CALL code_entry%+CONST_entry_heap_free
      IF icon_buffer%!24 AND 1 THEN
        /*if text, there are two buffers*/
        IF NOT icon_buffer%!32 THEN
          B%=CONST_ident_IBFF
          C%=icon_buffer%!32
          CALL code_entry%+CONST_entry_heap_free
        ENDIF
      ENDIF
    ENDIF
  ENDIF
ENDPROC

DEF PROCicon_write(a%,b%,s$)
  LOCAL h%,i%,n%
  Ftracef("PROCicon_write")
  PROCcaret_info(h%,i%,n%)
  !icon_buffer%=a%
  icon_buffer%!4=b%
  SYS "Wimp_GetIconState",,icon_buffer%
  IF LEN s$+1>icon_buffer%!36 THEN
    ERROR CONST_error_fatal,FNmsg_2(A%!CONST_interface_host_desc,"FAH",s$,STR$ b%)
  ENDIF
  $icon_buffer%!28=s$
  icon_buffer%!8=0
  icon_buffer%!12=0
  SYS "Wimp_SetIconState",,icon_buffer%
  IF h%=a% AND i%=b% PROCcaret_set(a%,b%)
ENDPROC

DEF PROCicon_validation(a%,b%,s$)
  Ftracef("PROCicon_validate")
  !icon_buffer%=a%
  icon_buffer%!4=b%
  SYS "Wimp_GetIconState",,icon_buffer%
  $icon_buffer%!32=s$
  icon_buffer%!8=0
  icon_buffer%!12=0
  SYS "Wimp_SetIconState",,icon_buffer%
ENDPROC

DEF FNicon_read(a%,b%)
  Ftracef("FNicon_read")
  !icon_buffer%=a%
  icon_buffer%!4=b%
  SYS "Wimp_GetIconState",,icon_buffer%
=$icon_buffer%!28

DEF PROCicon_unshade(a%,b%)
  Ftracef("PROCicon_unshade")
  !icon_buffer%=a%
  icon_buffer%!4=b%
  icon_buffer%!8=0
  icon_buffer%!12=1<<22
  SYS "Wimp_SetIconState",,icon_buffer%
ENDPROC

DEF PROCicon_shade(a%,b%)
  Ftracef("PROCicon_shade")
  !icon_buffer%=a%
  icon_buffer%!4=b%
  icon_buffer%!8=1<<22
  icon_buffer%!12=1<<22
  SYS "Wimp_SetIconState",,icon_buffer%
ENDPROC

DEF PROCicon_deselect(a%,b%)
  Ftracef("PROCicon_deselect")
  !icon_buffer%=a%
  icon_buffer%!4=b%
  icon_buffer%!8=0
  icon_buffer%!12=1<<21
  SYS "Wimp_SetIconState",,icon_buffer%
  /*
     Major kludge!
     If you've only got one printer installed, then doing a select all
     only selects one icon, which then causes the selection to be
     cleared by a variety of methods.
     So, the select all code now sets a global flag to true when it
     has done a selection, and this code clears that flag.
  */
  IFa%=prntctrl% select_all%=FALSE
ENDPROC

DEF PROCicon_select(a%,b%)
  Ftracef("PROCicon_select")
  !icon_buffer%=a%
  icon_buffer%!4=b%
  icon_buffer%!8=1<<21
  icon_buffer%!12=1<<21
  SYS "Wimp_SetIconState",,icon_buffer%
  /*
     Major kludge!
     If you've only got one printer installed, then doing a select all
     only selects one icon, which then causes the selection to be
     cleared by a variety of methods.
     So, the select all code now sets a global flag to true when it
     has done a selection, and this code clears that flag.
  */
  IFa%=prntctrl% select_all%=FALSE
ENDPROC

DEF FNicon_set(a%,b%)
  Ftracef("FNicon_set")
  !icon_buffer%=a%
  icon_buffer%!4=b%
  SYS "Wimp_GetIconState",,icon_buffer%
=(icon_buffer%!24 AND 1<<21)<>0

DEF PROCicon_info(a%,b%,RETURN x1%,RETURN y1%,RETURN x2%,RETURN y2%)
  Ftracef("PROCicon_info")
  !icon_buffer%=a%
  icon_buffer%!4=b%
  SYS "Wimp_GetIconState",,icon_buffer%
  x1%=icon_buffer%!8
  y1%=icon_buffer%!12
  x2%=icon_buffer%!16
  y2%=icon_buffer%!20
ENDPROC

DEF PROCcaret_set(h%,i%)
  LOCAL j%
  Ftracef("PROCcaret_set")
  j%=LEN FNicon_read(h%,i%)
  SYS "Wimp_SetCaretPosition",h%,i%,-1,-1,,j%
  SYS "Wimp_SetCaretPosition",h%,i%,-1,-1,-1,j%
ENDPROC

DEF PROCcaret_info(RETURN h%,RETURN i%,RETURN n%)
  Ftracef("PROCcaret_info")
  SYS "Wimp_GetCaretPosition",,icon_buffer%
  h%=!icon_buffer%
  i%=icon_buffer%!4
  n%=icon_buffer%!20
ENDPROC

  /*Window handling routines*/

DEF PROCwin_initialise
  Ftracef("PROCwin_initialise")
  /*Now DIMMED at startup time
    B%=CONST_ident_WIND
    C%=256
    win_buff%=USR(code_entry%+CONST_entry_heap_claim)*/
  win_template$=""
ENDPROC

DEF PROCwin_template_open(f2$,f3$)
  LOCAL a$,a%
  Ftracef("PROCwin_template_open")
  /*
    default is 2D. If allocated CMOS bit is set, use 3D
    unless file isn't available, in which case go back to
    default
  */
  SYS"OS_Byte",161,&8C TO ,,a%
  IF (a%AND1)=1 THEN
    SYS"OS_File",17,f3$ TO a%
    IFa%=1 win_template$=f3$ ELSE win_template$=f2$
  ELSE
   win_template$=f2$
  ENDIF
  SYS"Wimp_OpenTemplate",,win_template$
ENDPROC

DEF PROCwin_template_close
  Ftracef("PROCwin_template_close")
  SYS "Wimp_CloseTemplate"
ENDPROC

DEF PROCwin_load_create(f$,n$,sprite_pool%,RETURN handle%)
  LOCAL buff%
  Ftracef("PROCwin_load_create")
  PROCwin_load(f$,n$,buff%) /*creates a WIND block large enough*/
  buff%!64=sprite_pool%
  PROCwin_create(buff%,handle%)
  B%=CONST_ident_WIND
  C%=buff%
  CALL code_entry%+CONST_entry_heap_free
ENDPROC

DEF PROCwin_load(f$,n$,RETURN buf%)
  /*  f$ - filename of template file
      n$ - name of template to load
    buf% - buffer which needs to be big enough to hold the window definition
           AND the indirected data, due to the way Wimp_LoadTemplate works.

    PROCwin_load will automatically dimension enough memory for
    the indirected data.*/
  LOCAL ws_buf%,size%,data%,found%,s%,f%,s$
  Ftracef("PROCwin_load")
  PROCwin_sizes(f$,n$,size%,data%)
  B%=CONST_ident_WIND
  C%=size%+data%
  buf%=USR(code_entry%+CONST_entry_heap_claim)
  IF buf%=0 \
    ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","WIND")
  IF f$<>"" SYS "Wimp_OpenTemplate",,f$
  IF data% THEN
   B%=CONST_ident_BUFF
   C%=data%
   ws_buf%=USR(code_entry%+CONST_entry_heap_claim)
   IF ws_buf%=0 \
     ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","BUFF")
   SYS "XWimp_LoadTemplate",,buf%,ws_buf%,ws_buf%+data%,-1,n$ TO \
       s%,,,,,,found%;f%
  ELSE
   SYS "XWimp_LoadTemplate",,buf%,,,-1,n$ TO s%,,,,,,found%;f%
  ENDIF
  IF f$<>"" SYS "Wimp_CloseTemplate"
  IF f% AND 1 \
    f%=s%+4: \
    CALL Z%,f%,s$: /*convert 0-terminated string*/ \
    ERROR CONST_error_ok,n$+": "+s$
  IF found%=0 \
    ERROR CONST_error_ok,FNmsg_1(A%!CONST_interface_host_desc,"OKAK",n$)
ENDPROC

DEF PROCwin_create(buf%,RETURN handle%)
  /*   buf% - buffer holding the window definition
    handle% - handle of the created window*/
  Ftracef("PROCwin_create")
  SYS "Wimp_CreateWindow",,buf% TO handle%
ENDPROC

DEF PROCwin_open(a%)
  Ftracef("PROCwin_open")
  !win_buff%=a%
  SYS "Wimp_GetWindowState",,win_buff%
  win_buff%!28=-1
  SYS "Wimp_OpenWindow",,win_buff%
ENDPROC

DEF PROCwin_title(a%,s$)
  LOCAL wox0%,way1%,wox1%,woy1%
  Ftracef("PROCwin_title")
  !win_buff%=a%
  SYS "Wimp_GetWindowInfo",,win_buff% OR 1
  $win_buff%!76=s$
  IF win_buff%!32 AND 1<<16 THEN
    way1%=win_buff%!16
    SYS "Wimp_GetWindowOutline",,win_buff%
    wox0%=win_buff%!4
    wox1%=win_buff%!12
    woy1%=win_buff%!16
    SYS "Wimp_ForceRedraw",-1,wox0%,way1%,wox1%,woy1%
  ENDIF
ENDPROC

DEF PROCwin_get_next_name(file$,RETURN ptr%,RETURN name$)
  LOCAL f%,offset%,type%
  Ftracef("PROCwin_get_next_name")
  IF f$="" AND wimp_version%>=300 THEN
    /*Ask the WIMP to look in the currently open template*/
    SYS "Wimp_LoadTemplate",,,,,-1,"*"+STRING$(12,CHR$ 0),ptr% TO\
        ,,,,,name$,ptr%
    #ifdef Trace
      IF ptr% PROCftracef("Found template """+name$+"""")
    #endif
  ELSE
    /*Look in the file*/
    IF file$="" file$=win_template$
    f%=OPENIN file$
    IF ptr%=0 ptr%=16
    REPEAT
      PTR#f%=ptr%
      offset%=FNwin_word(f%)
      IF offset% THEN
        PTR#f%=ptr%+8
        type%=FNwin_word(f%)
        name$=FNwin_string(f%)
        ptr%+=24
        IF type%=1 offset%=0
      ELSE
        ptr%=0
      ENDIF
    UNTIL offset%=0
    SYS "XOS_Find",,f% /*Close*/
  ENDIF
ENDPROC

  /*It is not advisable for you to use any of the following routines.
    They exist to do something for the rest of the templates library.*/

DEF PROCwin_sizes(f$,n$,RETURN size%,RETURN data%)
  LOCAL i%,file%,ptr%,offset%,type%,ident$,num_icons%
  Ftracef("PROCwin_sizes")
  IF f$="" AND wimp_version%>=300 THEN
    /*Ask the WIMP to look in the currently open template*/
    SYS "Wimp_LoadTemplate",,,,,-1,n$ TO,size%,data%
    Ftracef("Sizes of "+n$+" are "+STR$ size%+", "+STR$ data%+" (the easy way)")
  ELSE
    /*We must look in the file - yuck*/
    IF f$="" f$=win_template$
    file%=OPENIN f$
    size%=0
    data%=0
    ptr%=16
    REPEAT
      PTR#file%=ptr%
      offset%=FNwin_word(file%)
      IF offset% THEN
        PTR#file%=ptr%+8
        type%=FNwin_word(file%)
        ident$=FNwin_string(file%)
        ptr%+=24
        IF type%=1 THEN
          IF ident$=n$ THEN
            PTR#file%=offset%+84
            num_icons%=FNwin_word(file%)
            data%=FNwin_title(file%,offset%)
            IF num_icons% data%+=FNwin_icon(file%,num_icons%,offset%)
            size%=88+(num_icons%*32)
            offset%=0 /*just to get out of the loop*/
          ENDIF
        ENDIF
      ENDIF
    UNTIL offset%=0
    SYS "XOS_Find",,file% /*Close*/
    Ftracef("Sizes of "+n$+" are "+STR$ size%+STR$ data%+" (the hard way)")
  ENDIF
ENDPROC

DEF FNwin_word(h%)
  Ftracef("FNwin_word")
=BGET#h% OR BGET#h%<<8 OR BGET#h%<<16 OR BGET#h%<<24

DEF FNwin_string(h%)
  LOCAL s$,c%
  Ftracef("FNwin_string")
  REPEAT
   c%=BGET#h%
   IF c%>31 s$+=CHR$ c%
  UNTIL c%<32
=s$

DEF FNwin_title(file%,offset%)
  LOCAL v%
  Ftracef("FNwin_title")
  PTR#file%=offset%+28
  v%=FNwin_word(file%)
  IF v% AND 1<<31 THEN
    IF v% AND 1<<26 THEN =FNwin_isd(file%,offset%+56,offset%+72,offset%)
  ELSE
    IF v% AND 1 THEN =FNwin_isd(file%,offset%+56,offset%+72,offset%)
  ENDIF
=0

DEF FNwin_icon(file%,num%,offset%)
  LOCAL i%,j%
  Ftracef("FNwin_icon")
  j%=0
  IF 0<=num%-1 THEN
    FOR i%=0 TO num%-1
     j%+=FNwin_isd(file%,offset%+88+i%*32+16,offset%+88+i%*32+20,offset%)
    NEXT
  ENDIF
=j%

DEF FNwin_isd(file%,o1%,o2%,offset%)
  LOCAL v%,ist%,size%,i%
  Ftracef("FNwin_isd")
  PTR#file%=o1%
  v%=FNwin_word(file%)
  /*even if an icon is marked as deleted
    it must be allowed for!*/
  i%=v% AND %100000000
  ist%=(v% AND 3)+(i% >> 6)
  CASE ist% OF
   WHEN 0,1,2,3,4
    size%=0
   WHEN 5,7
    PTR#file%=o2%+4
    v%=FNwin_word(file%)
    IF v%=-1 THEN
      size%=0
    ELSE
      PTR#file%=offset%+v%
      size%=LEN FNwin_string(file%)+1
    ENDIF
    PTR#file%=o2%+8
    size%+=FNwin_word(file%)
   WHEN 6
    PTR#file%=o2%+8
    size%=FNwin_word(file%)
  ENDCASE
=size%

  /*Save handling code*/

DEF PROCsave_initialise
  LOCAL f%
  Ftracef("PROCsave_initialise")
  SYS "XOS_SWINumberFromString",,"DragASprite_Start" TO save_start%;f%
  IF f% AND 1 save_start%=-1
  SYS "XOS_SWINumberFromString",,"DragASprite_Stop" TO save_stop%;f%
  IF f% AND 1 save_stop%=-1
  SYS "OS_Byte",161,&1C TO,,f%
  IF(f% AND 2)=0 THEN
   /*CMOS has turned DragASprite off*/
   save_start%=-1
   save_stop%=-1
  ENDIF
  B%=CONST_ident_SAVE
  C%=256
  save_buff%=USR(code_entry%+CONST_entry_heap_claim)
  IF save_buff%=0 ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","SAVE")
  save_dragging%=FALSE
ENDPROC

DEF PROCsave_setup(filetype%,icon_name$)
  LOCAL b$
  Ftracef("PROCsave_setup")
  b$=STR$~filetype%
  b$=RIGHT$("000"+b$,3)
  save_filetype%=filetype%
  PROCicon_validation(save_wind%,CONST_save_ic,"sfile_"+b$)
  PROCicon_write(save_wind%,CONST_save_nm,icon_name$)
ENDPROC

DEF PROCsave_dragicon(mousex%,mousey%)
  LOCAL bx%,by%,ix0%,ix1%,iy0%,iy1%,scrx%,scry%,f$,mc_sw%,mc_dx%,mc_sh%,mc_dy%
  Ftracef("PROCsave_dragicon")
  !save_buff%=save_wind%
  SYS "Wimp_GetWindowState",,save_buff%
  bx%=save_buff%!4 - save_buff%!20
  by%=save_buff%!16 - save_buff%!24
  PROCicon_info(save_wind%,CONST_save_ic,ix0%,iy0%,ix1%,iy1%)
  SYS "OS_ReadModeVariable",-1,4 TO,,mc_dx%
  mc_dx%=1<<mc_dx%
  SYS "OS_ReadModeVariable",-1,5 TO,,mc_dy%
  mc_dy%=1<<mc_dy%
  SYS "OS_ReadModeVariable",-1,11 TO,,mc_sw%
  mc_sw%+=1
  SYS "OS_ReadModeVariable",-1,12 TO,,mc_sh%
  mc_sh%+=1
  scrx%=mc_sw%*mc_dx%
  scry%=mc_sh%*mc_dy%
  !save_buff%=save_wind%
  save_buff%!4=5
  save_buff%!8=bx%+ix0%
  save_buff%!12=by%+iy0%
  save_buff%!16=bx%+ix1%
  save_buff%!20=by%+iy1%
  save_buff%!24=save_buff%!8-mousex%
  save_buff%!28=save_buff%!12-mousey%
  save_buff%!32=scrx%+save_buff%!16-mousex%
  save_buff%!36=scry%+save_buff%!20-mousey%
  IF NOT save_start% THEN
   f$="file_"+RIGHT$("000"+STR$~save_filetype%,3)
   SYS save_start%,%11000101,1,f$,save_buff%+8,save_buff%+24
  ELSE
   SYS "Wimp_DragBox",,save_buff%
  ENDIF
  save_dragging%=TRUE
ENDPROC

DEF PROCsave_decodedrag
  LOCAL h%,i%,mx%,my%,ft%
  Ftracef("PROCsave_decodedrag")
  save_dragging%=FALSE
  IF NOT save_stop% SYS save_stop%
  SYS "Wimp_GetPointerInfo",,save_buff%
  mx%=!save_buff%
  my%=save_buff%!4
  h%=save_buff%!12
  i%=save_buff%!16
  IF h%=save_wind% ENDPROC /*dropped on myself!*/
  PROCsave_dragfile(h%,i%,mx%,my%)
ENDPROC

DEF PROCsave_dragfile(h%,i%,mx%,my%)
  LOCAL f1$
  Ftracef("PROCsave_dragfile")
  f1$=FNsave_leafname
  !save_buff%=48+LEN f1$ AND NOT 3
  save_buff%!12=0
  save_buff%!16=1 /*DataSave*/
  save_buff%!20=h%
  save_buff%!24=i%
  save_buff%!28=mx%
  save_buff%!32=my%
  save_buff%!36=0
  save_buff%!40=save_filetype%
  $(save_buff%+44)=f1$+CHR$ 0
  SYS "Wimp_SendMessage",17,save_buff%,h%,i%
  Ftrace_Send(17,save_buff%,-1)
ENDPROC

DEF FNsave_leafname
  LOCAL f$,i%
  Ftracef("FNsave_leafname")
  f$=FNicon_read(save_wind%,CONST_save_nm)
  REPEAT
   i%=INSTR(f$,":")
   IF i% f$=MID$(f$,i%+1)
  UNTIL i%=0
  REPEAT
   i%=INSTR(f$,".")
   IF i% f$=MID$(f$,i%+1)
  UNTIL i%=0
=f$

  /*Menu handling code*/

DEF PROCmenu_initialise
  Ftracef("PROCmenu_initialise")
  menu_top%=0
  menu_count%=0
ENDPROC

DEF PROCmenu_create(RETURN menu%,menu$)
  LOCAL menutitle$,i%,menu1$,item$,j%,x%,t%
  Ftracef("PROCmenu_create")
  IF menu_top% THEN
    PROCmenu_release
    menu_top%=0
    menu_count%=0
  ENDIF
  IF LEFT$(menu$,1)="#" THEN
    i%=1
    menutitle$=FNmenu_par(menu$,",",i%)
  ELSE
    menutitle$=""
  ENDIF
  #ifdef Trace
    menutitle$="Tracing "+menutitle$
    PROCftracef("creating menu "+menutitle$)
  #endif
  menu1$=menu$
  j%=i%
  REPEAT
    item$=FNmenu_par(menu$,",",i%)
    IF item$<>"" menu_count%+=1
  UNTIL item$=""
  menu$=menu1$
  i%=j%
  B%=CONST_ident_MENU
  C%=28+menu_count%*24
  menu_top%=USR(code_entry%+CONST_entry_heap_claim)
  IF menu_top%=0 \
    ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","MENU")
  IF LEN menutitle$<=12 THEN
    Ftracef("menu title is here and now")
    $menu_top%=menutitle$
  ELSE
    Ftracef("menu title is indirected")
    B%=CONST_ident_MENU
    C%=LEN menutitle$+2
    t%=USR(code_entry%+CONST_entry_heap_claim)
    IF t%=0 \
      ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","MENU")
    $t%=menutitle$+CHR$ 0
    menu_top%!0=t%
  ENDIF
  menu_top%?12=7
  menu_top%?13=2
  menu_top%?14=7
  menu_top%?15=0
  menu_top%!16=196
  menu_top%!20=44
  menu_top%!24=0
  x%=LEN menutitle$-3
  menu_top%!16=(x%*8+6)*2
  #ifdef Trace
    IF menu_count%<0 ERROR CONST_error_fatal,"Assertion failure"
  #endif
  FOR j%=0 TO menu_count%-1
    item$=FNmenu_par(menu$,",",i%)
    Ftracef("adding item "+item$)
    PROCmenu_item(menu_top%,j%,item$,LEN menutitle$>12)
  NEXT
  menu%=menu_top%
  Ftracef("PROCmenu_create done")
ENDPROC

DEF PROCmenu_release
  LOCAL i%,p%,indirected_title%
  Ftracef("PROCmenu_release")
  p%=menu_top%+28
  indirected_title%=p%!0 AND &100
  IF 0<=menu_count%-1 THEN
    FOR i%=0 TO menu_count%-1
      IF p%!8 AND &100 THEN
        /*OK, we've got an indirected option
          is it writable?*/
        IF(!p% AND 4)=0 THEN
          /*no, so it must just be an option*/
          B%=CONST_ident_MENU
          C%=p%!12
          CALL code_entry%+CONST_entry_heap_free
        ENDIF
      ENDIF
      p%+=24
    NEXT
  ENDIF

  IF indirected_title% THEN
    Ftracef("releasing "+$menu_top%!0+" (title is indirected)")
    B%=CONST_ident_MENU
    C%=menu_top%!0
    CALL code_entry%+CONST_entry_heap_free
  ENDIF
  #ifdef Trace
    IF indirected_title%=0 \
      menu_top%?12=13: \
      PROCftracef("releasing "+$menu_top%+" (title is not indirected)")
  #endif

  B%=CONST_ident_MENU
  C%=menu_top%
  CALL code_entry%+CONST_entry_heap_free
  Ftracef("PROCmenu_release done")
ENDPROC

DEF PROCmenu_item(RETURN menu%,item%,item$,indirected_title%)
  LOCAL F%,p%,i%,x%,m%
  Ftracef("PROCmenu_item")
  x%=(menu%!16/2-6)/8
  IF RIGHT$(item$,1)="#" THEN
    item$=LEFT$(item$)
    F%=F% OR 2 /*dotted line*/
  ENDIF
  IF RIGHT$(item$,1)="@" THEN
    item$=LEFT$(item$)
    F%=F% OR 8 /*menu warning*/
  ENDIF
  IF item%>=menu_count% THEN
    /*extend the menu block by enough bytes*/
    B%=CONST_ident_MENU
    C%=menu_top%
    D%=(item%-menu_count%+1)*24
    m%=USR(code_entry%+CONST_entry_heap_extend)
    IF m%=0 \
      ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","MENU")
    menu_top%=m%
    p%=menu_top%+28+(menu_count%-1)*24
    !p%=!p% AND NOT &80 /*cancel the last item flag*/
    menu_count%=item%+1
  ENDIF
  IF item%=menu_count%-1 F%=F% OR &80 /*last item*/
  IF item%=0 AND indirected_title% F%=F% OR &100 /*indirected title    */
  p%=menu_top%+28+item%*24
  p%!0=F%
  p%!4=-1
  p%!8=&07000021
  IF LEFT$(item$,1)="$" THEN
    !p%+=4
    item$=STRING$(12," ")
  ELSE
    IF LEN item$<12 THEN
      $(p%+12)=item$
    ELSE
      B%=CONST_ident_MENU
      C%=LEN item$+1
      i%=USR(code_entry%+CONST_entry_heap_claim)
      IF i%=0 \
        ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","MENU")
      $i%=item$
      p%!8=p%!8 OR &100
      p%!12=i%
      p%!16=-1
      p%!20=LEN item$+1
    ENDIF
  ENDIF
  menu%=menu_top%
  IF LEN item$>x% THEN
    x%=LEN item$
    menu%!16=(x%*8+6)*2
  ENDIF
ENDPROC

DEF PROCmenu_attach(menu%,item%,ptr%,traverse%)
  Ftracef("PROCmenu_attach")
  menu%+=28+item%*24
  IF traverse% THEN !menu%=!menu% OR 1<<4
  menu%!4=ptr%
ENDPROC

DEF FNmenu_par(menu$,sep$,RETURN I%)
  LOCAL L%
  Ftracef("FNmenu_par")
  L%=I%+1
  I%=INSTR(menu$+sep$,sep$,L%)
=MID$(menu$,L%,I%-L%)

DEF PROCmenu_shade(menuhandle%,item%,value%)
  Ftracef("PROCmenu_shade")
  IF((menuhandle%!(28+8+24*item%)AND &400000)=&400000)<>value% THEN
   menuhandle%!(28+8+24*item%)=menuhandle%!(28+8+24*item%)EOR &400000
  ENDIF
ENDPROC

DEF FNmenu_shade(menuhandle%,item%)
  Ftracef("FNmenu_shade")
=((menuhandle%!(28+8+24*item%)AND &400000)=&400000)

DEF PROCmenu_tick_match(menuhandle%,match$)
  LOCAL item%,string$
  Ftracef("PROCmenu_tick_match")
  item%=menuhandle%+28
  REPEAT
   IF item%!8 AND &100 string$=$item%!12 ELSE string$=$(item%+12)
   IF FNtask_compare(string$,match$)=0 THEN
    !item%=!item% EOR 1
    ENDPROC
   ENDIF
   IF !item% AND &80 ENDPROC
   item%+=24
  UNTIL FALSE
ENDPROC

DEF PROCmenu_tick(menuhandle%,item%,on%)
  IF on% \
    menuhandle%!(28+24*item%)=menuhandle%!(28+24*item%) OR 1 \
  ELSE \
    menuhandle%!(28+24*item%)=menuhandle%!(28+24*item%) AND NOT 1
ENDPROC

DEF PROCmenu_window_centre(h%)
  LOCAL x%,y%,mc_sw%,mc_dx%,mc_sh%,mc_dy%
  Ftracef("PROCmenu_window_centre")
  SYS "OS_ReadModeVariable",-1,4 TO,,mc_dx%
  mc_dx%=1<<mc_dx%
  SYS "OS_ReadModeVariable",-1,5 TO,,mc_dy%
  mc_dy%=1<<mc_dy%
  SYS "OS_ReadModeVariable",-1,11 TO,,mc_sw%
  mc_sw%+=1
  SYS "OS_ReadModeVariable",-1,12 TO,,mc_sh%
  mc_sh%+=1
  !task_buff%=h%
  SYS "Wimp_GetWindowState",,task_buff%
  x%=mc_sw%*mc_dx%
  y%=mc_sh%*mc_dy%
  x%=(x%-task_buff%!12+task_buff%!4)DIV 2
  y%=(y%+task_buff%!16-task_buff%!8)DIV 2
  SYS "Wimp_CreateMenu",,h%,x%,y%
ENDPROC

  /* SMC: locale specific code */

DEF PROClocale_initialise
  LOCAL p%
  SYS "Territory_ReadSymbols",-1,0 TO p%
  CALL Z%,p%,decimal_point$
ENDPROC

DEF FNlocale_val(n$)
  IF decimal_point$="." : =VALn$
  LOCAL i%
  i%=INSTR(n$,decimal_point$)
  IF i%<>0 : =VAL(LEFT$(n$,i%-1)+"."+MID$(n$,i%+1))
=VALn$

  /*page size handling code*/

DEF PROCopen_papersize_window(a%)
  LOCAL i%
  Ftracef("PROCopen_papersize_window")
  B%=CONST_ident_PSZE
  C%=CONST_psze_MAX
  psize_edit%=USR(code_entry%+CONST_entry_heap_claim)
  IF psize_edit%=0 ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","PSZE")

  IF a% THEN
    /* we've got a 'live' printer. Show the paper size for that printer */
    a%=a%!CONST_prnt_psze
    IF CONST_psze_next < CONST_psze_flag THEN
      FOR i%=CONST_psze_next TO CONST_psze_flag STEP 4
        psize_edit%!i%=a%!i%
      NEXT
    ENDIF
  ELSE
    IF CONST_psze_next<=CONST_psze_flag THEN
      FOR i%=CONST_psze_next TO CONST_psze_flag STEP 4
        psize_edit%!i%=0
      NEXT
    ENDIF
  ENDIF
  PROCinitialise_papersize_window
  PROCtell_pinboard(papersize%)
  PROCwin_open(papersize%)
  PROCcaret_set(papersize%,CONST_paper_name)
ENDPROC

DEF PROCinitialise_papersize_window
  LOCAL h%,i%,n%
  Ftracef("PROCinitialise_papersize_window")
  PROCcaret_info(h%,i%,n%)
  PROCset_string(papersize%,CONST_paper_name,psize_edit%,CONST_psze_name)
  PROCreset_papertext(CONST_paper_ttop,CONST_psze_ttop)
  PROCreset_papertext(CONST_paper_tbottom,CONST_psze_tbottom)
  PROCreset_papertext(CONST_paper_tleft,CONST_psze_tleft)
  PROCreset_papertext(CONST_paper_tright,CONST_psze_tright)
  PROCreset_papertext(CONST_paper_theight,CONST_psze_theight)
  PROCreview_papersize_units
  /* PJC. If this is not a user defined size, it can't be deleted */
  IF psize_edit%!CONST_psze_flag=CONST_psze_flag_userdefined THEN
    PROCicon_unshade(papersize%,CONST_paper_delete)
  ELSE
    PROCicon_shade(papersize%,CONST_paper_delete)
  ENDIF
ENDPROC

DEF PROCreview_papersize_units
  LOCAL s$
  Ftracef("PROCreview_papersize_units")

  /* ensure that one of the options is selected! */
  IF NOTFNicon_set(papersize%,CONST_paper_mm) AND NOTFNicon_set(papersize%,CONST_paper_in) THEN
    PROCicon_select(papersize%,CONST_paper_mm)
  ENDIF

  IF FNicon_set(papersize%,CONST_paper_mm)THEN
   s$=FNmsg_0(A%!CONST_interface_host_desc,"mm")
  ELSE
   s$=FNmsg_0(A%!CONST_interface_host_desc,"in")
  ENDIF
  PROCicon_write(papersize%,CONST_paper_units1,s$)
  PROCicon_write(papersize%,CONST_paper_units2,s$)
  PROCicon_write(papersize%,CONST_paper_units3,s$)
  PROCicon_write(papersize%,CONST_paper_units4,s$)
  PROCicon_write(papersize%,CONST_paper_units5,s$)
  PROCicon_write(papersize%,CONST_paper_units6,s$)
  PROCreset_papersize(CONST_paper_width,CONST_psze_pwidth)
  PROCreset_papersize(CONST_paper_height,CONST_psze_pheight)
  PROCreset_papersize(CONST_paper_gtop,CONST_psze_tmargin)
  PROCreset_papersize(CONST_paper_gbottom,CONST_psze_bmargin)
  PROCreset_papersize(CONST_paper_gleft,CONST_psze_lmargin)
  PROCreset_papersize(CONST_paper_gright,CONST_psze_rmargin)
ENDPROC

DEF PROCreset_papertext(icon%,offset%)
  Ftracef("PROCreset_papertext")
  PROCicon_write(papersize%,icon%,STR$ psize_edit%!offset%)
ENDPROC

DEF PROCreset_papersize(icon%,offset%)
  LOCAL v%
  Ftracef("PROCreset_papersize")
  v%=psize_edit%!offset%
  CASE icon% OF
    WHEN CONST_paper_gtop
      v%=psize_edit%!CONST_psze_pheight-v%
    WHEN CONST_paper_gright
      v%=psize_edit%!CONST_psze_pwidth-v%
  ENDCASE
  PROCicon_write(papersize%,icon%,FNmills(v%))
ENDPROC

DEF FNmills(v%)
  LOCAL @%
  Ftracef("FNmills")
  IF FNicon_set(papersize%,CONST_paper_mm)THEN
   @%="+F10"+decimal_point$+"1"
   =STR$(v%/mm_to_72000)
  ELSE
   @%="+F10"+decimal_point$+"3"
   =STR$(v%/in_to_72000)
  ENDIF

DEF PROCread_paper_file(f$,flag%)
  LOCAL ts%,psize%,head%,last%,t$
  Ftracef("PROCread_paper_file")
  IF FNload_file(f$)THEN
   REPEAT
    ts%=FNmatch_line("pn:")
    IF ts% THEN
     t$=FNload_paper_size(psize%,$ts%)
     IF t$<>"" PROCpaper_error(f$,t$)
     psize%!CONST_psze_flag=flag%
     head%=psize_head%
     last%=0
     WHILE head%>0
      IF $psize%!CONST_psze_name=$head%!CONST_psze_name THEN
       /*
          we have found an existing definition with the same name.
          if the found one is NOT user defined, replace it with
          the new definition.
        */
       IF head%!CONST_psze_flag = CONST_psze_flag_candelete THEN
         psize%!CONST_psze_next=head%!CONST_psze_next
         PROCfree_structure(head%!CONST_psze_name)
         B%=CONST_ident_PSZE
         C%=head%
         CALL code_entry%+CONST_entry_heap_free
         head%=-1
       ELSE
         /* free up the now-redundant PSZE block */
         B%=CONST_ident_PSZE
         C%=psize%
         CALL code_entry%+CONST_entry_heap_free
         psize%=0
         head%=-1
       ENDIF
      ELSE
       IF $psize%!CONST_psze_name<$head%!CONST_psze_name THEN
        /*psize fits in before head*/
        psize%!CONST_psze_next=head%
        head%=-1
       ELSE
        last%=head%
        head%=head%!CONST_psze_next
       ENDIF
      ENDIF
     ENDWHILE
     IF psize% THEN
       /*
         when we get to here, no matter what,
         all we have to do is slot psize% into
         last%
       */
       IF last% last%!CONST_psze_next=psize% ELSE psize_head%=psize%
     ENDIF
    ENDIF
   UNTIL ts%=0 /* PJC: was !data_ptr%>=data_size% */
   PROCrelease_file
  ENDIF
ENDPROC

DEF PROCpaper_error(f$,t$)
  Ftracef("PROCpaper_error")
  PROCram_file_error(FNmsg_2(A%!CONST_interface_host_desc,"OKO",f$,t$))
ENDPROC

DEF FNload_paper_size(RETURN psize%,name$)
  LOCAL t$
  Ftracef("FNload_paper_size")
  B%=CONST_ident_PSZE
  C%=CONST_psze_MAX
  psize%=USR(code_entry%+CONST_entry_heap_claim)
  IF psize%=0 ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","PSZE")
  psize%!CONST_psze_next=0
  $task_buff%=name$
  B%=task_buff%
  C%=2
  psize%!CONST_psze_name=USR(code_entry%+CONST_entry_store_string)
  ts%=FNmatch_line("pw:")
  IF ts% psize%!CONST_psze_pwidth=VAL $ts% ELSE ="pw:"
  ts%=FNmatch_line("ph:")
  IF ts% psize%!CONST_psze_pheight=VAL $ts% ELSE ="ph:"
  ts%=FNmatch_line("pb:")
  IF ts% psize%!CONST_psze_bmargin=VAL $ts% ELSE ="pb:"
  ts%=FNmatch_line("pt:")
  IF ts% psize%!CONST_psze_tmargin=VAL $ts% ELSE ="pt:"
  ts%=FNmatch_line("pl:")
  IF ts% psize%!CONST_psze_lmargin=VAL $ts% ELSE ="pl:"
  ts%=FNmatch_line("pr:")
  IF ts% psize%!CONST_psze_rmargin=VAL $ts% ELSE ="pr:"
  ts%=FNmatch_line("tb:")
  IF ts% psize%!CONST_psze_tbottom=VAL $ts% ELSE ="tb:"
  ts%=FNmatch_line("tt:")
  IF ts% psize%!CONST_psze_ttop=VAL $ts% ELSE ="tt:"
  ts%=FNmatch_line("tl:")
  IF ts% psize%!CONST_psze_tleft=VAL $ts% ELSE ="tl:"
  ts%=FNmatch_line("tr:")
  IF ts% psize%!CONST_psze_tright=VAL $ts% ELSE ="tr:"
  ts%=FNmatch_line("th:")
  IF ts% psize%!CONST_psze_theight=VAL $ts% ELSE ="th:"
=""

DEF PROCsave_paper_size(c%,ptr%)
  Ftracef("PROCsave_paper_size")
  BPUT#c%,"pn: "+$ptr%!CONST_psze_name
  BPUT#c%,"pw: "+STR$ ptr%!CONST_psze_pwidth
  BPUT#c%,"ph: "+STR$ ptr%!CONST_psze_pheight
  BPUT#c%,"pb: "+STR$ ptr%!CONST_psze_bmargin
  BPUT#c%,"pt: "+STR$ ptr%!CONST_psze_tmargin
  BPUT#c%,"pl: "+STR$ ptr%!CONST_psze_lmargin
  BPUT#c%,"pr: "+STR$ ptr%!CONST_psze_rmargin
  BPUT#c%,"tb: "+STR$ ptr%!CONST_psze_tbottom
  BPUT#c%,"tt: "+STR$ ptr%!CONST_psze_ttop
  BPUT#c%,"tl: "+STR$ ptr%!CONST_psze_tleft
  BPUT#c%,"tr: "+STR$ ptr%!CONST_psze_tright
  BPUT#c%,"th: "+STR$ ptr%!CONST_psze_theight
ENDPROC

DEF PROCsave_papersize
  LOCAL psize%,s$,this_psize%,head%,last%,c%,prnt%
  LOCAL width, height, left, right, top, bottom
  Ftracef("PROCsave_papersize")

  /* validate some values */
  /* SMC: we now use FNlocale_val instead of VAL as decimal point character may not be "." */
  width = FNlocale_val(FNicon_read(papersize%, CONST_paper_width))
  height = FNlocale_val(FNicon_read(papersize%, CONST_paper_height))
  left = FNlocale_val(FNicon_read(papersize%, CONST_paper_gleft))
  right = FNlocale_val(FNicon_read(papersize%, CONST_paper_gright))
  top = FNlocale_val(FNicon_read(papersize%, CONST_paper_gtop))
  bottom = FNlocale_val(FNicon_read(papersize%, CONST_paper_gbottom))

  s$=FNicon_read(papersize%,CONST_paper_name)
  IF s$="" ERROR CONST_error_ok,FNmsg_0(A%!CONST_interface_host_desc,"OKAD")

  /* SMC: we now use FNlocale_val instead of VAL as decimal point character may not be "." */
  IF FNlocale_val(FNicon_read(papersize%,CONST_paper_width))=0 ERROR CONST_error_ok,FNmsg_0(A%!CONST_interface_host_desc,"OKAE")
  IF FNlocale_val(FNicon_read(papersize%,CONST_paper_height))=0 ERROR CONST_error_ok,FNmsg_0(A%!CONST_interface_host_desc,"OKAE")

  IF (top+bottom > height) ERROR CONST_error_ok, \
    FNmsg_1(A%!CONST_interface_host_desc,"OKAY",FNmsg_0(A%!CONST_interface_host_desc,"OKAZ"))

  IF (left+right > width) ERROR CONST_error_ok, \
    FNmsg_1(A%!CONST_interface_host_desc,"OKAY",FNmsg_0(A%!CONST_interface_host_desc,"OKBA"))

  /*try to find a paper entry with a matching name*/
  SYS "Hourglass_On"
  psize%=psize_head%
  WHILE psize%
   IF $psize%!CONST_psze_name=s$ THEN
    /*matched - remember it*/
    this_psize%=psize%
    psize%=0
   ELSE
    psize%=psize%!CONST_psze_next
   ENDIF
  ENDWHILE

  IFthis_psize% \
    IFthis_psize%!CONST_psze_flag=CONST_psze_flag_cannotdelete \
      ERROR CONST_error_ok,FNmsg_0(A%!CONST_interface_host_desc,"OKAX")

  IF this_psize%=0 THEN
   /*no match - claim a new block*/
   B%=CONST_ident_PSZE
   C%=CONST_psze_MAX
   this_psize%=USR(code_entry%+CONST_entry_heap_claim)
   IF this_psize%=0 ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","PSZE")
   this_psize%!CONST_psze_next=0
   $task_buff%=s$
   B%=task_buff%
   C%=2
   this_psize%!CONST_psze_name=USR(code_entry%+CONST_entry_store_string)
   /*now link it into alphabetical order*/
   head%=psize_head%
   last%=0
   WHILE head%>0
    IF $this_psize%!CONST_psze_name<$head%!CONST_psze_name THEN
     /*psize fits in before head*/
     this_psize%!CONST_psze_next=head%
     head%=-1
    ELSE
     last%=head%
     head%=head%!CONST_psze_next
    ENDIF
   ENDWHILE
   IF last% last%!CONST_psze_next=this_psize% ELSE psize_head%=this_psize%
  ENDIF
  /*now get the values from the window*/
  PROCsave_value(CONST_paper_width,this_psize%,CONST_psze_pwidth,TRUE,saveit%)
  PROCsave_value(CONST_paper_height,this_psize%,CONST_psze_pheight,TRUE,saveit%)
  PROCsave_value(CONST_paper_gbottom,this_psize%,CONST_psze_bmargin,TRUE,saveit%)
  PROCsave_value(CONST_paper_gtop,this_psize%,CONST_psze_tmargin,TRUE,saveit%)
  PROCsave_value(CONST_paper_gleft,this_psize%,CONST_psze_lmargin,TRUE,saveit%)
  PROCsave_value(CONST_paper_gright,this_psize%,CONST_psze_rmargin,TRUE,saveit%)
  PROCsave_value(CONST_paper_tbottom,this_psize%,CONST_psze_tbottom,FALSE,saveit%)
  PROCsave_value(CONST_paper_ttop,this_psize%,CONST_psze_ttop,FALSE,saveit%)
  PROCsave_value(CONST_paper_tleft,this_psize%,CONST_psze_tleft,FALSE,saveit%)
  PROCsave_value(CONST_paper_tright,this_psize%,CONST_psze_tright,FALSE,saveit%)
  PROCsave_value(CONST_paper_theight,this_psize%,CONST_psze_theight,FALSE,saveit%)
  this_psize%!CONST_psze_flag=CONST_psze_flag_userdefined
  PROCsave_user_defined_paper_sizes
  /*are there any printers using this size?*/
  prnt%=A%!CONST_interface_printer_installed
  WHILE prnt%
   IF prnt%!CONST_prnt_psze=this_psize% THEN
    /*ensure the system knows!*/
    IF prnt%!CONST_prnt_flags AND CONST_prnt_flags_selected THEN
     PROCdo_select_printer(prnt%,TRUE,FALSE,FALSE)
     PROCset_page_size(prnt%)
     PROCtell_the_world
    ENDIF
   ENDIF
   prnt%=prnt%!CONST_prnt_next
  ENDWHILE
  SYS "Hourglass_Off"
ENDPROC

DEF PROCsave_user_defined_paper_sizes
  Ftracef("PROCsave_user_defined_paper_sizes")
  LOCAL c%,psize%,count%,s$,r0%
#ifdef Sparrow
  IF multiple_choices% THEN
    s$ = PrintersChoicesWriteDir+".Remote.ID"+unique_string$+".PaperRW"
  ELSE
#endif
    s$ = PrintersChoicesWriteDir+".PaperRW"
#ifdef Sparrow
  ENDIF
#endif

  /* see if the file exists */
  SYS "XOS_File",17,s$ TO r0%;f%
  IF(f%AND1) !r0%=CONST_error_ok:SYS"OS_GenerateError",r0%
  /* if it doesn't, create it */
  IF(r0%=0) THEN
    SYS "XOS_File",11,s$,&FC6,,0,0 TO r0%;f%
    IF(f%AND1) PROCerror_warning(FNmsg_0(A%!CONST_interface_host_desc,"WA14")):ENDPROC
  ELSE
    /* if it does exist, set the access rights on it */
    /* do it twice to try and provoke an error on a protected disc */
    SYS "XOS_File",4,s$,,,,0 TO r0%;f%
    IF(f%AND1)=0 SYS "XOS_File",4,s$,,,,3 TO r0%;f%
    IF(f%AND1) PROCerror_warning(FNmsg_0(A%!CONST_interface_host_desc,"WA14")):ENDPROC
  ENDIF

  /* now try and write to the file */
  SYS "XOS_Find",&8F,s$ TO c%;f%
  IF(f%AND1) PROCerror_warning(FNmsg_0(A%!CONST_interface_host_desc,"WA14")):ENDPROC
  IF c% THEN
   psize%=psize_head%
   WHILE psize%
    IF psize%!CONST_psze_flag=CONST_psze_flag_userdefined THEN
      PROCsave_paper_size(c%,psize%)
      count%+=1
    ENDIF
    psize%=psize%!CONST_psze_next
   ENDWHILE
   SYS "XOS_Find",,c% /*Close*/
   IF count% THEN
    SYS "XOS_File",18,s$,&FC6
    SYS "XOS_File",4,s$,,,,&13 /*attributes to WR/r*/
   ELSE
    SYS "XOS_File",6,s$
   ENDIF
  ENDIF
ENDPROC

DEF PROCsave_value(icon%,block%,offset%,convert%,RETURN flag%)
  Ftracef("PROCsave_value")
  LOCAL v,v%
  /* SMC: we now use FNlocale_val instead of VAL as decimal point character may not be "." */
  v=FNlocale_val(FNicon_read(papersize%,icon%))
  CASE icon% OF
    WHEN CONST_paper_gtop
      v=FNlocale_val(FNicon_read(papersize%,CONST_paper_height))-v
    WHEN CONST_paper_gright
      v=FNlocale_val(FNicon_read(papersize%,CONST_paper_width))-v
  ENDCASE
  IF convert% THEN
    IF FNicon_set(papersize%,CONST_paper_mm)v%=v*mm_to_72000 ELSE v%=v*in_to_72000
  ELSE
    v%=v /*Copy even if you're not converting. JRC 26 Nov '91*/
  ENDIF
  IF block%!offset%<>v% THEN
    flag%=TRUE
    block%!offset%=v%

    /* keep the global edit block up to date with the page specific block */
    IFpsize_edit% psize_edit%!offset%=v%
  ENDIF
ENDPROC

DEF PROCdelete_papersize
  Ftracef("PROCdelete_papersize")
  LOCAL s$,psize%,last%,i%,prnt%
  SYS "Hourglass_On"
  s$=FNicon_read(papersize%,CONST_paper_name)
  psize%=psize_head%
  WHILE psize%>0
   IF$psize%!CONST_psze_name=s$ THEN
    IF psize%!CONST_psze_flag=CONST_psze_flag_userdefined THEN
     /*this is a user defined size, so we
       need to see if any printers are using it*/
     prnt%=A%!CONST_interface_printer_installed
     WHILE prnt%
      IF prnt%!CONST_prnt_psze=psize% ERROR CONST_error_ok,FNmsg_0(A%!CONST_interface_host_desc,"OKQa")
      prnt%=prnt%!CONST_prnt_next
     ENDWHILE
     IF last% THEN
      last%!CONST_psze_next=psize%!CONST_psze_next
     ELSE
      psize_head%=psize%!CONST_psze_next
     ENDIF
     PROCfree_structure(psize%!CONST_psze_name)
     B%=CONST_ident_PSZE
     C%=psize%
     CALL code_entry%+CONST_entry_heap_free
     PROCsave_user_defined_paper_sizes
    ELSE
     ERROR CONST_error_ok,FNmsg_0(A%!CONST_interface_host_desc,"OKR")
    ENDIF
    FOR i%=CONST_psze_next TO CONST_psze_flag STEP 4
      psize_edit%!i%=0
    NEXT
    PROCinitialise_papersize_window
    psize%=-1
   ELSE
    last%=psize%
    psize%=psize%!CONST_psze_next
   ENDIF
  ENDWHILE
  IF psize%=0 ERROR CONST_error_ok,FNmsg_0(A%!CONST_interface_host_desc,"OKQ")
  SYS "Hourglass_Off"
ENDPROC

  /*Queue window handling code*/

DEF PROCopen_queue_window
  Ftracef("PROCopen_queue_window")
  PROCtell_pinboard(A%!CONST_interface_queue)
  !task_buff%=A%!CONST_interface_queue
  SYS "Wimp_GetWindowInfo",,task_buff% OR 1
  task_buff%!48=task_buff%!56-(A%!CONST_interface_printer_active*line_space%*2)-(A%!CONST_interface_queue_entries*line_space%)
  SYS "Wimp_SetExtent",A%!CONST_interface_queue,task_buff%+44
  task_buff%!28=-1 /*at the top of the stack*/
  SYS "Wimp_OpenWindow",,task_buff%
ENDPROC

DEF PROCredraw_prntctrl_entry(prnt%)
  Ftracef("PROCredraw_prntctrl_entry")
  IF NOT FNwindow_open(prntctrl%) ENDPROC
  !win_buff%=prntctrl%
  win_buff%!4=prnt%!CONST_prnt_pane
  SYS "Wimp_GetIconState",,win_buff%
  SYS "Wimp_ForceRedraw",prntctrl%,win_buff%!8,win_buff%!12,win_buff%!16,win_buff%!20
ENDPROC

DEF PROCredraw_queue_entry(y%,prnt%,queu%)
  LOCAL more%
  Ftracef("PROCredraw_queue_entry: y% "+STR$ y%)
  IF NOT FNwindow_open(A%!CONST_interface_queue)ENDPROC
  IF y%=-1 THEN
    B%=prnt%
    C%=queu%
    y%=USR(code_entry%+CONST_entry_visualise_entry)
    Ftracef("after visualise_entry y% "+STR$ y%)
  ENDIF
  !win_buff%=A%!CONST_interface_queue
  SYS "Wimp_GetWindowState",,win_buff%
  Ftracef("visible area (("+STR$ win_buff%!4+", "+STR$ win_buff%!8+"), ("+STR$ win_buff%!12+", "+STR$ win_buff%!16+")), scroll offsets ("+STR$ win_buff%!20+", "+STR$ win_buff%!24+")")
  win_buff%!12=win_buff%!12-win_buff%!4
  win_buff%!4=0
  win_buff%!8=y%-line_space%
  win_buff%!16=y%
  Ftracef("updating (("+STR$ win_buff%!4+", "+STR$ win_buff%!8+"), ("+STR$ win_buff%!12+", "+STR$ win_buff%!16+"))")
  SYS "Wimp_ForceRedraw",!win_buff%,win_buff%!4,win_buff%!8,win_buff%!12,win_buff%!16
 /*TO more%
  B%=win_buff%
  C%=more%
  CALL code_entry%+CONST_entry_update_queue_window*/
ENDPROC

DEF PROCredraw_queue_block(y%,prnt%,queu1%,queu2%)
  LOCAL count%
  Ftracef("PROCredraw_queue_block")
  IF NOT FNwindow_open(A%!CONST_interface_queue)ENDPROC
  IF y%=-1 THEN
    B%=prnt%
    C%=queu%
    y%=USR(code_entry%+CONST_entry_visualise_entry)
  ENDIF
  !win_buff%=A%!CONST_interface_queue
  SYS "Wimp_GetWindowState",,win_buff%
  win_buff%!12=win_buff%!12-win_buff%!4
  win_buff%!4=0
  count%=2
  WHILE queu1%<>queu2%
   count%+=1
   queu1%=queu1%!CONST_queu_next
  ENDWHILE
  win_buff%!8=y%-line_space%*count%
  win_buff%!16=y%
  SYS "Wimp_ForceRedraw",!win_buff%,win_buff%!4,win_buff%!8,win_buff%!12,win_buff%!16
/*TO y%
  B%=win_buff%
  C%=y%
  CALL code_entry%+CONST_entry_update_queue_window*/
ENDPROC

DEF PROCadd_queue_entry(temp_file%,sender$,pathname$,leafname$,prnt%,type%)
  B%=temp_file%
  C%=task_buff%: $C%=sender$
  D%=buff1%: $D%=pathname$
  E%=buff1%+256: $E%=leafname$
  F%=prnt%
  G%=type%
  CALL code_entry%+CONST_entry_add_queue_entry
ENDPROC

DEF PROCdelete_queue_entry(prnt%,queu%,redraw%)
  LOCAL head%,p%,cnct%
  Ftracef("PROCdelete_queue_entry")

  /*in case the queue entry is disappearing while the menu is still open, clear
      the menu globals (only the queue one - the printer one will still work)*/
  IF menued_prnt%=prnt% AND menued_queu%=queu% menued_queu%=0:SYS"Wimp_CreateMenu",-1

  /*if this entry is paused because of the pause flag
      then release the printer as well and close its pause window*/
  p%=queu%!CONST_queu_tpub
  IF p% THEN
    IF p%!CONST_tpub_pause_flag THEN
      prnt%!CONST_prnt_flags=prnt%!CONST_prnt_flags AND NOT CONST_prnt_flags_suspaused
      IF prnt%!CONST_prnt_pause THEN
        !task_buff%=prnt%!CONST_prnt_pause
        PROCclose_window
      ENDIF
    ENDIF
  ENDIF

  /*adjust the linked list to show the entry has gorn*/
  IF prnt%!CONST_prnt_queu=queu% THEN
    prnt%!CONST_prnt_queu=queu%!CONST_queu_next
    head%=0
  ELSE
    head%=prnt%!CONST_prnt_queu
    WHILE head%!CONST_queu_next<>queu%
      head%=head%!CONST_queu_next
    ENDWHILE
    head%!CONST_queu_next=queu%!CONST_queu_next
  ENDIF

  IF queu%!CONST_queu_handle_in THEN
    SYS "XOS_Find",,queu%!CONST_queu_handle_in /*Close*/
    queu%!CONST_queu_handle_in=0
    prnt%!CONST_prnt_flags=prnt%!CONST_prnt_flags AND NOT CONST_prnt_flags_printing
    PROCprinter_status(prnt%)
    IF NOT prnt%!CONST_prnt_pane THEN
      buff1%!0=prntctrl%
      buff1%!4=prnt%!CONST_prnt_pane
      buff1%!8=0
      buff1%!12=1<<22
      SYS "Wimp_SetIconState",,buff1%
    ENDIF
  ENDIF

  /*if either the output file or the scratch file
    are registered as printer jobs, abort them*/
  p%=0
  REPEAT
    SYS "PDriver_EnumerateJobs",p% TO p%
    IF p% IF p%=queu%!CONST_queu_handle_out OR p%=queu%!CONST_queu_handle_scratch SYS "PDriver_AbortJob",p%
  UNTIL p%=0

  IF queu%!CONST_queu_handle_out THEN
    cnct%=prnt%!CONST_prnt_cnct
    /*if printing to parallel or serial, flush the buffer.
      in the normal course of duty, the code dealing with printing
      will have ensured that the buffer is already empty, so this
      shouldn't do any damage*/
    #ifdef Trace
      IF cnct%!CONST_cnct_type=1 OR cnct%!CONST_cnct_type=2 PROCftracef("Flushing buffer "+STR$ FNbuffer(cnct%!CONST_cnct_type))
    #endif
    IF cnct%!CONST_cnct_type=1 OR cnct%!CONST_cnct_type=2 SYS "OS_Byte",21,FNbuffer(cnct%!CONST_cnct_type)
    Ftracef("Flush done - closing file")
    SYS "XOS_Find",0,queu%!CONST_queu_handle_out /*Close*/
    Ftracef("File closed")
    queu%!CONST_queu_handle_out=0
    PROCbuffer_free(cnct%!CONST_cnct_type)

    /*allow the back-end to free up its resources
      since we've closed the output file, any bad programming on
      their part will be shown up :-)*/
    !task_buff%=queu%
    PROCprinter_reason_code(prnt%!CONST_prnt_psup,prnt%,-7,task_buff%)
  ENDIF

  IF queu%!CONST_queu_handle_scratch THEN
    SYS "XOS_Find",,queu%!CONST_queu_handle_scratch /*Close*/
    queu%!CONST_queu_handle_scratch=0
  ENDIF
  SYS "XOS_File",6,$queu%!CONST_queu_scratch_name /*Delete*/
  PROCfree_structure(queu%!CONST_queu_scratch_name)

  /*if a temporary file - delete it*/
  IF queu%?CONST_queu_status AND 2 SYS "XOS_File",6,$queu%!CONST_queu_path
  Ftracef("Freeing sender @ "+STR$~(queu%!CONST_queu_sender))
  PROCfree_structure(queu%!CONST_queu_sender)
  Ftracef("Freeing path @ "+STR$~(queu%!CONST_queu_path))
  PROCfree_structure(queu%!CONST_queu_path)
  Ftracef("Freeing leaf @ "+STR$~(queu%!CONST_queu_leaf))
  PROCfree_structure(queu%!CONST_queu_leaf)
  Ftracef("Got public block @ "+STR$~(queu%!CONST_queu_tpub))
  p%=queu%!CONST_queu_tpub
  IF p% THEN
    PROCfree_structure(p%!CONST_tpub_layout_line) /*layout string*/
    PROCfree_structure(p%!CONST_tpub_line_epilogue) /*line epilogue*/
    PROCfree_structure(p%!CONST_tpub_name) /*name*/
    PROCfree_structure(p%!CONST_tpub_time) /*time*/
    B%=CONST_ident_TPUB
    C%=p%
    CALL code_entry%+CONST_entry_heap_free
  ENDIF

  Ftracef("Got TBFF @ "+STR$~(queu%!CONST_queu_tbff))
  IF queu%!CONST_queu_tbff THEN
     B%=CONST_ident_TBFF
     C%=queu%!CONST_queu_tbff
     CALL code_entry%+CONST_entry_heap_free
  ENDIF
  Ftracef("Freeing queu block @ "+STR$~(queu%))
  B%=CONST_ident_QUEU
  C%=queu%
  CALL code_entry%+CONST_entry_heap_free
  A%!CONST_interface_queue_entries-=1
  IF A%!CONST_interface_queue_entries<=0 A%!CONST_interface_global_mask=A%!CONST_interface_global_mask OR 1 /*turn off null polls*/

  IF redraw% THEN
    !task_buff%=A%!CONST_interface_queue
    SYS "Wimp_GetWindowInfo",,task_buff% OR 1
    IF task_buff%!32 AND 1<<16 THEN
      task_buff%!48=task_buff%!56-A%!CONST_interface_printer_active*line_space%*2-A%!CONST_interface_queue_entries*line_space%
      SYS "Wimp_SetExtent",A%!CONST_interface_queue,task_buff%+44
      SYS "Wimp_OpenWindow",,task_buff%
      B%=prnt%
      C%=head%
      CALL code_entry%+CONST_entry_redraw_queue_below
    ENDIF
  ENDIF
ENDPROC

DEF PROCflush_queue(prnt%)
  LOCAL queu%,next%
  Ftracef("PROCflush_queue")
  SYS "Hourglass_On"
  REPEAT
    queu%=prnt%!CONST_prnt_queu
    IF queu% PROCdelete_queue_entry(prnt%,queu%,FALSE)
  UNTIL queu%=0
  !task_buff%=A%!CONST_interface_queue
  SYS "Wimp_GetWindowInfo",,task_buff% OR 1
  IF task_buff%!32 AND 1<<16 THEN
    task_buff%!48=task_buff%!56-A%!CONST_interface_printer_active*line_space%*2-A%!CONST_interface_queue_entries*line_space%
    SYS "Wimp_SetExtent",A%!CONST_interface_queue,task_buff%+44
    SYS "Wimp_OpenWindow",,task_buff%
    B%=prnt%
    C%=0
    CALL code_entry%+CONST_entry_redraw_queue_below
  ENDIF
  SYS "Hourglass_Off"
ENDPROC

DEF PROCdestroy_queue
  LOCAL prnt%
  Ftracef("PROCdestroy_queue")
  prnt%=A%!CONST_interface_printer_installed
  WHILE prnt%
    PROCflush_queue(prnt%)
    prnt%=prnt%!CONST_prnt_next
  ENDWHILE
  /*and just to make sure*/
  A%!CONST_interface_queue_entries=0
ENDPROC

DEF PROCprocess_queue
  /*find a printer to process
    we don't have to worry about inactive ones, 'cos they don't have a queue*/
  LOCAL last_queu%,j%,prnt%,queu%
  Ftracef("PROCprocess_queue")

  REPEAT
    IF A%!CONST_interface_nudged_prnt \
      A%!CONST_interface_nudged_prnt=\
          !(A%!CONST_interface_nudged_prnt+CONST_prnt_next)
    IF A%!CONST_interface_nudged_prnt=0 \
      A%!CONST_interface_nudged_prnt=A%!CONST_interface_printer_installed
  UNTIL A%!CONST_interface_nudged_prnt

  prnt%=A%!CONST_interface_nudged_prnt

  IF(prnt%!CONST_prnt_flags AND CONST_prnt_flags_paused)=0 THEN
    /*OK - printer is not paused, which means we can try to print
      Find the first non-suspended file: there may not be one, though*/
    A%!CONST_interface_nudged_queu=prnt%!CONST_prnt_queu
    last_queu%=0
    WHILE A%!CONST_interface_nudged_queu
      IF ?(A%!CONST_interface_nudged_queu+CONST_queu_status)AND 1 THEN
        /*this one is paused - we can go no further*/
        A%!CONST_interface_nudged_queu=0
      ELSE
        IF ?(A%!CONST_interface_nudged_queu+CONST_queu_status)AND 4 THEN
          /*this one is suspended - try the next file*/
          last_queu%=A%!CONST_interface_nudged_queu
          A%!CONST_interface_nudged_queu=!(A%!CONST_interface_nudged_queu+CONST_queu_next)
        ELSE
          /*OK - if this file has been started, continue it*/
          IF !(A%!CONST_interface_nudged_queu+CONST_queu_handle_in)THEN
            PROCprint_file(prnt%,A%!CONST_interface_nudged_queu)
          ELSE
            /*This file has not been started - is the printer suspended?
              If not, we can start printing the file*/
            IF(prnt%!CONST_prnt_flags AND CONST_prnt_flags_suspended)=0 THEN
              IF A%!CONST_interface_nudged_queu<>prnt%!CONST_prnt_queu THEN
                /*move the file to the head of the queue*/
                IF last_queu% last_queu%!CONST_queu_next=\
                    !(A%!CONST_interface_nudged_queu+CONST_queu_next)
                !(A%!CONST_interface_nudged_queu+CONST_queu_next)=\
                    prnt%!CONST_prnt_queu
                prnt%!CONST_prnt_queu=A%!CONST_interface_nudged_queu
                PROCredraw_queue_block(-1,prnt%,\
                    A%!CONST_interface_nudged_queu,last_queu%)
              ENDIF

              /*keep things tidy to prevent the user from altering things
                behind our back*/
              IF prnt_edit%=prnt% THEN
                !task_buff%=connections%
                PROCclose_window
              ENDIF

              j%=prnt%!CONST_prnt_psup
              j%=j%!CONST_psup_wind
              WHILE j%
                IF $(j%+CONST_wind_name)="configure" THEN
                  IF j%!CONST_wind_prnt=prnt% THEN
                    !task_buff%=j%!CONST_wind_hand
                    PROCclose_window
                  ENDIF
                ENDIF
                j%=j%!CONST_wind_next
              ENDWHILE

              PROCprint_file(prnt%,A%!CONST_interface_nudged_queu)
            ENDIF
          ENDIF
          /*no more work on this printer, thanks!*/
          A%!CONST_interface_nudged_queu=0
        ENDIF
      ENDIF
    ENDWHILE
  ENDIF

  /*Silly fix because it seems the number of queues can get out of step with
       A%!CONST_interface_queue_entries. So recalculate it here.*/
  A%!CONST_interface_queue_entries=0
  prnt%=A%!CONST_interface_printer_installed
  WHILE prnt%
    queu%=prnt%!CONST_prnt_queu
    Ftrace_Queu(queu%)
    WHILE queu%
      A%!CONST_interface_queue_entries+=1
      queu%=queu%!CONST_queu_next
    ENDWHILE
    prnt%=prnt%!CONST_prnt_next
  ENDWHILE

  IF A%!CONST_interface_queue_entries=0 \
    A%!CONST_interface_global_mask=A%!CONST_interface_global_mask OR 1
        /*turn off null polls*/
ENDPROC

DEF FNcheck_type(queu%,output_type%,RETURN alias$)
  LOCAL type$,i%,name$,psup%
  Ftracef("FNcheck_type")
  alias$=""
  /*is there a print alias?*/
  type$=RIGHT$("00"+STR$~queu%!CONST_queu_type,3)
  SYS "XOS_ReadVarVal","Alias$@PrintType_"+type$,,-1 TO,,i%
  IF i%<0 alias$="@PrintType_"+type$: =TRUE

  CASE queu%!CONST_queu_type OF
    WHEN -1 /*Untyped*/
      name$=FNmsg_0(A%!CONST_interface_host_desc,"UNT")
    WHEN &2000 /*Application*/
      PROCerror_box(FNmsg_0(A%!CONST_interface_host_desc,"OKT"),1)
      =FALSE
    WHEN &1000 /*Directory*/
      PROCerror_box(FNmsg_0(A%!CONST_interface_host_desc,"OKS"),1)
      =FALSE
    WHEN &FFF,&AF8 /*Text,1stWord+*/
      queu%!CONST_queu_type=&FFF
      =TRUE
    WHEN &FD6,&FD7,&FEA,&FEB,&FFE /*TaskExec,TaskObey,Desktop,Obey,Command*/
      queu%!CONST_queu_type=&FFE
      =TRUE
    WHEN output_type%
      queu%!CONST_queu_type=output_type%
      =TRUE
    OTHERWISE
      name$=FNtask_read_env("File$Type_"+type$,task_buff%)
      IF name$="" \
        name$=FNmsg_1(A%!CONST_interface_host_desc,"TYP",type$)
  ENDCASE

  CASE FNpicktype(name$,queu%)OF
    WHEN CONST_how_plain
      /*change filetype to turn off 1WP decoding*/
      queu%!CONST_queu_type=&FFE
      =TRUE
    WHEN CONST_how_fancy
      /*change filetype to force 1WP decoding*/
      queu%!CONST_queu_type=&FFF
      =TRUE
  ENDCASE
=FALSE

DEF FNpicktype(name$,queu%)
  LOCAL x%,y%,w%,h%
  Ftracef("FNpicktype")
  PROCicon_write(howquery%,CONST_how_text,\
      FNmsg_2(A%!CONST_interface_host_desc,"WA5",name$,\
      $queu%!CONST_queu_leaf))
  SYS "Wimp_GetPointerInfo",,task_buff%
  x%=!task_buff%
  y%=task_buff%!4
  !task_buff%=howquery%
  SYS "Wimp_GetWindowState",,task_buff%
  w%=task_buff%!12-task_buff%!4
  h%=task_buff%!16-task_buff%!8
  task_buff%!4=x%-340 /*half the width of the window*/
  task_buff%!8=y%-120 /*half the height of the window*/
  task_buff%!12=task_buff%!4+w%
  task_buff%!16=task_buff%!8+h%
  task_buff%!28=-1
  SYS "Wimp_OpenWindow",,task_buff%
  PROCbound_mouse(howquery%)
  query_state%=0
  REPEAT
    Ftracef("waiting for answer")
    PROCdespatch_poll(click_mask%)
  UNTIL query_state%
  Ftracef("got it")
  !task_buff%=howquery%
  PROCclose_window
  PROCunbound_mouse
=query_state%

DEF PROCappend_file_tidyup(in%,out%,out_size%,in$)
  /* close the two files (if they are open) and delete the source file */
  IFin% SYS"XOS_Find",0,in%
  IFout% EXT#out%=out_size%
  IFout% SYS"XOS_Find",0,out%
  SYS"XOS_File",6,in$
ENDPROC

DEF PROCappend_file(out$,in$)
  LOCAL in_f%,out_f%,in_size%,out_size%,i%
  LOCAL ERROR

  ON ERROR LOCAL RESTORE ERROR:PROCappend_file_tidyup(in_f%,out_f%,out_size%,in$):\
    PROCerror_box(REPORT$, 1):ENDPROC

  Ftracef("PROCappend_file("""+out$+""", """+in$+""")")

  in_f%=OPENIN in$
  in_size%=EXT#in_f%

  /*Don't bother if there's no input.*/
  IF in_size% THEN
    SYS"Hourglass_On"
    out_f%=OPENUP out$
    out_size%=EXT#out_f% /* remember this in case we need to restore it */
    PTR#out_f%=out_size%

    FOR i%=1 TO in_size% DIV 512
      SYS "OS_GBPB",4,in_f%,buff1%,512 /*Read*/
      SYS "OS_GBPB",2,out_f%,buff1%,512 /*Write*/
    NEXT

    IF in_size% MOD 512 \
      SYS "OS_GBPB",4,in_f%,buff1%,in_size% MOD 512 /*Read*/: \
      SYS "OS_GBPB",2,out_f%,buff1%,in_size% MOD 512 /*Write*/
    CLOSE#out_f%
    SYS"Hourglass_Off"
  ENDIF

  CLOSE#in_f%
  SYS "OS_File",6,in$ /*Delete*/
ENDPROC

DEF PROCprint_file(prnt%,queu%)
  LOCAL psup%,cnct%,pr_type%,b%,t%,file$,t$,alias$,load%,size%,\
    finished%,s%,spooling%,ptmp$,check_type%,spool_file$
#ifdef Sparrow
  LOCAL application$, leafname$, lpsup%, l%, f%
#endif
  Ftracef("PROCprint_file")

  psup%=prnt%!CONST_prnt_psup
  cnct%=prnt%!CONST_prnt_cnct
  pr_type%=psup%!CONST_psup_type

  IF queu%!CONST_queu_handle_in=0 THEN
    Ftracef("starting afresh")
    /*select the printer
      check that we know how to print this file
      open printer_output$
          (we can't use printer: 'cos RO2.00 can't cope)
      restore the permanent selection
      open the input file
      change the printer's status to printing
      update the iconbar icon
      redraw the printer's queue header
          (needs to be done AFTER the file has been opened)
    */

    /* PJC: PROCdo_select_printer no longer 'blows up' */
    /* Therefore there is no longer a need to pause the printer */
    /* pause the printer, in case PROCdo_select_printer blows up */
    /* PROCpause_printer(prnt%) */
    Ftracef("PROCdo_select_printer loc 8")
    PROCdo_select_printer(prnt%,FALSE,FALSE,FALSE)

    /* PJC: however, if the printer is paused on exit, give up */
    IF (prnt%!CONST_prnt_flags AND CONST_prnt_flags_paused)<>0 ENDPROC

    /* now un-pause the printer ('cos if we are here then PROCdo_select_printer didn't blow up) */
    /* prnt%!CONST_prnt_flags=prnt%!CONST_prnt_flags AND NOT CONST_prnt_flags_paused */
    /* PROCprinter_status(prnt%) */
    /* PROCredraw_queue_entry(-1,prnt%,0) */
    file$=$queu%!CONST_queu_path

#ifdef Sparrow
    /* need to initialise the global strings, in case it gets printed directly */
    last_application$ = $queu%!CONST_queu_sender
    last_leafname$    = $queu%!CONST_queu_leaf
#endif

    /*First, redirect the output to a spool file if this is a spooled queue.*/
    IF cnct%!CONST_cnct_type=5 THEN
      spooling%=(cnct%?CONST_cnct_flags AND CONST_cnct_flags_append)<>0
    ELSE
      spooling%=(cnct%?CONST_cnct_flags AND CONST_cnct_flags_background)<>0
    ENDIF

    IF spooling% THEN
      printer_output$=FNtemporary_name(FALSE)
      IFprinter_output$="" THEN
        prnt%!CONST_prnt_flags = prnt%!CONST_prnt_flags OR CONST_prnt_flags_paused
        PROCprinter_status(prnt%)
        PROCredraw_queue_entry(-1,prnt%,0)
        ENDPROC
      ENDIF
      IFcnct%!CONST_cnct_type=5 THEN
       Ftracef("%Set PrinterType$5 "+printer_output$)
       SYS "OS_SetVarVal","PrinterType$5",printer_output$,LEN printer_output$
       PROCfx5(5)
      ELSE
       Ftracef("%Set PrinterType$10 "+printer_output$)
       SYS "OS_SetVarVal","PrinterType$10",printer_output$,LEN printer_output$
       PROCfx5(10)
      ENDIF
      Ftracef("***SPOOLING via "+printer_output$)
      spool_file$=printer_output$
    ENDIF

    /*Let's see if anyone wants this filetype*/
    ptmp$=FNtemporary_name(FALSE)
    IFptmp$="" THEN
      prnt%!CONST_prnt_flags = prnt%!CONST_prnt_flags OR CONST_prnt_flags_paused
      PROCprinter_status(prnt%)
      PROCredraw_queue_entry(-1,prnt%,0)
      ENDPROC
    ENDIF
    Ftracef("%Set Printer$Temp "+ptmp$)
    SYS "OS_SetVarVal","Printer$Temp",ptmp$,LEN ptmp$

    task_buff%!0=48+LEN file$ AND NOT 3
    task_buff%!12=0
    task_buff%!16=&80145 /*PrintTypeOdd*/
    task_buff%!40=queu%!CONST_queu_type
    $(task_buff%+44)=file$+CHR$ 0
    SYS "Wimp_SendMessage",18,task_buff%
    Ftrace_Send(18,task_buff%,0)
    type_state%=0
    REPEAT
      PROCdespatch_poll(message_mask%)
    UNTIL type_state%

    b%=TRUE
    IF type_state%<>2 THEN
      Ftracef("No-one answered")
      /*Can we still do something? Check the file type, and
        if all else fails ask the user.*/
      b%=FNcheck_type(queu%,pr_type%,alias$)
      IF b% THEN
        /*This is a file type we know about, somehow.*/
        IF alias$<>"" THEN
          Ftracef("Wimp_StartTask """+alias$+" "+file$+"""")
          SYS "Wimp_StartTask",alias$+" "+file$
        ENDIF
      ENDIF
    ENDIF

    /*If b%, either the file has been printed or saved to Printer$Temp by
      an application, or queu%!CONST_queu_type has been updated so we can
      print it ourselves. Otherwise, the user is not interested in the file,
      and neither are we.
    */

    IF NOTb% THEN
      /* not interested */
      PROCdelete_queue_entry(prnt%,queu%,TRUE)
      ENDPROC
    ENDIF

    IF spooling% THEN
      Ftracef("Reset the connection to what it should be")
      s$=FNselect_connection(prnt%,TRUE,FALSE)
      IF s$<>"" THEN
        PROCerror_warning(s$)
        IF prnt%!CONST_prnt_queu THEN
          prnt%!CONST_prnt_flags = prnt%!CONST_prnt_flags OR CONST_prnt_flags_paused
          PROCprinter_status(prnt%)
          PROCredraw_queue_entry(-1,prnt%,0)
        ENDIF
      ENDIF
    ENDIF

    Ftracef("Significant file type is &"+STR$~queu%!CONST_queu_type)
    IF NOT(queu%!CONST_queu_type=&FFF OR queu%!CONST_queu_type=&FFE OR \
        queu%!CONST_queu_type=pr_type%)THEN
      Ftracef("Starting to print a non-text file type")

      SYS "OS_File",17,ptmp$ TO t%,,load%,,size% /*ReadNoPath*/
      IF t% THEN
        Ftracef("Printer$Temp found")

        /*if the previous file was temporary, delete it*/
        IF queu%?CONST_queu_status AND 2 THEN
          IF file_to_delete$<>"" SYS "XOS_File",6,file_to_delete$ /*Delete*/
              /*Just in case*/
          file_to_delete$=$queu%!CONST_queu_path
              /*was SYS "XOS_File",6,$queu%!CONST_queu_path*/
        ENDIF

        Ftracef("Update this queue entry to refer to the new file")
        PROCfree_structure(queu%!CONST_queu_path)
        $task_buff%=ptmp$
        B%=task_buff%
        C%=2
        queu%!CONST_queu_path=USR(code_entry%+CONST_entry_store_string)
        queu%!CONST_queu_ext=size%
        queu%!CONST_queu_type=(load% AND &FFF00)>>8
        Ftracef("Filetype of temp file = &"+STR$~queu%!CONST_queu_type)
        queu%?CONST_queu_status=queu%?CONST_queu_status OR 2
      ELSE
        Ftracef("No Printer$Temp - the file has actually been printed")
        IF spooling% THEN
          /*SYS "XOS_File",18,spool_file$,pr_type%*/ /*SetType*/

          /*What we do now depends on why we were spooling.*/
          IF cnct%!CONST_cnct_type=5 THEN
            /*It was because the stuff we've just got has to be appended to
              a file - so do it.*/
            PROCappend_file($cnct%!CONST_cnct_file,spool_file$)
            PROCdelete_queue_entry(prnt%,queu%,TRUE)
          ELSE
            Ftracef("File is to be printed in background. Update "+
                "the queue entry to refer to the spooled file")
            SYS "OS_File",17,spool_file$ TO b%,,,,size% /*ReadNoPath*/

            IF b%=0 OR size%=0 THEN
              REM nothing to print - remove the entry and the spool file
              SYS"XOS_File",6,spool_file$
              PROCdelete_queue_entry(prnt%,queu%,TRUE)
            ELSE
              /*
                 if the original file in the queue was a temporary file,
                 we need to delete it here, before we forget the name
              */
              IF (queu%?CONST_queu_status AND 2) \
                SYS"XOS_File",6,$queu%!CONST_queu_path
              PROCfree_structure(queu%!CONST_queu_path)
              $task_buff%=spool_file$
              B%=task_buff%
              C%=2
              queu%!CONST_queu_path=USR(code_entry%+CONST_entry_store_string)
              queu%!CONST_queu_ext=size%
              queu%!CONST_queu_type=pr_type%
              queu%?CONST_queu_status=queu%?CONST_queu_status OR 2
            ENDIF
          ENDIF
        ELSE
#ifdef Sparrow
          application$ = $queu%!CONST_queu_sender
          leafname$    = $queu%!CONST_queu_leaf
#endif
          PROCdelete_queue_entry(prnt%,queu%,TRUE)
#ifdef Sparrow
          IF cnct%!CONST_cnct_type = 9 AND printer_prefix$ <> "" THEN
            Ftracef ("PROCprint_file: end of job, this is a conn type 9")
            name$ = $(prnt%!CONST_prnt_name)
            ptr% = INSTR(name$, " ") /* Hard space */
            WHILE ptr%
              MID$(name$,ptr%,1) = CHR$160
              ptr% = INSTR(name$, " ", ptr%+1)
            ENDWHILE
            sname$ = printer_prefix$+"RemSpool."+unique_string$+"."+name$
            qname$ = printer_prefix$+"RemQueue."+unique_string$+"."+STR$(remote_jobno%)

            SYS "XOS_File", 17, sname$ TO t%,,,,l% ; f%
            IF (l% > 0) AND ((f% AND 1) = 0) AND (t% = 1) THEN

              IF FNwrite_information_file (prnt%, application$, leafname$) THEN
                Ftracef ("Trying to rename from "+sname$+" to "+qname$)
                lpsup% = selected_prnt%!CONST_prnt_psup
                /*SYS "XOS_File", 18, sname$, lpsup%!CONST_psup_type*/
                SYS "XOS_FSControl", 25, sname$, qname$ /* Rename */
              ELSE
                Ftracef ("Deleting "+sname$+" because of an error")
                SYS "XOS_File", 6, sname$
              ENDIF
              last_application$ = ""
              last_leafname$ = ""
              s$=FNselect_connection(prnt%,TRUE,FALSE)
              IF s$<>"" THEN
                PROCerror_warning(s$)
              ENDIF

            ENDIF
          ENDIF
#endif
          /* PJC: bug-fix: restore the selected printer in case the last print-job was
                           to a non-selected printer
          */
          PROCdo_select_printer(0,TRUE,TRUE,FALSE)
        ENDIF
      ENDIF
    ELSE
      Ftracef("Start to print a text file type")

      /*Get the buffer number if needed*/
      Ftracef("connection type is "+STR$ cnct%!CONST_cnct_type)
      CASE cnct%!CONST_cnct_type OF
        WHEN 1
          IFprnt%!CONST_prnt_flags AND CONST_prnt_flags_fastpar THEN
            printer_output$="devices#buffer"+STR$FNbuffer_ensure(1)+":$."+FNsupport_fast_parallel
          ELSE
            printer_output$="devices#buffer"+STR$ FNbuffer_ensure(1)+":$.Parallel"
          ENDIF
          SYS "OS_SetVarVal","PrinterType$1",printer_output$,LEN printer_output$
        WHEN 2
          printer_output$="devices#buffer"+STR$ FNbuffer_ensure(2)+\
              ":$.Serial"
          SYS "OS_SetVarVal","PrinterType$2",printer_output$,\
              LEN printer_output$
      ENDCASE

      SYS "Hourglass_On"
      Ftracef("Opening "+printer_output$)
      printer_output$="printer:"
      /*must preserve the error message in case PROCdo_select_printer tramples
        on it*/
      IF cnct%!CONST_cnct_type=5 AND (cnct%?CONST_cnct_flags AND CONST_cnct_flags_append)<>0 THEN
        SYS "XOS_Find",&CF,printer_output$ TO b%;t% /*OpenupNoPath OR
            ErrorIfAbsent OR ErrorIfDir*/
        IF(t% AND 1)=0 PTR#b%=EXT#b% /*we want to append to the file*/
      ELSE
        SYS "XOS_Find",&8F,printer_output$ TO b%;t% /*OpenoutNoPath OR
            ErrorIfAbsent OR ErrorIfDir*/
      ENDIF
      IF t% AND 1 i%=b%+4: CALL Z%,i%,t$ /*convert 0-terminated string*/
      SYS "Hourglass_Off"

      Ftracef("PROCdo_select_printer loc 9")
      PROCdo_select_printer(0,TRUE,TRUE,FALSE)
      IF t% AND 1 THEN
        /*failed to open the file - pause the printer, free the buffer*/
        PROCpause_printer(prnt%)
        PROCbuffer_free(cnct%!CONST_cnct_type)
        ERROR CONST_error_ok,FNmsg_1(A%!CONST_interface_host_desc,"OKP",t$)
      ENDIF
      queu%!CONST_queu_handle_out=b%
      SYS"XOS_Find",&40,$queu%!CONST_queu_path TO queu%!CONST_queu_handle_in;t%
      IF(t%AND1) queu%!CONST_queu_handle_in = 0
      IF queu%!CONST_queu_handle_in=0 THEN
        /*failed to open the input file - pause the printer*/
        PROCdelete_queue_entry(prnt%,queu%,TRUE)
        ERROR CONST_error_ok,FNmsg_1(A%!CONST_interface_host_desc,\
            "OKAF",$queu%!CONST_queu_path)
      ENDIF
      t$=FNtemporary_name(FALSE)
      IFt$="" THEN
        prnt%!CONST_prnt_flags = prnt%!CONST_prnt_flags OR CONST_prnt_flags_paused
        PROCprinter_status(prnt%)
        PROCredraw_queue_entry(-1,prnt%,0)
        ENDPROC
      ENDIF
      Ftracef("CreateStamped "+t$)
      SYS "XOS_File",11,t$,&FFD TO b%;t% /*CreateStamped*/
      IF(t% AND 1)=0 SYS "XOS_Find",&CF,t$ TO b%;t% /*OpenupNoPath OR
          ErrorIfAbsent OR ErrorIfDir*/
      IF t% AND 1 THEN
        PROCpause_printer(prnt%)
        b%+=4
        CALL Z%,b%,s$ /*convert 0-terminated string*/
        ERROR CONST_error_ok,FNmsg_1(A%!CONST_interface_host_desc,"OKP",s$)
      ENDIF
      queu%!CONST_queu_handle_scratch=b%
      $task_buff%=t$
      B%=task_buff%
      C%=2
      queu%!CONST_queu_scratch_name=\
          USR(code_entry%+CONST_entry_store_string)
      Ftracef("scratch name @ "+STR$~(queu%!CONST_queu_scratch_name))
      B%=CONST_ident_TBFF
      C%=PrinterBufferSize
      s%=USR(code_entry%+CONST_entry_heap_claim)
      IF s%=0 ERROR CONST_error_fatal,\
          FNmsg_1(A%!CONST_interface_host_desc,"FA5","TBFF")
      queu%!CONST_queu_tbff=s%
      prnt%!CONST_prnt_flags=prnt%!CONST_prnt_flags OR CONST_prnt_flags_printing
      PROCprinter_status(prnt%)
      PROCredraw_queue_entry(-1,prnt%,0)
      IF queu%!CONST_queu_type<>pr_type% THEN
        IF prnt%!CONST_prnt_flags AND CONST_prnt_flags_notext THEN
          PROCdelete_queue_entry(prnt%,queu%,TRUE)
          IF prnt%!CONST_prnt_name=0 \
            s$=$prnt%!CONST_prnt_type \
          ELSE \
            s$=$prnt%!CONST_prnt_name
          ERROR CONST_error_ok,\
              FNmsg_1(A%!CONST_interface_host_desc,"OKAC",s$)
        ENDIF
        PROCstart_job(queu%,pr_type%)
      ENDIF
      /*end of code for text-file types*/
    ENDIF
    /*end of "starting afresh" code*/
  ELSE
    /*(continuing to print)
      process a chunk of the file
      IF    the end of the file has been reached
            close the files
            change the printer's status to un-printing
            update the iconbar icon
            remove the queue entry (results in the necessary redrawing and
               deletion of temporary files)
      ELSE  update the display to show the percentage
      FI
    */
    IF EOF#queu%!CONST_queu_handle_in AND queu%!CONST_queu_buff_in=0 THEN
      /*has the scratch file been emptied?*/
      t%=EXT#queu%!CONST_queu_handle_scratch-\
          PTR#queu%!CONST_queu_handle_scratch
      IF t% THEN
        IF cnct%!CONST_cnct_type=1 OR cnct%!CONST_cnct_type=2 THEN
          SYS "OS_Byte",128,NOT FNbuffer(cnct%!CONST_cnct_type)TO\
              ,size%,load%
          size%=size% OR load%<<8
          IF size%>PrinterBufferSize size%=PrinterBufferSize
        ELSE
          size%=PrinterBufferSize2
        ENDIF

        PROCprocess_scratch_file(queu%,t%,size%)
        ENDPROC
      ENDIF

      /*have we finished writing OUR buffer?*/
      finished%=TRUE

      /*ok - if parallel or serial, is the buffer empty?*/
      IF cnct%!CONST_cnct_type=1 OR cnct%!CONST_cnct_type=2 THEN
        SYS "OS_Byte",152,FNbuffer(cnct%!CONST_cnct_type)TO;b%
        IF(b% AND 2)=0 finished%=FALSE
      ENDIF

      IF finished% THEN
        /*This routine does all the necessary tidying up, but only when
          we've finished writing to the printer*/
        PROCprinter_status(prnt%)
#ifdef Sparrow
        application$ = $queu%!CONST_queu_sender
        leafname$    = $queu%!CONST_queu_leaf
#endif
        PROCdelete_queue_entry(prnt%,queu%,TRUE)
#ifdef Sparrow
        IF cnct%!CONST_cnct_type = 9 AND printer_prefix$ <> "" THEN
Ftracef ("PROCprint_file: end of job, this is a conn type 9")
          name$ = $(prnt%!CONST_prnt_name)
          ptr% = INSTR(name$, " ") /* Hard space */
          WHILE ptr%
            MID$(name$,ptr%,1) = CHR$160
            ptr% = INSTR(name$, " ", ptr%+1)
          ENDWHILE
          sname$ = printer_prefix$+"RemSpool."+unique_string$+"."+name$
          qname$ = printer_prefix$+"RemQueue."+unique_string$+"."+STR$(remote_jobno%)
          IF FNwrite_information_file (prnt%, application$, leafname$) THEN
           Ftracef ("Trying to rename from "+sname$+" to "+qname$)
           lpsup% = selected_prnt%!CONST_prnt_psup
           /*SYS "XOS_File", 18, sname$, lpsup%!CONST_psup_type*/
           SYS "XOS_FSControl", 25, sname$, qname$
          ELSE
           Ftracef ("Deleting "+sname$+" because of an error")
           SYS "XOS_File", 6, sname$
          ENDIF
          s$=FNselect_connection(prnt%,TRUE,FALSE)
          IF s$<>"" THEN
            PROCerror_warning(s$)
          ENDIF
        ENDIF
#endif
      ENDIF
    ELSE
      PROCjob_chunk(prnt%,queu%,pr_type%)
    ENDIF
  ENDIF
ENDPROC

  /*Text printing code*/

DEF PROCstart_job(queu%,output_type%)
  LOCAL i%,p%,name$
  LOCAL ERROR
  ON ERROR LOCAL RESTORE ERROR: PROCjob_chunk_error(A%!CONST_interface_nudged_prnt,A%!CONST_interface_nudged_queu)
  Ftracef("PROCstart_job")
  /*this is the first call to us, so let's claim our public text block*/
  B%=CONST_ident_TPUB
  C%=CONST_tpub_MAX
  p%=USR(code_entry%+CONST_entry_heap_claim)
  IF p%=0 ERROR CONST_error_fatal,FNmsg_1(A%!CONST_interface_host_desc,"FA5","TPUB")
  queu%!CONST_queu_tpub=p%
  IF 0<=CONST_tpub_MAX-4
    FOR i%=0 TO CONST_tpub_MAX-4 STEP 4
      p%!i%=0
    NEXT
  ENDIF

  ?buff1%=3
  SYS "OS_Word",14,buff1%
  SYS "OS_ConvertStandardDateAndTime",buff1%,buff1%+5,250
  B%=buff1%+5
  C%=2
  p%!CONST_tpub_time=USR(code_entry%+CONST_entry_store_string)
  IF queu%?CONST_queu_status AND 2 THEN
    name$=$queu%!CONST_queu_sender+" - "+$queu%!CONST_queu_leaf
  ELSE
    name$=$queu%!CONST_queu_path
    IF LEN name$>40 THEN
      name$=RIGHT$(name$,40)
      name$=MID$(name$,1+INSTR(name$,"."))
    ENDIF
  ENDIF
  $task_buff%=name$
  B%=task_buff%
  C%=2
  p%!CONST_tpub_name=USR(code_entry%+CONST_entry_store_string)
  p%!CONST_tpub_line_flag=1 /*force the text engine to start a new line*/
  $task_buff%=STRING$(32," ")
  B%=task_buff%
  C%=5
  D%=32
  p%!CONST_tpub_layout_line=USR(code_entry%+CONST_entry_store_string) /*a blank 32 char layout buffer*/
  p%!CONST_tpub_style_bits=&80
  PROCtext_printer_code(A%!CONST_interface_nudged_prnt,A%!CONST_interface_nudged_queu,-1)
ENDPROC

DEF PROCjob_chunk_error(prnt%,queu%)
  Ftracef("PROCjob_chunk_error")
  Ftracef("Error is "+REPORT$)
  /* now delete the offending job */
  PROCdelete_queue_entry(prnt%,queu%,TRUE)
  /* suspend the printer ... but only if there is more stuff in the queue */
  IF prnt%!CONST_prnt_queu<>0 THEN
    prnt%!CONST_prnt_flags = prnt%!CONST_prnt_flags OR CONST_prnt_flags_suspended
    PROCprinter_status(prnt%)
  ENDIF
  ERROR CONST_error_ok,FNmsg_1(A%!CONST_interface_host_desc,"OKPa",REPORT$)
ENDPROC

DEF PROCjob_chunk(prnt%,queu%,output_type%)
  LOCAL l%,t%,new_perc%,len%,b$,p%,tpub%,cnct%,text%,psup%
  LOCAL ERROR
  ON ERROR LOCAL RESTORE ERROR: PROCjob_chunk_error(prnt%,queu%)
  Ftracef("PROCjob_chunk")

  cnct%=prnt%!CONST_prnt_cnct
  psup%=prnt%!CONST_prnt_psup
  tpub%=queu%!CONST_queu_tpub

  IF cnct%!CONST_cnct_type=1 OR cnct%!CONST_cnct_type=2 THEN
    SYS "OS_Byte",128,NOT FNbuffer(cnct%!CONST_cnct_type)TO,len%,l%
    len%=len% OR l%<<8
    Ftracef(STR$ len%+" bytes in buffer "+STR$ FNbuffer(cnct%!CONST_cnct_type))
    IF len%>PrinterBufferSize len%=PrinterBufferSize
  ELSE
    len%=PrinterBufferSize2
  ENDIF

  /*if there is some scratch data to output, do it, unless there is already
    some pending buffered data*/
  l%=EXT#queu%!CONST_queu_handle_scratch-PTR#queu%!CONST_queu_handle_scratch
  IF queu%!CONST_queu_buff_in l%=0
  Ftracef(STR$ l%+" bytes in scratch file")
  IF l% PROCprocess_scratch_file(queu%,l%,len%): ENDPROC

  SYS "Hourglass_On"
  l%=queu%!CONST_queu_ext-PTR#queu%!CONST_queu_handle_in

  IF queu%!CONST_queu_type=output_type% THEN
    IF PTR#(queu%!CONST_queu_handle_in)=0 THEN
      task_buff%!8=queu%!CONST_queu_handle_out
      task_buff%!12=queu%!CONST_queu_handle_in
      PROCtext_printer_code(prnt%,queu%,-20)
    ENDIF

    /*send straight to printer, do not pass go, etc*/
    IF l%>len% l%=len%
    Ftracef("Sending "+STR$ l%+" bytes straight to the printer")
    SYS "OS_GBPB",4,queu%!CONST_queu_handle_in,task_buff%,l% /*Read*/
    SYS "OS_GBPB",2,queu%!CONST_queu_handle_out,task_buff%,l% /*Write*/
  ELSE
    IF queu%!CONST_queu_type=&FFF OR (psup%!CONST_psup_text AND 1)<>0 THEN
      /*text printing*/
      CASE tpub%!CONST_tpub_stage OF
        WHEN 0
          task_buff%!8=queu%!CONST_queu_handle_scratch
          PROCtext_printer_code(prnt%,queu%,-2)
          queu%!CONST_queu_perc=-1
          tpub%!CONST_tpub_stage=1
        WHEN 1
          task_buff%!8=queu%!CONST_queu_handle_scratch
          PROCtext_printer_code(prnt%,queu%,-3)
          queu%!CONST_queu_perc=0
          tpub%!CONST_tpub_stage=2
        WHEN 2
          IF psup%!CONST_psup_text AND 2 THEN
            IF queu%!CONST_queu_buff_in=0 THEN
              PROCtext_trans(0)
              task_buff%!8=queu%!CONST_queu_buff_in
              PROCprinter_buffer(queu%,FNtext_printer_string(prnt%,queu%,-4))
              PROCoutput_buffer(prnt%,queu%,len%)
              /*to ensure that the footer gets done, especially when we've
                reached the end of the file, we'll do it now!*/
              IF tpub%!CONST_tpub_stage=3 THEN
                task_buff%!8=queu%!CONST_queu_handle_scratch
                PROCtext_printer_code(prnt%,queu%,-14)
                tpub%!CONST_tpub_stage=1
              ENDIF
            ELSE
              PROCoutput_buffer(prnt%,queu%,len%)
            ENDIF
          ELSE
            IF queu%!CONST_queu_buff_in=0 THEN
              /*although the buffer size claimed is 256 bytes
                we need to keep the time slice down (hence the 64)
                also, we CANNOT output more than the permitted
                size, as indicated by len%*/
              t%=PrinterBufferSize4
              IF t%>len% t%=len%
              queu%!CONST_queu_buff_out=0
              PROCtext_trans(t%)
              IF tpub%!CONST_tpub_pause_flag THEN
                /*first of all - pause the printer!*/
                PROCpause_printer(prnt%)
                PROCopen_pause_window(prnt%)
                p%=tpub%!CONST_tpub_pause_flag
              ENDIF
            ENDIF
            IF len%>queu%!CONST_queu_buff_in len%=queu%!CONST_queu_buff_in
            IF tpub%!CONST_tpub_pause_flag<>0 AND len%>p% len%=p%
            Ftracef("Sending "+STR$ len%+" bytes")
            IF len% \
              SYS "OS_GBPB",2,queu%!CONST_queu_handle_out,\
                  queu%!CONST_queu_tbff+queu%!CONST_queu_buff_out,len%
                  /*Write*/
            queu%!CONST_queu_buff_in-=len%
            queu%!CONST_queu_buff_out+=len%
          ENDIF
      ENDCASE
    ELSE
      /*plain printing*/
      t%=LEN FNprinter_read_string(tpub%!CONST_tpub_line_epilogue)
      Ftracef("Sending "+STR$ len%+" bytes")
      WHILE l% AND len%>t%
        b$=FNtext_plain(BGET#queu%!CONST_queu_handle_in,tpub%)
        l%-=1
        IF b$<>"" BPUT#queu%!CONST_queu_handle_out,b$;
        len%-=LEN b$
      ENDWHILE
    ENDIF
  ENDIF

  /*if we have done all the processing, do the job termination*/
  IF EOF#queu%!CONST_queu_handle_in AND queu%!CONST_queu_buff_in=0 THEN
    task_buff%!8=queu%!CONST_queu_handle_scratch
    PROCtext_printer_code(A%!CONST_interface_nudged_prnt,\
        A%!CONST_interface_nudged_queu,-15)
  ENDIF

  IF queu%!CONST_queu_ext=0 \
    new_perc%=0 \
  ELSE \
    new_perc%=PTR#queu%!CONST_queu_handle_in*100/queu%!CONST_queu_ext

  IF new_perc%<>queu%!CONST_queu_perc THEN
    queu%!CONST_queu_perc=new_perc%
    Ftracef("updating queue window")
    PROCredraw_queue_entry(-1,prnt%,queu%)
  ENDIF

  /*in case some data has been put into the back-end, reset the pointer*/
  PTR#queu%!CONST_queu_handle_scratch=0
  SYS "Hourglass_Off"
ENDPROC

DEF PROCprocess_scratch_file(queu%,to_do%,len%)
  Ftracef("PROCprocess_scratch_file")
  IF to_do%>len% to_do%=len%
  SYS "OS_GBPB",4,queu%!CONST_queu_handle_scratch,task_buff%,to_do% /*Read*/
  SYS "OS_GBPB",2,queu%!CONST_queu_handle_out,task_buff%,to_do% /*Write*/
  IF EXT#queu%!CONST_queu_handle_scratch-PTR#queu%!CONST_queu_handle_scratch=0 THEN
    PTR#queu%!CONST_queu_handle_scratch=0
    EXT#queu%!CONST_queu_handle_scratch=0
  ENDIF
ENDPROC

DEF FNtext_plain(C%,tpub%)
  LOCAL r$
  Ftracef("FNtext_plain")

  IF C%=10 OR C%=13 THEN
    IF tpub%!CONST_tpub_line_flag=1 OR tpub%!CONST_tpub_line_flag=C% \
      r$=FNprinter_read_string(tpub%!CONST_tpub_line_epilogue)

    tpub%!CONST_tpub_line_flag=C%
  ELSE
    IF tpub%!CONST_tpub_line_flag r$=FNprinter_read_string(tpub%!CONST_tpub_line_epilogue)
    r$+=CHR$ C%

    tpub%!CONST_tpub_line_flag=0
  ENDIF
=r$

DEF PROCprinter_buffer(queu%,s$)
  LOCAL prbff_ptr%,prbff%
  Ftracef("PROCprinter_buffer")
  prbff%=queu%!CONST_queu_tbff
  prbff_ptr%=queu%!CONST_queu_buff_in
  IF s$<>"" THEN
    $(prbff%+prbff_ptr%)=s$
    queu%!CONST_queu_buff_in+=LEN s$
  ENDIF
ENDPROC

DEF PROCoutput_buffer(prnt%,queu%,len%)
  LOCAL prbff_ptr%,prbff%
  Ftracef("PROCoutput_buffer")
  prbff%=queu%!CONST_queu_tbff
  prbff_ptr%=queu%!CONST_queu_buff_in
  IF prbff_ptr% THEN
    IF cnct%!CONST_cnct_type=1 OR cnct%!CONST_cnct_type=2 THEN
      IF prbff_ptr%>=len% ENDPROC
    ENDIF
    prbff%?prbff_ptr%=10
    prbff_ptr%+=1
    prbff%?prbff_ptr%=13
    SYS "OS_GBPB",2,queu%!CONST_queu_handle_out,prbff%,prbff_ptr% /*Write*/
    queu%!CONST_queu_buff_in=0
  ENDIF
ENDPROC

DEF PROCtext_printer_code(prnt%,queu%,code%)
  /*LOCAL c%
    c%=OPENUP "$.Profile": IF c%=0 c%=OPENOUT "$.Profile"
    PTR#c%=EXT#c%
    BPUT#c%,STR$ code%
    CLOSE#c%*/
  Ftracef("PROCtext_printer_code")
  Ftracef("text code = "+STR$(code%))
  Ftracef("queu block = &"+STR$~(queu%))
  task_buff%!0=code%
  task_buff%!4=queu%
  PROCprinter_reason_code(prnt%!CONST_prnt_psup,prnt%,-8,task_buff%)
ENDPROC

DEF FNtext_printer_string(prnt%,queu%,code%)
  LOCAL s$,i%
  Ftracef("FNtext_printer_string")

  task_buff%!0=code%
  task_buff%!4=queu%
  PROCprinter_reason_code(prnt%!CONST_prnt_psup,prnt%,-8,task_buff%)

  i%=task_buff%+8
  CALL Y%,i%,s$ /*convert counted string*/
=s$

DEF PROCtext_trans(F%)
  LOCAL psup%
  Ftracef("PROCtext_trans")
  psup%=prnt%!CONST_prnt_psup
  B%=psup%
  C%=queu%
  D%=tpub%
  E%=buff1%+128
  E%!0=psup%
  E%!4=prnt%
  E%!8=queu%
  E%!12=tpub%
  E%!16=task_buff%
  E%!20=buff1%+356
  $(buff1%+356)=CHR$ &A4+$psup%!CONST_psup_class+"_support("+STR$ buff1%+")"
  buff1%!0=-8
  buff1%!4=psup%
  buff1%!8=prnt%
  buff1%!12=task_buff%
  buff1%!16=psize_head%
  buff1%!20=code_entry%
  buff1%!24=F%
  IF F%=0 CALL code_entry%+CONST_entry_postscript ELSE CALL code_entry%+CONST_entry_dot_matrix
ENDPROC

/*Buffer handling. Always return buffer 3 first, then 2 for serial or 10*/
/*  for parallel. Assumes that there is only one thread of processes*/
/*  trying to use serial and parallel.*/

DEF FNbuffer_ensure(t%)
  Ftracef("FNbuffer_ensure")
  CASE t% OF
    WHEN 1
      /*Parallel*/
      IF A%!CONST_interface_parallel_buffer=0 THEN
        IF A%!CONST_interface_serial_buffer<>3 THEN
          A%!CONST_interface_parallel_buffer=3
        ELSE
          A%!CONST_interface_parallel_buffer=10
        ENDIF
      ENDIF
      =A%!CONST_interface_parallel_buffer
    WHEN 2
      /*Serial*/
      IF A%!CONST_interface_serial_buffer=0 THEN
        IF A%!CONST_interface_parallel_buffer<>3 THEN
          A%!CONST_interface_serial_buffer=3
        ELSE
          A%!CONST_interface_serial_buffer=2
        ENDIF
      ENDIF
      =A%!CONST_interface_serial_buffer
  ENDCASE
=0

DEF PROCbuffer_free(t%)
  Ftracef("PROCbuffer_free")
  CASE t% OF
    WHEN 1
      A%!CONST_interface_parallel_buffer=0
    WHEN 2
      A%!CONST_interface_serial_buffer=0
  ENDCASE
ENDPROC

DEF FNbuffer(t%)
  Ftracef("FNbuffer")
  CASE t% OF
    WHEN 1
      =A%!CONST_interface_parallel_buffer
    WHEN 2
      =A%!CONST_interface_serial_buffer
  ENDCASE
=0

DEF FNsupport_higher_baudrates
LOCAL r0%,r1%
SYS"OS_ReadSysInfo",3 TO r0%,r1%
REM if bits 12-15 of R0 = 1 and bits 12-15 of R1 = 1 then yes we do
IF(r0%AND61440)=4096 AND (r1%AND61440)=4096 :=TRUE
=FALSE

DEF FNsupport_fast_parallel
LOCAL r0%
SYS"OS_File",5,"Devices:FastParallel" TO r0%
IFr0%<>0 THEN
 := "FastParallel"
ELSE
 := "Parallel"
ENDIF

DEF FNrmload_latest_module(name$, path$)
/*
   Strategy:
    * is the module currently in memory?
    * if so, what is its version number?
    * is the module in ROM?
    * if so, what is its version number?
    * is the module on disc?
    * if so, what is its version number?
    * use whichever module has the latest version
*/
LOCAL ram_version%, rom_version%, disc_version%
LOCAL ptr%,f%,r1%,r2%,r6%,s$,rom_state%

ram_version%=-1
SYS"XOS_Module",18,name$ TO ,,,ptr%;f%
IF(f%AND1)=0 AND ptr%!&14<>0 THEN
 ptr%+=(ptr%!&14)
 WHILE ?ptr%<>9 AND ?ptr%<>0
  ptr%+=1
 ENDWHILE
 IF?ptr%<>0 THEN
  ram_version%=0:ptr%+=1
  WHILE ?ptr%<>32
   IF?ptr%>=ASC"0" AND ?ptr%<=ASC"9" THEN
    ram_version%=ram_version%*10+?ptr%-ASC"0"
   ENDIF
   ptr%+=1
  ENDWHILE
 ENDIF
ENDIF

rom_version%=-1
r1%=0:r2%=-1
REPEAT
 SYS"XOS_Module",20,r1%,r2% TO ,r1%,r2%,ptr%,rom_state%,,r6%;f%
 IF(f%AND1)=0 THEN
  CALL Z%,ptr%,s$
  IFs$=name$ rom_version%=VAL(STR$~(r6%))/100
 ENDIF
UNTIL (rom_version%<>-1) OR (f%AND1)<>0

disc_version%=-1
SYS"XOS_Find",&43,path$ TO f%;ptr%
IF(ptr%AND1) f%=0
IFf%<>0 THEN
 PTR#f%=&14:ptr%=BGET#f%+((BGET#f%)<<8)+((BGET#f%)<<16)+((BGET#f%)<<24)
 IFptr%<>0 THEN
  PTR#f%=ptr%
  REM find the start of the version number
  REPEAT
   r1%=BGET#f%
  UNTIL r1%=0 OR r1%=9
  IFr1%<>0 THEN
   disc_version%=0
   REPEAT
    r1%=BGET#f%
    IFr1%>=ASC"0" AND r1%<=ASC"9" THEN
     disc_version%=disc_version%*10+r1%-ASC"0"
    ENDIF
   UNTIL r1%=32
  ENDIF
 ENDIF
 CLOSE#f%
ENDIF

/* find the latest version number */
IFram_version%>rom_version% r1%=ram_version% ELSE r1%=rom_version%
IFr1%>disc_version% f%=r1% ELSE f%=disc_version%

/* no error yet */
r1%=0
/* now take the appropriate action */
IFrom_version%=f% THEN
 IFrom_state%<1 THEN
  SYS"XOS_Module",4 /* rmkill */, name$
  SYS"XOS_Module",3 /* rmreinit */, name$ TO ptr%;r1%
 ENDIF
ENDIF

/* only load the disc version if it is greater than a currently loaded version */
IFdisc_version%=f% AND disc_version%>rom_version% AND disc_version%>ram_version%THEN
 SYS"XOS_Module",1 /* rmload */, path$ TO ptr%;r1%
ENDIF

/* check that we've got a module */
IF(r1%AND1)=0 SYS"XOS_Module",18,name$ TO ptr%;r1%
IF(r1%AND1) !ptr%=CONST_error_fatal:SYS"OS_GenerateError",ptr%

/* return the version loaded */
=f%

DEF FNparallel_error_detect_possible
LOCAL flags%
IF parallel_possible% \
   SYS"XParallel_Op",0TO;flags%
ELSE
   flags%=1
ENDIF
=(flags%AND1)=0

DEF FNparallel_paper_out
LOCAL flags%,s%
SYS"XParallel_Op",0TO,,s%;flags%
IF(flags%AND1)=1 THEN =0
/*IF(s%AND&A0)<>&80 THEN =0 / * If ~BUSY!=1 or ~ACK!=0 then confused - so bale */
=(s%AND&20)=&20

DEF FNparallel_error
LOCAL flags%,s%
SYS"XParallel_Op",0TO,,s%;flags%
IF(flags%AND1)=1 THEN =0
/* IF(s%AND&A0)<>&80 THEN =1 / * If ~BUSY!=1 or ~ACK!=0 then confused - so bale */
=(s%AND&8)=0

DEF PROCinit_detect_protocols
parallel_possible%=FALSE
SYS "XOS_Module",18,"ParallelDeviceDriver" TO ;f%
IF ((f% AND 1)=0) THEN parallel_possible%=TRUE
lpr_possible%=FALSE
f%=OPENIN("Printers:Modules.lprDriver")
IF f%<>0 THEN lpr_possible%=TRUE:CLOSE#f%
SYS "XOS_Module",18,"lprDeviceDriver" TO ;f%
IF ((f% AND 1)=0) THEN lpr_possible%=TRUE
f%=OPENIN("Printers:Modules.JetDirect")
jetdirect_possible%=FALSE
IF f%<>0 THEN jetdirect_possible%=TRUE:CLOSE#f%
SYS "XOS_Module",18,"JetDirectFS" TO ;f%
IF ((f% AND 1)=0) THEN jetdirect_possible%=TRUE
ENDPROC

DEF PROCload_lpr
LOCAL dummy%
dummy%=FNrmload_latest_module("lprDeviceDriver","Printers:Modules.lprDriver")
SYS "XOS_Module",18,"lprDeviceDriver" TO ;f%
IF ((f% AND 1)=1) THEN lpr_possible%=FALSE
IF NOT lpr_possible% THEN PROCerror_warning(FNmsg_2(A%!CONST_interface_host_desc,"WA9",\
                                            $prnt%!CONST_prnt_type,FNmsg_0(A%!CONST_interface_host_desc,"CN10")))
ENDPROC

DEF PROCload_jetdirect
LOCAL dummy%
dummy%=FNrmload_latest_module("JetDirectFS","Printers:Modules.JetDirect")
SYS "XOS_Module",18,"JetDirectFS" TO ;f%
IF ((f% AND 1)=1) THEN jetdirect_possible%=FALSE
IF NOT jetdirect_possible% THEN PROCerror_warning(FNmsg_2(A%!CONST_interface_host_desc,"WA9",\
                                            $prnt%!CONST_prnt_type,FNmsg_0(A%!CONST_interface_host_desc,"CN13")))
ENDPROC

DEF FNbinfeed_save(path$,dir$,s$,t$,buff%)
  LOCAL j%,i%,k%,n%
  dir$="Printers:"+path$+"."+dir$+"."+s$
  k%=0
  n%=0
  REPEAT
    SYS"OS_GBPB",9,dir$,buff%,1,k%,256,"*" TO ,,,i%,k%
    IFi%=1 THEN
      CALL Z%,buff%,s$
      i%=OPENIN(dir$+"."+s$)
      IF i%<>0 THEN
        s$=GET$#i%
        CLOSE#i%
        IF LEFT$(s$,6)="name: " THEN s$=MID$(s$,7)
        IF FNtask_compare(t$,s$)=0 THEN
          j%=n%
        ENDIF
      ENDIF
      n%+=1
    ENDIF
  UNTIL k%=-1
=j%

DEF PROCbinfeed_menu(path$,RETURN menu%,s$,t$,a$,buff%)
  PROCmenu_create(menu%,FNmsg_0(psup%!CONST_psup_msg,s$))
  ind_title%=(menu%!28 AND &100)<>0
  /* scan the list of available paper feeds */
  list_index%=0
  menu_index%=0:REM add items after default entry
  t$="Printers:"+path$+"."+t$+"."+a$
  SYS"Hourglass_On"
  i%=0
  REPEAT
    SYS"OS_GBPB",9,t$,buff%,1,i%,256,"*" TO ,,,j%,i%
    IFj%=1 THEN
      CALL Z%,buff%,s$
      j%=OPENIN(t$+"."+s$)
      IF j%<>0 THEN
        s$=GET$#j%
        CLOSE#j%
      ELSE
        s$="name: "
      ENDIF
      IF LEFT$(s$,6)="name: " THEN s$=MID$(s$,7)
      PROCmenu_item(menu%,menu_index%,s$,ind_title%):menu_index%+=1
    ENDIF
  UNTIL i%=-1
  SYS"Hourglass_Off"
ENDPROC

DEF FNgen_strings(path$,j%,t$,dir$,buff%)
  LOCAL i%,got%,s$
  i%=0
  j%+=1
  REPEAT
    SYS"OS_GBPB",9,"Printers:"+path$+"."+t$+"."+dir$,buff%,1,i%,256,"*" TO ,,,got%,i%
    j%-=1
  UNTIL i%=-1 OR j%=0
  IF got% AND j%=0 THEN
    CALL Z%,buff%,s$
    i%=OPENIN("Printers:"+path$+"."+t$+"."+dir$+"."+s$)
    IF i% THEN
      s$=GET$#i%
      s$=GET$#i%
      CLOSE#i%
      IF LEFT$(s$,6)="data: " THEN :=MID$(s$,7)
    ELSE
      s$=""
    ENDIF
  ENDIF
=s$

DEF FNget_gen_name(path$,dir$,j%,t$,buff%)
  LOCAL i%,got%,s$
  i%=0
  j%+=1
  REPEAT
    SYS"OS_GBPB",9,"Printers:"+path$+"."+t$+"."+dir$,buff%,1,i%,256,"*" TO ,,,got%,i%
    j%-=1
  UNTIL i%=-1 OR j%=0
  IF got% AND j%=0 THEN
    CALL Z%,buff%,s$
    i%=OPENIN("Printers:"+path$+"."+t$+"."+dir$+"."+s$)
    IF i% THEN
      s$=GET$#i%
      CLOSE#i%
      IF LEFT$(s$,6)="name: " THEN :=MID$(s$,7)
    ENDIF
  ENDIF
=""

#include "sources.Sparrow"

/* resident support code */
#ifndef DISC
#  include "sources.SupportDP"
#  include "sources.SupportLJ"
#  include "sources.SupportPS"
#endif

