/* ***** 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 ***** */

#ifdef Sparrow

DEF PROCinitialise_sparrow (startup%)

  LOCAL f%, g%, fs%, rps%, s$, dummy%

  Ftracef("PROCinitialise_sparrow")

  multiple_choices% = FALSE

  /* start-up latest version of RemotePrinterSupport */
  IFFNrmload_latest_module("PDriver","Printers:Modules.PDriver")
  IFFNrmload_latest_module("RemotePrinterSupport","Printers:Modules.RemPrnSpt")

  fs%=0
  SYS "XOS_Module", 18, "Freeway" TO ;f%
  IF (f% AND 1) = 0 THEN
    SYS "XOS_SWINumberFromString",,"Freeway_Status" TO ;g%
    IF (g% AND 1) = 0 THEN SYS "XFreeway_Status",0 TO ,fs% ELSE fs% = 1
  ENDIF
  SYS "XOS_Module", 18, "RemotePrinterSupport" TO ;rps%
  SYS "XOS_Module", 18, "ShareFS" TO ;g%

  IF (f% AND 1) OR (fs% = 0) OR (g% AND 1) OR (rps% AND 1) THEN
    sparrow_present% = FALSE
  ELSE
  
    SYS "XOS_CLI", "RMEnsure ShareFS 2.00 ERROR Foo" TO ;f%
    
    IF (f% AND 1) THEN
      sparrow_present% = FALSE
    ELSE
    
      unique_string$ = FNtask_read_env("Inet$LocalAddr", task_buff%)
    
      sparrow_present% = TRUE
      PROCfreeway_register

      dummy%=FNrmload_latest_module("PathUtils", "Printers:Modules.PathUtils")

      freeway_my_choices_shared%=FALSE
      /* PROCshare_my_choices RJW: New stuff */
    
      PROCenumerate_remote_printers
    
      SYS "XRemotePrinterSupport_Enable", 3 /* Says: OK start passing object added/deleted messages now */
    
      printer_scrap$ = "<Wimp$ScrapDir>.Printers"
    
      s$ = FNtask_read_env ("Printers$Dir", task_buff%)
      IF INSTR(s$, "Share:") THEN
        multiple_choices% = TRUE
      ELSE
        multiple_choices% = FALSE
      ENDIF
      
    ENDIF

  ENDIF

  /*
   * Always do this - we get to know if freeway starts up
   */

  IF (rps% AND 1) = 0 THEN
    SYS "XRemotePrinterSupport_ReadPollwordLocation" TO pollword_location%
  ENDIF

  IF multiple_choices% THEN
    SYS "XOS_File", 8, "<Printers$Path>Remote" TO ; f%
    s$ = "<Printers$Path>Remote.ID"+unique_string$
    SYS "XOS_File", 8, s$ TO ; f%
  ENDIF

ENDPROC


DEF PROCfreeway_register

  Ftracef("PROCfreeway_register")

  SYS "Freeway_Register", CONST_freeway_register_interest, CONST_freewaytype_printers

ENDPROC


DEF FNconvert_null(nullstr%)

  LOCAL thing$

  CALL Z%, nullstr%, thing$

= thing$


DEF PROCenumerate_queue_directory

#if 1
  ENDPROC
#else
  LOCAL top_directory$, directory$, top_num_read%, top_offset%, type%, num_read%, offset%, name$, n$, n1$


  /* 
   * Here's the scheme: Enumerate <Wimp$ScrapDir>.Printers.RemQueue looking for directories.
   * For each directory, enumerate it looking for Ixx and then a matching xx file. If both
   * exist, call add_to_queue quoting scsi::....xx as the name. 
   */

  top_directory$ = "<Wimp$ScrapDir>.Printers.RemQueue"

  SYS "OS_GBPB", 12, top_directory$, msg_text%, 1, 0, 256, "*" TO ,,,top_num_read%, top_offset%

Ftracef ("PROCenumerate_queue_dir: Objects read = "+STR$top_num_read%+" Offset = "+STR$top_offset%)

  WHILE (top_offset% <> -1)

    IF (top_num_read% = 1) THEN

      IF msg_text%!16 AND 2 THEN /* A directory or image has been found */

        directory$ = top_directory$+"."+FNconvert_null(msg_text%+24)
        SYS "OS_GBPB", 12, directory$, task_buff%, 1, 0, 256, "*I" TO ,,,num_read%, offset%

  Ftracef ("PROCenumerate_queue_dir: > Directory found, let's enumerate it: "+directory$)
  Ftracef ("PROCenumerate_queue_dir: > Objects read = "+STR$num_read%+" Offset = "+STR$offset%)

        WHILE (offset% <> -1)

          IF num_read% = 1 THEN

            name$ = FNconvert_null (task_buff%+24)
            name$ = LEFT$(name$, LEN(name$) - 1)

    Ftracef ("Got a filename of "+name$+" type "+STR$(task_buff%!16))

            IF (task_buff%!16) AND 1 THEN /* It's a file, therefore add it to the queue */
              n$ = directory$+"."+name$
              n$ = MID$(n$, INSTR(n$, ".") + 1)
              n$ = MID$(n$, INSTR(n$, ".") + 1) /* Chop off <Wimp$ScrapDir>.Printers. */
    Ftracef ("PROCenumerate_queue_dir: > > > Adding to queue: "+n$)
              PROCadd_to_queue (n$)
            ENDIF

    Ftracef ("PROCenumerate_queue_dir: > > Objects read = "+STR$num_read%+" Offset = "+STR$offset%+" "+FNconvert_null(task_buff%+24))

          ENDIF /* If num_read% = 1 */

          SYS "OS_GBPB", 12, directory$, task_buff%, 1, offset%, 256, "*I" TO ,,,num_read%, offset%

        ENDWHILE

      ENDIF

    ENDIF /* top_num_read% = 1 */

    SYS "OS_GBPB", 12, top_directory$, msg_text%, 1, top_offset%, 256, "*" TO ,,,top_num_read%, top_offset%
    Ftracef ("PROCenumerate_queue_dir: Objects read = "+STR$top_num_read%+" Offset = "+STR$top_offset%)

  ENDWHILE

ENDPROC
#endif

DEF PROCenumerate_remote_printers

  LOCAL here%, enum_ref%, new_enum_ref%, nlen%, dlen%, ip%, name$, err%
  LOCAL printer_name%, printer_descriptor%, name$, descriptor$, rmtp%, doit%

  Ftracef("PROCenumerate_remote_printers")

  enum_ref% = 0
  new_enum_ref% = 0

  remote_printer_count% = 0

  REPEAT
    Ftracef("Top of repeat loop")

    enum_ref% = new_enum_ref%

    SYS "Freeway_Enumerate", 0, CONST_freewaytype_printers, 0, 0, 0, 0, 0, enum_ref% \
                             TO ,,nlen%,,dlen%,,,new_enum_ref%

    Ftracef ("PROCenumerate_remote_printers: Done first, old enum ref = "+STR$enum_ref%+" new = "+STR$new_enum_ref%) 

    IF (new_enum_ref% > 0) THEN

      Ftracef ("Inside IF, therefore found an object")

      printer_name%        = FNmalloc (CONST_ident_STRG, nlen%)
      printer_descriptor%  = FNmalloc (CONST_ident_STRG, dlen%+1)
      printer_name1%        = FNmalloc (CONST_ident_STR0, nlen%)
      printer_descriptor1%  = FNmalloc (CONST_ident_STR0, dlen%+1)

      Ftracef ("About to do second enumerate")

      SYS "Freeway_Enumerate", 0, CONST_freewaytype_printers, nlen% , printer_name1%, \
                               dlen%+1, printer_descriptor1%, 0, enum_ref% \
                               TO ,,,,,,ip%

    Ftracef ("PROCenumerate_remote_printers: Done second, old enum ref = "+STR$enum_ref%+" new = "+STR$new_enum_ref%) 

      printer_descriptor1%?dlen% = 0

      $printer_name% = FNconvert_null (printer_name1%)
      $printer_descriptor% = FNconvert_null (printer_descriptor1%)

      PROCfree (CONST_ident_STR0, printer_name1%)
      PROCfree (CONST_ident_STR0, printer_descriptor1%)

      Ftracef ("About to add object to list")

      rmtp% = FNconstruct_rmtp (printer_name%, printer_descriptor%, ip%)

      PROCadd_to_list (remote_printers%, rmtp%)

      Ftracef ("Done")

      name$ = $printer_name% /* not sure when this goes away! */

      IF FNprinter_wanted (name$) THEN
        junk% = FNensure_printer (rmtp%, 0, FALSE, TRUE, err%)
        IF NOT err% THEN
          PROCremove_unavailable_printer (name$)
          PROCremove_remote_printer (name$)
          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("PROCselect_printer loc 6a")
                  PROCselect_printer(doit%,TRUE,FALSE)
                  doit%=0
                ELSE
                  doit%=doit%!CONST_prnt_next
                ENDIF
              ENDWHILE
            ENDIF
          ENDIF
        ENDIF
      ENDIF

      remote_printer_count% += 1

    ENDIF /* new_enum_ref > 0 */

  UNTIL (new_enum_ref% < 0)
ENDPROC


DEF PROCadd_remote_printer (name$)
  /*
   * We do this when we get an UpCall indicating that a new printer is
   * on the scene
   */
  LOCAL printer_name%, printer_descriptor%, dlen%, ip%, descriptor$, flags%, rmtp%, junk$, doit%, err%, found%

  SYS "XFreeway_Read", 0, CONST_freewaytype_printers, name$, 0, 0 TO ,,,dlen%,,ip% ; flags%
  IF (flags% AND 1) THEN
    /* Disaster has befallen the world */
    Ftracef ("Oh no, freeway_read_failed in add_remote_printer")
    ENDPROC
  ENDIF

  /*
   * First check the printer isn't already an available remote printer,
   * if so exit
   */

  found% = FALSE
  rmtp% = remote_printers%
  WHILE rmtp%
    IF ($rmtp%!CONST_rmtp_name = name$) AND ((rmtp%!CONST_rmtp_icon) <= 0) THEN
      Ftracef ("Found an available remote printer with this name already - "+name$)
      ENDPROC
    ENDIF
    rmtp% = rmtp%!CONST_rmtp_next
  ENDWHILE

  printer_name% = FNmalloc (CONST_ident_STRG, LENname$ + 1)
  printer_descriptor% = FNmalloc (CONST_ident_STRG, dlen% + 1)
  printer_descriptor1% = FNmalloc (CONST_ident_STR0, dlen% + 1)

  $printer_name% = name$
  
  SYS "XFreeway_Read", 0, CONST_freewaytype_printers, name$, dlen% + 1, printer_descriptor1% TO ; flags%
  IF (flags% AND 1) THEN
    /* Disaster has befallen the world */
    ENDPROC
  ENDIF

  printer_descriptor1%?dlen% = 0

  $printer_descriptor% = FNconvert_null (printer_descriptor1%)

  PROCfree (CONST_ident_STR0, printer_descriptor1%)

  rmtp% = FNconstruct_rmtp (printer_name%, printer_descriptor%, ip%)

  PROCadd_to_list (remote_printers%, rmtp%)

  remote_printer_count% += 1

  IF FNprinter_wanted (name$) THEN
    junk% = FNensure_printer (rmtp%, 0, FALSE, TRUE, err%)

    IF NOT err% THEN 
      PROCremove_unavailable_printer (name$)
      PROCremove_remote_printer (name$)
      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("PROCselect_printer loc 6a")
              PROCselect_remote_printer(doit%,TRUE,FALSE,TRUE,err%)
              doit%=0
            ELSE
              doit%=doit%!CONST_prnt_next
            ENDIF
          ENDWHILE
        ENDIF
      ENDIF
    ENDIF
  ENDIF

  PROCcreate_installed_printer_icons

ENDPROC


DEF PROCremove_unavailable_printer (name$)

  LOCAL last%, here%, found%, iter%

  here%  = remote_printers%
  last%  = 0
  found% = FALSE

  IF here% THEN

    REPEAT
Ftracef ("REMOVE_FROM_LIST: inside while, match name = "+name$+" current name = "+$(here%!CONST_rmtp_name))
      IF ($here%!CONST_rmtp_name) = name$ AND here%!CONST_rmtp_icon > 0 THEN
        found% = TRUE
      ELSE
        last% = here%
        here% = here%!CONST_rmtp_next
      ENDIF
    UNTIL found% OR (here% = 0)

    IF (last% = 0) AND (here% <> 0) THEN  /* First list item */
Ftracef("1st list item needs to be removed") 
      remote_printers% = here%!CONST_rmtp_next

      PROCicon_delete (-2, here%!CONST_rmtp_icon)
Ftracef("About to free name")
      PROCfree (CONST_ident_STRG, here%!CONST_rmtp_name)
Ftracef ("About to free desc")
        PROCfree (CONST_ident_STRG, here%!CONST_rmtp_descriptor)
Ftracef("About to free RMTP block")
      PROCfree (CONST_ident_RMTP, here%)

    ELSE
      IF here% THEN /* Any other list item */
Ftracef("Other list item needs to be removed")
        last%!CONST_rmtp_next = here%!CONST_rmtp_next

        PROCicon_delete (-2, here%!CONST_rmtp_icon)
Ftracef ("About to free name")
        PROCfree (CONST_ident_STRG, here%!CONST_rmtp_name)
Ftracef ("About to free desc")
        PROCfree (CONST_ident_STRG, here%!CONST_rmtp_descriptor)
Ftracef ("About to free rmtp block")
        PROCfree (CONST_ident_RMTP, here%)

      ENDIF
    ENDIF

  ENDIF

ENDPROC


DEF FNprinter_wanted (name$)

  LOCAL here%, wanted%

  here% = remote_printers%
  wanted% = FALSE

  WHILE here% AND NOT wanted%
    IF $here%!CONST_rmtp_name = name$ AND here%!CONST_rmtp_icon > 0 THEN
      wanted% = TRUE
    ELSE
      here% = here%!CONST_rmtp_next
    ENDIF
  ENDWHILE

= wanted%


DEF PROCremove_remote_printer (name$)

  LOCAL prnt%, last_prnt%, ptr%, cnct%, doit%, type$, psup%, class$

  Ftracef ("DEF PROCremove_remote_printer")


  IF FNmember_of_list (remote_printers%, name$) THEN
    /* It's an inactive remote printer */
    PROCremove_from_list (remote_printers%, name$)
  ELSE
    last_prnt% = 0
    prnt% = A%!CONST_interface_printer_installed
    ptr% = prnt%
    cnct% = prnt%!CONST_prnt_cnct

    WHILE ptr%
      IF $ptr%!CONST_prnt_name = name$ AND cnct%!CONST_cnct_type = 9 THEN
        /* We've found our match */
        ptr% = 0
      ELSE
        last_prnt% = prnt%
        prnt% = prnt%!CONST_prnt_next
        ptr% = prnt%
        cnct% = prnt%!CONST_prnt_cnct
      ENDIF
    ENDWHILE

    IF prnt% THEN
      psup% = prnt%!CONST_prnt_psup
      class$ = $psup%!CONST_psup_class
      type$ = $prnt%!CONST_prnt_type
      PROCadd_unavailable_printer (name$, class$, type$)
      PROCremove_this_printer (prnt%,last_prnt%)
      PROCdelete_prdata_entry (type$)
    ENDIF
  ENDIF

  IF FNwindow_open (prntctrl%) THEN
    PROCcreate_installed_printer_icons
    PROCwin_open (prntctrl%)
  ENDIF

ENDPROC


DEF FNip_string(ip%)
= STR$~ip%


/*
 * Memory allocation with error checking.
 */

DEF FNmalloc (ident%, size%)

  LOCAL ret%

  B% = ident%
  C% = size%

  Ftracef("FNmalloc, ident = "+CHR$(B% AND &000000ff)+CHR$((B% AND &0000FF00) >> 8)+CHR$((B% AND &00FF0000) >> 16)+CHR$((B% AND &FF000000) >> 24)+" size = "+STR$size%)

  ret% = USR (code_entry% + CONST_entry_heap_claim)
  IF (ret% = 0) THEN
    ERROR CONST_error_fatal, FNmsg_1 (A%!CONST_interface_host_desc, "FA5", \
        CHR$((B% AND &FF000000) >> 24)+CHR$((B% AND &00FF0000) >> 16)+CHR$((B% AND &0000FF00) >> 8)+CHR$(B% AND &000000ff))
  ENDIF

= ret%


DEF PROCfree (ident%, block%)
  Ftracef("Sparrow: freeing block at &"+STR$~(block%)+" with ident &"+STR$~(ident%))
  B% = ident%
  C% = block%
  CALL code_entry% + CONST_entry_heap_free

ENDPROC


DEF PROCstrcpy (RETURN dest%, str$)

  $task_buff% = str$
  B% = task_buff%
  C% = 2

  dest% = USR(code_entry%+CONST_entry_store_string)

ENDPROC


/*
 * Allocate a remote printer information block, and fill in the fields
 */    

DEF FNconstruct_rmtp (printer_name%, printer_descriptor%, printer_ip_address%)

  LOCAL ret%

  Ftracef ("FNconstruct_rmtp")

  /*
   * Allocate a RMTP block
   */

  ret% = FNmalloc (CONST_ident_RMTP, CONST_rmtp_MAX)

  /*
   * Populate it
   */

  ret%!CONST_rmtp_next = 0
  ret%!CONST_rmtp_name = printer_name%
  ret%!CONST_rmtp_descriptor = printer_descriptor%
  ret%!CONST_rmtp_IP_address = printer_ip_address%
  ret%!CONST_rmtp_pane = -1
  ret%!CONST_rmtp_icon = -1

= ret%

DEF FNconstruct_unavailable (name$, icon%, desc$)

  LOCAL ret%, str%, desc%
  
  ret% = FNmalloc (CONST_ident_RMTP, CONST_rmtp_MAX)

  /*
   * Populate it
   */

  PROCstrcpy (str%, name$)
  PROCstrcpy (desc%, desc$)

  ret%!CONST_rmtp_next = 0
  ret%!CONST_rmtp_name = str%
  ret%!CONST_rmtp_descriptor = desc%
  ret%!CONST_rmtp_IP_address = -1
  ret%!CONST_rmtp_pane = -1
  ret%!CONST_rmtp_icon = icon%

= ret%

DEF PROCadd_to_list (RETURN list%, item%)

  /* 
   * Unordered linked list looking like this:-
   * list%!0 = ptr to next
   * list%!4 = ptr to object
   */

  LOCAL here%

  Ftracef("PROCadd_to_list")

  IF list% = 0 THEN
    Ftracef("Emptly list case")

    list% = item%
  ELSE
    here% = list%
    
    Ftracef("Something in the list, skipping to end")

    Ftracef("Before while, here->next = "+STR$~(here%!CONST_rmtp_next))
    WHILE (here%!CONST_rmtp_next <> 0)
      here% = here%!CONST_rmtp_next
      Ftracef("Inside while, here->next = "+STR$~(here%!CONST_rmtp_next))
    ENDWHILE

    here%!CONST_rmtp_next = item%
  ENDIF
ENDPROC


DEF FNmember_of_list (RETURN list%, name$)

  LOCAL here%
   
  IF list% = 0 THEN
    /* Empty list */
    = FALSE
  ELSE
    here% = list%
    WHILE here%
      IF $here%!CONST_rmtp_name = name$ THEN
        =TRUE
      ELSE
        here% = here%!CONST_rmtp_next
      ENDIF
    ENDWHILE
  ENDIF

=FALSE


DEF PROCremove_from_list (RETURN list%, name$)

  LOCAL last%, here%, found%, iter%

  IF list% THEN
    here%  = list%
    last%  = 0
    found% = FALSE

    REPEAT
Ftracef ("REMOVE_FROM_LIST: inside while, match name = "+name$+" current name = "+$(here%!CONST_rmtp_name))
      IF ($here%!CONST_rmtp_name) = name$ THEN
        found% = TRUE
      ELSE
        last% = here%
        here% = here%!CONST_rmtp_next
      ENDIF
    UNTIL found% OR (here% = 0)

    IF (last% = 0) AND (here% <> 0) THEN  /* First list item */
Ftracef("1st list item needs to be removed") 
      list% = here%!CONST_rmtp_next

      PROCfree (CONST_ident_STRG, here%!CONST_rmtp_name)
      PROCfree (CONST_ident_STRG, here%!CONST_rmtp_descriptor)
      PROCfree (CONST_ident_RMTP, here%)

    ELSE 
     IF here% THEN /* Any other list item */
Ftracef("Other list item needs to be removed")
      last%!CONST_rmtp_next = here%!CONST_rmtp_next

Ftracef ("Freeing name")
      PROCfree (CONST_ident_STRG, here%!CONST_rmtp_name)
Ftracef ("Freeing descriptor")
      PROCfree (CONST_ident_STRG, here%!CONST_rmtp_descriptor)
Ftracef ("Freeing block")
      PROCfree (CONST_ident_RMTP, here%)
     ENDIF
    ENDIF
  ENDIF
       
ENDPROC


DEF PROCpollword_changed

  LOCAL reason%, prnt%, cnct%, doit%
  LOCAL name%, bufsize%, s$, psup%, s%, t%, l%, t$, ptr%

  REPEAT
    SYS "XRemotePrinterSupport_GetNextEvent",,,-1 TO reason%,,bufsize%
    Ftracef ("Initial call of GetNextEvent yields reason "+STR$reason%+" bufsz "+STR$bufsize%) 
    IF reason% > 0 THEN /* We've got an event on the queue */

      /*
       * Some events do not have an object associated with them, but we
       * must still call GetNextEvent with bufsize = 0 (or not -1) to
       * ensure that the event is discarded from the queue
       */

      IF bufsize% > 0 THEN /* There's a name to allocate for */
        name% = FNmalloc (CONST_ident_STRG, bufsize%)
        SYS "XRemotePrinterSupport_GetNextEvent",,name%, bufsize%
      ELSE
        SYS "XRemotePrinterSupport_GetNextEvent",,0, 0
      ENDIF

      CASE reason% OF
        WHEN CONST_reason_printer_closed
          Ftracef ("PROCpollword_changed: printer: closed")
          Ftracef ("--> Object was "+FNconvert_null (name%))
          IF selected_prnt% THEN
            cnct% = selected_prnt%!CONST_prnt_cnct
            IF cnct%!CONST_cnct_type = 9 AND printer_prefix$ <> "" THEN
Ftracef ("PROCpollword_changed: printer: has been closed, this is a remote printer")
              t$ = $(selected_prnt%!CONST_prnt_name)

              ptr% = INSTR(t$, " ")
              WHILE ptr%
                MID$(t$,ptr%,1) = CHR$160
                ptr% = INSTR(t$, " ", ptr%+1)
              ENDWHILE

              sname$ = printer_prefix$+"RemSpool."+unique_string$+"."+t$
              qname$ = printer_prefix$+"RemQueue."+unique_string$+"."+STR$(remote_jobno%)

              /* HACK! FIXME! */
              /* If file size is zero, or we can't get file info do not do a rename! */
              SYS "XOS_File", 17, sname$ TO t%,,,,l% ; f%
              IF (l% > 0) AND ((f% AND 1) = 0) AND (t% = 1)THEN
                IF last_application$ = "" THEN
                  last_application$ = FNmsg_0(A%!CONST_interface_host_desc, "UNKN")
                ENDIF
                IF last_leafname$ = "" THEN
                  last_leafname$ = FNmsg_0(A%!CONST_interface_host_desc, "UNKN")
                ENDIF
                IF FNwrite_information_file (selected_prnt%, last_application$, last_leafname$) THEN
                 Ftracef ("Trying to rename from "+sname$+" to "+qname$)
                 psup% = selected_prnt%!CONST_prnt_psup
                 /*SYS "XOS_File", 18, sname$, psup%!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(selected_prnt%,TRUE)
                IF s$<>"" THEN 
                   PROCerror_warning(s$)
                ENDIF
              ENDIF
            ENDIF
          ENDIF

        WHEN CONST_reason_file_renamed
          Ftracef ("PROCpollword_changed: file renamed")
          Ftracef ("--> Object was "+FNconvert_null (name%))
          PROCadd_to_queue (FNconvert_null (name%))

        WHEN CONST_reason_printer_added
          Ftracef ("PROCpollword_changed: printer added")
          Ftracef ("--> Printer was "+FNconvert_null (name%))
          IF sparrow_present% THEN
            PROCadd_remote_printer (FNconvert_null (name%))
          ENDIF

        WHEN CONST_reason_printer_deleted
          Ftracef ("PROCpollword_changed: printer deleted")
          Ftracef ("--> Printer was "+FNconvert_null (name%))
          PROCremove_remote_printer (FNconvert_null (name%))

        WHEN CONST_reason_printer_changed
          Ftracef ("PROCpollword_changed: printer changed")
          Ftracef ("--> Printer was "+FNconvert_null (name%))

        WHEN CONST_reason_localprinter_deleted
          Ftracef ("PROCpollword_changed: local printer deleted")
          Ftracef ("--> Printer was "+FNconvert_null (name%))
          PROClocalprinter_deleted (FNconvert_null (name%))

        WHEN CONST_reason_freeway_starting
          Ftracef ("PROCpollword_changed: freeway starting")
          Ftracef ("--> Object was "+FNconvert_null (name%))
          PROCremove_remote_available_printers
          PROCinitialise_sparrow (FALSE)
REM          freeway_just_started% = 1
    
        WHEN CONST_reason_freeway_terminating
          Ftracef ("PROCpollword_changed: freeway terminating")
          Ftracef ("--> Object was "+FNconvert_null (name%))
          PROCfreeway_terminating
      
      ENDCASE
      IF (bufsize% > 0) THEN
        PROCfree (CONST_ident_STRG, name%)
      ENDIF
      
    ENDIF
  UNTIL reason% < 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("PROCselect_printer loc 6a")
          PROCselect_printer(doit%,TRUE,FALSE)
          doit%=0
        ELSE
          doit%=doit%!CONST_prnt_next
        ENDIF
      ENDWHILE
    ENDIF
  ENDIF

ENDPROC


DEF PROCfreeway_starting

  PROCremove_remote_available_printers
  PROCinitialise_sparrow (FALSE)
  freeway_just_started% = 0

ENDPROC
       

DEF PROClocalprinter_deleted (name$)
ENDPROC


DEF FNset_jobno

  LOCAL qname$, f%, v%, w%, e$, num%, first%

Ftracef ("PROCset_jobno: Job number on entry is "+STR$remote_jobno%)

  REPEAT 
      
    qname$ = printer_prefix$+"RemQueue."+unique_string$+"."+STR$remote_jobno%
    SYS "XRemotePrinterSupport_DisableUpcalls"
    SYS "XOS_File", 5, qname$ TO v%; f%
    SYS "XRemotePrinterSupport_EnableUpcalls"
    IF f% AND 1 THEN
      /* 
       * Dilemma: Can't set the job number, is ShareFS stuffed? FIXME!
       */
      remote_jobno% = -1
      = FNmsg_0 (A%!CONST_interface_host_desc, "OKAS", FNconvert_null(v%+4))
    ENDIF

    IF (v%<>0) THEN /* Queue file found */
      remote_jobno% += 1
    ENDIF

  UNTIL v%=0

=""


DEF PROCadd_to_queue (filename$)
  LOCAL fullpath$, infopath$, handle%, printer$, leafname$, c%, prnt%
  LOCAL ptr%, name$, psup%, type%, sender_id$, application$

  /*
   * This filename is a leafname of the form RemQueue.xxxx.xxx
   * We can concatenate it with <Wimp$ScrapDir>.Printers. to
   * get the full path. RemQueue.xxxx.xxxI contains the printer name.
   * I guess we must enumerate prnt blocks to find the matching
   * one, then add the file to its queue.
   */

  leafname$ = MID$(filename$, INSTR(filename$, ".") + 1)
  fullpath$ = printer_scrap$+"."+filename$
  infopath$ = printer_scrap$+".RemQueue."+leafname$+"I"
  printer$ = ""
  sender$ = ""

  Ftracef("PROCadd_to_queue: fullpath = "+fullpath$)
  Ftracef("PROCadd_to_queue: infopath = "+infopath$)

  h% = OPENIN infopath$
  IF h% = 0 THEN
    /*
     * Fail silently...
     */
    Ftracef ("PROCadd_to_queue: Open of information file failed, exiting")
    ENDPROC
  ENDIF

  /*
   * Read printer name, 0 terminated
   */

  c% = BGET#h%
  WHILE (NOT EOF#h%) AND (c% <> 0)
    printer$ += CHR$c%
    c% = BGET#h%
  ENDWHILE

  Ftracef ("PROCadd_to_queue: read printer name")

  /*
   * Read sender id, 0 terminated
   */

  c% = BGET#h%
  WHILE (NOT EOF#h%) AND (c% <> 0)
    sender_id$ += CHR$c%
    c% = BGET#h%
  ENDWHILE

    Ftracef ("PROCadd_to_queue: Read sender ID")

  /*
   * Read application name, 0 terminated
   */

  c% = BGET#h%
  WHILE (NOT EOF#h%) AND (c% <> 0)
    application$ += CHR$c%
    c% = BGET#h%
  ENDWHILE

    Ftracef ("PROCadd_to_queue: Read application name")

  /*
   * Lastly, leafname
   */
  leafname$ = ""
  c% = BGET#h%
  WHILE (NOT EOF#h%) AND (c% > 31)
    leafname$ += CHR$c%
    c% = BGET#h%
  ENDWHILE

  CLOSE# h%

  Ftracef ("PROCadd_to_queue: Read leafname")

  SYS "XOS_File", 6, infopath$ /* Delete */

  /*
   * This is annoying; we have to enumerate all the printers in memory to find
   * the right PRNT block to pass to PROCadd_queue_entry
   */

    Ftracef ("PROCadd_to_queue: About to find prnt")

  ptr% = A%!CONST_interface_printer_installed /* interface% */
  prnt% = 0

  WHILE (ptr%)

    /*
     * The name can be in one of two places (maybe)
     */

    IF (ptr%!CONST_prnt_name = 0) THEN
      psup% = ptr%!CONST_prnt_psup
      name$ = $(psup%!CONST_psup_class)
    ELSE
      name$ = $(ptr%!CONST_prnt_name)
    ENDIF

    Ftracef ("PROCadd_to_queue: prnt name is "+name$+" looking for "+printer$)

    IF name$ = printer$ THEN 
      prnt% = ptr%
      ptr% = 0
    ELSE
      ptr% = ptr%!CONST_prnt_next
    ENDIF
    
  ENDWHILE

  Ftracef("PROCadd_to_queue: printer  = "+printer$)
  Ftracef("PROCadd_to_queue: sender   = "+sender$)

  Ftracef("PROCadd_to_queue: prnt% = "+STR$prnt%)

  /*
   * If prnt% is STILL 0 here, it means that a print job has just arrived for
   * a printer that has gone away. Nothing can be done, so fail silently
   */

  IF (prnt% <> 0) THEN
    Ftracef ("PROCadd_to_queue: FOUND prnt block for print job, add to queue")

    psup% = prnt%!CONST_prnt_psup
    /*type% = psup%!CONST_psup_type*/
    SYS "XOS_File", 23, fullpath$ TO ,,,,,,type%
    Ftracef ("PROCadd_to_queue: got a filetype of &"+STR$~type%)
    /*SYS "XOS_File", 18, fullpath$, type%*/
    PROCadd_queue_entry (TRUE, "("+FNmsg_0 (A%!CONST_interface_host_desc, "IC9")+") "+application$, fullpath$, leafname$, prnt%, type%)
  ENDIF

ENDPROC

DEF PROCsave_sender_info (receiver_handle%, leaf$)

  LOCAL e%, f%

  SYS "XTaskManager_TaskNameFromHandle",receiver_handle% TO e% ; f%

  IF (f% AND 1) THEN
    last_application$ = FNmsg_0(A%!CONST_interface_host_desc, "UNKN")
    last_leafname$ = FNmsg_0(A%!CONST_interface_host_desc, "UNKN")
  ELSE
    Ftracef ("Last application was "+$e%)
    last_application$ = FNconvert_null (e%)
    last_leafname$ = leaf$
  ENDIF

ENDPROC

DEF FNwrite_information_file (prnt%, application$, leaf$)
  REM returns TRUE if successful, else FALSE
  LOCAL filename$, h%, f%, name$, ptr%

  filename$ = printer_prefix$+"RemQueue."+unique_string$+"."+STR$(remote_jobno%)+"I"

  name$ = $prnt%!CONST_prnt_name

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

  SYS "XOS_Find", &83, filename$ TO h%;f%
  IF (f%AND1) h%=0
  IF h% <> 0 THEN
    Ftracef ("Writing "+name$+" "+unique_string$+" "+application$+" "+leaf$+" to "+filename$)
    BPUT#h%, name$+CHR$0+unique_string$+CHR$0+application$+CHR$0+leaf$
    SYS "XOS_Find", 0, h% TO ;f%
  ENDIF

  IF (f%AND1) OR h%=0 :=FALSE

=TRUE

DEF PROCshare_printer

  LOCAL prnt%, icon%, rmtp%

  /*
   * This is basically a copy of PROCactivate_printer
   */

  Ftracef("PROCshare_printer")

  IF freeway_my_choices_shared%=FALSE THEN
    PROCshare_my_choices
    freeway_my_choices_shared%=TRUE
  ENDIF

  IF NOTFNinitialise_scrap THEN
    PROCerror_box(FNmsg_0(A%!CONST_interface_host_desc, "OKAV"),1)
    ENDPROC
  ENDIF

  Ftracef ("++++++++++++++++++++++ Looking at scrap "+printer_scrap$)

  IF INSTR(FNscrap_location, "Share:") > 0 THEN
    PROCerror_warning (FNmsg_0 (A%!CONST_interface_host_desc, "OKAT"))
    ENDPROC
  ENDIF

  REPEAT

    PROCfind_prnt (prnt%, rmtp%, icon%)

    PROCicon_deselect (prntctrl%, icon%)

    IF prnt% AND ((prnt%!CONST_prnt_flags AND CONST_prnt_flags_remote) = 0) THEN
      PROCshare_one_printer (prnt%)
    ENDIF

  UNTIL (prnt% = 0) AND (rmtp% = 0)

ENDPROC


DEF PROCshare_one_printer (prnt%)

  LOCAL name$, vptr%, buf%, vlen%, thing$, f%, r0%, f$, xprnt%, xname$, psup%

  /*
   * DON'T worry about the fact that this printer may already be shared,
   * this routine is called from initialise_one_printer which is done at
   * startup time & deals with saved printers that already have the shared
   * flag set. The worst thing this can do is waste a little time.
   */

    IF (prnt%!CONST_prnt_flags AND CONST_prnt_flags_remote) > 0 THEN
      ENDPROC
    ENDIF

    IF freeway_my_choices_shared%=FALSE THEN
     PROCshare_my_choices
      freeway_my_choices_shared%=TRUE
    ENDIF

    IF (prnt%!CONST_prnt_name = 0) THEN
      psup% = prnt%!CONST_prnt_psup
      name$ = $(psup%!CONST_psup_class)
    ELSE
      name$ = $(prnt%!CONST_prnt_name)
    ENDIF

    IF NOTFNinitialise_scrap THEN
      PROCerror_box(FNmsg_1(A%!CONST_interface_host_desc, "OKAW",name$),1)
      prnt%!CONST_prnt_flags = prnt%!CONST_prnt_flags AND (NOT CONST_prnt_flags_shared)
      ENDPROC
    ENDIF

    IF INSTR(FNscrap_location, "Share:") > 0 THEN
      PROCerror_warning (FNmsg_1 (A%!CONST_interface_host_desc, "OKAU", name$))
      prnt%!CONST_prnt_flags = prnt%!CONST_prnt_flags AND (NOT CONST_prnt_flags_shared)
      ENDPROC
    ENDIF

    desc$ = $(prnt%!CONST_prnt_type)

    IF (prnt%!CONST_prnt_flags AND CONST_prnt_flags_active) = 0 THEN
      PROCactivate_this_printer (prnt%)
    ENDIF

    vptr% = 0

    REPEAT

      Ftracef("PROCshare_one_printer: trying to read first Inet$LocalAddr*")

      SYS "XOS_ReadVarVal", "Inet$LocalAddr*", 0, 1<<31, vptr%, 0 TO ,,vlen%

      Ftracef("PROCshare_one_printer: finding length: "+STR$vlen%+" "+STR$(NOT(vlen%)))

      /*
       * There can be a number of Inet$LocalAddr* variables - as many as there
       * are interfaces in the machine. For each one we must do a *export, 
       * and we'll do it properly - allocating the correct buffer size for
       * reading variables so future expansion doesn't go BANG!
       */

      IF vlen% < 0 THEN

        buf% = FNmalloc (CONST_ident_STRG, NOT(vlen%) + 1)

        Ftracef ("PROCshare_one_printer: buf% + "+STR$buf%)

        IF (buf% > 0) THEN

          SYS "OS_ReadVarVal", "Inet$LocalAddr*", buf%, NOT(vlen%), vptr%, 0 TO ,,,vptr%

          buf%?(NOT(vlen%)) = 0 /* Terminate the string */

          thing$ = FNconvert_null (buf%)

          PROCfree (CONST_ident_STRG, buf%)

          Ftracef ("Exporting _P and _S >>>>"+thing$+"<<<<")
          Ftracef ("share <Wimp$ScrapDir>.Printers _S"+thing$+" -noicon")

          /*
           * First, unshare the directory if it is already shared. This makes the share succeed,
           * especially important if scrap has moved.
           */

          f$ = "unshare _S"+thing$
          SYS "XOS_CLI", f$

          /*
           * Share the directory
           */

          f$ = "share <Wimp$ScrapDir>.Printers _S"+thing$+" -noicon"
          SYS "XOS_CLI", f$

        ENDIF

      ENDIF

    UNTIL vlen% >= 0

    PROCshare_one_prdata (prnt%, name$)

    SYS "XFreeway_Read", 0, CONST_freewaytype_printers, name$, 0, 0 TO ,,,,,ip% ; f%

    IF (f% AND 1) = 0 THEN
      PROCerror_warning (FNmsg_1 (A%!CONST_interface_host_desc, "OKAQ", name$))
      ENDPROC
    ENDIF

    xprnt% = A%!CONST_interface_printer_installed

    WHILE xprnt%

      IF (xprnt%!CONST_prnt_name = 0) THEN
        psup% = xprnt%!CONST_prnt_psup
        xname$ = $(psup%!CONST_psup_class)
      ELSE
        xname$ = $(xprnt%!CONST_prnt_name)
      ENDIF

      IF (xname$ = name$) AND ((xprnt%!CONST_prnt_flags AND CONST_prnt_flags_shared) > 0) THEN
        PROCerror_warning (FNmsg_1 (A%!CONST_interface_host_desc, "OKAQa", name$))
        ENDPROC
      ENDIF

      xprnt% = xprnt%!CONST_prnt_next

    ENDWHILE

    SYS "XFreeway_Write", 0, CONST_freewaytype_printers, name$, LENdesc$, desc$ TO r0% ; f%
Ftracef ("Just done a freeway write, flags are "+STR$f%)
    IF (f% AND 1) THEN
      /* If there's an error then there's a name clash - just checking all ways possible! */
      PROCerror_warning (FNmsg_1 (A%!CONST_interface_host_desc, "OKAQ", name$))
      ENDPROC
    ENDIF

    prnt%!CONST_prnt_flags = prnt%!CONST_prnt_flags OR CONST_prnt_flags_shared

ENDPROC


DEF PROCunshare_one_printer (prnt%)

  LOCAL name$, vlen%, buf%, lptr%, desc$, thing$, psup%

  /*
   * Get the printer name, and remove it from the freeway domain 
   */

  IF (prnt%!CONST_prnt_name = 0) THEN
    psup% = prnt%!CONST_prnt_psup
    name$ = $(psup%!CONST_psup_class)
  ELSE
    name$ = $(prnt%!CONST_prnt_name)
  ENDIF

  IF (prnt%!CONST_prnt_flags AND CONST_prnt_flags_shared) THEN
Ftracef ("This is a shared printer:      prnt%!CONST_prnt_flags = "+STR$~(prnt%!CONST_prnt_flags))
Ftracef ("This is a shared printer:     CONST_prnt_flags_shared = "+STR$~(CONST_prnt_flags_shared))
Ftracef ("This is a shared printer:  CONST_prnt_flags_unsharemask = "+STR$~(CONST_prnt_flags_unsharemask))
    prnt%!CONST_prnt_flags = prnt%!CONST_prnt_flags AND CONST_prnt_flags_unsharemask
Ftracef ("This is a shared printer:      prnt%!CONST_prnt_flags = "+STR$~(prnt%!CONST_prnt_flags))
  ENDIF

  IF sparrow_present% THEN
    SYS "Freeway_Write", 1, CONST_freewaytype_printers, name$, 0, 0
  ENDIF

  Ftracef ("Just removed printer "+name$+" from freeway domain")
     
ENDPROC

DEF PROCunshare_directories
#ifdef braindead
  LOCAL name$, vlen%, buf%, lptr%, desc$, thing$, vptr%

  vptr% = 0

  REPEAT

    SYS "XOS_ReadVarVal", "Inet$LocalAddr*", 0, 1<<31, vptr%, 0 TO ,,vlen%

    /*
     * There can be a number of Inet$LocalAddr* variables - as many as there
     * are interfaces in the machine. For each one we must do a *unexport, 
     * and we'll do it properly - allocating the correct buffer size for
     * reading variables so future expansion doesn't go BANG!
     */

    IF vlen% < 0 THEN

      buf% = FNmalloc (CONST_ident_STRG, (NOT(vlen%)) + 1)

      SYS "OS_ReadVarVal", "Inet$LocalAddr*", buf%, NOT(vlen%), vptr%, 0 TO ,,,vptr%

      buf%?(NOT(vlen%)) = 0 /* Terminate the string */

      thing$ = FNconvert_null (buf%)

      thing$ = "unshare _s"+thing$
      SYS "XOS_CLI", thing$

      PROCfree (CONST_ident_STRG, buf%)

    ENDIF

  UNTIL vlen% >= 0
#endif
ENDPROC

DEF PROCsparrow_local_file
  /*Saves the context away so that you can look ahead using FNmatch_line.
    There is only one level of nesting.*/
  Ftracef("PROCsparrow_local_file")
  sparrow_saved_data_block%=data_block%
  sparrow_saved_data_ptr%=data_ptr%
  sparrow_saved_data_ptrc%=!data_ptr%
  sparrow_saved_data_size%=data_size%
  sparrow_saved_data_line%=data_line%
  sparrow_saved_data_file$=data_file$
ENDPROC

DEF PROCsparrow_restore_file
  /*Restore the context as above.*/
  Ftracef("PROCsparrow_restore_file")
  data_block%=sparrow_saved_data_block%
  data_ptr%=sparrow_saved_data_ptr%
  !data_ptr%=sparrow_saved_data_ptrc%
  data_size%=sparrow_saved_data_size%
  data_line%=sparrow_saved_data_line%
  data_file$=sparrow_saved_data_file$
ENDPROC

DEF PROCsparrow_local_file_2
  /*Saves the context away so that you can look ahead using FNmatch_line.
    There is only one level of nesting.*/
  Ftracef("PROCsparrow_local_file2")
  sparrow_saved_data_block2%=data_block%
  sparrow_saved_data_ptr2%=data_ptr%
  sparrow_saved_data_ptrc2%=!data_ptr%
  sparrow_saved_data_size2%=data_size%
  sparrow_saved_data_line2%=data_line%
  sparrow_saved_data_file2$=data_file$
ENDPROC

DEF PROCsparrow_restore_file_2
  /*Restore the context as above.*/
  Ftracef("PROCsparrow_restore_file2")
  data_block%=sparrow_saved_data_block2%
  data_ptr%=sparrow_saved_data_ptr2%
  !data_ptr%=sparrow_saved_data_ptrc2%
  data_size%=sparrow_saved_data_size2%
  data_line%=sparrow_saved_data_line2%
  data_file$=sparrow_saved_data_file2$
ENDPROC

DEF FNensure_printer(rmtp%, settings_flags%, in_settings%, ret_error%, RETURN error%)
  LOCAL scrap$, settings$, class$
  LOCAL printer$, s$, rempath$, name$, raise_error%
  LOCAL flags%, fileptr%, cl%, sn%, found%, p%, prnt%
  LOCAL ERROR

  error% = FALSE

  Ftracef ("About to ensure _S and _P directories")

  SYS "Hourglass_On"

  scrap$  = "Share::_S"+FNip_string (rmtp%!CONST_rmtp_IP_address)+".$"

  flags% = 0 
  SYS "XRemotePrinterSupport_DisableUpcalls"
  SYS "XOS_File", 17, scrap$ TO ; flags%
  SYS "XRemotePrinterSupport_EnableUpcalls"
  IF (flags% AND 1) THEN
    IF ret_error% THEN
      error% = TRUE
    ELSE
      PROCerror_warning(FNmsg_1 (A%!CONST_interface_host_desc,"OKAOs", $rmtp%!CONST_rmtp_name))
    ENDIF
    SYS "Hourglass_Off"
    = 0
  ENDIF

  name$ = $rmtp%!CONST_rmtp_name
  p% = INSTR(name$, " ") /* Space */
  WHILE p%
    MID$(name$,p%,1) = CHR$160 /* Hard Space */
    p% = INSTR(name$, " ", p%+1) /* Space */
  ENDWHILE

  rempath$ = scrap$+"."+name$

  Ftracef ("Trying to get remote PrData "+rempath$)

  prnt% = FNadd_remote_to_prdata(rmtp%, rempath$, settings_flags%, in_settings%, ret_error%, error%)

  SYS "Hourglass_Off"

= prnt%


DEF FNadd_remote_to_prdata (rmtp%, prpath$, flags%, in_settings%, ret_error%, RETURN error%)
  LOCAL name%,psup%,ptr%,s$,ntry%,prdata%,last_prdata%,this_prhead%,matched%,fix_up%, last_prhead%
  LOCAL prnt%, cnct%, junk$, class$, cl%, i%, last_prdata1%, tmpt%, saved_prhead%, odb%, ods%, prd%
  LOCAL new_prhead%, error%, raise_error%

  error% = FALSE

  Ftracef("PROCadd_remote_to_prdata")
  IF NOT FNload_file (prpath$) THEN
    SYS "Hourglass_Off"
    IF ret_error% THEN
      error% = TRUE
      = 0
    ELSE
      PROCerror_warning (FNmsg_1(A%!CONST_interface_host_desc,"OKAOs",$rmtp%!CONST_rmtp_name))
    ENDIF
  ENDIF
  SYS "Hourglass_On"

  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"
            prnt% = FNinstall_remote_printer($rmtp%!CONST_rmtp_name, $rmtp%!CONST_rmtp_descriptor,psup%,prdata%,in_settings%, ret_error%, error%)
            = prnt%
          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 2
      /*mark PSUP info as modified*/

  prnt% = FNinstall_remote_printer($rmtp%!CONST_rmtp_name, $rmtp%!CONST_rmtp_descriptor,psup%,last_prdata%,in_settings%, ret_error%, error%)

  SYS "Hourglass_Off"

= prnt%



DEF PROCremove_one_printer (prnt%)
  LOCAL i%,ptr%,last_prnt%,private_buff%,doit%,type$, icon%, rmtp%, dontcare%
  Ftracef("PROCremove_one_printer")

  PROCfind_prnt (dontcare%, rmtp%, icon%)
  IF (NOT dontcare%) AND rmtp% THEN
    /*
     * This is *BAD*, should never happen. Famous last wossnames...
     */
    ENDPROC
  ENDIF

  SYS "Hourglass_On"

  /*
   * Work out the prnt block before this one, so remove_this_printer can
   * munge the list successfully. Much easier to put all this funcionality
   * into remove_this_printer...
   */

  ptr% = A%!CONST_interface_printer_installed
  WHILE ptr%
    IF ptr%!CONST_prnt_next = prnt% THEN
      last_prnt% = ptr%
      ptr% = 0
    ELSE
      ptr% = ptr%!CONST_prnt_next
    ENDIF
  ENDWHILE

Ftracef ("After finding last prnt, last_prnt = "+STR$~last_prnt%+" prnt = "+STR$~prnt%+" last!next = "+STR$~(last_prnt%!CONST_prnt_next))

  type$=$prnt%!CONST_prnt_type
  PROCremove_this_printer(prnt%,last_prnt%)
  PROCdelete_prdata_entry(type$)

  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("PROCselect_printer loc 7")
          PROCselect_printer(doit%,TRUE,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
  IF FNwindow_open(prntctrl%) THEN 
    PROCwin_open(prntctrl%)
  ENDIF
  SYS "Hourglass_Off"
ENDPROC

DEF FNpsup_used (psup%)

  LOCAL prnt%, ret%

  prnt% = A%!CONST_interface_printer_installed
  ret% = FALSE

  /*
   * Tells us if anything makes use of this psup
   * by scanning the installed printer list looking for
   * pointers to it. Necessary since we need to do more
   * work if it isn't already used
   */

Ftracef ("Before while loop, prnt% = "+STR$prnt%)
  WHILE prnt%
Ftracef ("FN psup_used, prnt% = "+STR$prnt%+" CONST_.._psup = "+STR$prnt%!CONST_prnt_psup+" psup = "+STR$psup%)
    IF prnt%!CONST_prnt_psup = psup% THEN
      ret% = TRUE
      prnt% = 0
    ELSE
      prnt% = prnt%!CONST_prnt_next
    ENDIF
  ENDWHILE

Ftracef ("About to return "+STR$ret%)

= ret%

DEF FNunavailable_count

  LOCAL here%, ret%

  ret% = 0

  here% = remote_printers%

  WHILE here%
    IF here%!CONST_rmtp_icon > 0 THEN
      ret% += 1
    ENDIF
    here% = here%!CONST_rmtp_next
  ENDWHILE

= ret%

DEF PROCfreeway_terminating

  LOCAL prnt%, doit%

  IF NOT sparrow_present% THEN
    ENDPROC
  ENDIF

  /* 
   * Convert active remote printers into unavailable ones
   */

  prnt% = A%!CONST_interface_printer_installed
  WHILE prnt%
    IF prnt%!CONST_prnt_flags AND CONST_prnt_flags_remote THEN
      PROCremove_remote_printer ($prnt%!CONST_prnt_name)
    ENDIF
    prnt% = prnt%!CONST_prnt_next
  ENDWHILE

  /* 
   * Remove any other remote printers
   */
  PROCremove_remote_available_printers

  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("PROCselect_printer loc 6a")
          PROCselect_printer(doit%,TRUE,FALSE)
          doit%=0
        ELSE
          doit%=doit%!CONST_prnt_next
        ENDIF
      ENDWHILE
    ENDIF
  ENDIF

  sparrow_present% = FALSE

ENDPROC

DEF PROCremove_remote_available_printers

  LOCAL here%, next%, doit%

  here% = remote_printers%

  WHILE here% /* Nasty little loop */
    next% = here%!CONST_rmtp_next
    IF here%!CONST_rmtp_icon <= 0 THEN
      PROCremove_remote_printer ($here%!CONST_rmtp_name)
    ENDIF
    here% = next%
  ENDWHILE
  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("PROCselect_printer loc 6a")
          PROCselect_printer(doit%,TRUE,FALSE)
          doit%=0
        ELSE
          doit%=doit%!CONST_prnt_next
        ENDIF
      ENDWHILE
    ENDIF
  ENDIF

ENDPROC

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

DEF PROCadd_config (prnt%)

ENDPROC



DEF FNinstall_remote_printer(name$,desc$,psup%,prdt%,in_settings%, ret_error%, RETURN error%)
  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)))

  error% = FALSE

/* FIXME! Determine if this is right */

  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_ok,FNmsg_1(A%!CONST_interface_host_desc,"FA5","PRNT")
  /* PROCadd_remote_to_prdata relies on this behaviour! */
  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)
  Ftracef("Sparrow: set prnt type to "+$(prnt%!CONST_prnt_type)+", "+STR$~(prnt%!CONST_prnt_type))
  B%=CONST_ident_CNCT
  C%=CONST_cnct_MAX
  cnct%=USR(code_entry%+CONST_entry_heap_claim)
  IF cnct%=0 \
    ERROR CONST_error_ok,FNmsg_1(A%!CONST_interface_host_desc,"FA5","CNCT")

  cnct%!CONST_cnct_type = 9 /* Remote */
  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_flags=0
  cnct%!CONST_cnct_nfsps=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_ok,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 %100 PROCprinter_reason_code(psup%,prnt%,-12,0)
  PROCstrcpy (prnt%!CONST_prnt_name, $rmtp%!CONST_rmtp_name)
  PROCcreate_installed_printer_icons /*increments printer_count%*/

  IF psup%!CONST_psup_flags AND %1000 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*/

  prnt%!CONST_prnt_flags = prnt%!CONST_prnt_flags OR CONST_prnt_flags_remote

  IF NOT in_settings% THEN
    PROCactivate_this_remote_printer(prnt%, ret_error%, error%)
  ENDIF
= prnt%


DEF PROCadd_unavailable_printer (name$, class$, desc$)

  LOCAL prnt%, icon%, side%, p%, ih%, here%

  prnt% = A%!CONST_interface_printer_installed
  IF NOT prnt% THEN
      icon% = &0F000000
      side% = -5
  ELSE
      icon% = FNleft_of (prnt%)
      side% = -3
  ENDIF
  spr$ = "su_"+class$

Ftracef ("OH LOOK! Unavailable printer, called "+name$+" with a sprite "+spr$)

  ih% = FNiconbar_tands (name$, spr$, side%, icon%)

  PROCadd_to_list (remote_printers%, FNconstruct_unavailable (name$, ih%, desc$))

  IF A%!CONST_interface_printer_installed = 0 AND main_icon% > 0 THEN
    PROCicon_delete (-1, main_icon%)
    main_icon% = -1
  ENDIF

ENDPROC


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

  /*Configuration details*/    
  Ftracef ("prnt% = "+STR$~prnt%)

  cnfg% = prnt%!CONST_prnt_cnfg
  psup% = prnt%!CONST_prnt_psup

  h%=FNevaluate($FNmatch_line_or_error("cs:"))
  Ftracef ("Got configuration size of "+STR$h%)
  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_prdata_pointer($ss%) /* Sad? Wrong? */
                  ELSE
                    PROCsettings_error(FNmsg_1(A%!CONST_interface_host_desc,"OKH",$ts%))
                  ENDIF
                ENDIF
              ENDIF
            ENDIF
          ENDIF
        ENDIF
      ENDIF
    NEXT
  ENDIF
Ftracef ("Trying to activate")
  PROCactivate_this_printer (prnt%)

ENDPROC

DEF FNscrap_location

= FNtask_read_env ("Wimp$ScrapDir", msg_text%)


DEF PROCshare_one_prdata (prnt%, name$)
  LOCAL psup%,head%,prdt%,c%,tmpt%,ntry%,list%,i%,j%,k%,l%,s$,p%,oname$, tmp%, gotit%, level%

  Ftracef("PROCshare_one_prdata")

  SYS "Hourglass_On"
  psup%=prnt%!CONST_prnt_psup

  oname$ = $prnt%!CONST_prnt_type

  IF psup% THEN
   IF psup%!CONST_psup_tmpt THEN
    /*we have a template to guide us*/
    Ftracef("Found psup class "+$psup%!CONST_psup_class)

    /* Convert spaces into hard spaces so we can save the filename */

    p% = INSTR(name$, " ") /* Space */
    WHILE p%
      MID$(name$,p%,1) = CHR$160 /* Hard Space */
      p% = INSTR(name$, " ", p%+1) /* Space */
    ENDWHILE


#ifdef Test
    c% = TIME
    REPEAT 
    UNTIL TIME > c%+100 /* 1 second delay */
#endif

    c% = OPENOUT("<Wimp$ScrapDir>.Printers."+name$)
    BPUT#c%, "cl: "+$psup%!CONST_psup_class

    tmpt%=psup%!CONST_psup_tmpt
    head%=psup%!CONST_psup_head
     IF $(tmpt%+CONST_tmpt_name) <> "printers" THEN
       BPUT#c%,$(tmpt%+CONST_tmpt_name)+":"
       BPUT#c%,"#"
     ENDIF
     prdt%=head%!CONST_head_prdt
     WHILE prdt%
      IF prdt%!(prdt%!CONST_prdt_num*4+CONST_prdt_1st)THEN
       ntry%=tmpt%!CONST_tmpt_ntry
       i%=prdt%+CONST_prdt_1st
Ftracef ("PROCshare_one_prdata: Entry name is "+$(ntry%+CONST_ntry_name)+" looking out for pr_name")
       IF LEFT$($(ntry%+CONST_ntry_name), 6) = "pr_nme" THEN
Ftracef ("PROCshare_one_prdata: Looking out for "+oname$+" got "+FNprinter_read_string(!i%))
         IF FNprinter_read_string(!i%) = oname$ THEN
           gotit% = TRUE 
         ELSE
           gotit% = FALSE
         ENDIF
       ELSE
         gotit% = TRUE
       ENDIF
         WHILE ntry%
          IF gotit% THEN BPUT#c%,$(ntry%+CONST_ntry_name)+" ";
          IF !i%=0 THEN
           IF ntry%!CONST_ntry_type=6 THEN
             IF gotit% THEN BPUT#c%,48 /*zero list entries*/
           ELSE
             IF ntry%!CONST_ntry_type=1 THEN
               IF gotit% THEN BPUT#c%,48 /* no integer => zero */
             ENDIF
           ENDIF
           IF gotit% THEN BPUT#c%,10
          ELSE
           j%=!i% /*j% points to record of value*/
           CASE ntry%!CONST_ntry_type OF
            WHEN 1
             IF gotit% THEN BPUT#c%,STR$ !j%
            WHEN 2
             IF gotit% THEN BPUT#c%,FNprinter_read_string(j%)
            WHEN 3
             IF gotit% THEN BPUT#c%,FNprinter_read_string(j%)
            WHEN 4
             IF gotit% THEN BPUT#c%,FNungstrans(FNprinter_read_string(j%))
            WHEN 5
             IF gotit% THEN BPUT#c%,10
             CASE ntry%!CONST_ntry_extra OF
              WHEN 1
               IF gotit% THEN BPUT#c%," "+STR$ !j%!CONST_bool_false+", "+STR$ !j%!CONST_bool_true
              WHEN 2
               IF gotit% THEN BPUT#c%," "+FNprinter_read_string(j%!CONST_bool_false)
               IF gotit% THEN BPUT#c%," "+FNprinter_read_string(j%!CONST_bool_true)
              WHEN 3
               IF gotit% THEN BPUT#c%," "+FNprinter_read_string(j%!CONST_bool_false)
               IF gotit% THEN BPUT#c%," "+FNprinter_read_string(j%!CONST_bool_true)
              WHEN 4
               IF gotit% THEN BPUT#c%," "+FNungstrans(FNprinter_read_string(j%!CONST_bool_false))
               IF gotit% THEN BPUT#c%," "+FNungstrans(FNprinter_read_string(j%!CONST_bool_true))
              WHEN 7
               IF gotit% THEN BPUT#c%," ";
               IF gotit% THEN PROCfollow_pointer(!j%!CONST_bool_false,psup%,c%,level%)
               IF gotit% THEN BPUT#c%,", ";
               IF gotit% THEN PROCfollow_pointer(!j%!CONST_bool_true,psup%,c%,level%)
             ENDCASE
            WHEN 6
             k%=j%
             l%=0
             WHILE k%
              l%+=1
              k%=!k%
             ENDWHILE
             IF gotit% THEN 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
                   IF gotit% THEN BPUT#c%," "+STR$ !l%+", ";
                  WHEN CONST_ident_STRG
                   IF gotit% THEN BPUT#c%," "+$l%+", ";
                  WHEN CONST_ident_STR0
                   CALL Z%,l%,s$ /*convert 0-terminated string*/
                   IF gotit% THEN BPUT#c%," "+s$+", ";
                  WHEN CONST_ident_GSTR
                   CALL Y%,l%,s$ /*convert counted string*/
                   IF gotit% THEN BPUT#c%," "+FNungstrans(s$)+", ";
                  WHEN CONST_ident_POTR
                   IF gotit% THEN PROCfollow_pointer (!l%, psup%, c%, level%)
                   IF gotit% THEN BPUT#c%, "##"
                 ENDCASE
                NEXT
              ENDIF
              IF gotit% THEN PTR#c%=PTR#c%-2
              IF gotit% THEN BPUT#c%,10
              j%=!j%
             ENDWHILE
            WHEN 7
             IF gotit% THEN PROCfollow_pointer (!j%, psup%, c%, level%)
            WHEN 8
             k%=j%
             l%=0
             WHILE k%
              l%+=1
              k%=!k%
             ENDWHILE
             IF gotit% THEN 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
              IF gotit% THEN BPUT#c%," "+FNungstrans(s$)
              j%=!j%
             ENDWHILE
           ENDCASE
          ENDIF
          ntry%=ntry%!CONST_ntry_next
          i%+=4
         ENDWHILE
         IF gotit% THEN BPUT#c%,"#"
      ENDIF
      prdt%=prdt%!CONST_prdt_next
     ENDWHILE

    CLOSE#c%
#ifdef Test
    c% = TIME
    REPEAT 
    UNTIL TIME > c%+100 /* 1 second delay */
#endif

    SYS "XOS_File",18,"<Wimp$ScrapDir>.Printers."+name$,&FC6 /* SetType */
    SYS "XOS_File", 4, "<Wimp$ScrapDir>.Printers."+name$,,,,3 /*WriteAttr*/

#ifdef Test
    c% = TIME
    REPEAT 
    UNTIL TIME > c%+100 /* 1 second delay */
#endif
   ENDIF
  ENDIF


  SYS "Hourglass_Off"
ENDPROC

DEF PROCfollow_pointer (ptr%, psup%, c%, level%)

  LOCAL template$, tmpt%, ntry%, found%, i%, j%, ptr$, tmp%, k%, l%, p%, s$

  level% += 1

  ptr$ = FNdiscover_ptr (ptr%, psup%)
Ftracef ("DEF FNfollow_pointer "+STR$ptr%+" "+ptr$+" level "+STR$level%)
  ntry% = INSTR(ptr$, ":")
  template$ = MID$(ptr$, 1, ntry% - 1)

Ftracef ("pointer to follow is "+template$)

  tmpt% = psup%!CONST_psup_tmpt
  found% = FALSE
  WHILE tmpt% AND NOT found%
Ftracef ("Checking versus "+$(tmpt%+CONST_tmpt_name))
    IF $(tmpt%+CONST_tmpt_name) = template$ THEN
      found% = TRUE
    ELSE
      tmpt% = tmpt%!CONST_tmpt_next
    ENDIF
  ENDWHILE

  IF NOT found% AND NOT tmpt% THEN
    Ftracef ("Can't fix up pointer, exiting")
    ENDPROC
  ENDIF

  BPUT#c%, " "+template$+":"

  ntry%=tmpt%!CONST_tmpt_ntry
  Ftracef ("About to try and fix up pointer "+ptr$)
  i% = FNfix_up_prdata_pointer (ptr$)

REM  WHILE (i%!(i%!CONST_prdt_num*4+CONST_prdt_1st) = 0) AND (i% > 0)
REMFtracef ("Zero usage prdt, skipping")
REM    i% = i%!CONST_prdt_next
REM  ENDWHILE

  IF i% = 0 THEN
    Ftracef ("Can't fix up pointer, exiting")
    ENDPROC
  ENDIF

  i% = i%+CONST_prdt_1st

  WHILE ntry%
   Ftracef ("Entry name is "+$(ntry%+CONST_ntry_name))

   BPUT#c%,$(ntry%+CONST_ntry_name)+" ";

   Ftracef ("Entry type is "+STR$(ntry%!CONST_ntry_type))

   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*/
    Ftracef ("Entry contains "+STR$(!j%)+" at "+STR$(j%))
    CASE ntry%!CONST_ntry_type OF
     WHEN 1
      BPUT#c%,STR$ !j%
     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%," ";
        PROCfollow_pointer(!j%!CONST_bool_false,psup%,c%,level%)
        BPUT#c%,", ";
        PROCfollow_pointer(!j%!CONST_bool_true,psup%,c%,level%)
      ENDCASE
     WHEN 6
      k%=j%
      l%=0
      WHILE k% /* Count no of list entries */
       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
            PROCfollow_pointer (!l%, psup%, c%,level%)
            BPUT#c%, "##" /* Oerrr, dodgy? */
          ENDCASE
         NEXT
       ENDIF
       PTR#c%=PTR#c%-2
       BPUT#c%,10
       j%=!j%
      ENDWHILE
     WHEN 7
      PROCfollow_pointer (!j%, psup%, c%,level%)
     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%,"#"

ENDPROC

#ifdef Test
DEF PROCdump_prdata (psup%)
  LOCAL head%,prdt%,c%,tmpt%,ntry%,list%,i%,j%,k%,l%,s$
  Ftracef("PROCsave_prdata")
  SYS "Hourglass_On"
  IF psup%!CONST_psup_tmpt THEN
    /*we have a template to guide us*/
    Ftracef("Data has been modified - saving it")
    /*the data has been modified so save it
      first of all, ensure the file attributes are OK (user WR)*/
    c%=OPENOUT("$.PrData-"+$psup%!CONST_psup_class)
    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%
REM      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
           BPUT#c%,STR$ !j%
          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%,"#"
REM      ENDIF
      prdt%=prdt%!CONST_prdt_next
     ENDWHILE
     tmpt%=tmpt%!CONST_tmpt_next
     head%=head%!CONST_head_next
    ENDWHILE
    CLOSE#c%
  ENDIF
  SYS "Hourglass_Off"
ENDPROC
#endif

DEF FNfix_up_prdata_pointer(s$)
  LOCAL j%,k%,t$
  Ftracef("FNfix_up_prdata_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 (j%!(j%!CONST_prdt_num*4+CONST_prdt_1st) = 0) AND (j% > 0) /* Skip 0 usage at start */
     j% = j%!CONST_prdt_next
    ENDWHILE
    WHILE k%
     j%=j%!CONST_prdt_next
Ftracef ("Usage is "+STR$(j%!(j%!CONST_prdt_num*4+CONST_prdt_1st)))
     IF j%!(j%!CONST_prdt_num*4+CONST_prdt_1st) THEN
      k%-=1
     ENDIF
    ENDWHILE

    /*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 PROCactivate_this_remote_printer(prnt%, ret_error%, RETURN error%)

  error% = FALSE

  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%)
  IF A%!CONST_interface_printer_active=1 THEN
    Ftracef("PROCselect_printer loc 5")
    PROCselect_remote_printer(prnt%,TRUE,FALSE, ret_error%, error%)
  ENDIF
ENDPROC

DEF PROCselect_remote_printer(prnt%,permanent%,restore%, ret_error%, RETURN error%)
  /*permanent implies the icon gets highlighted
    restore ensures that the permanent connection is valid*/
  LOCAL old_prnt%,i%,s$
  Ftracef("PROCselect_printer")

  error% = FALSE

  /*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)
  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
    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)
    IF selected_prnt%=old_prnt% THEN
      /*we have to deselect the printer - connection has failed totally*/
      PROCicon_deselect(-1,old_prnt%!CONST_prnt_icon)
      old_prnt%=0
    ENDIF
    selected_prnt%=old_prnt%
    /*ERROR CONST_error_ok,s$: REM Just give a warning for now. JRC 21 Mar*/
    IF ret_error% THEN
      error% = TRUE
    ELSE
      PROCerror_warning(s$)
    ENDIF
    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("PROCselect_printer done")
ENDPROC

DEF PROCshare_my_choices
  LOCAL addr%,out%,len%,new%,i%,context%,n%,err%
  /* First we unshare the choices */
  i%=0
  REPEAT
   SYS"XOS_CLI","Unshare _P"+unique_string$+"_"+STR$(i%) TO ;err%
   i%+=1
  UNTIL (err% AND 1)=1
  /* Now we share them again */
  addr%=FNmalloc(CONST_ident_STR0,16)
  $addr%="Printers$Path"+CHR$(0)
  i%=0
  context%=0
  REPEAT
   SYS"PathUtils_EnumeratePath","Printers:",out%,0,context% TO ,,len%,new%
   IF len%<>0 AND new%<>-1 THEN
    len%=NOTlen%
    out%=FNmalloc(CONST_ident_STR0,len%+48)
    $out%="Share "
    SYS"PathUtils_EnumeratePath","Printers:",out%+6,len%,context%
    n%=out%+5+len%
    IF ?n%<>ASC"." THEN n%+=1
    $n%=" _P"+unique_string$+"_"+STR$(i%)+" -noicon -readonly"+CHR$(0)
    SYS"XOS_CLI",out% TO ;err%
    IF (err% AND 1)=0 THEN i%+=1
    PROCfree(CONST_ident_STR0,out%)
   ENDIF
   context%=new%
  UNTIL context%=-1
  PROCfree(CONST_ident_STR0,addr%)
ENDPROC

#endif /* Sparrow */
