OS/2, eCS & ArcaOS - Technical > Utilities

"Pack this tree" on XWorkplace - ArcaOS

<< < (3/3)

ivan:
Hi Doug and Pete,

I couldn't find it on the hard disk so I installed it from the DVD.  I am now a happy camper with my usual icons back - thanks

Pete, take care of yourself and don't over do it too soon.

Martin Iturbide:
Thanks for the feedback. I have the "Pack this tree" back on the WPS. Thanks Doug.

Regards

Andreas Schnellbacher:
Hi all, I've finally ported my GetRealCase function to REXX and have created a replacement for XWP's packtree.cmd. I always found it annoying that the original script always creates uppercased zip filenames. (I guess it's an XWP bug when the Configuration folder feature is used.)

Here's a replacement/extension. It also adds the zip option 'S' (include system and hidden files):

* Create a new file. Give it the name e.g. PackTreeRealCase.cmd.
* Copy the contents of the following code into it.
* Then open the properties of the program object System Setup ->  XWorkplace Configuration Folder -> Folder actions -> Pack tree.
* Under "Path and filename" replace the entry with: <path>PackTreeRealCase.cmd, where <path> is the path where you placed the .cmd file. Let the other fileds empty.
* To restore the original behavior, just restore the entry, e.g. C:\sys\apps\xwps\bin\packtree.cmd

--- Code: ---/* REXX ------------------------------------------------------------------ */
/* This is a replacement for XWP's packtree.cmd.                           */
/* It works around the XWP flaw to always return the filename of a folder  */
/* in uppercase.                                                           */
/* Therefore it uses the GetRealCase function. That uses SysFileTree,      */
/* which uses DosFind* to query the real case of a file spec.              */
/* Unfortunately DosFind* returns only the last segment in the correct     */
/* case, so it must be processed segment-wise.                             */
/* Additionally, several ZipOptions are specified and the default value    */
/* (the last one) was changed.                                             */

'@ECHO OFF'

CALL RxFuncAdd 'SysLoadFuncs', 'REXXUTIL', 'SysLoadFuncs'
CALL SysLoadFuncs

/* The last one is the active one */
ZipOptions = '-r9'     /* original XWP */
ZipOptions = '-rSX9'   /* with system attributes, without EAs */
ZipOptions = '-rS9'    /* with system attributes */

Dirname = DIRECTORY()
Dirname = GetRealCase( Dirname)

Foldername = FILESPEC( 'NAME', Dirname)

SAY 'Packing 'Dirname' into file 'Foldername'.zip...'
'zip 'ZipOptions' ..\'Foldername'.zip *'

EXIT

/* ----------------------------------------------------------------------- */
/* Gets the real case of a file system object. Returns the input if it     */
/* doesn't exist.                                                          */
/* DosFind* for a filename or dirname returns the correct case, but only   */
/* for the last segment. To get the correct case for the entire string, it */
/* must be processed segment-wise.                                         */
GetRealCase:

DO 1
   PARSE ARG FileMask

   fFile = 0
   fDir  = 0
   rc = 0

   /* Process only full file specs */
   IF SUBSTR( FileMask, 2, 1) <> ':' THEN
      LEAVE

   /* Check if dir or file to call the correct proc for the last segment */
   SELECT
      WHEN FileExist( FileMask) THEN
         fFile = 1
      WHEN DirExist( FileMask) THEN
         fDir  = 1
      /* Handle drive only */
      WHEN RIGHT( FileMask, 1) = ':' THEN
      DO
         FileMask = TRANSLATE( FileMask)
         LEAVE
      END
   OTHERWISE
      /* Process only existing file specs */
      LEAVE
   END

   Rest = FileMask
   NewFileMask = ''
   DO WHILE Rest <> ''
      PARSE VALUE Rest WITH Next'\'Rest
      IF Next = '' THEN
         ITERATE

      /* Drive */
      IF RIGHT( next, 1) = ':' THEN
      DO
         NewFileMask = NewFileMask''TRANSLATE( Next)
         /* For root dir: append '\' here, because no more segemnt exists */
         IF RIGHT( FileMask, 2) = ':\' THEN
            NewFileMask = NewFileMask'\'
         ITERATE
      END

      IF Rest = '' THEN
      DO
         /* Last segment */
         SELECT
            WHEN fFile THEN
            DO
               NewFileMask = NewFileMask'\'Next
               Found. = ''
               Found.0 = 0
               rcx = SysFileTree( NewFileMask, 'Found.', 'FO')
               IF Found.0 > 0 THEN
                  NewFileMask = Found.1
            END
            WHEN fDir THEN
            DO
               NewFileMask = NewFileMask'\'Next
               Found. = ''
               Found.0 = 0
               rcx = SysFileTree( NewFileMask, 'Found.', 'DO')
               IF Found.0 > 0 THEN
                  NewFileMask = Found.1
            END
         END
      END
      ELSE
      DO
         /* Other segments */
         NewFileMask = NewFileMask'\'Next
         Found. = ''
         Found.0 = 0
         rcx = SysFileTree( NewFileMask, 'Found.', 'DO')
         IF Found.0 > 0 THEN
            NewFileMask = Found.1
      END

   END  /* DO WHILE Rest <> '' */

   SAY 'FileMask = 'FileMask', NewFileMask = 'NewFileMask
   FileMask = NewFileMask

END

RETURN FileMask

/* ----------------------------------------------------------------------- */
FileExist: PROCEDURE EXPOSE (GlobalVars)
   rc = ERROR.NO_ERROR

   PARSE ARG Filename

   IF FileName = '' THEN
      RETURN( 0)
   ELSE
      RETURN( STREAM( Filename, 'C', 'QUERY EXISTS') <> '')

/* ------------------------------------------------------------------------- */
DirExist: PROCEDURE EXPOSE (GlobalVars)
   rc = ERROR.NO_ERROR

   PARSE ARG Dirname

   Found.0 = 0
   rcx = SysFileTree( Dirname, 'Found.', 'DO')

   RETURN( Found.0 > 0)


--- End code ---


Navigation

[0] Message Index

[*] Previous page

Go to full version