/****************************** Module Header ******************************* * * Module Name: convoldmode.cmd * * Syntax: convoldmode * * with * = fully-qualified directory specification of a directory * that contains files to convert, e.g. * ...\netlabs\mode * or * ...\netlabs\mode\c * * This REXX file is executed during the installation to convert old user * mode files from before 1.22. It may also be executed after the installtion. * The directory was renamed from mode to hilite, some files were renamed and * some keys were moved to defaults.cfg -> NEPMD.INI. * * That was done to separate the definitions for syntax highlighting from * those for modes. Special files may now have a highlighting different from * that for other files of a mode. Additionally, all settings, except those * for syntax highlighting, are now configurable via NEPMD.INI. * * Copyright (c) Netlabs EPM Distribution Project 2021 * * $Id$ * * =========================================================================== * * This file is part of the Netlabs EPM Distribution package and is free * software. You can redistribute it and/or modify it under the terms of the * GNU General Public License as published by the Free Software * Foundation, in version 2 as it comes in the "COPYING" file of the * Netlabs EPM Distribution. This library is distributed in the hope that it * will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty * of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * General Public License for more details. * ****************************************************************************/ /* Some header lines are used as help text */ HelpLine.Start = 5 HelpLine.End = 22 '@ECHO OFF' CALL SETLOCAL /* ----------------- Standard CMD initialization follows ----------------- */ SIGNAL ON HALT NAME Halt SIGNAL ON NOVALUE NAME RexxError SIGNAL ON SYNTAX NAME RexxError SIGNAL ON FAILURE NAME RexxError /* SIGNAL ON ERROR NAME RexxError /* Causes doubled error messages */ SIGNAL ON NOTREADY NAME RexxError /* Causes error on calling external apps */ */ env = 'OS2ENVIRONMENT' TRUE = (1 = 1) FALSE = (0 = 1) CrLf = '0d0a'x Redirection = '>NUL 2>&1' PARSE SOURCE . . ThisFile GlobalVars = 'env TRUE FALSE CrLf Redirection ERROR. ThisFile' /* Some OS/2 Error codes */ ERROR.NO_ERROR = 0 ERROR.INVALID_FUNCTION = 1 ERROR.FILE_NOT_FOUND = 2 ERROR.PATH_NOT_FOUND = 3 ERROR.ACCESS_DENIED = 5 ERROR.NOT_ENOUGH_MEMORY = 8 ERROR.INVALID_FORMAT = 11 ERROR.INVALID_DATA = 13 ERROR.NO_MORE_FILES = 18 ERROR.WRITE_FAULT = 29 ERROR.READ_FAULT = 30 ERROR.SHARING_VIOLATION = 32 ERROR.GEN_FAILURE = 31 ERROR.INVALID_PARAMETER = 87 ERROR.ENVVAR_NOT_FOUND = 204 rc = ERROR.NO_ERROR CALL RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs' CALL SysLoadFuncs /* ----------------- Standard CMD initialization ends -------------------- */ /* Extend the environment, if not already */ lp = LASTPOS( '\', ThisFile) ThisDir = LEFT( ThisFile, lp - 1) next = VALUE( 'NEPMD_NAME',, env) IF next = '' THEN 'CALL' ThisDir'\..\..\netlabs\bin\EPMENV' /* ------------- Configuration ---------------- */ RootDir = VALUE( 'NEPMD_ROOTDIR',, env) UserDir = VALUE( 'NEPMD_USERDIR',, env) KeyPath = '\NEPMD\User\Mode' Ini._Filename = UserDir'\bin\nepmd.ini' Ini._RegKeys = 'RegKeys' Ini._RegContainer = 'RegContainer' Ini._RegDefaults = 'RegDefaults' Delay.Delete = 10 /* in s, max. time for verification */ /* -------------------------------------------- */ GlobalVars = GlobalVars 'HelpLine. Dir. Delay. ModeName KeyPath Ini.' GlobalVars = GlobalVars 'RootDir UserDir Count.' DO 1 /* Parse arg */ PARSE ARG Dir Dir = STRIP( Dir) IF LEFT( Dir, 1) = '"' & RIGHT( Dir, 1) = '"' THEN Dir = SUBSTR( Dir, 2, LENGTH( Dir) - 2) Dir = GetFullPath( Dir) UpDir = TRANSLATE( Dir) /* Check arg */ IF Dir = '' THEN DO rc = ERROR.INVALID_PARAMETER IF RunningInPm() THEN CALL ShowError 'Syntax: convoldmode ' ELSE CALL ShowHelp LEAVE END IF \DirExist( Dir) THEN DO rc = ERROR.PATH_NOT_FOUND LEAVE END /* Call ConvertModeDir, either for contained subdirs or for specified dir */ Count.Modes = 0 Count.Files = 0 IF RIGHT( UpDir, 5) = '\MODE' THEN fMainModeDir = 1 ELSE fMainModeDir = 0 IF fMainModeDir THEN DO /* Rename main mode dir to avoid processing this again at install */ /* Remove .LONGNAE EA */ rcx = RmLongnameEa( Dir) DirName = FILESPEC( 'N', Dir) ParentDir = GetFullPath( Dir'\..') IsoDate = GetIsoDate() NewDirName = DirName'_'IsoDate NewDir = STRIP( ParentDir, 'T', '\')'\'NewDirName /* Check for already existing dir name */ c = 0 DO WHILE DirExist( NewDir) /* Append counter to dir name */ c = c + 1 NewDirName = DirName'_'IsoDate'_'c NewDir = STRIP( ParentDir, 'T', '\')'\'NewDirName END 'RENAME' Enquote( Dir) Enquote( NewDirName) Redirection /* Determine dirs */ IF DirExist( NewDir) THEN Dir.MainMode = NewDir ELSE /* Rename may have failed */ Dir.MainMode = Dir SAY 'Old main mode dir = 'Dir.MainMode SAY 'Destination dir = 'Dir.MainMode'\converted' Dir.ConvertedHilite = Dir.MainMode'\converted\hilite' CALL MakeTree( Dir.ConvertedHilite) Dir.ConvertedBin = Dir.MainMode'\converted\bin' CALL MakeTree( Dir.ConvertedBin) /* Convert global.ini */ GlobalIni = Dir.MainMode'\global.ini' IF FileExist( GlobalIni) THEN CALL ProcessModeFile GlobalIni, Dir.ConvertedHilite'\common.cfg' /* Convert mode dirs */ Found. = '' Found.0 = 0 rcx = SysFileTree( Dir.MainMode'\*', 'Found.', 'DO') DO d = 1 to Found.0 CALL ConvertModeDir Found.d Count.Modes = Count.Modes + 1 END END ELSE DO /* Determine dirs */ Dir.MainMode = GetFullPath( Dir'\..') SAY 'Old mode dir = 'Dir SAY 'Destination dir = 'Dir.MainMode'\converted' Dir.ConvertedHilite = Dir.MainMode'\converted\hilite' CALL MakeTree( Dir.ConvertedHilite) Dir.ConvertedBin = Dir.MainMode'\converted\bin' CALL MakeTree( Dir.ConvertedBin) /* Convert mode dir */ CALL ConvertModeDir Dir Count.Modes = 1 END /* Report result */ SAY 'Converted 'Count.Files' old mode file(s) of 'Count.Modes' mode(s).' END EXIT( rc) /* ------------------------------------------------------------------------- */ ConvertModeDir: PROCEDURE EXPOSE (GlobalVars) rc = ERROR.NO_ERROR PARSE ARG ModeDir ModeName = FILESPEC( 'N', ModeDir) ConvertedModeDir = Dir.ConvertedHilite'\'ModeName CALL MakeTree( ConvertedModeDir) /* Process .hil files */ Found. = '' Found.0 = 0 rcx = SysFileTree( ModeDir'\*.hil', 'Found.', 'FO') DO f = 1 to Found.0 HilFile = ConvertedModeDir'\'FILESPEC( 'N', Found.f) CALL ProcessModeFile Found.f, HilFile END /* Process default.ini */ DefaultIni = ModeDir'\default.ini' HiliteCfg = ConvertedModeDir'\hilite.cfg' ModeCfg = Dir.ConvertedBin'\'ModeName'.cfg' CALL ProcessDefaultIni DefaultIni, HiliteCfg, ModeCfg RETURN( '') /* ----------------------------------------------------------------------- */ ConvertModeKey: PROCEDURE EXPOSE (GlobalVars) rc = ERROR.NO_ERROR PARSE ARG ModeKey, ModeValue UpperKeys = '' UpperKeys = UpperKeys'CaseSensitive LineComment LineCommentPos' UpperKeys = UpperKeys' LineCommentAddSpace LineCommentNeedSpace' UpperKeys = UpperKeys' MultiLineCommentStart MultiLineCommentEnd' UpperKeys = UpperKeys' MultiLineCommentNested PreferredComment' SpecialKeys = 'Extensions BaseNames' ConfigKey = '' ConfigValue = '' ModeKeyPath = KeyPath'\'TRANSLATE( ModeName) DO 1 UpKeyList = TRANSLATE( UpperKeys) wp = WORDPOS( ModeKey, UpKeyList) IF wp > 0 THEN DO ConfigKey = ModeKeyPath'\'WORD( UpperKeys, wp) ConfigValue = ModeValue LEAVE END UpKeyList = TRANSLATE( SpecialKeys) TRANSLATE( SpecialKeys) UpKeyList = '' DO w = 1 TO WORDS( SpecialKeys) ThisWord = WORD( SpecialKeys, w) IF UpKeyList = '' THEN UpKeyList = UpKeyList'DEF'TRANSLATE( ThisWord) ELSE UpKeyList = UpKeyList' DEF'TRANSLATE( ThisWord) IF UpKeyList = '' THEN UpKeyList = UpKeyList'ADD'TRANSLATE( ThisWord) ELSE UpKeyList = UpKeyList' ADD'TRANSLATE( ThisWord) END wp1 = WORDPOS( ModeKey, UpKeyList) IF wp1 > 0 THEN DO IF POS( 'DEF', ModeKey) = 1 THEN DO RestKey = SUBSTR( ModeKey, 4) wp2 = WORDPOS( RestKey, TRANSLATE( SpecialKeys)) IF wp2 > 0 THEN DO ConfigKey = ModeKeyPath'\'WORD( SpecialKeys, wp2) ConfigValue = ModeValue LEAVE END END IF POS( 'ADD', ModeKey) = 1 THEN DO RestKey = SUBSTR( ModeKey, 4) wp2 = WORDPOS( RestKey, TRANSLATE( SpecialKeys)) IF wp2 > 0 THEN DO ConfigKey = ModeKeyPath'\'WORD( SpecialKeys, wp2) ConfigValue = ModeValue /* Query current default key value */ next = SysIni( Ini._Filename, Ini._RegDefaults, ConfigKey) DefaultValue = STRIP( next, 'T', '00'x) IF DefaultValue <> '' & DefaultValue <> 'ERROR:' THEN DO /* Append each word if unique */ UpConfigValue = TRANSLATE( ConfigValue) DO w = 1 TO WORDS( DeafultValue) ThisDefaultValue = WORD( DefaultValue, w) IF WORDPOS( TRANSLATE( ThisDefaultValue), UpConfigValue) = 0 THEN ConfigValue = ConfigValue ThisDefaultValue END END LEAVE END END END END RETURN( ConfigKey'='ConfigValue) /* ----------------------------------------------------------------------- */ StringFromTemplateString: PROCEDURE EXPOSE (GlobalVars) rc = ERROR.NO_ERROR PARSE ARG CfgType, File, DestFile TemplateString = '' VarStr = '' /* global.ini */ IF CfgType = 'G' THEN DO /* Write header for highlight config file */ TemplateString = '' TemplateString = TemplateString ||, '; NEPMD configuration file for all highlight modes - %CFGFILENAME%' || CrLf TemplateString = TemplateString ||, '; Converted from %MODEFILENAME% on %DATETIME%' || CrLf TemplateString = TemplateString ||, '; Copy to %USERDIR%\hilite, analogous to %ROOTDIR%\netlabs\hilite.' || CrLf VarStr = '' VarStr = VarStr'CFGFILENAME='FILESPEC( 'N', DestFile) VarStr = VarStr' MODEFILENAME='FILESPEC( 'N', File) VarStr = VarStr' DATETIME="'DateTime()'"' VarStr = VarStr' USERDIR='UserDir VarStr = VarStr' ROOTDIR='RootDir END /* Highlight mode */ IF CfgType = 'H' THEN DO /* Write header for highlight config file */ TemplateString = '' TemplateString = TemplateString ||, '; NEPMD configuration file for highlight mode "%HIGHLIGHTMODE%" - %CFGFILENAME%' || CrLf TemplateString = TemplateString ||, '; Converted from %MODEFILENAME% on %DATETIME%' || CrLf TemplateString = TemplateString ||, '; Copy to %USERDIR%\hilite, analogous to %ROOTDIR%\netlabs\hilite.' || CrLf VarStr = '' VarStr = VarStr'HIGHLIGHTMODE='TRANSLATE( ModeName) VarStr = VarStr' CFGFILENAME='FILESPEC( 'N', DestFile) VarStr = VarStr' MODEFILENAME='FILESPEC( 'N', File) VarStr = VarStr' DATETIME="'DateTime()'"' VarStr = VarStr' USERDIR='UserDir VarStr = VarStr' ROOTDIR='RootDir END /* Mode */ ELSE IF CfgType = 'M' THEN DO /* Write header for mode config file */ TemplateString = '' TemplateString = TemplateString ||, '; NEPMD configuration file for mode "%MODE%" - %CFGFILENAME%' || CrLf TemplateString = TemplateString ||, '; Converted from %MODEFILENAME% on %DATETIME%' || CrLf TemplateString = TemplateString ||, '; Copy to %USERDIR%\bin and import in NEPMD.INI with:' || CrLf TemplateString = TemplateString ||, '; Preferences -> User settings -> Import user settings' || CrLf VarStr = '' VarStr = VarStr'MODE='TRANSLATE( ModeName) VarStr = VarStr' CFGFILENAME='FILESPEC( 'N', DestFile) VarStr = VarStr' MODEFILENAME='FILESPEC( 'N', File) VarStr = VarStr' DATETIME="'DateTime()'"' VarStr = VarStr' USERDIR='UserDir VarStr = VarStr' ROOTDIR='RootDir END RETURN ExpandTemplateString( TemplateString, VarStr) /* ----------------------------------------------------------------------- */ ProcessModeFile: PROCEDURE EXPOSE (GlobalVars) rc = ERROR.NO_ERROR PARSE ARG File, DestFile DO 1 /* Delete DestFile */ IF FileExist( DestFile) THEN CALL FileDelete DestFile /* Open files */ next = STREAM( File, 'C', 'OPEN READ') IF next <> 'READY:' THEN DO rc = ERROR.READ_FAULT LEAVE END next = STREAM( DestFile, 'C', 'OPEN WRITE') IF next <> 'READY:' THEN DO rc = ERROR.WRITE_FAULT LEAVE END Count.Files = Count.Files + 1 /* Write header */ IF TRANSLATE( FILESPEC( 'N', File)) = 'GLOBAL.INI' THEN CfgType = 'G' ELSE CfgType = 'H' CALL LINEOUT DestFile, StringFromTemplateString( CfgType, File, DestFile) Section = '' DO WHILE CHARS( File) > 0 NewSection = '' /* Read line */ LineStr = LINEIN( File) /* Get section */ fIgnore = 0 IF LEFT( LineStr, 1) = '[' THEN PARSE VALUE LineStr WITH '['NewSection']' /* Ignore everything before the first section, e.g. headers */ ELSE IF Section = '' THEN fIgnore = 1 /* Write line */ IF \fIgnore THEN CALL LINEOUT DestFile, LineStr IF NewSection <> '' THEN Section = NewSection END /* Close files */ next = STREAM( File, 'C', 'CLOSE') IF next <> 'READY:' THEN DO rc = ERROR.READ_FAULT LEAVE END next = STREAM( DestFile, 'C', 'CLOSE') IF next <> 'READY:' THEN DO rc = ERROR.WRITE_FAULT LEAVE END END RETURN( rc) /* ----------------------------------------------------------------------- */ ProcessDefaultIni: PROCEDURE EXPOSE (GlobalVars) rc = ERROR.NO_ERROR PARSE ARG File, DestFile, DestFile2 DO 1 /* Delete DestFile */ IF FileExist( DestFile) THEN CALL FileDelete DestFile /* Delete DestFile2 */ IF FileExist( DestFile2) THEN CALL FileDelete DestFile2 /* Open files */ next = STREAM( File, 'C', 'OPEN READ') IF next <> 'READY:' THEN DO rc = ERROR.READ_FAULT LEAVE END next = STREAM( DestFile, 'C', 'OPEN WRITE') IF next <> 'READY:' THEN DO rc = ERROR.WRITE_FAULT LEAVE END IF DestFile2 <> '' THEN DO next = STREAM( DestFile2, 'C', 'OPEN WRITE') IF next <> 'READY:' THEN DO rc = ERROR.WRITE_FAULT LEAVE END END Count.Files = Count.Files + 1 /* Write headers */ CALL LINEOUT DestFile, StringFromTemplateString( 'H', File, DestFile) CALL LINEOUT DestFile2, StringFromTemplateString( 'M', File, DestFile2) Section = '' DO WHILE CHARS( File) > 0 NewSection = '' /* Read line */ LineStr = LINEIN( File) /* Get section */ fIgnore = 0 IF LEFT( LineStr, 1) = '[' THEN PARSE VALUE LineStr WITH '['NewSection']' /* Replace [GLOBAL] */ IF NewSection = 'GLOBAL' THEN LineStr = '[EPMKWDSFILE]' /* Split GLOBAL keys */ ELSE IF Section = 'GLOBAL' & NewSection = '' THEN DO 1 /* Split GLOBAL section into hilite\\hilite.cfg and */ /* bin\.cfg config keys */ IF LEFT( LineStr, 1) = ';' THEN LEAVE IF STRIP( LineStr) = '' THEN LEAVE PARSE VALUE LineStr WITH VarName '=' VarValue VarName = STRIP( VarName) VarValue = STRIP( VarValue) IF VarName = 'CHARSET' THEN LineStr = 'CHARSET = 'VarValue ELSE DO /* Write to config import file */ next = ConvertModeKey( VarName, VarValue) IF DestFile2 <> '' THEN DO PARSE VALUE next WITH ConfigKey '=' ConfigValue ConfigLine = LEFT( ConfigKey, MAX( LENGTH( ConfigKey), 50))' = 'ConfigValue CALL LINEOUT DestFile2, ConfigLine END fIgnore = 1 END END /* Ignore everything before the first section, e.g. headers */ ELSE IF Section = '' THEN fIgnore = 1 /* Write line */ IF \fIgnore THEN CALL LINEOUT DestFile, LineStr IF NewSection <> '' THEN Section = NewSection END /* Close files */ next = STREAM( File, 'C', 'CLOSE') IF next <> 'READY:' THEN DO rc = ERROR.READ_FAULT LEAVE END next = STREAM( DestFile, 'C', 'CLOSE') IF next <> 'READY:' THEN DO rc = ERROR.WRITE_FAULT LEAVE END IF DestFile2 <> '' THEN DO next = STREAM( DestFile2, 'C', 'CLOSE') IF next <> 'READY:' THEN DO rc = ERROR.WRITE_FAULT LEAVE END END END RETURN( rc) /* ----------------------------------------------------------------------- */ GetIsoDate: PROCEDURE EXPOSE (GlobalVars) rc = ERROR.NO_ERROR DateStr = DATE( 'S') PARSE VAR DateStr Year 5 Month 7 Day IsoDate = Year'-'Month'-'Day RETURN( IsoDate) /* ------------------------------------------------------------------------- */ /* Returns current date and time in ISO format. */ DateTime: PROCEDURE EXPOSE (GlobalVars) rc = ERROR.NO_ERROR PARSE VALUE DATE( 'S') WITH yyyy +4 mm +2 dd PARSE VALUE TIME() WITH Hours':'Mins':'Secs IsoDate = yyyy'-'mm'-'dd IsoTime = RIGHT( Hours, 2, '0')':'RIGHT( Mins, 2, '0')':'RIGHT( Secs, 2, '0') RETURN( IsoDate IsoTime) /* ----------------------------------------------------------------------- */ GetBootDrive: PROCEDURE EXPOSE (GlobalVars) rc = ERROR.NO_ERROR IF \RxFuncQuery( 'SysBootDrive') THEN BootDrive = SysBootDrive() ELSE PARSE UPPER VALUE VALUE( 'PATH',, env) WITH ':\OS2\SYSTEM' -1 BootDrive +2 RETURN( BootDrive) /* ----------------------------------------------------------------------- */ /* Parses %% and %%. For %%, searches for = in */ /* VarStr. If not found, keeps %%. Expands %% to %. Expands env */ /* vars and boot drive. */ ExpandTemplateString: PROCEDURE EXPOSE (GlobalVars) rc = ERROR.NO_ERROR PARSE ARG TemplateString, VarStr ExpandedString = TemplateString p1 = 0 p2 = 0 pStart = 1 p2Start = pStart DO FOREVER /* parse is not used here, because if only 1 % char is present, it */ /* would assign all the rest to EnvVar. */ IF p1 = 0 THEN DO p1 = POS( '%', ExpandedString, pStart) /* dprintf( 'p1 = 'p1' = pos( %, 'ExpandedString', 'pStart')') */ IF p1 = 0 THEN LEAVE pStart = p1 + 1 p2Start = pStart END IF p2 = 0 THEN DO p2 = POS( '%', ExpandedString, p2Start) /* dprintf( 'p2 = 'p2' = pos( %, 'ExpandedString', 'pStart')') */ IF p2 = 0 THEN LEAVE p2Start = p2 + 1 END LeftPart = SUBSTR( ExpandedString, 1, p1 - 1) VarName = SUBSTR( ExpandedString, p1 + 1, p2 - p1 - 1) RightPart = SUBSTR( ExpandedString, p2 + 1) IF VarName = '' THEN DO /* Replace %% with % */ ExpandedString = LeftPart'%'RightPart pStart = p1 + 1 p1 = 0 p2 = 0 ITERATE END p3 = POS( TRANSLATE( VarName)'=', TRANSLATE( VarStr)) IF p3 <> 0 THEN DO /* VarName found in VarStr */ /* Note: Positional parsing doesn't work with (var)s in E. */ p4 = p3 + LENGTH( VarName'=') rest = SUBSTR( VarStr, p4) IF LEFT( rest, 1) = '"' THEN PARSE VALUE rest WITH '"'ThisVal'"' ELSE PARSE VALUE rest WITH ThisVal . ExpandedString = LeftPart''ThisVal''RightPart pStart = p1 + LENGTH( ThisVal) p1 = 0 p2 = 0 ITERATE END ELSE DO /* VarName not found in VarStr */ ThisVal = VALUE( VarName,, env) if ThisVal = '' THEN DO /* Keep %VarStr% */ pStart = p2 + 1 p1 = 0 p2 = 0 ITERATE END ELSE DO /* Replace with env var value */ ExpandedString = LeftPart''ThisVal''RightPart pStart = p1 + LENGTH( ThisVal) p1 = 0 p2 = 0 ITERATE END END END /* Replace ?: with boot drive */ DO WHILE POS( '?:', ExpandedString) > 0 PARSE VALUE ExpandedString WITH LeftPart'?:'RightPart BootDrive = GetBootDrive() ExpandedString = LeftPart''BootDrive''RightPart END RETURN ExpandedString /* ----------------------------------------------------------------------- */ /* Replaces Search in SourceString with Replace */ ChangeString: PROCEDURE EXPOSE (GlobalVars) rc = ERROR.NO_ERROR PARSE ARG Search, SourceString, Replace, NumChanges OutString = SourceString pStart = 1 n = 0 DO FOREVER n = n + 1 IF NumChanges <> '' THEN DO IF n > NumChanges THEN LEAVE END pSearch = POS( Search, OutString, pStart) IF pSearch > 0 THEN DO OutString = DELSTR( OutString, pSearch, LENGTH( Search)) OutString = INSERT( Replace, OutString, pSearch - 1) pStart = pSearch + LENGTH( Replace) END ELSE LEAVE END RETURN OutString /* ----------------------------------------------------------------------- */ RmLongnameEa: PROCEDURE EXPOSE (GlobalVars) rc = ERROR.NO_ERROR PARSE ARG FileDir DO 1 /* Find .LONGNAME EA */ rc = SysGetEa( FileDir, '.LONGNAME', 'EaVal') IF rc <> ERROR.NO_ERROR THEN LEAVE IF EaVal ='' THEN LEAVE /* Remove .LONGNAME EA */ rc = SysPutEa( FileDir, '.LONGNAME', '') /*SAY 'Removed .LONGNAME EA: 'FileDir*/ END RETURN( rc) /* ----------------------------------------------------------------------- */ FileDelete: PROCEDURE EXPOSE (GlobalVars) rc = ERROR.NO_ERROR PARSE ARG Filename, fCheckExist, fRmAttr IF fCheckExist = '' THEN fCheckExist = 1 IF fRmAttr = '' THEN fRmAttr = 1 DO 1 IF fCheckExist THEN DO IF \FileExist( Filename) THEN DO rc = ERROR.FILE_NOT_FOUND LEAVE END END IF fRmAttr THEN DO /* Remove file attributes - does not work with option 'O' */ rcx = SysFileTree( Filename, 'File.', 'F',, '-----') END DO i = 1 TO Delay.Delete * 10 rc = SysFileDelete( Filename) IF rc = ERROR.NO_ERROR THEN LEAVE i IF TRANSLATE( RIGHT( Filename, 4)) = '.DLL' THEN DO /* Unlock DLL */ 'UNLOCK' Enquote( Filename) rc = SysFileDelete( Filename) IF rc = ERROR.NO_ERROR THEN LEAVE i END IF \FileExist( Filename) THEN LEAVE i CALL SysSleep 0.1 END END RETURN( rc) /* ----------------------------------------------------------------------- */ GetFullPath: PROCEDURE EXPOSE (GlobalVars) rc = ERROR.NO_ERROR PARSE ARG FileMask, ThisDir FullFileMask = FileMask IF ThisDir = '' THEN ThisDir = DIRECTORY() /* Resolve relative file spec with ThisDir */ SELECT WHEN LEFT( FullFileMask, 1) = '\' THEN FullFileMask = LEFT( ThisDir, 2)''FullFileMask WHEN SUBSTR( FullFileMask, 2, 2) <> ':\' THEN FullFileMask = STRIP( ThisDir, 'T', '\')'\'FullFileMask OTHERWISE NOP END /* Parse into segments at backslash */ rest = FullFileMask s = 0 DO FOREVER IF rest = '' THEN LEAVE PARSE VAR rest next'\'rest s = s + 1 Segment.s = next Segment.0 = s END /* Rejoin segments and resolve '.' and '..' */ FullFileMask = '' DO s = Segment.0 TO 1 BY -1 ThisSegment = Segment.s IF ThisSegment = '.' THEN ITERATE IF ThisSegment = '..' THEN DO s = MAX( 2, s - 1) ITERATE END IF FullFileMask = '' THEN FullFileMask = ThisSegment ELSE FullFileMask = ThisSegment'\'FullFileMask END RETURN( FullFileMask) /* ----------------------------------------------------------------------- */ MakeTree: PROCEDURE EXPOSE (GlobalVars) rc = ERROR.NO_ERROR PARSE ARG Dir DO once = 1 to 1 NextDir = '' i = 0 /* Prepend current dir if Dir is relative */ Dir = GetFullPath( Dir) /* Strip drive, set start value for NextDir */ /* NextDir: without trailing \, rest: without leading \ */ rest = Dir PARSE VAR rest NextDir'\'rest /* Create entire tree */ DO WHILE rest <> '' PARSE VAR rest next'\'rest NextDir = NextDir'\'next rc = SysMkDir( NextDir) /* Check rc */ /* rc = ERROR.ACCESS_DENIED is returned if dir already exists */ IF rc = ERROR.ACCESS_DENIED THEN rc = ERROR.NO_ERROR IF rc <> ERROR.NO_ERROR THEN DO SAY 'Error: MakeTree:SysMkDir( 'NextDir') returned rc = 'rc'.' LEAVE once END END END /*SAY 'MakeTree: 'arg( 1)' -> 'Dir', rc = 'rc'.'*/ RETURN( rc) /* ----------------------------------------------------------------------- */ Enquote: PROCEDURE EXPOSE (GlobalVars) rc = ERROR.NO_ERROR PARSE ARG Filename IF VERIFY( Filename, ' &|<>', 'M') <> 0 THEN Filename = '"'Filename'"' RETURN( Filename) /* ------------------------------------------------------------------------- */ FileExist: PROCEDURE EXPOSE (GlobalVars) rc = ERROR.NO_ERROR PARSE ARG FileName 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) /* ------------------------------------------------------------------------- */ ShowHelp: PROCEDURE EXPOSE (GlobalVars) rc = ERROR.NO_ERROR /* Show help text */ DO i = 1 TO HelpLine.End ThisLineStr = LINEIN( ThisFile) IF i >= HelpLine.Start THEN SAY SUBSTR( ThisLineStr, 3) END /* Close file */ rcx = STREAM( Thisfile, 'C', 'CLOSE') RETURN( '') /* ----------------------------------------------------------------------- */ RunningInPm: PROCEDURE EXPOSE (GlobalVars) rc = ERROR.NO_ERROR next = SysTextScreenSize() RETURN( next == '0 0') /* ----------------------------------------------------------------------- */ /* Show info message in a message box and/or write to STDOUT */ ShowInfo: PROCEDURE EXPOSE (GlobalVars) rc = ERROR.NO_ERROR PARSE ARG Message IF RunningInPm() THEN DO /* Additionally write info message for easier copying from a */ /* command line window. */ CALL LINEOUT 'STDOUT', Message /* Show message box in PM mode */ Title = FILESPEC( 'N', ThisFile) /* Message length seems to be limited */ rcx = RxMessageBox( Message, Title, 'OK', 'INFORMATION') END ELSE CALL LINEOUT 'STDOUT', Message RETURN( '') /* ----------------------------------------------------------------------- */ /* Show error message in a message box and/or write to STDERR */ ShowError: PROCEDURE EXPOSE (GlobalVars) rc = ERROR.NO_ERROR PARSE ARG Message IF RunningInPm() THEN DO /* Additionally write info message for easier copying from a */ /* command line window. */ CALL LINEOUT 'STDERR', Message /* Show message box in PM mode */ Title = FILESPEC( 'N', ThisFile) /* Message length seems to be limited */ rcx = RxMessageBox( Message, Title, 'CANCEL', 'ERROR') END ELSE DO CALL LINEOUT 'STDERR', Message END RETURN( '') /* ----------------------------------------------------------------------- */ Halt: CALL ShowError 'Interrupted by user.' EXIT( 99) /* ----------------------------------------------------------------------- */ /* Give a standard REXX error message. */ /* This is for REXX error conditions only. */ /* System error codes and REXX error codes are different. */ RexxError: /* SIGL must be saved to not get overwritten later. */ ErrorLine = SIGL /* As an extension to the standard REXX error messages, */ /* the error condition will be appended to the error text. */ ConditionText = 'Condition: 'CONDITION( 'C') ConditionDescription = CONDITION( 'D') IF ConditionDescription <> '' THEN ConditionText = ConditionText', Reason: 'ConditionDescription ErrText = '' IF SYMBOL( 'rc') = 'VAR' THEN DO IF rc > 0 & rc < 100 THEN ErrText = ERRORTEXT( rc) END IF ErrText = '' THEN ErrText = ConditionText ELSE ErrText = ErrText', 'ConditionText /* Ensure that rc is set and that rc <> 0 is returned */ IF SYMBOL( 'rc') = 'VAR' THEN DO IF \( rc > 0 & rc < 100) THEN rc = 999 END ELSE rc = 999 ErrorMessage = '' IF ErrorLine > 0 THEN ErrorMessage = RIGHT( ErrorLine, 6)' +++ 'SOURCELINE( ErrorLine) IF ErrorMessage <> '' THEN ErrorMessage = ErrorMessage''CrLf ErrorMessage = ErrorMessage ||, 'REX'RIGHT( rc, 4, 0)': Error 'rc' running 'ThisFile', line 'ErrorLine': 'ErrText CALL ShowError ErrorMessage EXIT( rc)