PROCEDURE (ram$delp) delete_procedure, delete_procedures, delp (
  procedure, procedures, p: list of any of
      name
      integer radix 16
      string
    anyend = $required
  from, f: file = $working_catalog.command_library
  status)

" PURPOSE:
"   Delete the specified modules from a library or object file.
" DESIGN:
"   Scan every module name on the library for the specified value. Write the resulting output, and update
"   the command list when appropriate.
" NOTES:
"   $WORKING_CATALOG.COMMAND_LIBRARY is overwritten when the working catalog is :$LOCAL. An integer
"   procedure value is hexadecimal, convenient for processing CDCNET configuration procedures.
"   A leading or trailing blank constrains the substring match to the beginning or end of a module name.

  VAR
    command_list_altered : status
    delete_status : status
    format : name = library
    library_list : file=$unique(:$local)
    modules_on_file : list 0..$max_list of string = ()
    modules_to_delete : list 0..$max_list of string = ()
    next_cycle : file = from
    specified_name : string 1..31
  VAREND

  IF $file(from, permanent) THEN " create absolute path to cycle $next
    next_cycle=from//$file(from//$next, cycle_number)
  IFEND

  IF ($file(from, fs)= 'DATA') AND ($file(from, fc)= 'LEGIBLE') THEN
    format=scl_proc
  IFEND

  CREATE_OBJECT_LIBRARY
    add_modules library=from
    set_file_attributes file=library_list page_format=continuous file_contents=legible
    display_new_library display_option=none output=library_list alphabetical_order=true
    get_line variable=modules_on_file input=library_list
    delete_file file=library_list
    FOR EACH procedure_specified IN procedures DO ..
          " accumulate (using $union) a list of non-duplicated module names
      IF $generic_type(procedure_specified)= integer THEN " a CDCNET configuration procedure reference
        specified_name=$integer_string(procedure_specified, 16)
      ELSE " a substring of the procedure name was specified
        specified_name=$translate(lower_to_upper, $string(procedure_specified))
      IFEND
      modules_to_delete=$union(modules_to_delete, ..
            $select(modules_on_file, $scan_string(specified_name, ' '//x//' ')>0))
    FOREND
    IF $nil(modules_to_delete) THEN " assign appropriate delete_module status
      delete_modules modules=$apply(procedures, $range_of($program_name(x))) status=delete_status
      IF delete_status.normal THEN " probably specified ALL, should have done delete_file
        generate_library library=next_cycle format=format status=delete_status
      IFEND
    ELSE " generate the resulting library or object file
      put_line line=' Deleting procedures from     '//next_cycle output=$response
      delete_modules modules=$apply(modules_to_delete, $range_of($program_name(x))) status=delete_status
      IF delete_status.normal THEN " account for the modules deleted
        put_lines lines=$apply(modules_to_delete, ' DELETED '//x) output=$response
      IFEND
      delete_command_list_entry entry=from status=command_list_altered
      IF command_list_altered.normal THEN " command list needs updating when processing is complete
        put_line line=' Deleted command list entry   '//from output=$response
      IFEND
      generate_library library=next_cycle format=format status=delete_status
      IF delete_status.normal THEN " summarize action performed
        put_line line=' Deleted '//$justify($integer_string($size(modules_to_delete)), 4, right)//..
' procedures from '//next_cycle output=$response
      IFEND
      IF command_list_altered.normal THEN " update the command list
        IF delete_status.normal THEN " add the new command library
          create_command_list_entry entry=next_cycle
          put_line line=' Created command list entry   '//next_cycle output=$response
        ELSE " restore the old command library
          create_command_list_entry entry=from
          put_line line=' Restored command list entry  '//from output=$response
        IFEND
      IFEND
    IFEND
  QUIT

  EXIT_PROC WITH delete_status

PROCEND delete_procedure
