?? RIGHT := 110 ??
?? NEWTITLE := 'Preprocess PostScript File Batch Output Filter' ??

MODULE nfm$preprocess_postscript_file;

{ PURPOSE:
{   Filter a PostScript file.
{
{ DESIGN:
{
{   This program "normalizes" PostScript files.  It will ensure the file
{   has an Ascii EOT character at the beginning and end of the file.  Input
{   can be coded or transparent, but output will always be transparent.
{   This program will also prefix the file with the specified dictionaries
{   and it will process embedded directives and attempt to load the
{   required Apple dictionary.
{
{ NOTES:
{   PostScript is a registered trademark of Adobe Systems, Inc.

?? NEWTITLE := 'Global References', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc osd$integer_limits
?? POP ??
*copyc amp$get_partial
*copyc amp$put_next
*copyc amp$put_partial
*copyc clp$change_variable
*copyc clp$evaluate_parameters
*copyc fsp$close_file
*copyc fsp$open_file
*copyc jmp$close_output_file
*copyc jmp$open_output_file
*copyc pmp$log
?? OLDTITLE ??

?? NEWTITLE := 'Global Definitions', EJECT ??
  CONST
    cr = $CHAR (13),
    eot = $CHAR (4),
    lf = $CHAR (10),
    max_buffer_size = 4096,
    sub = $CHAR (26);

  TYPE
    file_descriptor = record
      file_id: amt$file_identifier,
      file_position: amt$file_position,
      cursor: ost$non_negative_integers,
      last: amt$transfer_count,
      buffer: array [1 .. max_buffer_size] of char,
    recend;
?? OLDTITLE ??

?? NEWTITLE := 'nfp$preprocess_postscript_file ', EJECT ??

  PROGRAM nfp$preprocess_postscript_file
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

    TYPE
      states = (beginning_of_line, mid_line);

    VAR
      byte_address: amt$file_byte_address,
      ch: char,
      data_move_var_value: clt$data_value,
      dictionary_name_entry: ^clt$data_value,
      dictionary_path: string (512),
      dictionary_path_size: integer,
      done: boolean,
      end_of_file: [STATIC] char := eot,
      ignore_status: ost$status,
      input_file: file_descriptor,
      output_file: file_descriptor,
      record_length: amt$max_record_length,
      state: states;

{ PROCEDURE preprocess_postscript_file, prepf (
{   input, i: record
{       system_file_name: name 19..19
{       password: string 1..31
{       file: file = $optional
{     recend = $required
{   output, o: file = $required
{   dictionary_catalog, dc: any of
{       key
{         none
{       keyend
{       file
{     anyend = none
{   dictionary_name, dictionary_names, dn: any of
{       key
{         none
{       keyend
{       list of name
{     anyend = none
{   data_mode, dm: (VAR) key
{       (coded, c)
{       (transparent, t)
{     keyend = $required
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 12] of clt$pdt_parameter_name,
      parameters: array [1 .. 6] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$record_type_qualifier,
        field_spec_1: clt$field_specification,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
        field_spec_2: clt$field_specification,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$string_type_qualifier,
        recend,
        field_spec_3: clt$field_specification,
        element_type_spec_3: record
          header: clt$type_specification_header,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
        default_value: string (4),
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$list_type_qualifier_v2,
          element_type_spec: record
            header: clt$type_specification_header,
            qualifier: clt$name_type_qualifier,
          recend,
        recend,
        default_value: string (4),
      recend,
      type5: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 4] of clt$keyword_specification,
      recend,
      type6: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [90, 8, 13, 11, 11, 45, 619],
    clc$command, 12, 6, 3, 0, 0, 1, 6, ''], [
    ['DATA_MODE                      ',clc$nominal_entry, 5],
    ['DC                             ',clc$abbreviation_entry, 3],
    ['DICTIONARY_CATALOG             ',clc$nominal_entry, 3],
    ['DICTIONARY_NAME                ',clc$nominal_entry, 4],
    ['DICTIONARY_NAMES               ',clc$alias_entry, 4],
    ['DM                             ',clc$abbreviation_entry, 5],
    ['DN                             ',clc$abbreviation_entry, 4],
    ['I                              ',clc$abbreviation_entry, 1],
    ['INPUT                          ',clc$nominal_entry, 1],
    ['O                              ',clc$abbreviation_entry, 2],
    ['OUTPUT                         ',clc$nominal_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 6]],
    [
{ PARAMETER 1
    [9, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 131,
  clc$required_parameter, 0, 0],
{ PARAMETER 2
    [11, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter,
  0, 0],
{ PARAMETER 3
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 67,
  clc$optional_default_parameter, 0, 4],
{ PARAMETER 4
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 85,
  clc$optional_default_parameter, 0, 4],
{ PARAMETER 5
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 155,
  clc$required_parameter, 0, 0],
{ PARAMETER 6
    [12, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$record_type], [3],
    ['SYSTEM_FILE_NAME               ', clc$required_field, 5], [[1, 0, clc$name_type], [19, 19]],
    ['PASSWORD                       ', clc$required_field, 8], [[1, 0, clc$string_type], [1, 31, FALSE]],
    ['FILE                           ', clc$optional_field, 3], [[1, 0, clc$file_type]]
    ],
{ PARAMETER 2
    [[1, 0, clc$file_type]],
{ PARAMETER 3
    [[1, 0, clc$union_type], [[clc$file_type, clc$keyword_type],
    FALSE, 2],
    44, [[1, 0, clc$keyword_type], [1], [
      ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    3, [[1, 0, clc$file_type]]
    ,
    'none'],
{ PARAMETER 4
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$list_type],
    FALSE, 2],
    44, [[1, 0, clc$keyword_type], [1], [
      ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    21, [[1, 0, clc$list_type], [5, 1, clc$max_list_size, 0, FALSE, FALSE],
        [[1, 0, clc$name_type], [1, osc$max_name_size]]
      ]
    ,
    'none'],
{ PARAMETER 5
    [[1, 0, clc$keyword_type], [4], [
    ['C                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['CODED                          ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['T                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['TRANSPARENT                    ', clc$nominal_entry, clc$normal_usage_entry, 2]]
    ],
{ PARAMETER 6
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$input = 1,
      p$output = 2,
      p$dictionary_catalog = 3,
      p$dictionary_name = 4,
      p$data_mode = 5,
      p$status = 6;

    VAR
      pvt: array [1 .. 6] of clt$parameter_value;

?? EJECT ??

    status.normal := TRUE;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;

    open_input_file (pvt [p$input].value, input_file, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    open_output_file (pvt [p$output].value^.file_value^, output_file, status);
    IF NOT status.normal THEN
      fsp$close_file (input_file.file_id, ignore_status);
      RETURN;
    IFEND;

    done := FALSE;
    input_file.file_position := amc$boi;
    output_file.buffer [1] := eot;
    output_file.cursor := 2;
    state := beginning_of_line;

{ Prefix output file with any dictionaries specified by DICTIONARY_NAME

    IF pvt [p$dictionary_name].value^.kind = clc$list THEN
      dictionary_name_entry := pvt [p$dictionary_name].value;
      WHILE dictionary_name_entry <> NIL DO
        STRINGREP (dictionary_path, dictionary_path_size, pvt [p$dictionary_catalog].value^.file_value^, '.',
              dictionary_name_entry^.element_value^.name_value);
        load_dictionary (output_file, dictionary_path (1, dictionary_path_size), status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        dictionary_name_entry := dictionary_name_entry^.link;
      WHILEND;
    IFEND;

    WHILE NOT done DO
      IF input_file.cursor > input_file.last THEN { refill input buffer }
        IF input_file.file_position = amc$eoi THEN
          done := TRUE;
        ELSEIF input_file.file_position = amc$eor THEN
          input_file.file_position := amc$mid_record;
          input_file.buffer [1] := lf;
          input_file.cursor := 1;
          input_file.last := 1;
        ELSE
          input_file.cursor := 1;
          amp$get_partial (input_file.file_id, ^input_file.buffer, max_buffer_size, record_length,
                input_file.last, byte_address, input_file.file_position, amc$no_skip, status);
        IFEND;
      ELSE
        ch := input_file.buffer [input_file.cursor];
        input_file.cursor := input_file.cursor + 1;

        CASE state OF

        = beginning_of_line =
          CASE ch OF

          = cr, lf =

            IF output_file.cursor > max_buffer_size THEN
              amp$put_next (output_file.file_id, ^output_file.buffer, max_buffer_size, byte_address, status);
              output_file.cursor := 1;
            IFEND;
            output_file.buffer [output_file.cursor] := ch;
            output_file.cursor := output_file.cursor + 1;

          = sub =

{ Ignore SUB character - added by some file transfer programs.

          ELSE

            IF (ch = '%') AND (pvt [p$dictionary_catalog].value^.kind = clc$file) THEN
              process_comment (input_file, output_file, pvt [p$dictionary_catalog].value^.file_value^,
                    status);
            ELSE
              state := mid_line;
              IF output_file.cursor > max_buffer_size THEN
                amp$put_next (output_file.file_id, ^output_file.buffer, max_buffer_size, byte_address,
                      status);
                output_file.cursor := 1;
              IFEND;
              output_file.buffer [output_file.cursor] := ch;
              output_file.cursor := output_file.cursor + 1;
            IFEND;

          CASEND;

        = mid_line =

          IF (ch = cr) OR (ch = lf) THEN { end of line }
            state := beginning_of_line;
          IFEND;

          IF output_file.cursor > max_buffer_size THEN
            amp$put_next (output_file.file_id, ^output_file.buffer, max_buffer_size, byte_address, status);
            output_file.cursor := 1;
          IFEND;
          output_file.buffer [output_file.cursor] := ch;
          output_file.cursor := output_file.cursor + 1;

        CASEND;

      IFEND;

      IF NOT status.normal THEN
        close_files (input_file, pvt [p$input], output_file, ignore_status);
        RETURN;
      IFEND;

    WHILEND;

    IF output_file.cursor > 1 THEN
      amp$put_next (output_file.file_id, ^output_file.buffer, output_file.cursor - 1, byte_address, status);
      IF NOT status.normal THEN
        close_files (input_file, pvt [p$input], output_file, ignore_status);
        RETURN;
      IFEND;
    IFEND;

    amp$put_next (output_file.file_id, ^end_of_file, 1, byte_address, status);
    IF NOT status.normal THEN
      close_files (input_file, pvt [p$input], output_file, ignore_status);
      RETURN;
    IFEND;

    close_files (input_file, pvt [p$input], output_file, status);
    IF status.normal THEN
      data_move_var_value.kind := clc$keyword;
      data_move_var_value.keyword_value := 'TRANSPARENT';
      clp$change_variable (pvt [p$data_mode].variable^, ^data_move_var_value, status);
    IFEND

  PROCEND nfp$preprocess_postscript_file;
?? OLDTITLE ??

?? NEWTITLE := 'close_files', EJECT ??

  PROCEDURE close_files
    (    input_file: file_descriptor;
         input_param: clt$parameter_value;
         output_file: file_descriptor;
     VAR status: ost$status);

    VAR
      local_status: ost$status;

    status.normal := TRUE;

    IF input_param.value^.field_values^ [3].value = NIL THEN
      jmp$close_output_file (input_file.file_id, status);
    ELSE
      fsp$close_file (input_file.file_id, status);
    IFEND;

    fsp$close_file (output_file.file_id, local_status);

    IF status.normal AND (NOT local_status.normal) THEN
      status := local_status;
    IFEND;

  PROCEND close_files;
?? OLDTITLE ??

?? NEWTITLE := 'include_proc_set', EJECT ??

  PROCEDURE include_proc_set
    (VAR {input/output} output_file: file_descriptor;
         line: string ( * );
         size: ost$non_negative_integers;
         cursor_position: ost$non_negative_integers;
         dictionary_catalog: fst$file_reference;
     VAR status: ost$status);

    CONST
      apple_token = '(AppleDict md)',
      max_token_size = 100;

    VAR
      byte_address: amt$file_byte_address,
      ch: char,
      cursor: ost$non_negative_integers,
      delimiter: char,
      dictionary_path: string (512),
      dictionary_path_size: integer,
      dictionary_prefix: string (200),
      dictionary_prefix_size: integer,
      done: boolean,
      end_of_line: [STATIC] char := lf,
      ignore_status: ost$status,
      token: string (max_token_size),
      token_size: ost$non_negative_integers,
      version: string (max_token_size),
      version_size: ost$non_negative_integers;

    status.normal := TRUE;
    cursor := cursor_position + 1;

{ Get next token and compare to "(AppleDict md)"

    done := FALSE;
    WHILE NOT done DO
      IF cursor > size THEN
        done := TRUE;
      ELSEIF line (cursor) <> ' ' THEN
        done := TRUE;
      ELSE
        cursor := cursor + 1;
      IFEND;
    WHILEND;

    IF cursor <= size THEN
      IF line (cursor) = '"' THEN
        delimiter := '"';
        cursor := cursor + 1;
      ELSE
        delimiter := ' ';
      IFEND;
    IFEND;

    token_size := 0;
    done := FALSE;

    WHILE NOT done DO
      IF cursor > size THEN
        done := TRUE;
      ELSEIF line (cursor) = delimiter THEN
        cursor := cursor + 1;
        done := TRUE;
      ELSE
        ch := line (cursor);
        cursor := cursor + 1;
        IF token_size < max_token_size THEN
          token_size := token_size + 1;
          token (token_size) := ch;
        IFEND;
      IFEND;
    WHILEND;

    IF token (1, token_size) <> apple_token THEN
      RETURN;
    IFEND;

{ Get version number

    done := FALSE;
    WHILE NOT done DO
      IF cursor > size THEN
        done := TRUE;
      ELSEIF line (cursor) <> ' ' THEN
        done := TRUE;
      ELSE
        cursor := cursor + 1;
      IFEND;
    WHILEND;

    version_size := 0;
    done := FALSE;

    WHILE NOT done DO
      IF cursor > size THEN
        done := TRUE;
      ELSEIF line (cursor) = ' ' THEN
        done := TRUE;
      ELSE
        ch := line (cursor);
        cursor := cursor + 1;
        IF version_size < max_token_size THEN
          version_size := version_size + 1;
          version (version_size) := ch;
        IFEND;
      IFEND;
    WHILEND;

    IF version_size <= 0 THEN
      RETURN;
    IFEND;

    STRINGREP (dictionary_prefix, dictionary_prefix_size, 'userdict /md known {md /av known {md /av get ',
          version (1, version_size), ' eq {stop} if} if} if', end_of_line, 'serverdict begin 0 exitserver',
          end_of_line);

    amp$put_next (output_file.file_id, ^dictionary_prefix, dictionary_prefix_size, byte_address, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    STRINGREP (dictionary_path, dictionary_path_size, dictionary_catalog, '.apple_dict_md_',
          version (1, version_size));

    load_dictionary (output_file, dictionary_path (1, dictionary_path_size), status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  PROCEND include_proc_set;
?? OLDTITLE ??

?? NEWTITLE := 'load_dictionary', EJECT ??

  PROCEDURE load_dictionary
    (VAR {input/output} output_file: file_descriptor;
         dictionary_path: fst$file_reference;
     VAR status: ost$status);

    VAR
      attachment_option: array [1 .. 3] of fst$attachment_option,
      byte_address: amt$file_byte_address,
      ch: char,
      dictionary_file: file_descriptor,
      done: boolean,
      ignore_status: ost$status,
      record_length: amt$max_record_length;

    status.normal := TRUE;

    attachment_option [1].selector := fsc$access_and_share_modes;
    attachment_option [1].access_modes.selector := fsc$specific_access_modes;
    attachment_option [1].access_modes.value := $fst$file_access_options [fsc$read];
    attachment_option [1].share_modes.selector := fsc$specific_share_modes;
    attachment_option [1].share_modes.value := $fst$file_access_options [fsc$read, fsc$execute];
    attachment_option [2].selector := fsc$open_share_modes;
    attachment_option [2].open_share_modes := $fst$file_access_options [fsc$read, fsc$execute];
    attachment_option [3].selector := fsc$create_file;
    attachment_option [3].create_file := FALSE;

    fsp$open_file (dictionary_path, amc$record, ^attachment_option, NIL, NIL, NIL, NIL,
          dictionary_file.file_id, status);
    IF NOT status.normal THEN
      pmp$log ('** PREPROCESS_POSTSCRIPT_FILE:  Dictionary open error:', ignore_status);
      pmp$log (dictionary_path, ignore_status);
      status.normal := TRUE;
      RETURN;
    IFEND;

    dictionary_file.cursor := max_buffer_size + 1;
    dictionary_file.last := 0;
    dictionary_file.file_position := amc$boi;

    done := FALSE;

    WHILE NOT done DO
      IF dictionary_file.cursor > dictionary_file.last THEN
        IF dictionary_file.file_position = amc$eoi THEN
          done := TRUE;
        ELSEIF dictionary_file.file_position = amc$eor THEN
          dictionary_file.file_position := amc$mid_record;
          dictionary_file.buffer [1] := lf;
          dictionary_file.cursor := 1;
          dictionary_file.last := 1;
        ELSE
          dictionary_file.cursor := 1;
          amp$get_partial (dictionary_file.file_id, ^dictionary_file.buffer, max_buffer_size, record_length,
                dictionary_file.last, byte_address, dictionary_file.file_position, amc$no_skip, status);
        IFEND;
      ELSE
        ch := dictionary_file.buffer [dictionary_file.cursor];
        IF ch = cr THEN
          ch := lf;
        IFEND;
        dictionary_file.cursor := dictionary_file.cursor + 1;

        IF output_file.cursor > max_buffer_size THEN
          amp$put_next (output_file.file_id, ^output_file.buffer, max_buffer_size, byte_address, status);
          output_file.cursor := 1;
        IFEND;

{ Ignore SUB character - added by some file transfer programs.

        IF ch <> sub THEN
          output_file.buffer [output_file.cursor] := ch;
          output_file.cursor := output_file.cursor + 1;
        IFEND;
      IFEND;

      IF NOT status.normal THEN
        fsp$close_file (dictionary_file.file_id, ignore_status);
        RETURN;
      IFEND;

    WHILEND;

    IF output_file.cursor > max_buffer_size THEN
      amp$put_next (output_file.file_id, ^output_file.buffer, max_buffer_size, byte_address, status);
      IF NOT status.normal THEN
        fsp$close_file (dictionary_file.file_id, ignore_status);
        RETURN;
      IFEND;
      output_file.cursor := 1;
    IFEND;

    output_file.buffer [output_file.cursor] := eot;
    output_file.cursor := output_file.cursor + 1;

    fsp$close_file (dictionary_file.file_id, status);

  PROCEND load_dictionary;
?? OLDTITLE ??

?? NEWTITLE := 'open_input_file', EJECT ??

  PROCEDURE open_input_file
    (    input_parameter: ^clt$data_value;
     VAR input_file: file_descriptor;
     VAR status: ost$status);

    VAR
      attachment_option: array [1 .. 3] of fst$attachment_option;

    status.normal := TRUE;

    IF input_parameter^.field_values^ [3].value = NIL THEN

      jmp$open_output_file (input_parameter^.field_values^ [1].
            value^.name_value (1, jmc$system_supplied_name_size), amc$record, jmc$public_usage,
            input_parameter^.field_values^ [2].value^.string_value^, input_file.file_id, status);

    ELSE

      attachment_option [1].selector := fsc$access_and_share_modes;
      attachment_option [1].access_modes.selector := fsc$specific_access_modes;
      attachment_option [1].access_modes.value := $fst$file_access_options [fsc$read];
      attachment_option [1].share_modes.selector := fsc$specific_share_modes;
      attachment_option [1].share_modes.value := $fst$file_access_options [fsc$read, fsc$execute];
      attachment_option [2].selector := fsc$open_share_modes;
      attachment_option [2].open_share_modes := $fst$file_access_options [fsc$read, fsc$execute];
      attachment_option [3].selector := fsc$create_file;
      attachment_option [3].create_file := FALSE;

      fsp$open_file (input_parameter^.field_values^ [3].value^.file_value^, amc$record,
            ^attachment_option, NIL, NIL, NIL, NIL, input_file.file_id, status);

    IFEND;

    input_file.cursor := max_buffer_size + 1;
    input_file.last := 0;

  PROCEND open_input_file;
?? OLDTITLE ??

?? NEWTITLE := 'open_output_file', EJECT ??

  PROCEDURE open_output_file
    (    file_name: fst$file_reference;
     VAR output_file: file_descriptor;
     VAR status: ost$status);

    VAR
      attachment_option: array [1 .. 2] of fst$attachment_option,
      file_attributes: array [1 .. 1] of fst$file_cycle_attribute;

    status.normal := TRUE;

    attachment_option [1].selector := fsc$access_and_share_modes;
    attachment_option [1].access_modes.selector := fsc$specific_access_modes;
    attachment_option [1].access_modes.value := $fst$file_access_options [fsc$append, fsc$shorten];
    attachment_option [1].share_modes.selector := fsc$specific_share_modes;
    attachment_option [1].share_modes.value := $fst$file_access_options [];
    attachment_option [2].selector := fsc$open_share_modes;
    attachment_option [2].open_share_modes := -$fst$file_access_options [];

    file_attributes [1].selector := fsc$record_type;
    file_attributes [1].record_type := amc$undefined;

    fsp$open_file (file_name, amc$record, ^attachment_option, NIL, ^file_attributes, NIL, NIL,
          output_file.file_id, status);

    output_file.cursor := 1;

  PROCEND open_output_file;
?? OLDTITLE ??

?? NEWTITLE := 'process_comment', EJECT ??

  PROCEDURE process_comment
    (VAR {input/output} input_file: file_descriptor;
     VAR {input/output} output_file: file_descriptor;
         dictionary_catalog: fst$file_reference;
     VAR status: ost$status);

    CONST
      include_comment = '%%IncludeProcSet:',
      include_comment_size = 17,
      max_line_size = 1000;

    VAR
      byte_address: amt$file_byte_address,
      ch: char,
      cursor: ost$non_negative_integers,
      done: boolean,
      end_of_line: [STATIC] char := lf,
      ignore_status: ost$status,
      line: string (max_line_size),
      record_length: amt$max_record_length,
      size: ost$non_negative_integers;

    status.normal := TRUE;

    done := FALSE;
    line := '%';
    cursor := 2;

    WHILE NOT done DO
      IF input_file.cursor > input_file.last THEN { refill input buffer }
        IF input_file.file_position = amc$eoi THEN
          done := TRUE;
        ELSEIF input_file.file_position = amc$eor THEN
          done := TRUE;
        ELSE
          input_file.cursor := 1;
          amp$get_partial (input_file.file_id, ^input_file.buffer, max_buffer_size, record_length,
                input_file.last, byte_address, input_file.file_position, amc$no_skip, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;
      ELSE
        ch := input_file.buffer [input_file.cursor];
        input_file.cursor := input_file.cursor + 1;
        IF (ch = cr) OR (ch = lf) THEN
          done := TRUE;
        ELSEIF cursor <= max_line_size THEN
          line (cursor) := ch;
          cursor := cursor + 1;
        IFEND;
      IFEND;
    WHILEND;

    size := cursor - 1;

    IF output_file.cursor > 1 THEN { flush output buffer }
      amp$put_next (output_file.file_id, ^output_file.buffer, output_file.cursor - 1, byte_address, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      output_file.cursor := 1;
    IFEND;

    amp$put_partial (output_file.file_id, ^line, size, byte_address, amc$start, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$put_partial (output_file.file_id, ^end_of_line, 1, byte_address, amc$terminate, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF line (1, include_comment_size) = include_comment THEN
      include_proc_set (output_file, line, size, include_comment_size, dictionary_catalog, status);
    IFEND;

  PROCEND process_comment;
?? OLDTITLE ??

MODEND nfm$preprocess_postscript_file;
