; Copyright(c) 1992, CreaSo Creative Software Systems GmbH. All rights reserved.
;	Unauthorized reproduction prohibited.
;+
; NAME:
;	PACK
;
; PURPOSE:          
;	Pack ascii files into one container file in order to make it
;       easier to transfer a bunch of procedures to another computer
;       system (especially for E-Mail and Kermit). The container file
;       may be used like an IDL command procedure to unpack itself.
;       No additional unpack procedure is neccessary.
;
; CALLING SEQUENCE:
;	pack, [filename, [packname]]
;
; INPUTS:
;	filename - A comma separated list of filenames to be packed
;                  into the container file (default = *.pro)
;	packname - The name of the container file (default = idl.pck).
;
; KEYWORDS:
;	None.
;
; OUTPUTS:
;	None.
;
; COMMON BLOCKS:
;	None.
;
; SIDE EFFECTS:
;       A container file is created.
;
; RESTRICTIONS:
;     - Tested on VAX/VMS only.
;     - No check for packing binary files or directories is done.
;     - No check for packing the current or other packfiles is done.
;     - The unpack operation will terminate IDL when done.
;     - No filename checking for other operating systems is performed.
;     - No I/O error handling is performed. All errors will stop the program.
;     - The pack procedure is not automatically copied into the packfile
;       for a later re-pack on the target system. This could be solved by
;       making PACK a userlib procedure (incl. loadarray.pro and filescan.pro).
;     - The directory information is not transfered (directory tree transfer).
;
; EXAMPLES:
;
;       Packing a default container:
;       IDL> pack
;
;       Unpack the default container IDL.PCK on the target machine:
;       IDL> @idl.pck
;
;       Alternative unpack without having IDL started before:
;       idl idl.pck
;
; MODIFICATION HISTORY:
;	October 1992, HJB, CreaSo		Created.
;-
pro pack, filename, packname

   ;a: Set defaults.

   if (n_elements(filename) eq 0) then filename = "*.pro"
   if (n_elements(packname) eq 0) then packname = "idl.pck"

   ;a: Define unpack procedure.

   unpack = ["openr, packlun, '" + packname + "', /get_lun           ", $
             "line     = ''                                          ", $
             "filename = ''                                          ", $
             "readf, packlun, line                                   ", $
             "pos = strpos(line, 'HDRLEN=') + 7                      ", $
             "val = strmid(line, pos, strlen(line)-pos)              ", $
             "hdr = strarr(long(val))                                ", $
             "readf, packlun, hdr                                    ", $
             "while (not(eof(packlun))) do begin                 & $ ", $
             "   readf, packlun, filename                        & $ ", $
             "   openw, filelun, filename, /get_lun              & $ ", $
             "   print, ' Unpacking ', filename, ' ...'          & $ ", $
             "   readf, packlun, line                            & $ ", $
             "   while (line ne '####----@@@@----####') do begin & $ ", $
             "      printf, filelun, line                        & $ ", $
             "      readf,  packlun, line                        & $ ", $
             "   endwhile                                        & $ ", $
             "   free_lun, filelun                               & $ ", $
             "endwhile                                               ", $
             "free_lun, packlun                                      ", $
             "exit                                                   "]
   hdrlen = string(n_elements(unpack),format='(i0)')

   ;a: Split the filename string into separate names.

   files = strtrim(loadarray(filename,','),2)

   ; Open the packfile and make it self-unpacking.

   openw,  packlun, packname, /get_lun
   printf, packlun, "; IDL PACK Version 1.0   HDRLEN=", hdrlen
   printf, packlun, unpack

   ;f: Loop through all filenames found.

   for i=0,n_elements(files)-1 do begin
       
      ;a: Get matching filenames in case wildcard have been used.

      names = findfile(files(i), count=count)

      ;w: Loop through all files found.

      while (count gt 0) do begin

         ;a: Step to next file.

         count = count - 1

         ;a: Open the current file.

         openr, filelun, names(count), /get_lun

         ;a: Transfer the current file into container file.
                        
         filescan, names(count), name=name, type=type
         if (!version.os eq 'vms' or !version.os eq 'Windows') then begin
            name = strlowcase(name)
            type = strlowcase(type)
         endif
         printf, packlun, name+type
         print , "Packing ", name+type, " ..."
         line = strarr(1)
         while (not(eof(filelun))) do begin
            readf , filelun, line 
            printf, packlun, line 
         endwhile
         printf, packlun, "####----@@@@----####"

         ;a: Close current file.

         free_lun, filelun
       
      endwhile

   endfor 

   ;a: Close the containerfile.

   free_lun, packlun

return
end