function bundle(dst, src, target, message)

% bundle Bundler for a collection of M-files.
%  bundle('DST') creates the bundle file 'DST'.
%  bundle('DST','SRC') opens the bundle file 'DST'
%   and adds the 'SRC' M-file routine to it.  The
%   bundled routines can then be installed at another
%   site by executing the 'DST' M-file in MATLAB 4.0+.
%   'DST' and 'SRC' may include the explicit path,
%   but do not include ".m" in 'DST'.
%   If 'SRC' is a string matrix, each of the
%   named routines is added to the 'DST' bundle.
%  bundle('DST','SRC','TARGET') adjusts filenames
%   for the particular TARGET computer.  For DOS-like
%   Matlabs, denoted by 'PCWIN', the names are forced
%   to lower-case and truncated to 8-characters. The
%   'TARGET' defaults to 'MAC2'.  Other choices are
%   'PCWIN', 'UNIX', and 'VAX_VMS'.
%  bundle('DST','SRC','TARGET','binary') bundles the
%   'SRC' file as a raw binary stream.
%  bundle('DST','eval','TARGET','MESSAGE') inserts a
%   statement in the bundle to 'eval' the 'MESSAGE'.
%   If the 'MESSAGE' is 'Success', a message on the
%   successful installation of the bundle will be posted.
%  bundle('DST', 'matlab', 'TARGET', 'STATEMENT') adds the
%   'STATEMENT' to the bundle as a Matlab statement to be
%   executed directly when the bundle itself is executed.
%   Use this to invoke logic, such as 'if ...".
%  bundle('demo') demonstrates itself with hello().
%
%  Note: After the bundle is fully constructed, it can be
%   made more portable by converting it to Matlab P-code.
 
% Copyright (C) 1994-7 Dr. Charles R. Denham, ZYDECO.
% All Rights Reserved.

% Original Version 15-Jul-94 at 12:00:05.217.
% Revised  Version  2-Aug-94 at 16:12:26.32.    Chunkified.
% Revised  Version of 1-Jul-96 at 08:35:40.4.   DOS-ified.
% Revised  Version of 2-Jul-96 at 07:39:32.17.  Eval added.
% Revised  Version of 10-Sep-96 at 09:56:21.25. Better NL.
% Revised  Version of 10-Sep-96 at 08:07:21.25. Matlab added.
% Revised  Version of 28-Jul-1997 09:04:07.     Addpath stuff.

if nargin < 1, dst = 'demo'; end
if nargin < 2, src = ''; end    % No source file.
if nargin < 3, target = computer; end
if nargin < 4, message = ''; end

MAX_CHUNK = 32;

if isempty(target), target = computer; end

if strcmp(dst, 'demo')   % Demonstration.
   help bundle
   disp(' ## Original:')
   hello world
   disp(' ')
   disp(' ## Bundling:')
   dst = 'hello_install';
   target = computer;
   bundle(dst, '', target)
   bundle(dst, 'hello', target)
   bundle(dst, 'matlab', target, 'hello world')
   bundle(dst, 'eval', target, 'Success')
   disp(' ')
   disp(' ## Conversion to P-code:')
   pcode('hello_install')
   disp(' ')
   disp(' ## Unbundling:')
   eval('hello_install')
   return
end

% Bundle a class.

if nargin > 1 & ~isempty(src)
   if (~isvms & src(1) == '@') | (isvms & src(1) == '#')
      bundle_class(dst, src, target, message)
      return
   end
end

% Date/time.

c = clock;
time = '';
for i = 1:6
   t = int2str(c(i));
   while length(t) < 2, t = ['0' t]; end
   if i < 6, t = [t '.']; end
   time = [time t];
end

% Get the destination function name.

dfunc = dst;
while any(dfunc == ':'), dfunc(1) = ''; end   % Macintosh.
while any(dfunc == '/'), dfunc(1) = ''; end   % Unix.
while any(dfunc == '\'), dfunc(1) = ''; end   % PC.
while any(dfunc == '.'), dfunc(length(dfunc)) = ''; end

% End of line marker.

EOL = '';
if (0) EOL = [' %%EOL%%']; end

% Newline character for printing.

NL = sprintf('\n');
if findstr(target, 'PCWIN'), NL = setstr([13 10]); end
if findstr(target, 'VAX_VMS'), NL = setstr([13 10]); end

% Newline character for reading.

newline1 = ['NL = sprintf(''\\n'');'];
newline2 = ['if findstr(computer, ''PCWIN''), NL = setstr([13 10]); end'];
newline3 = ['if findstr(computer, ''VAX_VMS''), NL = setstr([13 10]); end'];

DOS_NAME = ['DOS_NAME = ''if findstr(computer, ''''PCWIN''''), mfile = dosfile; end;'';']; % DOS adjustment.
NEW_FILE = ['NEW_FILE = ''[fp, msg] = fopen(mfile, ''''w'''');'';']; % Open a new file.
BAD_FILE = ['BAD_FILE = ''if(fp < 0), error(msg), end;'';']; % Bad file error.
ADD_TEXT = ['ADD_TEXT = ''fprintf(fp, mtext);'';']; % Append text to the file.
ADD_BINA = ['ADD_BINA = ''fwrite(fp, mtext, ''''uchar'''');'';']; % Append binary to the file.
END_FILE = ['END_FILE = ''fclose(fp);'';']; % Close the file.

NEW_CHUNK = ['mtext = [ ...' EOL NL];
END_CHUNK = ['];' EOL NL];

NEW_LINE = [''''];                 % Initialize a new line.
END_LINE = [''' NL ...' EOL NL];   % Mark EOL and terminate line.

PROGRESS= ['PROGRESS = ''disp([''''    Unbundled: '''' mfile])'';'];

special = [NL(1) '%' '\' ''''];

% Initialize the new dst file if needed.

fclose('all');

dstfile = [dst '.m'];
if isempty(src) | exist(dstfile) ~= 2
   fp = fopen(dstfile, 'w');
   fprintf(fp, ['function ' dfunc EOL NL]);
   fprintf(fp, [newline1 EOL NL]);
   fprintf(fp, [newline2 EOL NL]);
   fprintf(fp, [newline3 EOL NL]);
   fprintf(fp, [DOS_NAME EOL NL]);
   fprintf(fp, [NEW_FILE EOL NL]);
   fprintf(fp, [BAD_FILE EOL NL]);
   fprintf(fp, [ADD_BINA EOL NL]);
   fprintf(fp, [ADD_TEXT EOL NL]);
   fprintf(fp, [END_FILE EOL NL]);
   fprintf(fp, [PROGRESS EOL NL]);
   fclose(fp);
   bundle(dst, 'disp', target, [' ##'])
   bundle(dst, 'disp', target, [' ## Generated by BUNDLE: ' dst])
   bundle(dst, 'disp', target, [' ## Created: ' time])
   bundle(dst, 'disp', target, [' ## Copyright (C) 1994-7 Dr. Charles R. Denham, ZYDECO.'])
   bundle(dst, 'disp', target, [' ## All Rights Reserved.'])
   bundle(dst, 'disp', target, [' ## E-Mail: cdenham@usgs.gov.'])
   bundle(dst, 'disp', target, [' ## WWW: http://crusty.er.usgs.gov/~cdenham/.'])
   bundle(dst, 'disp', target, [' ##'])
   if (0)
      bundle(dst, 'uisetdir', target)
      bundle(dst, 'makedir', target)
      bundle(dst, 'eval', target, 'eval(''addpath(pwd)'')')
      bundle(dst, 'eval', target, 'clear uisetfile')
      bundle(dst, 'eval', target, 'clear makedir')
   end
end

% Insert a directive to be evaluated.

if nargin > 3 & ...
      (strcmp(src, 'eval') | strcmp(src, 'disp') | strcmp(src, 'matlab'))
   if strcmp(message, 'Success')
      message = 'disp('' ## Successful installation.'')';
   end
   string = message;
   quotes = '';
   if ~isempty(string)
      s = (string == '''');
      if ~isempty(s), quotes = setstr(s .* abs('''')); end
   end
   string = [string; quotes];
   string = string(:).';
   string = string(string ~= 0);
   if strcmp(src, 'matlab')
      string = string;   % Raw Matlab statement.
     else
      string = [src '(''' string ''');'];
   end
   string = [string EOL NL];
   fp = fopen(dstfile, 'at');
   fprintf(fp, string);
   fclose(fp);
   return
end

[m, n] = size(src);

for k = 1:m   % Loop over all source files.

% Input the source as a text stream.

s = src(k, :);

sfunc = s;
while any(sfunc == ':'), sfunc(1) = ''; end   % Macintosh.
while any(sfunc == '/'), sfunc(1) = ''; end   % Unix.
while any(sfunc == '\'), sfunc(1) = ''; end   % PC.

if strcmp(target, 'PCWIN')
   sfunc = lower(sfunc);
   f = find(sfunc == '.');
   if any(f)
      f = f(1); if f > 9, sfunc(9:f-1) = ''; end
     elseif length(sfunc) > 8
      sfunc(9:length(sfunc)) = '';
   end
end

s = s(s ~= ' ' & s ~= setstr(0));
d = s;
if ~any(s == '.')
   if exist([s '.m']) == 2
      d = s;
      if length(d) > 8, d = d(1:8); end
      d = lower([s '.m']);
      s = [s '.m'];
   end
end
dosfile = d;
sfile = s;
disp(sfile)
if strcmp(message, 'binary')
   fp = fopen(sfile, 'rb');   % Filename with extension.
   if fp < 0, error([' ## Unable to open "' sfile '"']), end
   mtext = setstr(fread(fp, inf, 'uchar').');   % Note "uchar".
  else
   fp = fopen(sfile, 'rt');   % Filename with extension.
   if fp < 0, error([' ## Unable to open "' sfile '"']), end
   mtext = setstr(fread(fp, inf, 'char').');   % Note "char".
end
fclose(fp);

% Adjust for various newline schemes.

if strcmp(message, 'binary')   % Binary
  else
   if length(NL) == 2            % Text.
      mtext(mtext == NL(2)) = '';
   end
   if NL(1) == 13
      f = find(mtext == setstr(10));
      if any(f), mtext(f) = setstr(0 .* mtext(f) + 13); end
     elseif NL(1) == 10
      f = find(mtext == setstr(13));
      if any(f), mtext(f) = setstr(0 .* mtext(f) + 10); end
   end
end

% Output buffer: enough to hold a line.

if strcmp(message, 'binary')
   buflen = 5 .* length(mtext);
   buffer = setstr(zeros(1, buflen));
  else
   f = [0 find(mtext == NL(1)) length(mtext)+1];
   buflen = 2 .* max(diff(f));
   buffer = setstr(zeros(1, buflen) + abs(' '));
end

% Package and output to the destination file.

fp = fopen(dstfile, 'at');
fprintf(fp, NL);
NEW_FUNC = ['mfile = ''' s '''; dosfile = ''' d '''; mfunc = ''' sfunc ''';' EOL NL];
fprintf(fp, NEW_FUNC);
fprintf(fp, ['eval(DOS_NAME);' EOL NL]);
fprintf(fp, ['eval(NEW_FILE);' EOL NL]);
fprintf(fp, ['eval(BAD_FILE);' EOL NL]);
begin_chunk = 1;   % Needs mtext = [ ... .
buflen = 0;   % Clear the buffer.
line_count = 0;
for i = 1:length(mtext)
   if line_count >= MAX_CHUNK
      fprintf(fp, END_CHUNK);
      if strcmp(message, 'binary')
         fprintf(fp, ['eval(ADD_BINA);' EOL NL]);
        else
         fprintf(fp, ['eval(ADD_TEXT);' EOL NL]);
      end
      begin_chunk = 1;
   end
   if begin_chunk
      fprintf(fp, NEW_CHUNK);
      begin_chunk = 0;
      begin_line = 1;    % Needs an opening quote.
      line_count = 0;
   end
   if begin_line
      begin_line = 0;
      buflen = 0;
      if strcmp(message, 'binary')
         d = '[';
         buffer(buflen + (1:length(d))) = d;
         buflen = buflen + length(d);
      else
         buffer(buflen + (1:length(NEW_LINE))) = NEW_LINE;
         buflen = buflen + length(NEW_LINE);
      end
   end
   c = mtext(i);
   if strcmp(message, 'binary')
      d = [' ' int2str(c)];
      buffer(buflen + (1:length(d))) = d;
      buflen = buflen + length(d);
      if rem(i, 25) == 0
         d = ['] ...\n'];
         buffer(buflen + (1:length(d))) = d;
         buflen = buflen + length(d);
         fprintf(fp, buffer(1:buflen));
         buflen = 0;
         line_count = line_count + 1;
         begin_line = 1;
      end
     elseif any(c == special)
      if c == NL(1)
         buffer(buflen + (1:length(END_LINE))) = END_LINE;
         buflen = buflen + length(END_LINE);
         fprintf(fp, buffer(1:buflen));
         buflen = 0;
         line_count = line_count + 1;
         begin_line = 1;
        elseif c == '%'
         buffer(buflen + (1:4)) = '%%%%';
         buflen = buflen + 4;
        elseif c == ''''
         buffer(buflen + (1:2)) = '''''';
         buflen = buflen + 2;
        elseif c == '\'
         buffer(buflen + (1:4)) = '\\\\';
         buflen = buflen + 4;
      end
     else
      buffer(buflen + 1) = c;
      buflen = buflen + 1;
   end
end

if buflen > 0
   if strcmp(message, 'binary')
      d = ']';
      buffer(buflen + (1:length(d))) = d;
      buflen = buflen + length(d);
   end
   fprintf(fp, buffer(1:buflen));
end

if begin_chunk == 0
   fprintf(fp, '\n');
   fprintf(fp, END_CHUNK);
   if strcmp(message, 'binary')
      fprintf(fp, ['eval(ADD_BINA);' EOL NL]);
     else
      fprintf(fp, ['eval(ADD_TEXT);' EOL NL]);
   end
end

fprintf(fp, ['eval(END_FILE);' EOL NL]);
fprintf(fp, ['eval(PROGRESS);' EOL NL]);

disp(['    Bundled in ' dstfile ': ' sfile])

fclose(fp);

end

function bundle_class(theDestination, theClass, theTarget, theMessage)

% Bundle_Class -- Bundle a class.
%  bundle_class('theDestination', 'theClass', 'theTarget', 'theMessage')
%   bundles 'theClass'.  The default directory remains intact.
 
% Copyright (C) 1997 Dr. Charles R. Denham, ZYDECO.
%  All Rights Reserved.
%   Disclosure without explicit written consent from the
%    copyright owner does not constitute publication.
 
% Version of 26-Jun-1997 08:27:26.

if nargin < 1, help(mfilename), return, end
if nargin < 3, theTarget = ''; end
if nargin < 4, theMessage = ''; end

if any(theClass(1) == '@#'), theClass(1) = ''; end

theWhich = which(theClass);
if isempty(theWhich), return, end
theMethods = methods(theClass);
if isempty(theMethods), return, end

theDirectory = pwd; setdef(theClass), cd ..

bundle(theDestination, 'makedir')
bundle(theDestination, 'newfolder.mac', theTarget, 'binary')
bundle(theDestination, 'eval', theTarget, 'clear makedir')

thePrefix = '@';
if any(findstr(theTarget, 'VMS')), thePrefix = '#'; end
bundle(theDestination, 'eval', theTarget, ['makedir ' thePrefix theClass])
bundle(theDestination, 'eval', theTarget, ['cd ' thePrefix theClass])
disp([' ## Bundling class ' theClass])
cd([thePrefix theClass])
for i = 1:length(theMethods)
   if exist([theMethods{i} '.p']) & 0
      bundle(theDestination, 'binary', theTarget, [theMethods{i} '.p'])
     else
      bundle(theDestination, theMethods{i}, theTarget)
   end
end
cd(theDirectory)

bundle(theDestination, 'eval', theTarget, ['cd ..'])
