/****************************** Module Header ******************************* * * Module Name: edit.e * * Copyright (c) Netlabs EPM Distribution Project 2002 * * $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. * ****************************************************************************/ ; Definitions for editing (loading) files. ; See also: SLNOHOST.E/SAVELOAD.E/E3EMUL.E and FILE.E. ; --------------------------------------------------------------------------- ; EPM bug during heavy processing, e.g. file loading: ; ; When too many procs are nested, esp. when changing between C and E code ; permanently, sometimes E or C code will not be executed. ; ; That was first seen when the call of NepmdActivateHighlight suppressed the ; usually following select event after all files are loaded. ; (Instead of letting the C function NepmdActivateHighlight execute the ; Highlight command, now NepmdQueryHighlightArgs is used to retrieve ; only the args for Highlight. Highlight is executed from E code now.) ; ; To workaround that bug, one has to change the code processing: ; ; o Try to avoid too many nested procs. ; ; o Try to avoid executing E commands from C code. ; ; o Split the E code before the critical point to an additional defc. ; An additional defproc won't help here. Apparently the previous code ; is always completed, when a new command is executed, at least most ; of the times. To ensure that any previous code is completed, the ; additional command must be executed with postme. ; --------------------------------------------------------------------------- ; Slow processing caused by specific code: ; ; The file load processing can easily be slowed down. It is extremely ; vulnerable to following code: ; ; o sayerror statement or command ; ; o postme command or other posted window messages. ; ; Therefore these should be avoided during file loading, if possible. ; --------------------------------------------------------------------------- ; Unreliable sayerrors: ; ; During heavy processing, sayerror statements are often gobbled, appear in ; the wrong order or even doubled in the message list. Therefore better use ; the NepmdPmPrintf proc or the dprintf proc, together with a PmPrintf ; application for debugging. ; --------------------------------------------------------------------------- ; Pre-processing before calling the LoadFile defproc. Same syntax as ; LoadFile. Calls itself LoadFile at the end. (LoadFile is defined in ; SLNOHOST.E / SAVELOAD.E / E3EMUL.E. Without HOST_SUPPORT, always SLNOHOST.E is ; included.) ; Checks a filespec, even wildcards, to remove REXX EAs before loading. ; Called by defc Edit. defproc PreLoadFile( FileSpec, Options) -- URL support, configurable via URL_LOAD_TEMPLATE. -- Default is to use wget for downloading it. if pos( '://', FileSpec) > 0 then EpmCmd = 'Edit' call LoadUrl( FileSpec, EpmCmd, Options) -- Don't execute the rest of PreLoadFile and Edit -> LoadFile stop endif -- Change slashes to backslashes, except for URLs if pos( '://', FileSpec) = 0 then FileSpec = translate( FileSpec, '\', '/') endif fWildcard = (pos( '*', FileSpec) + pos( '?', FileSpec) > 0) -- Resolve wildcards in FileSpec to delete REXX EAs for every REXX file -- and for setting universal vars Handle = '' -- always create a new handle! Filename = '' fNoMoreFiles = 0 do while fNoMoreFiles = 0 if fWildcard then -- If FileSpec contains wildcards then find Filenames if NepmdGetNextFile( FileSpec, Handle, Filename) then NepmdGetNextClose( Handle) else fNoMoreFiles = 1 leave endif else -- If FileSpec doesn't contain wildcards then set Filename to make the -- edit command add a file to the ring, even when it doesn't exist Filename = FileSpec fNoMoreFiles = 1 endif dprintf( 'EDIT', 'PreLoadFile: FileSpec = 'FileSpec', Filename = 'Filename) -- Close filename if it is already loaded and if it is hidden to -- process defload later. getfileid testfid, Filename if testfid <> '' then if not testfid.visible then getfileid startfid activatefile testfid .modify = 0 'xcom quit' activatefile startfid endif endif -- Delete REXX EAs if extension is found in RexxEaExtensions. call PreloadDeleteRexxEas( Filename) -- GetMode doesn't work here, because it tries to write the fid'.mode' -- array var. At this time the file is not loaded, so the fileid is not set. -- But calling QueryDefaultMode( Filename) would work. -- We should better determine the mode here, save it in a array var with the -- .filename as identifier, and replace the identifier with the fileid later -- at defload (or replace the array var with the final one). compile if 0 -- Experimentell codepage support call PreloadProcessCodepage( Filename) compile endif enddo return ; --------------------------------------------------------------------------- const compile if not defined( REXX_EA_EXTENSIONS) -- Extensions, whose REXX EAs shall be removed before loading -- to workaround the EPM bug that it can't load EAs > 32 KB. REXX_EA_EXTENSIONS = 'CMD ERX' compile endif ; Delete REXX EAs if extension is found in RexxEaExtensions. ; Use the extension here instead of the mode to avoid determining the ; mode twice: here and at defload. ; Note: The use of array vars containing the fileid to become file-specific ; does only work properly at or after defload. Therefore the mode should be ; determined at defload. ; Syntax: PreloadDeleteRexxEas( Filename) defproc PreloadDeleteRexxEas( Filename) rc = 0 do once = 1 to 1 p = lastpos( '\', Filename) Name = substr( Filename, p + 1) -- strip path p = lastpos( '.', Name) if p <= 1 then leave endif Ext = translate( substr( Name, p + 1)) if not wordpos( Ext, REXX_EA_EXTENSIONS) then leave endif compile if 0 -- Calling here another proc doesn't always work reliable. if GetReadOnly( Filename) <> 0 then leave endif compile else -- Inserting the code here directly always works. fReadonly = 0 Attr = NepmdQueryPathInfo( Filename, 'ATTR') if Attr = '' then -- file doesn't exist --sayerror 'Attributes for "'Filename'" can''t be retrieved, rc = 'rc return elseif length( Attr) = 5 then fReadonly = (substr( Attr, 5, 1) = 'R') endif -- dprintf( 'PreloadDeleteRexxEas', Filename' - 'attr', fReadonly = 'fReadonly) if fReadonly then leave endif compile endif --sayerror 'Removing REXX EAs with NepmdLib from 'Filename rc = 0 NepmdDeleteRexxEa( Filename) enddo return ; --------------------------------------------------------------------------- ; Experimental codepage support. ; The .codepage field var exists, but is not yet used. defproc PreloadProcessCodepage( Filename) rc = 0 do once = 1 to 1 CurCodepage = 'cp850' Codepage = NepmdQueryStringEa( Filename, 'EPM.CODEPAGE') if rc then leave endif if Codepage = '' then leave endif Codepage = upcase( Codepage) if Codepage = 'CP1004' then Codepage = 'latin-1' endif -- Note: GNU Recode deletes all EAs lp = lastpos( '.', Filename) if lp > 1 then EaFile = leftstr( Filename, lp)'ea' else EaFile = Filename'.ea' endif StripEaCmd = 'eautil' Filename EaFile '/s /r' --JoinEaCmd = 'eautil' Filename EaFile '/j /m' JoinEaCmd = 'eautil' Filename EaFile '/j /o' RecodeCmd = 'recode 'Codepage':'CurCodepage Filename -- Use cmd.exe for concatenation: Cmd = 'cmd /c 'StripEaCmd' & 'RecodeCmd' & 'JoinEaCmd quietshell Cmd /* quietshell StripEaCmd quietshell RecodeCmd quietshell JoinEaCmd */ -- Delete EA, because it will not be reset on save yet NepmdDeleteStringEa( Filename, 'EPM.CODEPAGE') enddo return ; --------------------------------------------------------------------------- defc LoadDir Dir = StripquotesFileSpec( arg( 1)) if Dir = '' then Dir = directory() endif call LoadDir( Dir) defproc LoadDir( FileSpec) rc = 3 -- Path not found do once = 1 to 1 if not NepmdDirExists( FileSpec) then -- NepmdDirExists sets rc = 0 also for existing files, probably from -- DosQueryPathInfo. Therefore better check the returned value. rc = 3 -- Path not found leave endif -- For Shell buffers: enter current dir name if IsAShell( .filename) then call ShellParseLinePromptCmd( .line, CurPrompt, CurCmd) StartDir = GetFileAVar( 'shellstartdir') --dprintf( 'LoadDir: CurPrompt = 'CurPrompt', CurCmd = 'CurCmd', .last = '.last) --dprintf( 'LoadDir: FileSpec = 'FileSpec', StartDir = 'StartDir) -- Don't execute cdd if not required and if shell is about to start if .last < 2 & not CurPrompt & StartDir = FileSpec then leave endif -- Execute cdd if CurPrompt then if CurCmd = '' then endline NewCmd = 'cdd' EnquoteFileSpec( FileSpec) else NewCmd = FileSpec endif keyin NewCmd else ShellNum = GetFileAVar( 'shellnum') NewCmd = 'cdd' EnquoteFileSpec( FileSpec) if .last < 2 then 'ShellWriteCmdQuiet' ShellNum NewCmd else 'ShellWriteCmd' ShellNum NewCmd endif endif leave endif -- If not a shell: open dir listing 'Dir 'EnquoteFileSpec( FileSpec) rc = 0 enddo return ; --------------------------------------------------------------------------- ;compile if LINK_HOST_SUPPORT & (HOST_SUPPORT='EMUL' | HOST_SUPPORT='E3EMUL') ; compile if not defined( MVS) ; MVS = 0 ; compile endif ; compile if not defined( E3MVS) ; E3MVS = 0 ; compile endif ; compile if not defined( HOST_LT_REQUIRED) ; HOST_LT_REQUIRED = 0 ; compile endif ;compile endif ; Returns 1 if not a VM file, otherwise 0. Sets Filemask and RestFilemask. defproc HostCheckParseFileMask( var Filemask, var RestFilemask) fIsVmFile = 0 do once = 1 to 1 compile if HOST_SUPPORT & not SMALL -- Rest is parsed Rest = Filemask RestFilemask p = length( Rest) + 1 -- If no delimiters, take to the end. p1 = pos( ',', Rest) if not p1 then p1 = p endif p2 = pos( '/', Rest) if not p2 then p2 = p endif p3 = pos( '"', Rest) if not p3 then p3 = p endif p4 = pos( "'", Rest) if not p4 then p4 = p endif p5 = pos( '[', Rest) if not p5 then -- Allow for [FTO] (file transfer options) p5 = p endif compile if HOST_SUPPORT='EMUL' | HOST_SUPPORT='E3EMUL' compile if MVS p4 = p -- Can't use single quote for commands if allowing MVS files compile endif compile else p5 = p compile endif p = Min( p1, p2, p3, p4, p5) FileSpec = leftstr( Rest, p - 1) -- VmFile parses FileSpec into (FileSpec = filename filetype filemode) -- and RestFileSpec if VmFile( FileSpec, RestFileSpec) then -- Tricky - VMfile modifies file if p = p1 then -- Keep any except comma in string p = p + 1 endif -- Set output vars Filemask = FileSpec RestFilemask = RestFileSpec substr( Rest, p) fIsVmFile = 1 endif compile endif enddo fParseFileMask = not fIsVmFile return fParseFileMask ; Sets universal fto (file transfer options). Sets rest. defproc HostParseFto( var rest) compile if (HOST_SUPPORT = 'EMUL' | HOST_SUPPORT = 'E3EMUL') & not SMALL universal fto -- Need this passed to loadfile if substr( strip( rest, 'L'), 1, 1) = '[' then parse value rest with '[' fto ']' rest else fto = '' -- reset for each file endif compile endif return ; MVS file specs can start with '. Returns flag if single quote should be ; parsed to get 'cmd'. defproc HostCheckParseCmd fParseCmd = 1 compile if (HOST_SUPPORT = 'EMUL' | HOST_SUPPORT = 'E3EMUL') & not SMALL compile if MVS & not HOST_LT_REQUIRED -- MVS file specs can start with ' fParseCmd = 0 compile endif compile endif return fParseCmd ; --------------------------------------------------------------------------- ; 1) PMSEEK uses the 'L ' syntax. ; 2) ACDATASEEKER uses the '' syntax. ; 3) Newer versions of DATASEEKER use "" 'postme '. const compile if not defined( POS_START_STRINGS) -- No pos restore for Cmds that start with any of these strings POS_START_STRINGS = 'L LOCATE / C CHANGE FIND TOP BOT BOTTOM LOADGROUP GOTO RESTORE' compile endif defproc IsAPosCmd( Cmd) fIsAPosCmd = 0 do forever EditCmd = '' -- Uppercase UpCmd = upcase( Cmd) -- Handle 'mc ;Cmd1;Cmd2' parse value UpCmd with 'MC' rest if rest <> '' then fMc = 1 rest = strip( rest) sep = leftstr( rest, 1) else fMc = 0 rest = '?' sep = '' endif do while rest <> '' if fIsAPosCmd then leave endif if fMc then parse value rest with (sep) next (sep) +0 rest CheckCmd = strip( next) else CheckCmd = UpCmd rest = '' -- stop at the end endif -- Remove leading PostMe commands do w = 1 to words( CheckCmd) Wrd = word( CheckCmd, w) if Wrd = 'POSTME' then CheckCmd = subword( CheckCmd, w + 1) else leave endif enddo CheckCmd = strip( CheckCmd) -- Num cmd = GoTo line if pos( leftstr( CheckCmd, 1), '+-') then fIsAPosCmd = 1 leave elseif IsNum( word( CheckCmd, 1)) then fIsAPosCmd = 1 leave endif -- Handle Edit cmd if word( CheckCmd, 1) = 'EDIT' then parse value CheckCmd with 'EDIT' . "'"EditCmd"'" dprintf( ' EditCmd = 'EditCmd) if EditCmd <> '' then Cmd = EditCmd leave endif endif -- Check for start strings do w = 1 to words( POS_START_STRINGS) NextWord = word( POS_START_STRINGS, w) if pos( NextWord, CheckCmd) = 1 then fIsAPosCmd = 1 leave endif enddo enddo if EditCmd <> '' then iterate endif leave enddo return fIsAPosCmd ; --------------------------------------------------------------------------- ; Restore cursor position from EPM.POS EA. This is executed by ProcessLoad. ; Only restore pos if Cmd doesn't position the cursor itself. Therefore the ; 'edit.'e'.nopos' array var is queried. e is determined from .filename. defc RestorePosFromEa universal posrestoredisabled do once = 1 to 1 if posrestoredisabled then --dprintf( '* RestorePosFromEa: posrestoredisabled set for '.filename) leave endif KeyPath = '\NEPMD\User\AutoRestore\CursorPos' RestorePos = QueryConfigKey( KeyPath) if RestorePos <> 1 then leave endif -- Restore pos from EA savedpos = Get_EAT_ASCII_Value( 'EPM.POS') if savedpos <> '' then call pRestore_Pos( savedpos) endif enddo ; --------------------------------------------------------------------------- ; Parses NextParm from RestParm. Sets RestParm to the remaining part after ; NextParm. Handles double-quoted parms and doubled double quotes. This is ; usually called in a loop to parse the entire RestParm string. ; The default SepStr is a space. For another string, it has to be specified ; as third arg. ; Note that compressing doubled double quotes is not required for filemasks, ; because double quotes are not allowed there. It may be useful when being ; specified within a command parameter. defproc ParseNextParm( var NextParm, var RestParm) SepStr = arg( 3) if SepStr = '' then SepStr = ' ' endif SepLen = length( SepStr) len = length( RestParm) pStart = 1 pSepStr = 0 -- required for len = 0 pMin = MAXCOL do while pStart <= len pSepStr = 0 pMin = MAXCOL -- Find double quotes and SepStr p1 = pos( '"', RestParm, pStart) px = 0 pxStart = pStart do forever -- Find px = pos of SepStr pFound = pos( SepStr, RestParm, pxStart) if pFound = 0 then leave endif fEnquoted = IsEnquoted( RestParm, pFound, '"') | IsEnquoted( RestParm, pFound, "'") if fEnquoted then pxStart = pFound + 1 iterate else px = pFound leave endif enddo if p1 & p1 < pMin then pMin = p1 endif if px & px < pMin then pMin = px endif -- Parse double-quoted strings -- That allows for SepStr being included if p1 = pMin then -- Append up to double quote, incl. pStart = p1 + 1 fEnquoted = 1 do while fEnquoted -- Find closing '"' p2 = pos( '"', RestParm, pStart) ch3 = '' if p2 then -- Check next char for doubled double quote ch3 = substr( RestParm, p2 + 1, 1) if ch3 = '"' then -- Doubled, append up to both, incl., find closing '"' again pStart = p2 + 2 else -- Not doubled, append up to double quote, incl. pStart = p2 + 1 fEnquoted = 0 endif else -- Not balanced, find next SepStr or double quote fEnquoted = 0 endif enddo -- Parse at found SepStr and break elseif px = pMin then pSepStr = px leave -- SepStr not found, break else leave endif enddo -- while pStart <= len -- Set output vars if pSepStr then NextParm = leftstr( RestParm, pSepStr - 1) RestParm = strip( substr( RestParm, pSepStr + SepLen)) else NextParm = RestParm RestParm = '' endif return ; --------------------------------------------------------------------------- ; Checks if a position of a string is enquoted. ; The default QuoteChar is a double quote. For another char, it has to be ; specified as third arg. defproc IsEnquoted( String, p) QuoteChar = arg( 3) if QuoteChar = '' then QuoteChar = '"' endif -- Count the number of QuoteChars in LeftPart. This handles esacped -- (doubled) QuoteChars. LeftPart = leftstr( String, Max( 0, p - 1)) n = count( QuoteChar, LeftPart) if n // 2 = 0 then -- Even number fEnquoted = 0 else -- Odd number fEnquoted = 1 endif return fEnquoted ; --------------------------------------------------------------------------- ; Surround String with double quotes if required. Double quotes within ; String are doubled. defproc Enquote( String) SpecialChars = arg( 2) if SpecialChars = '' then -- Use chars for filenames that need double quotes. -- This includes the following 3 chars that have a special meaning in -- EPM, but not elsewhere: ' , = (single quote, comma, eqal). SpecialChars = ' &|<>+"' || "',=" endif -- Check if already enquoted if (not (leftstr( String, 1) = '"' & rightstr( String, 1) = '"')) & verify( String, SpecialChars, 'M') then -- Double " in String String = DoubleCharInStr( '"', String) -- Surround String with " String = '"'String'"' endif return String ; --------------------------------------------------------------------------- ; Removes surrounding double quotes from enquoted strings. Also doubled ; double quotes are converted to one. The opposite of Enquote( String). defproc DeQuote( String) QuoteChar = arg( 2) if QuoteChar = '' then QuoteChar = '"' endif if leftstr( String, 1) = QuoteChar & rightstr( String, 1) = QuoteChar & ((leftstr( String, 2) <> QuoteChar''QuoteChar & rightstr( String, 2) <> QuoteChar''QuoteChar) | length( String) = 2) then -- Remove surrounded QuoteChars String = substr( String, 2, length( String) - 2) endif -- Process doubled QuoteChars pStart = 1 do forever if String == '' then leave endif p1 = pos( QuoteChar''QuoteChar, String, pStart) if not p1 then leave endif -- Doubled, delete the second char String = delstr( String, p1 + 1, 1) pStart = p1 + 1 enddo return String ; --------------------------------------------------------------------------- ; Removes double quotes from enquoted strings. Balanced double quotes may ; appear anywhere within a String to get removed. Unbalanced double quotes ; are not removed. defproc DeQuoteAll( String) QuoteChar = arg( 2) if QuoteChar = '' then QuoteChar = '"' endif -- Process doubled QuoteChars pStart = 1 pOpenQuote = 0 do forever if String == '' then leave endif if not pOpenQuote then -- Find opening double quote p1 = pos( QuoteChar, String, pStart) p2 = pos( QuoteChar''QuoteChar, String, pStart) if not p1 then leave elseif p2 then -- Doubled, delete the second char String = delstr( String, p1 + 1, 1) pStart = p2 + 1 else -- Not doubled, found, save pos. of the char -- Save pos. of the opening char pStart = p1 + 1 pOpenQuote = p1 endif endif if pOpenQuote then -- Find closing double quote p3 = pos( QuoteChar, String, pStart) p4 = pos( QuoteChar''QuoteChar, String, pStart) if not p3 then leave elseif p4 then -- Doubled, delete the second char String = delstr( String, p3 + 1, 1) pStart = p4 + 1 else -- Not doubled, found, delete the char String = delstr( String, p3, 1) pStart = p3 -- Delete also the opening char String = delstr( String, pOpenQuote, 1) pStart = pStart - 1 pOpenQuote = 0 endif enddo enddo return String ; --------------------------------------------------------------------------- ; This replaces the '=' char with a part of a source file. Which part is ; chosen, depends on the context of the '=' char. ; o The source file may be specified as second arg and defaults to the ; current .filename in EPM. ; o This extension allows to load another file where only a part of the ; filename is changed or to open the current file in a new window, without ; having to specify the unchanged parts again. Therefore just the '=' may ; be used at the specific place of a filespec. defproc ExpandEqualChar( String) do once = 1 to 1 SourceFile = strip( arg( 2)) if SourceFile = '' then if leftstr( .filename, 1) = '.' then -- Prepend path for a virtual filename SourceFile = strip( directory(), 'T', '\')'\'.filename else -- Current file SourceFile = .filename endif endif -- Parse SourceFile SourcePath = GetFileSpec( 'D', SourceFile)''GetFileSpec( 'P', SourceFile) SourceName = GetFileSpec( 'N', SourceFile) SourceBase = GetFileSpec( 'B', SourceFile) SourceExt = GetFileSpec( 'E', SourceFile) -- Parse NewFile StringPath = GetFileSpec( 'D', String)''GetFileSpec( 'P', String) StringName = GetFileSpec( 'N', String) StringBase = GetFileSpec( 'B', String) StringExt = GetFileSpec( 'E', String) NewFile = '' NewPath = '' NewName = '' NewBase = '' NewExt = '' if String = '=' then -- File NewFile = SourceFile else -- Path if StringPath = '=\' then NewPath = SourcePath elseif leftstr( String, 1) = '=' then NewPath = SourcePath else NewPath = StringPath endif -- Name if StringName = '=' then NewName = SourceName else -- Base if leftstr( String, 2) = '=.' then NewBase = SourceBase elseif StringBase = '=' then NewBase = SourceBase else -- Strip leading '=' from StringBase. It belongs to StringPath. if leftstr( StringBase, 1) = '=' & StringBase <> '=' then StringBase = substr( StringBase, 2) endif NewBase = StringBase endif -- Ext if StringExt = '=' then NewExt = SourceExt else NewExt = StringExt endif -- Name if NewBase = '' then NewName = '.'NewExt elseif NewExt = '' then NewName = NewBase else NewName = NewBase'.'NewExt endif endif -- File NewFile = NewPath''NewName endif enddo return NewFile ; --------------------------------------------------------------------------- ; Expands environment variables in a string. Additionally, ?: is replaced ; with the boot drive. Returns converted string. ; Handles % chars within double quotes as strings. ; If arg( 2) is set to 1, than the global var rc is set to either 0 or 204. ; 204 is set, if any of the contained env vars is unset or empty. defproc ExpandEnvVars( String) fSetRc = (arg( 2) = 1) rcx = 0 p1 = 0 p2 = 0 startp = 1 startp2 = startp do forever -- parse is not used here, because if only 1 % char is present, it -- would assign all the rest to EnvVar. if not p1 then p1 = pos( '%', String, startp) --dprintf( 'p1 = 'p1' = pos( %, 'String', 'startp')') if p1 = 0 then leave endif startp = p1 + 1 startp2 = startp if IsEnquoted( String, p1) then p1 = 0 iterate endif endif if not p2 then p2 = pos( '%', String, startp2) --dprintf( 'p2 = 'p2' = pos( %, 'String', 'startp')') if p2 = 0 then leave endif startp2 = p2 + 1 if IsEnquoted( String, p2) then p2 = 0 iterate endif endif -- Check for invalid chars for an env var name -- Only the equal char is not allowed: --p3 = verify( String, '=', 'M', startp) -- Better allow only standard env var names: -- Check first char of env var name CheckString = substr( String, startp, 1) p3 = pos( '[^A-Za-z!]', CheckString, 1, 'x') --dprintf( 'p3 = 'p3' = pos( [^A-Za-z!], 'CheckString', 1, x)') if p3 > 0 then -- 1st % char can't be the start of an env var. Set startp to 2nd % char. startp = p2 --dprintf( 'p3 > 0') iterate endif -- Check rest of env var name CheckString = substr( String, startp + 1, p2 - startp - 1) p4 = pos( '[^A-Za-z0-9_\-!]+', CheckString, 1, 'x') --dprintf( 'p4 = 'p4' = pos( [^A-Za-z0-9_\-!]+, 'CheckString', 1, x)') if p4 > 0 then -- 1st % char can't be the start of an env var. Set startp to 2nd % char. startp = p2 --dprintf( 'p4 > 0') iterate endif LeftPart = substr( String, 1, p1 - 1) EnvVarName = substr( String, p1 + 1, p2 - p1 - 1) RightPart = substr( String, p2 + 1) EnvVarValue = Get_Env( EnvVarName) if EnvVarValue = '' then rcx = 204 -- ENVVAR_NOT_FOUND (may also be set to empty) endif --dprintf( 'EnvVarName = 'EnvVarName', EnvVarValue = 'EnvVarValue) -- Replace %...% string and move startp startp = length( LeftPart) + length( EnvVarValue) + 1 String = LeftPart''EnvVarValue''RightPart -- Reset pos vars to find next env var p1 = 0 p2 = 0 enddo -- Replace ?: with bootdrive do while pos( '?:', String) > 0 parse value String with LeftPart'?:'RightPart BootDrive = NepmdQuerySysInfo( 'BOOTDRIVE') String = LeftPart''BootDrive''RightPart enddo if fSetRc then rc = rcx endif return String ; --------------------------------------------------------------------------- ; Prepends 'GoTo' for number commands. Recognizes leading PostMes. defproc PrependGoToForNumbers( Cmd) CmdRest = Cmd NumPostMes = 0 do i = 1 to 10 -- just an upper limit CmdRest = strip( CmdRest) parse value CmdRest with Word1 tmp Word1 = strip( Word1) tmp = strip( tmp) if upcase( Word1) = 'POSTME' then NumPostMes = NumPostMes + 1 CmdRest = tmp elseif pos( leftstr( Word1, 1), '+-') then Cmd = CmdRest leave elseif IsNum( Word1) then Cmd = 'GoTo' CmdRest leave else Cmd = CmdRest leave endif enddo do n = 1 to NumPostMes Cmd = 'PostMe' Cmd enddo return Cmd ; --------------------------------------------------------------------------- defproc ParseCmd( var NextParm, var RestSegment, var Cmd, var fCmdFound, var fIsAPosCmd) universal posrestoredisabled do once = 1 to 1 -- Save vars from first call of ParseNextParm SavedNextParm = NextParm SavedRestSegment = RestSegment fCmdFound = 0 Cmd = substr( NextParm, 2) if rightstr( Cmd, 1) = "'" then Cmd = leftstr( Cmd, length( Cmd) - 1) fCmdFound = 1 endif -- Find closing single quote do while not fCmdFound if RestSegment = '' then leave endif -- ParseNextParm handles strings within double quotes call ParseNextParm( NextParm, RestSegment) if rightstr( NextParm, 1) = "'" then NextCmdPart = leftstr( NextParm, length( NextParm) - 1) -- Append last part Cmd = Cmd NextCmdPart fCmdFound = 1 else NextCmdPart = NextParm -- Append next part Cmd = Cmd NextCmdPart endif enddo if fCmdFound then Cmd = PrependGoToForNumbers( Cmd) NextParm = '' fIsAPosCmd = IsAPosCmd( Cmd) if fIsAPosCmd then --dprintf( '* Edit: fIsAPosCmd, set posrestoredisabled') posrestoredisabled = 1 endif else -- Cmd not found - this may be a filemask -- Restore vars from first call of ParseNextParm Cmd = '' NextParm = SavedNextParm RestSegment = SavedRestSegment endif enddo -- once dprintf( 'EDIT', 'ParseCmd: NextParm = 'NextParm', RestSegment = 'RestSegment', Cmd = 'Cmd', fCmdFound = 'fCmdFound', fIsAPosCmd = 'fIsAPosCmd) return ; --------------------------------------------------------------------------- ; This defc Edit eventually calls the built-in edit command (xcom edit), by ; calling PreLoadFile -> LoadFile, that does additional processing before ; the file(s) is/are loaded. ; ; The Edit command can not only be executed from EPM's commandline, but is ; also prepended to the submitted args when EPM is started. Before that, ; EPM removes the options that it knows. The rest of the arg string is always ; submitted to the Edit command. (Main arg processing is done in MAIN.E.) ; ; Parse off each file individually. Files can optionally be followed by one ; or more commands, each in quotes. The first file that follows a host file ; must be separated by a comma, an option, or a (possibly null) command. ; ; EPM doesn't give error messages from xcom Edit, so we have to handle that ; for it. ; ; Note: If a proc that's been used here is not defined, EPM starts hidden ; and is not fully initialized. defc Edit, e, ed universal default_edit_options universal nepmd_hini universal mainstate universal loadstate universal posrestoredisabled universal edithistorydisabled universal loadhistorydisabled edit_rc = '' EditArgs = strip( arg( 1)) do once = 1 to 1 -- Workaround: Set LoaderKeys to empty and reset flag. This is executed -- when the executable (defmain) was not called, but the loader. App = 'RegKeys' LoaderKey1 = '\NEPMD\Var\Loader\PgmInputs' LoaderKey2 = '\NEPMD\Var\Loader\StartDir' LoaderKey3 = '\NEPMD\Var\Loader\Called' call setprofile( nepmd_hini, App, LoaderKey1, '') call setprofile( nepmd_hini, App, LoaderKey2, '') call setprofile( nepmd_hini, App, LoaderKey3, '0') EpmArgs = strip( arg( 1)) if EpmArgs = '' then edit_rc = 0 leave endif --dprintf( 'Edit: EpmArgs = 'EpmArgs', hwnd = 'getpminfo( EPMINFO_EDITCLIENT)) -- Workaround: This avoids unwanted window scrolling of the previous file 'VSyncCursor' Options = default_edit_options NumErrors = 0 fIsAPosCmd = 0 firstfid = '' getfileid startfid fParseCmd = 1 if isadefproc( 'HostCheckParseCmd') then fParseCmd = HostCheckParseCmd() -- MVS file specs can start with ' endif -- Always reset the var on next Edit cmd posrestoredisabled = 0 -- Disable Load history for wildcards, enable it for others fWildcard = (pos( '*', EpmArgs) + pos( '?', EpmArgs) > 0) if fWildcard then -- Automatically reset in ProcessPostFilesLoaded loadhistorydisabled = 1 endif dprintf( 'EDIT', 'mainstate = 'mainstate', hwnd = 'getpminfo( EPMINFO_EDITCLIENT)', CtrlIsDown() = 'CtrlIsDown()', EpmArgs = 'EpmArgs) -- Limitation with mainstate ensures that this is not executed for a -- freshly opened window, which would cause an endless loop. if mainstate = 0 then if CtrlIsDown() then 'Open' EpmArgs return endif endif -- Query previously saved source file for equal char expansion. -- It's reset after the next LoadFile call. EqualCharSourceFile = GetAVar( 'EqualCharSourceFile') RestArgs = EpmArgs NextSegment = '' -- Expand env vars first. RestArgs = ExpandEnvVars( RestArgs) -- Process RestArgs segment-wise (comma-separated) do while RestArgs <> '' -- Parse NextSegment from RestArgs -- Options must be specified before Filemask and are applied to -- all FileMasks within one segment. call ParseNextParm( NextSegment, RestArgs, ', ') Options = default_edit_options -- Parse into EditOptions, EditFile and EditCmd and process them RestSegment = NextSegment load_rc = 0 do while RestSegment <> '' Cmd = '' Filemask = '' fIsAPosCmd = 0 fCmdFound = 0 SavedCmd = '' SavedFilemask = '' -- Discard current segment if LoadFile returned an error if load_rc then leave endif -- Parse file list fFileList = 0 if leftstr( strip( RestSegment), 1) = '@' then fFileList = 1 RestSegment = substr( RestSegment, 2) endif -- Parse next word or cmd string from RestSegment -- ParseNextParm handles strings within double quotes call ParseNextParm( NextParm, RestSegment) ch1 = leftstr( NextParm, 1) -- Parse option if ch1 = '/' then -- Filter out new option, unknown by xcom e -- (np = no pos. restore) if lowcase( NextParm) = '/np' then --dprintf( '* Edit: /np specified, set posrestoredisabled') -- Set universal posrestoredisabled = 1 -- Filter out new option, unknown by xcom e -- (cf = current file to expand '=') elseif lowcase( leftstr( NextParm, 4)) = '/cf=' then EqualCharSourceFile = StripquotesFileSpec( substr( NextParm, 5)) -- Save source file for equal char expansion. -- This is submitted by Open. call SetAVar( 'EqualCharSourceFile', EqualCharSourceFile) --dprintf( '* Edit: /cf specified, EqualCharSourceFile = 'EqualCharSourceFile) else -- Append option Options = Options NextParm endif --dprintf( 'Options = 'Options) iterate -- Parse cmd elseif ch1 = "'" & fParseCmd then call ParseCmd( NextParm, RestSegment, Cmd, fCmdFound, fIsAPosCmd) if fCmdFound then --dprintf( 'Process Cmd = 'Cmd) if Cmd <> '' then -- Execute Cmd Cmd if edit_rc = '' then edit_rc = 0 endif endif -- Save Cmd for Edit /n SavedCmd = Cmd -- Reset Cmd var Cmd = '' iterate endif endif -- Parse filemask -- '=' chars are expanded below Filemask = NextParm -- Handle VM host files fParseFileMask = 1 if isadefproc( 'HostCheckParseFileMask') then -- Submit copies to HostCheckParseFileMask/VmFile, because -- they modify them CheckFilemask = Filemask RestFilemask = RestSegment -- Check if a VM filename and parse it fParseFileMask = HostCheckParseFileMask( CheckFilemask, RestFilemask) -- Returns 0 if a VM file if not fParseFileMask then if isadefproc( 'HostParseFto') then call HostParseFto( RestFilemask) endif -- Host filespec found, copy vars Filemask = CheckFilemask RestSegment = RestFilemask endif endif -- Process Filemask together with Options if Filemask <> '' then --dprintf( 'Process Filemask = 'Filemask) if fParseFilemask then -- if not a VM host file -- Remove surrounding double quotes Filemask = StripQuotesFileSpec( Filemask) -- Expand '=' chars in Filemask Filemask = ExpandEqualChar( Filemask, EqualCharSourceFile) -- GetFullName returns a fully qualified Filemask. -- The EPM executable also submits fully qualified filenames, -- but relative to its initial start dir, e.g. by the program -- object or the dir of the executable. -- Using the start data of the loader, makes the following work: -- cd -- start epm -- It works also, if an EPM window is already open. -- StartDir is only renewed when the loader is involved StartDir = QueryLoaderStartDir() if StartDir = '' then RelativeDir = directory() else RelativeDir = StartDir -- Ensure that StartDir is processed only once --dprintf( 'Reset StartDir by: Edit 'EpmArgs) call ResetLoaderStartDir() endif Filemask = GetFullName( Filemask, RelativeDir) -- This returns the real case of Filemask Filemask = GetRealCase( Filemask) -- Process file list if fFileList then -- Parse Cmd to be executed on all lines of Filemask. -- This must be parsed here together with the Filemask, -- because the normal Cmd parsing is done after execution -- of RestoreFileList. SavedRestSegment = RestSegment call ParseNextParm( NextParm, RestSegment) call ParseCmd( NextParm, RestSegment, Cmd, fCmdFound, fIsAPosCmd) -- Avoid addition to Load history -- Automatically reset in ProcessPostFilesLoaded loadhistorydisabled = 1 -- Execute Filemask and Cmd if fCmdFound then call RestoreFileList( Filemask, '', Cmd) else RestSegment = SavedRestSegment call RestoreFileList( Filemask) endif if rc then -- Give more detailed info than 'xcom e' 'SayError 'sayerrortext( rc)': 'Filemask endif iterate endif -- Handle dirs specially call LoadDir( Filemask) if not rc then -- on success iterate endif -- Preload the file if fParseFileMask then call PreLoadFile( Filemask, Options) endif endif -- fParseFilemask -- Load Filemask and Options dprintf( 'EDIT', 'call LoadFile( 'Filemask', 'Options')') display -14 -- Avoid error message by 'xcom e' call LoadFile( Filemask, Options) -- 'xcom e' sets rc display 14 edit_rc = rc -- restore this rc at the end load_rc = rc -- If file to open is the topmost file, check if it needs to -- be refreshed if FileMask = .filename then 'RenewDateTimeModified' 'RefreshInfoLine MODIFIED' endif -- Reset previously saved source file for equal char expansion. call SetAVar( 'EqualCharSouceFile', '') if edit_rc then -- Give more detailed info than 'xcom e' 'SayError 'sayerrortext( edit_rc)': 'Filemask NumErrors = NumErrors + 1 else if firstfid = '' then -- If rc = 0, then set firstfid: getfileid firstfid endif endif -- Save Filemask for Edit /n SavedFilemask = Filemask -- Reset Filemask var Filemask = '' endif -- Make 'Edit /n' execute 'xcom e /n' to create a new .Untitled file if SavedFilemask = '' & SavedCmd = '' & pos( '/n', lowcase( Options)) then call LoadFile( '', Options) edit_rc = rc load_rc = rc if not edit_rc then getfileid firstfid endif endif enddo -- while RestSegment <> '' enddo -- while RestArgs <> '' -- Ensure that StartDir is reset after the first Edit cmd if QueryLoaderStartDir() <> '' then --dprintf( 'Reset StartDir by Edit 'EpmArgs) call ResetLoaderStartDir() endif if NumErrors > 1 then MessageNWait( MULTIPLE_ERRORS__MSG) stop endif dprintf( 'EDIT', 'arg( 1) = ['arg( 1)'], firstfid = ['firstfid'], ['firstfid.filename']') -- edithistoryenabled is set and reset by: -- o FILELIST.E:"defc RestoreLastRing" -- o FILELIST.E:"defproc RestoreFileList" -- It is also reset by: -- o SELECT.E:"defc ProcessPostFilesLoaded" if edithistorydisabled then -- nop elseif fIsAPosCmd then -- nop elseif pos( 'RESTORERING', upcase( Cmd)) then -- nop else 'AddToHistory EDIT 'EpmArgs endif enddo -- once -- If the file to be loaded was already at the top, no select event is -- triggered. Ensure that PostSelect is executed to e.g. highlight the -- cursor. getfileid fid if fid = startfid then 'PostMe ProcessPostSelect' endif rc = edit_rc ; --------------------------------------------------------------------------- ; Edits a file in a different PM window. This means invoking a completely ; new instance of E.DLL, with its own window and data. We do it by posting ; a message to the executive, the top-level E application. defc Open, o EpmArgs = strip( arg( 1)) -- Prepend /cf (current file) option if an '=' char is included. -- That will be used for ExpandEqualChar. if pos( '=', EpmArgs) then EpmArgs = '/cf='EnquoteFileSpec( .filename) EpmArgs endif --dprintf( 'Open: EpmArgs = 'EpmArgs', hwnd = 'getpminfo( EPMINFO_EDITCLIENT)) call windowmessage( 0, getpminfo( APP_HANDLE), 5386, -- EPM_EDIT_NEWFILE Put_In_Buffer( EpmArgs), 1) -- Tell EPM to free the buffer ; --------------------------------------------------------------------------- ; LAM - Edit a file along the EPATH. This command will be included if ; the user is including the required routines. If you've done a ; SET EPMPATH=d:\EPM;d:\my_emacs;d:\E_macros ; and then do ; ep stdcmds.e ; that will load this file, just as if you had entered ; e d:\e_macros\stdcmds.e ; 1994/03/02: Can specify '.' as the path to use the default, and can ; include additional arguments for the E command. E.g., ; ep mystuff.e . '/spell' defc EPath, ep parse arg Filename Pathname Rest if leftstr( Filename, 1) = '"' then parse arg '"'Filename'"' Pathname Rest endif if Pathname = '' | Pathname = '.' then if FileType( Filename) = 'CMD' then PathnameList = 'PATH' else PathnameList = EPATH';PATH' endif else PathnameList = Pathname endif -- Expand env vars, '?' and '=' call Parse_Filename( Filename, .filename) -- Search in PathnameList FoundFile = FindFileInList( Filename, PathnameList) if FoundFile = '' then -- Search in current dir FoundFile = FindFileInList( Filename, '.') endif if FoundFile = '' then -- Search in dir of current file lp = lastpos( '\', .filename) if lp > 0 then DirOfCurFile = leftstr( .filename, lp - 1) FoundFile = FindFileInList( Filename, DirOfCurFile) endif endif Cmd = strip( 'e' FoundFile Rest) Cmd ; --------------------------------------------------------------------------- defc OpenPath, OPath, op "Open 'ep "arg( 1)"'" ; --------------------------------------------------------------------------- ; Add a new .Untitled file defc NewUntitledFile 'xcom e /n' ; --------------------------------------------------------------------------- ; Replace the current file with a new .Untitled file defc New getfileid startfid 'xcom e /n' if rc <> -282 then -- sayerror 'New file' return endif getfileid newfid activatefile startfid temp = startfid -- temp fix for some bug 'Quit' getfileid curfid activatefile newfid if curfid = startfid then -- Wasn't quit; user must have said Cancel to Quit dlg 'xcom Quit' endif ; --------------------------------------------------------------------------- ; Move current file to a newly opened EPM window. defc MoveNewWindow, NewWindow if leftstr( .filename, 5) = '.DOS ' then fn = "'"substr( .filename, 6)"'" elseif upcase( leftstr( .filename, 5)) = '.TREE' then parse value .filename with TreeFilename Args parse value TreeFilename with '.'Cmd fn = "'"Cmd Args"'" elseif IsAShell() then EpmDir = directory() call pSave_Pos( SavedPos) SavedRc = rc -- Search (reverse) in command shell buffer for the prompt and -- retrieve the current directory. Go to previous prompt line. call ShellGotoNextPrompt( 'P') CurDir = '' Cmd = '' if not rc then call ShellParseLineDirCmd( .line, CurDir, Cmd) endif ShellCmd = 'Shell' if CurDir <> '' then ShellCmd = ShellCmd 'cdd' CurDir endif rc = SavedRc call pRestore_Pos( SavedPos) fn = "'mc ;cd "EpmDir";"ShellCmd"'" elseif leftstr( .filename, 1 ) = '.' then -- other temp file fn = '' else if .modify then 'Save' if rc then 'SayError 'ERROR_SAVING_HALT__MSG return endif endif fn = .filename if fn = GetUnnamedFileName() then fn = '' else fn = EnquoteFileSpec( fn) endif if .readonly then fn = '/r' fn endif endif if GetMode() = 'BIN' then -- Prepend 'binedit' fn = "'BinEdit "fn"'" else OpenCmd = '' if fn <> '' then 'VSyncCursor' call pSave_Pos( savedpos) OpenCmd = 'PostMe RestorePos 'savedpos endif endif -- EPM bug: Valid EPM commandline options are always reognized by the -- EPM executable, even when they are enclosed in '...' to make it work -- for the submitted command. if OpenCmd <> '' then "Open" fn "'"OpenCmd"'" else 'Open' fn endif 'Quit' ; --------------------------------------------------------------------------- ; Edit binary files in EPM. ; Linebreak after 64 chars ; Program object: ; Name : EPM Bin ; Parameters: 'binedit %*' defc BinEdit, be Filename = StripQuotesFileSpec( strip( arg( 1))) FileCmd = 'PostMe Mode BIN noea' call BinEditOpen( 'e', Filename, FileCmd) defc BinOpen, bo Filename = StripQuotesFileSpec( strip( arg( 1))) FileCmd = 'PostMe Mode BIN noea' call BinEditOpen( 'o', Filename, FileCmd) defproc BinEditOpen( EditCmd, Filename) FileCmd = arg( 3) --dprintf( 'BinEditOpen: EditCmd = 'EditCmd', Filename = 'Filename) -- Edit options should go before filename. -- /64 doesn't work if run from a program object. Cmd = EditCmd '/t /64 /bin' if FileCmd then -- Append FileCmd Cmd = Cmd "'"FileCmd"'" endif -- Append Filename Cmd = Cmd EnquoteFileSpec( Filename) -- Execute Cmd ; --------------------------------------------------------------------------- ; Linebreak at lineend chars defc BinLineEdit, ble -- Change default options for save command to simply save a bin file -- with F2. Therefore this command should be used in a separate EPM -- window only. FileCmd = 'PostMe Mode BIN noea' -- Edit options should go before filename. "e /t /bin '"FileCmd"'" arg( 1) ; --------------------------------------------------------------------------- ; Linebreak at maxmargin defc BinMaxEdit, bme -- Change default options for save command to simply save a bin file -- with F2. Therefore this command should be used in a separate EPM -- window only. FileCmd = 'PostMe Mode BIN noea' -- Edit options should go before filename. "e /t /1599 /bin '"FileCmd"'" arg( 1) ; --------------------------------------------------------------------------- ; Open a file dialog to select a file for binary editing in a new edit ; window. No args. defc OpenBinDlg universal app_hini Filemask = '*.exe;*.dll' -- The next, except the FileDlg execution, is copied from OpenDlg. -- Here the FileMask can be specified, in contrast to OpenDlg, so a dir -- may also prepended to FileMask instead of changing the work dir. ThisFilename = .filename ThisDir = '' lp = lastpos( '\', ThisFilename) if lp > 1 then ThisDir = leftstr( ThisFilename, lp - 1) endif PrevFileSelected = queryprofile( app_hini, 'ERESDLGS', 'LASTFILESELECTED') PrevDir = '' lp = lastpos( '\', PrevFileSelected) if lp > 1 then PrevDir = leftstr( PrevFileSelected, lp - 1) endif WorkDir = directory() KeyPath = '\NEPMD\User\StartDir\OpenDlg\Type' opt = QueryConfigKey( KeyPath) -- 0 = previous dir -- 1 = work dir -- 2 = dir of current file if opt = 2 & pos( ':\', ThisFilename) = 0 then opt = 1 endif -- Make the standard file dialog select the configured dir. -- The ini key LASTFILESELECTED is read internally by the file dialog adapted -- for EPM, but not by EPM's 'Open' or 'Add file' dialog. fWriteLastFileSelected = 0 LastFileSelected = PrevFileSelected if opt = 0 then -- 0 = previous dir -- nop elseif opt = 1 then -- 1 = work dir LastFileSelected = '' fWriteLastFileSelected = 1 elseif opt = 2 then -- 2 = dir of current file LastFileSelected = ThisFilename fWriteLastFileSelected = 1 endif if fWriteLastFileSelected then call setprofile( app_hini, 'ERESDLGS', 'LASTFILESELECTED', LastFileSelected) endif -- Make the EPM 'Open' or 'Add file' dialog select the configured dir. -- Different from the file dialog, the dir of the 'Add file' dialog can only -- be configured by temporarily changing the work dir. The default -- behavior is to open the dir configured by the program object. -- Note: The startup option /o suppresses this dialog and opens the -- file dialog instead. fChangeDir = 0 NewDir = '' if opt = 0 then -- 0 = previous dir NewDir = PrevDir fChangeDir = 1 elseif opt = 1 then -- 1 = work dir -- nop elseif opt = 2 then -- 2 = dir of current file NewDir = ThisDir fChangeDir = 1 endif if fChangeDir then NextDir = Directory2( NewDir) endif Title = 'Select a binary file' 'FileDlg 'Title', bo, 'Filemask -- The change back to the previous dir must be posted to work reliable. if fChangeDir then 'PostMe Cd' WorkDir endif ; --------------------------------------------------------------------------- ; Finds EPM macro files .e in Dir of arg( 1) and EPMMACROPATH. ; Opens listbox to select one file if multiple found. ; is parsed from arg( 1), so arg( 1) may have any extension. ; For association with *.ex (type: EX file) and *.e: ; Program object: ; Name : EPM Edit macro file ; Parameters: /r 'editmacrofile %*' ; From command line: ; start epm /r 'editmacrofile ' ; Todo?: handle UNC (\\server\resource) names defc EditMacroFile PathName = 'EPMMACROPATH' SearchInDirOfFile = 1 File = strip( arg( 1)) if File = '' then return endif -- Remove ".." len = length( File) if leftstr( File, 1) = '"' & rightstr( File, 1) = '"' then File = substr( File, 2, len - 2) endif if File = '' then return endif -- Get full pathname if exists File = NepmdQueryFullName( File) -- Build MacroFileName lp1 = lastpos( '\', File) Name = substr( File, lp1 + 1) Dir = substr( File, 1, Max( 0, lp1 - 1)) lp2 = lastpos( '.', Name) if lp2 = 0 | lp2 = 1 then BaseName = Name else BaseName = substr( Name, 1, Max( 0, lp2 - 1)) endif MacroFileName = BaseName'.e' Found = 0 FoundOnlyInDirOfFile = 0 MacroFileList = '' LastMacroFile = '' Len = 0 -- Search MacroFile in dir of File first if SearchInDirOfFile = 1 then MacroFile = Dir'\'MacroFileName if NepmdFileExists( MacroFile) then Found = Found + 1 Len = Max( Len, length( MacroFile)) FoundOnlyInDirOfFile = 1 MacroFileList = MacroFileList''\1''MacroFile LastMacroFile = MacroFile endif endif -- Get value of PathName Path = Get_Env( PathName) rest = Path -- Search in all parts of Path do while rest <> '' parse value rest with NextPath';'rest -- Search in NextPath MacroFile = NextPath'\'MacroFileName if NepmdFileExists( MacroFile) then if upcase( MacroFile) = upcase( LastMacroFile) then FoundOnlyInDirOfFile = 0 iterate endif Found = Found + 1 Len = Max( Len, length( MacroFile)) MacroFileList = MacroFileList''\1''MacroFile LastMacroFile = MacroFile endif enddo if Found = 0 then 'postme sayerror "'MacroFileName'" not found in directory of "'Name'" or in 'PathName elseif Found = 1 then -- Use postme here to delay the msg until all other msgs are processed. -- Otherwise the last msg would be 'Link completed, module # ?' if a new window -- is opened. But sometimes it doesn't work though. if FoundOnlyInDirOfFile = 1 then 'postme sayerror Found macro file "'MacroFileName'" only in directory of "'Name'"' else 'postme sayerror Found 1 macro file "'MacroFileName'" in 'PathName endif parse value MacroFileList with \1''select 'e' select else -- Multiple files found, open listbox Title = 'Select macro file 'MacroFileName -- Text to appear in 1 line below the title, above the list -- Only 1 line (no \13 or \n) allowed in Text, but \9 is recognized. if FoundOnlyInDirOfFile = 1 then Text = 'Multiple macro files found in directory of "'Name'" and 'PathName'.' else Text = 'Multiple macro files found in 'PathName'.' endif 'SayError 'Text Text = CTRL_KEY__MSG' to open a new window' ItemList = MacroFileList -- first char is separator Buttons = '/~Open/'CANCEL__MSG -- first char is separator, first button is selected Selection = 1 -- selected item of ItemList Height = Min( Found, 12) -- make the list max. 12 lines high Width = Max( Len, 50) -- make the list min. 50 ??? wide refresh -- Add everytime a refresh before opening a listbox. -- Otherwise sometimes only a part of it is shown. Result = ListBox( Title, ItemList, Buttons, 0, 0, -- top, left, Height, Width, -- height, width, GethWndC( APP_HANDLE) || atoi( Selection) || atoi( 1) || atoi( 0) || Text\0) parse value Result with Button 2 Select \0 -- get button and (Select = selected item) Select = strip( Select, 'B', \1) -- sometimes the returned value for Cancel is \1 if Select = '' then -- Cancel ==> no item is returned return endif if Button = \1 then EditArgs = EnquoteFileSpec( Select) 'DialogLoadFile 'EditArgs endif endif return ; --------------------------------------------------------------------------- ; Edits a user macro file. If file doesn't exist, the contents of the ; Netlabs file is copied to the new user file buffer. A file is only created ; if a user saves the buffer afterwards. defc EditCreateUserMacro MacroFile = arg( 1) lp = lastpos( '\', MacroFile) MacroFileName = substr( MacroFile, lp + 1) 'EditCreateUserFile macros\'MacroFileName ; --------------------------------------------------------------------------- ; Edits a user macro file. If file doesn't exist, the contents of the ; Netlabs file is copied to the new user file buffer. A file is only created ; if a user saves the buffer afterwards. ; Syntax: EditCreateUserFile \, e.g.: bin\epm.env defc EditCreateUserFile MacroFile = strip( arg( 1)) UserDir = Get_Env( 'NEPMD_USERDIR') NetlabsDir = Get_Env( 'NEPMD_ROOTDIR')'\netlabs' UserFile = UserDir'\'MacroFile NetlabsFile = NetlabsDir'\'MacroFile if Exist( UserFile) then 'Edit 'UserFile else 'Edit 'NetlabsFile if not rc then .filename = UserFile -- Disabled. The header could contain useful docs. In some cases -- also the RCS id may be helpful to determine the original version -- of the netlabs file. --'postme mc ;1;RemoveNextHeader' 'postme postme EditCreateUserFileMsgBox' UserFile endif endif ; --------------------------------------------------------------------------- defc EditCreateUserFileMsgBox NewFile = strip( arg( 1)) NewFilename = '' if NewFile <> '' then lp = lastpos( '\', NewFile) NewFilename = substr( NewFile, lp + 1) endif Mode = GetMode() Title = 'New user file: 'NewFilename Text = '' Text = Text || 'The current file was copied from the NETLABS tree.' Text = Text || ' On saving, it will be created in the user tree and' Text = Text || ' will override the original NETLABS file.' if Mode = 'E' then Text = Text || \n\n Text = Text || 'Note that a macro file needs recompilation before' Text = Text || ' it gets applied. In that case, execute RecompileNew' Text = Text || ' via Run -> Macros -> "Recompile new user macros".' endif Style = MB_OK + MB_INFORMATION + MB_MOVEABLE rcx = WinMessageBox( Title, Text, Style) ; --------------------------------------------------------------------------- defc EditCreateProfile UserDir = Get_Env( 'NEPMD_USERDIR') Profile = UserDir'\bin\profile.erx' if Exist( Profile) then 'Edit 'Profile else 'Edit 'Profile insertline "/* After save, press the Run button or execute Run -> Run current file */", 1 insertline "/*'DropAVar debuglist'*/", 2 insertline "/*'AddAVar debuglist init main edit load select filesloaded'*/", 3 endif ; --------------------------------------------------------------------------- defc EditCreateMyepmEnv UserDir = Get_Env( 'NEPMD_USERDIR') MyepmEnvFile = UserDir'\bin\myepm.env' TemplateFile = GetUserNetlabsFile( 'myepmenv.tpl', 'install') do once = 1 to 1 if Exist( MyepmEnvFile) then 'Edit 'EnquoteFilespec( MyepmEnvFile) if rc then leave endif else CreateFileFromTemplate( ListFile, TemplateFile) if rc then leave endif .modify = 0 endif 'PostMe FindTop TOOLKIT_DIR=' enddo ; --------------------------------------------------------------------------- defproc ParseFilename( var Filename) call Parse_Filename( Filename, arg( 2)) return ; --------------------------------------------------------------------------- ; Expands env vars and '?:' = boot dir. Expands '=' to the corresponding ; filename part of arg( 2) = a source file. If source file is not specified, ; the topmost filename is used. For a virtual source file the current path is ; prepended. defproc Parse_Filename( var Filename) if Filename = '' then return endif Filename = ExpandEnvVars( Filename) Filename = ExpandEqualChar( Filename, arg( 2)) return ; --------------------------------------------------------------------------- ; Find a filemask, maybe relative, with a given startdir. ; Doesn't check if file exists. ; Doesn't resolve envvars. ; Doesn't resolve "=". ; Supports UNC and Unix names, including something like ftp://. ; Not tested with IBM host names. ; Syntax: GetFullName( FileMask [, StartDir]) ; FileMask: any maybe relative dir or file filemask, wildcards allowed ; StartDir: parts of StartDir are appended to FileMask, if it's relative defproc GetFullName( FileMask) FullName = FileMask do once = 1 to 1 if FileMask = '' then leave endif if IsVirtual( FileMask) then leave endif -- Get current dir and drive CurDir = directory() CurDrive = leftstr( CurDir, 2) -- Get specified dir StartDir = arg( 2) -- Translate '/' to '\' if local masks specified p1 = pos( ':/', FileMask) p2 = pos( '://', FileMask) p3 = pos( ':/', StartDir) p4 = pos( '://', StartDir) if (p1 > 0 & p1 <> p2) | (p3 > 0 & p3 <> p4) then FileMask = translate( FileMask, '\', '/') StartDir = translate( StartDir, '\', '/') endif -- Init if StartDir = '' then StartDir = CurDir endif StartDrive = '' Server = '' -- Determine StartDir and StartDrive or Server if substr( StartDir, 2, 2) = ':\' then -- fully qualified StartDrive = leftstr( StartDir, 2) elseif leftstr( StartDir, 2, 2) <> '\\' then -- UNC p1 = 3 p2 = pos( '\', StartDir, p1) if p2 = 0 then Server = StartDir else Server = leftstr( StartDir, p2 - 1) endif elseif pos( '://', StartDir ) then -- something like ftp:// or http:// p1 = pos( '://', StartDir ) + 3 p2 = pos( '/', StartDir, p1) if p2 = 0 then Server = StartDir else Server = leftstr( StartDir, p2 - 1) endif elseif leftstr( StartDir, 1) = '\' then -- local, without drive StartDrive = CurDrive StartDir = StartDrive''StartDir else -- relative StartDrive = CurDrive StartDir = strip( CurDir, 't', '\')'\'StartDir endif -- Determine fullname -- fully qualified if substr( FileMask, 2, 2) = ':\' then -- local, fully qualified FullName = FileMask elseif leftstr( FileMask, 2, 2) = '\\' then -- fully qualified UNC FullName = FileMask elseif pos( '://', FileMask ) then -- fully qualified, starting with something like ftp:// or http:// FullName = Server''FileMask -- only drive or server missing elseif leftstr( FileMask, 1) = '\' & -- UNC mask without server leftstr( StartDir, 2, 2) = '\\' then FullName = Server''FileMask elseif leftstr( FileMask, 1) = '/' & -- Unix mask without server pos( '://', StartDir ) then FullName = Server''FileMask elseif leftstr( FileMask, 1) = '\' then -- without drive FullName = StartDrive''FileMask -- relative elseif leftstr( StartDir, 2, 2) = '\\' then -- relative UNC mask FullName = strip( StartDir, 't', '\')'\'FileMask elseif pos( '://', StartDir ) then -- relative Unix mask FullName = strip( StartDir, 't', '/')'/'FileMask else -- relative FullName = strip( StartDir, 't', '\')'\'FileMask endif -- Resolve '.' and '..' in FullName if not pos( '/', FullName) then FullName = NepmdQueryFullname( FullName) endif enddo return FullName ; --------------------------------------------------------------------------- ; This proc is called by defc app, append, put and defc save. ; It parses input args (ArgStr) and returns filename(s) and options. ; Options are recognized by a leading slash and must be specified in ; the input args before filename. ; Example: ArgStr = '/opt1 /opt2 /opt3 ' ; Parse_Leading_Options( ArgStr, Options) defproc Parse_Leading_Options( var ArgStr, var Options) Options = '' do forever parse value ArgStr with Wrd Rest if leftstr( Wrd, 1) = '/' then Options = Options Wrd ArgStr = Rest else leave endif enddo return ; --------------------------------------------------------------------------- ; This proc is called by defc app, append, put. ; A common routine to parse an argument string containing a mix of ; options and DOS file specs. The DOS file specs can contain an "=" for the ; path or the fileid, which will be replaced by the corresponding part of the ; previous file (initially, the current filename). defproc Parse_File_N_Opts( ArgStr) PrevFilename = .filename Output = '' do while ArgStr <> '' parse value ArgStr with Filename Rest if leftstr( Filename, 1) = '"' then parse value ArgStr with '"' Filename '"' ArgStr Filename = '"'Filename'"' else ArgStr = Rest endif if leftstr( Filename, 1) <> '/' then call Parse_Filename( Filename, PrevFilename) PrevFilename = Filename endif Output = Output Filename end return substr( Output, 2) ; --------------------------------------------------------------------------- ; Called when the EPM file icon is dropped on another EPM window, while the ; source file is modified. ; We can just execute 'get' to achieve the same result. defc Insert_Text_File 'Get 'arg( 1)