/****************************** Module Header ******************************* * * Module Name: stdctrl.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. * ****************************************************************************/ compile if not defined( SMALL) -- If compiled separately EA_comment 'PM controls.' define INCLUDING_FILE = 'STDCTRL.E' include 'stdconst.e' const tryinclude 'mycnf.e' const compile if not defined( NLS_LANGUAGE) NLS_LANGUAGE = 'ENGLISH' compile endif include NLS_LANGUAGE'.e' compile endif ; --------------------------------------------------------------------------- /* ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» º What's it called: stdctrl.e º º º º What does it do : contains special PM procedures and commands that enable º º the following from the EPM editor: º º º º listbox support - enables the dynamic creation of PM º º list boxes. A macro can pop up a º º list of items and have a the users º º selection returned to the macro. º º º º menu support - enables the dynamic creation and º º maintenance of named menus. º º A macro can create several menus that º º when shown and selected can execute º º editor commands. º º º º EPM - E.DLL communication : º º gives a EPM macro the ability to º º converse with EPM.EXE controls. º º For Example, popping EPM's commandline º º message dialog, etc. º º º º Who and When : Gennaro (Jerry) Cuomo 3 -88 º º º ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ */ /* ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ³ List Box Functions: ³ ³ ³ ³ ListBox() ³ ³ listdemo() ³ ³ listdemo2() ³ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ */ ; --------------------------------------------------------------------------- ; EPM bug of the ListBox proc, eventually only in conjunction with NewView: ; On closing the list box dialog, a previously opened EPM.HLP via the Help ; Manager is closed, too. It doesn't matter how the dialog is closed. ; That doesn't happen for any other dialog nor if the .HLP file was opened ; without the Help Manager. ; --------------------------------------------------------------------------- ; ListBox() ; param1 - Listbox title ; ; param2 - string of items, separated by a common separator. The common ; separator is the first character in the string. ; example: /cat/dog/fish/ ; separator='/' list=cat, dog, fish ; example: $cat/ground$fish/water$ ; separator='$' list=cat/ground, fish/water ; ; If this parameter starts with an x'00', then it will be assumed to ; represent a buffer, in the format: ; ; \0 || atol(usedsize) || atoi(buffer_offset) || atoi(buffer_selector) [ || flag ] ; ; The default flag is 3. The bits are: ; 1 - Display the listbox below the specified point. ; 2 - Map the specified points to the desktop. ; 4 - Each listbox item starts with an ASCII help panel ID. ; The IDs are removed before filling the listbox. The ; first button is assumed to be a Details button. ; Pressing it invokes help for the panel ID associated ; with the current listbox item. (This feature is used by ; the Workframe/2.) ; Other flags from older versions are not supported. ; ; The function listbox_buffer_from_file, defined in STDCTRL.E, ; can be used for putting the contents of a file into a buffer ; in a suitable format for listbox(). It requires an empty line ; at the top, as created by 'xcom e /n' ; ; param3 - (optional) button names. A maximum of seven button names can be ; specified to allow multiple buttons. ; ; param4 - (optional) row of text in which list box will go under. ; If this parameter is not specified or if a parameter of zero (0) ; is specified, the box will be placed centered. ; If the parameter 'C' is used, the box will be placed beneath the ; cursor. ; This is the x-pos. in columns. A good value is 6. ; ; param5 - (optional) column of text in which list box will go under. ; If this parameter is not specified or if a parameter of zero (0) ; is specified, the box will be placed centered. ; If the parameter 'C' is used, the box will be placed beneath the ; cursor. ; NOTE: If the row parameter is selected, the column parameter ; must be selected as well. ; NOTE: Previously, "beneath the cursor" was the default behavior. ; That seems to behave annoying in most cases, therefore ; that was changed to place the box centered. To place it ; beneath the cursor, now 'C' has to be specified explicitely ; for param4 and 5. ; This is the y-pos. in lines, where it describes the middle of ; the dialog. The bottom pos. of the dialog depends on its height. ; A good value is 10 with the height of 6 lines and 2 rows of ; buttons. ; ; param6 - (optional) height of the listbox in characters ; (NOTE: Since the default PM font is proportional, the character ; height and width are approximate values.) ; ; param7 - (optional) width of listbox in characters. ; ; param8 - (optional) buffer string (see below) ; ; The following procedure creates a PM list box dialog. The listbox will ; wait for user input and return a value that corresponds to the users input. ; ; If the user presses Enter or double clicks on an entry, that entry will ; be returned as the result of the listbox function. ; ; If Cancel is selected or Esc is pressed, the listbox function will return ; null. ; ; The listbox is a modal listbox, therefore user input is required before ; anything else can happen. ; ; Jerry Cuomo 1-89 ; ; EPM 5.21 / 5.50 added some new features to the ETOOLKIT interface. Parameter ; 8 is used to expose this to the caller of listbox(). ; ; If present, it is a string consisting of: ; ; handle || item# || button# || help_ID || prompt ; ; where ; ; item# is the listbox entry to be initially selected, ; ; button# is the button that will be the default, ; ; help_ID is a help panel ID (all shorts), ; ; handle is the window handle of the OWNERCLIENT (needed to call help; ; ignored if help_ID is 0) and ; prompt is an ASCIIZ string to be displayed below the title bar. If ; help_ID is non-zero, the rightmost button is assumed to be the ; help button. ; ; The new parameters are passed to the toolkit in the return buffer, which is ; padded with nulls, so only the minimum needed string need be sent. ; ; The new way returns one byte representing the button number (in hex) ; followed by the selected item. A button number of 0 means Esc was pressed ; or the dialog was closed. ; ; If param8 was passed, the listbox() routine returns this entire string; if ; not, it parses it and returns what the old callers expected. ; ; Larry Margolis / John Ponzo 6/91 ; ; ---- ; ; Correction/clarification of FLAGS description of bits 0 and 1: ; bit 0 ; 0: y = bottom of listbox ; 1: y = top of listbox ; bit 1 ; 0: map x, y to the desktop ; 1: map x, y relative to EPM window ; ; When caller does not pass a valid FLAGS an artifical, temporary value is set: -2. ; When FLAGS is -2 the code will ; a) determine if there is more space above or below the ROW ; b) Set FLAGS, and Y so that the listbox will appear just above or just ; below ROW depending on where there is more room ; defproc ListBox( title, listbuf) universal app_hini -- Ensure that the frame window is fully visible on the desktop. Otherwise -- the dialog is not painted correctly. MoveWindowToDesktop( getpminfo( EPMINFO_EDITFRAME)) if leftstr( listbuf, 1) = \0 then liststuff = substr( listbuf, 2, 8) flags = substr( listbuf, 10) if not IsNum( flags) then flags = -2 -- artificial value indicating "don't care" endif else listbuf = listbuf\0 liststuff = atol( length( listbuf) - 1) || -- length of list address( listbuf) -- list flags = -2 -- artificial value indicating "don't care" endif title = title\0 if arg( 3) <> '' then -- button names were specified parse value arg( 3) with delim 2 but1 (delim) but2 (delim) but3 (delim) but4 (delim) but5 (delim) but6 (delim) but7 (delim) nb = 0 if but1 <> '' then but1 = but1\0 nb = nb + 1 else 'SayError ListBox:' BUTTON_ERROR__MSG return 0 endif if but2 <> '' then but2 = but2\0 nb = nb + 1 else but2 = \0 endif if but3 <> '' then but3 = but3\0 nb = nb + 1 else but3 = \0 endif if but4 <> '' then but4 = but4\0 nb = nb + 1 else but4 = \0 endif if but5 <> '' then but5 = but5\0 nb = nb + 1 else but5 = \0 endif if but6 <> '' then but6 = but6\0 nb = nb + 1 else but6 = \0 endif if but7 <> '' then but7 = but7\0 nb = nb + 1 else but7 = \0 endif else -- default buttons but1 = ENTER__MSG\0 but2 = CANCEL__MSG\0 but3 = \0 but4 = \0 but5 = \0 but6 = \0 but7 = \0 nb = 2 endif if arg() > 5 then -- were height and width specified height = arg( 6) -- height was passed else height = 0 -- default: 0 = use listbox default endif if height < 4 then height = 4 -- internal default is to show 4 lines endif if arg() > 6 then -- were height and width specified width = arg( 7) -- width was passed else width = 0 -- default: 0=use listbox default endif -- Row and col count from the lower left corner of the edit window row = 0 col = 0 fAtCursor = 0 if arg() > 3 then -- row and col were passed row = arg( 4) col = arg( 5) endif if row = 0 then row = (.windowheight - (height + 4)) % 2 -- centered elseif leftstr( translate( row), 1) = 'C' then row = .cursory -- beneath the cursor fAtCursor = 1 endif if col = 0 then col = (.windowwidth - Max( width, 30)) % 2 -- centered elseif leftstr( translate( col), 1) = 'C' then col = .cursorx -- beneath the cursor fAtCursor = 1 endif --dprintf( 'row = 'row', col = 'col', height = 'height', width = 'width', .windowheight = '.windowheight', .windowwidth = '.windowwidth) if arg() > 7 then selectbuf = leftstr( arg( 8), 255, \0) else selectbuf = copies( \0, 255) endif --parse value entrybox( 'Enter row col addl heightadjust') with row col jbsu hadj --parse value entrybox( 'Enter row col adj') with row col jbsu call dprintf( 'listbox', 'curx cury: '.cursorx .cursory) call dprintf( 'listbox', 'col row: 'col row) --call listbox2( title, listbuf, arg( 3), row, col, arg( 6), arg( 7)) --parse value entrybox( 'Enter comment') with msg --call dprintf( 'listbox', 'Comment: 'msg) -- o .windowy and .windowx are always 0 in EPM -- o screenheight() and screenwidth() return the window dimensions in -- pixels -- o .fontheight and .fontwidth are values in pixel, e.g. for 12.System -- VIO: 16x8 -- o Of course the dialog font differs from the edit window font and -- .fontheight and .fontwidth return the size of the edit window font -- o .cursory is 1 when cursor is on top and .windowheight when cursor is -- on bottom, values in lines -- o .cursorx is 1 when cursor is at the left and .windowwidth when cursor -- is at the right edge, values in cols -- JBSQ: "flags" does not seem to work as documented. -- Bits 0 and 1 seem to work as follows: -- 00: x, y mapped to desktop, listbox kept on screen -- 01: x mapped to desktop, y = ?, listbox can go off top of screen -- 10: x, y mapped relative to EPM window, listbox stays on screen -- 11: x, y mapped relative to EPM window, y measured down from bottom of EPM window? -- Conclusion: only 00 and 10 (0 and 2 in decimal) seem to work predictably if fAtCursor then -- Determining the x coordinate works very well using the standard method: x = .fontwidth * col -- convert row and column into... -- The y coordinate depends on the height of the dialog font. The old -- method gives bad results: -- y = .windowy + screenheight() - .fontheight * (row + 1) - 4 /* (Add a fudge factor temporarily */ -- Correct row for 9.WarpSans (standard was either 10.System Proportional -- or 10.System Monospaced). row and .cursory are counted in number of -- lines from the top. desktop_cy = NepmdQuerySysInfo( 'CYSCREEN') Msg = '' if rc then Msg = 'Error query system screen resolution, rc = 'rc'.' 'SayError 'Msg return Msg endif call dprintf( 'listbox', 'Desktop height /2 = 'desktop_cy (desktop_cy/2)) win_data = NepmdQueryWindowPos( EPMINFO_EDITFRAME) if rc then Msg = 'Error query frame position, rc = 'rc'.' 'SayError 'Msg return Msg endif parse value win_data with fwindowx fwindowy fwindowcx fwindowcy call dprintf( "listbox", 'SWP F: 'fwindowx fwindowy fwindowcx fwindowcy) win_data = NepmdQueryWindowPos( EPMINFO_EDITCLIENT) if rc then Msg = 'Error query client position, rc = 'rc'.' 'SayError 'Msg return Msg endif parse value win_data with cwindowx cwindowy cwindowcx cwindowcy -- the x and y are relative to the frame windowx = cwindowx + fwindowx -- so add in the frame x to get absolute client x windowy = cwindowy + fwindowy -- so add in the frame y to get absolute client y call dprintf( 'listbox', 'SWP C: 'cwindowx cwindowy cwindowcx cwindowcy) -- Estimate the height of the entire listbox dialog -- The height of additional dialog controls takes about 7 lines of -- 9.WarpSans (same height as 12.System VIO, which has 16x8). --addpixels = 102 + (50 * (nb > 4)) addpixels = 122 + (40 * (nb > 4)) -- 40 per row of buttons + 122 for other "overhead" pixels boxfontheight = 16 -- value in pels = pixels boxcy = height * ( boxfontheight ) + addpixels call dprintf( 'listbox', 'wdwhgt hgt boxcy addl: '.windowheight height boxcy addpixels) row_y = .fontheight * (.windowheight - (row - 1)) SpaceBelowCursor = windowy + row_y call dprintf( 'listbox', 'row_y Spcbelow: 'row_y SpaceBelowCursor) if flags < 0 then if SpaceBelowCursor < (desktop_cy / 2) then -- Position listbox window above row, col wanty = row_y topofwin = 0 too_much = 0 if flags < 0 then topofwin = wanty + boxcy + windowy too_much = topofwin - desktop_cy if too_much > 0 then height = height - (too_much + boxfontheight - 1) % boxfontheight endif flags = 0 endif call dprintf( 'listbox', 'Above cursor::wanty top too adjh: 'wanty topofwin too_much height) else -- Position listbox window below row, col wanty = row_y - .fontheight if flags < 0 then too_much = wanty + windowy - boxcy -- - 10 -- fudge factor if too_much < 0 then height = (boxcy + too_much - addpixels) % boxfontheight endif flags = 1 endif call dprintf( 'listbox', 'Below cursor::wanty adjh too_much: 'wanty height too_much) endif endif call dprintf( 'listbox', 'flags bit1 winy: 'flags ((flags % 2) // 2) windowy) if ((flags % 2) // 2) then y = wanty else x = x + windowx y = wanty + windowy endif -- Prevent corrupted window diplays because the cursor is offscreen if (flags < 2) and (x <= -windowx) then x = 1 - windowx endif -- With this coordinate determination, the listbox window may be placed -- outside of the frame window. That is intended, since we don't have a -- MDI window. Limiting the listbox window to screen values is done -- automatically by the LISTBOX function. else -- not at cursor y = .fontheight * row x = .fontwidth * col flags = 2 -- gives best results for centering in the edit window endif if getpminfo( EPMINFO_EDITFRAME) then handle = EPMINFO_EDITFRAME else -- If frame handle is 0, use edit client instead. handle = EPMINFO_EDITCLIENT endif call dprintf( 'listbox', 'final::flags col row x y: 'flags col row x y) call dynalink32( ERES_DLL, -- list box control in EDLL dyna 'LISTBOX', -- function name GethWndC( handle) || -- edit frame handle atol( flags) || atol( x) || -- coordinates atol( y) || atol( height) || atol( width) || atol( nb) || address( title) || -- list box dialog title address( but1) || -- text to appear in buttons address( but2) || address( but3) || address( but4) || address( but5) || address( but6) || address( but7) || liststuff || address( selectbuf) || -- return string buffer atol( app_hini)) -- handle to INI file 'PostMe HighlightCursor' parse value selectbuf with Button 2 Select \0 Button = asc( Button) RetVal = Select do once = 1 to 1 if arg( 6) then -- New way RetVal = selectbuf elseif Button = 0 | Button = 2 then -- Old way RetVal = '' elseif Button <> 1 then RetVal = Button else EOS = pos( \0, selectbuf, 2) -- chr( 0) signifies End Of String if not EOS then RetVal = 'Error' endif endif enddo 'PostMe SetFocusToEditClient' return RetVal /* ; --------------------------------------------------------------------------- ; Sample command that uses the old list box function defc listdemo select = ListBox( 'My List', '/Bryan/Jason/Jerry Cuomo/Ralph/Larry/Richard/'); if select == '' then 'SayError Nothing Selected' else 'SayError List box selection = "'select'"' endif ; --------------------------------------------------------------------------- ; Sample command that uses the new list box function defc listdemo2 sayerror 'Selected entry 3; default button 2; help panel 9300.' selectbuf = ListBox( 'My List', '/One/Two/Three', '/Go to/Delete/Cancel/Help', 0, 0, 0, 0, GethWndC( APP_HANDLE) || atoi( 3) || atoi( 2) || atoi( 9300) || 'Prompt text'); -- Parse return string parse value selectbuf with Button 2 Select \0 Button = asc( Button) if Button = 0 then 'SayError Nothing selected' else 'SayError Button' Button 'was pressed; string =' Select endif */ ; --------------------------------------------------------------------------- /* ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ³ ³ ³ What's it called: Listbox_Buffer_From_File ³ ³ ³ ³ What does it do : Inserts contents of a temp file into a buffer, ready for ³ ³ a call to listbox(). Quits the source file. Returns '' ³ ³ if no problems. ³ ³ ³ ³ startfid - the starting fileid to which we return ³ ³ bufhndl - (output) the buffer handle ³ ³ noflines - (output) number of lines inserted in buffer ³ ³ usedsize - (output) amount of space used in the buffer ³ ³ ³ ³ Who and when : Larry Margolis 1994/08/29 ³ ³ ³ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ Larry Margolis */ ; o startfid can now be empty if activating a specified file should be ; suppressed. ; o buffer( PUTBUF) reads current file into a buffer. The first line is ; ignored to handle the empty line 'xcom e' added when creating a file. ; o This proc ensures now that the first line is empty. defproc ListBox_Buffer_From_File( startfid, var bufhndl, var noflines, var usedsize) -- Ensure that first line is empty. if textline( 1) <> '' then -- Insert an empty line before line 1. insertline '', 1 endif -- Check buffer size. buflen = filesize() + .last + 1 if buflen > MAXBUFSIZE then 'SayError 'LIST_TOO_BIG__MSG '(' buflen '>' MAXBUFSIZE ')' buflen = MAXBUFSIZE endif -- Create a private buffer. bufhndl = buffer( CREATEBUF, 'LISTBOX', buflen, 1) if not bufhndl then 'SayError CREATEBUF' ERROR_NUMBER__MSG RC return rc endif -- Copy lines of current file to the buffer. Omit line 1. noflines = buffer( PUTBUF, bufhndl, 1, 0, APPENDCR) buf_rc = rc -- Close temporary file and switch to the specified startfid. .modify = 0 'xcom quit' if startfid <> '' then activatefile startfid endif -- Check if lines were added. if not noflines then 'SayError PUTBUF' ERROR_NUMBER__MSG buf_RC return buf_RC endif -- Set buffer size var. usedsize = buffer( USEDSIZEBUF, bufhndl) ; --------------------------------------------------------------------------- /* ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ³Outdated description: ³ ³ What's it called: EntryBox ³ ³ ³ ³ What does it do : Creates an application-modal dialog box. ³ ³ The dialog box contains a entry field and 2 push buttons.³ ³ (Up to 4 as of EPM 5.21 / 5.50. See below.) ³ ³ ³ ³ hwnd - handle of owner window ³ ³ title - question to appear on dialog title bar ³ ³ x, y - coordinates of lower left of entry box ³ ³ if (0, 0) then centered to screen. ³ ³ cols - approximate number of cols in entry field ³ ³ in PM font characters ³ ³ max - maximum number of chars ³ ³ entry - entry field string returned ³ ³ ³ ³ Who and when : Gennaro (Jerry) Cuomo 4-89 ³ ³ ³ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ EPM 5.21 / 5.50 added some new features to the ETOOLKIT interface. Parameter 6 is used to expose this to the caller of EntryBox(). If present, it is a string consisting of: selected_button# || help_ID || handle || prompt. Larry Margolis / John Ponzo 6/91 Styles = param7 LAM: New feature for EPM 6.01a: Can pass entryfield styles as a 7th parameter. Primarily of interest for getting passwords: defc pw = pw = EntryBox( 'Enter Password', '', -- Buttons '', -- Entry text '', -- Cols '', -- Max len '', -- Return buffer 140) -- ES_UNREADABLE + ES_AUTOSCROLL + ES_MARGIN 'SayError Password = "'pw'"' SelectBuf = buffer for input (param6) and output (selectbuf) param6 = selected_button# || help_ID || handle || prompt o The help_ID must be specified as atoi( help_ID). o The handle should be specified as GethWndC( APP_HANDLE). o The help panel is opened via F1 or via the help button, - if the help panel exists in or was added to EPM.HLP, - if the help_ID was correctly specified (see the IPF source for the help ids) as atoi( help_ID), - if GethWndC( APP_HANDLE) was specified as handle. o If no help id exists in the .hlp file, specify atoi( 0). The handle can then be specified as atol( 0). o If a help_ID was specified, the last button works as help key, independent of its text. Example 1 buttons = '/'OK__MSG'/'CANCEL__MSG'/'HELP__MSG or '/'OK__MSG'/'CANCEL__MSG'/'HELP__MSG'/' param6 = atoi( 1) || atoi( 32115) || GethWndC( APP_HANDLE) || TREE_DIR_PROMPT__MSG Example 2 buttons = '/~Set/~Reset/'CANCEL__MSG param6 = atoi( 1) || atoi( 0) || atol( 0) || Text Parsing the returned buffer parse value EntryBox( ...) with SelectedButton 2 NewEntryText \0 SelectedButton = \1 for button #1, \2 for button #2, ... or SelectedButton = asc( SelectedButton) for numbers. PosFlag = '' | 0 | 1 o It's possible to change the centering of the entry box by using other values than 0 for x and y in dynalink32. That doesn't work as expected and has a side effect. o The flag was added for specifying if the dialog should open with at (x, y) = (128, 72) = col 17, 4.5 lines above the bottom line. Then PosFlag should be specified as 1. The default centered behavior can be specified with PosFlag = 0 or with omitting it. o Side efect: The right edge of the dialog is not painted correctly. That seem to depend on the max. lengths of title, prompt and entry. The texts may get invisible at the right edge. */ ; Syntax: entrybox title [,buttons][,entrytext][,cols][,maxchars][,param6][,entryfieldstyles][,posflag] defproc EntryBox( title) -- Ensure that the frame window is fully visible on the desktop. Otherwise -- the dialog is not painted correctly. MoveWindowToDesktop( getpminfo( EPMINFO_EDITFRAME)) title = title\0 nb = 2 -- default number of buttons if arg( 2) <> '' then -- button names were specified parse value arg( 2) with delim 2 but1 (delim) but2 (delim) but3 (delim) but4 (delim) if but1 <> '' then but1 = but1\0 else 'SayError EntryBox:' BUTTON_ERROR__MSG return 0 endif if but2 <> '' then but2 = but2\0 else but2 = ''\0 endif if but3 <> '' then but3 = but3\0 nb = 3 else but3 = ''\0 endif if but4 <> '' then but4 = but4\0 nb = 4 else but4 = ''\0 endif else but1 = \0 but2 = \0 but3 = \0 but4 = \0 endif if arg() >= 3 then entrytext = arg( 3)\0 else entrytext = \0 endif -- The dialog width can't be specified with this. It depends on the -- number of buttons, the length of the button texts and the length of -- entrytext. columns = arg( 4) -- width of entry field in approx. columns, no effect if columns < 0 then columns = 30 endif -- Max. number of chars = Max( maxchars, length( entrytext)) if arg() >= 5 & arg( 5) <> '' & arg( 5) <> 0 then maxchars = Max( 1, arg( 5), length( arg( 3))) else maxchars = 254 endif -- Null-terminate param6 -- In : selectbuf = atoi( selected_button#) || atoi( help_ID) || (handle = GethWndC( APP_HANDLE), for help only) || prompt if arg() > 5 then -- Out: selectbuf = (pressed_button# = asc( leftstr( selectbuf, 1))) || entrytext \0 selectbuf = leftstr( arg( 6), MAXCOL, \0) else selectbuf = copies( \0, MAXCOL) endif -- If different from 0 and specified, entry-field styles can be configured -- here. These are ES_ constants. See the example above and os2win.h. The -- hex. values should be specified as the sum of their dec. values. if arg() >= 7 & arg( 7) <> '' & arg( 7) <> 0 then styles = arg( 7) else styles = 0 endif -- PosFlag: Apparently only values 0 and 1 = different from 0 are handled if arg() >= 8 & arg( 8) <> '' & arg( 8) <> 0 then -- 1 = Dialog is positioned on the edit window, horizontaly -- centered and 4.5 lines above the bottom. -- Side effect: If the text is longer than the visible -- entry field, the right part of the dialog is cut. -- => This can't be used. posflag = 1 else -- 0 = Dialog is centered on the desktop. posflag = 0 endif call dynalink32( ERES_DLL, -- entry box control in EDLL dyna 'ENTRYBOX', -- function name GethWndC( EPMINFO_EDITFRAME)|| -- edit frame handle address( title) || -- atol( posflag) || -- (x coordinate) (0 = centered or any other value for x = 128) > mixed atol( posflag) || -- (y coordinate) (0 = centered or any other value for y = 72) > up? atol( columns) || -- (no effect) atol( maxchars) || -- (max. of maxchars and entrytext length) address( entrytext) || -- (optional text in entry field) atoi( nb) || -- Number of buttons, and atoi( styles) || -- styles: mpfrom2short( styles, nb) address( but1) || -- (optional button 1 text) address( but2) || -- (optional button 2 text) address( but3) || -- (optional button 3 text) address( but4) || -- (optional button 4 text) address( selectbuf)) -- return string buffer 'PostMe HighlightCursor' -- Parse return string parse value selectbuf with Button 2 Select \0 Button = asc( Button) RetVal = Select do once = 1 to 1 if arg( 6) then -- New way RetVal = selectbuf elseif Button = 0 | Button = 2 then -- Old way RetVal = '' elseif Button <> 1 then RetVal = Button else EOS = pos( \0, selectbuf, 2) -- chr( 0) signifies End Of String if not EOS then RetVal = 'Error' endif endif enddo 'PostMe SetFocusToEditClient' return RetVal ; --------------------------------------------------------------------------- -- Unused /* ; LineStr is parsed and values for Filename, Line, Col, SearchStr are ; returned. Vars for Filename, Line, Col, SearchStr must be specified, even ; when they are expected to be returned with empty values. ; Syntax of LineStr: ; ; () ; (,) ; / defproc DialogParseListBoxLine( LineStr, var Filename, var Line, var Col, var SearchStr) do once = 1 to 1 Filename = '' Line = '' Col = '' SearchStr = '' LineStr = strip( LineStr) if leftstr( LineStr, 1) = '"' then parse value LineStr with '"'Filename'"' '('PosStr')' else parse value LineStr with Filename '('PosStr')' endif if PosStr <> '' then parse value PosStr with Line','Col Filename = strip( Filename) Line = strip( Line) Col = strip( Col) leave endif if leftstr( LineStr, 1) = '"' then parse value LineStr with '"'Filename'"' '/'SearchStr else parse value LineStr with Filename '/'SearchStr endif if SearchStr <> '' then Filename = strip( Filename) SearchStr = strip( SearchStr) leave endif enddo return */ ; --------------------------------------------------------------------------- ; This passes its args to either Open or Edit, depending on the pressed ; Ctrl key. Being a defc, it allows for posting. defc DialogLoadFile EditArgs = strip( arg( 1)) -- Must check the filename in EditArgs, not current file. This is also -- executed on loading a file from history. if leftstr( EditArgs, 1) = '"' then parse value EditArgs with '"'LoadName'"' "'"LoadCmd"'" else parse value EditArgs with LoadName "'"LoadCmd"'" endif if leftstr( LoadName, 1) = '.' then if LoadName <> .filename then -- Switch to it pActivateFile( LoadName) endif if LoadCmd <> '' then LoadCmd endif elseif CtrlIsDown() then Cmd = 'Open' Cmd EditArgs else Cmd = 'Edit' Cmd EditArgs endif ; --------------------------------------------------------------------------- ; This loads or activates a background bitmap. Checks for valid filename ; added, because otherwise initialization on EPM's startup would stop on a ; non-valid OS/2 file. defc Load_Dt_Bitmap universal bm_filename universal bitmap_present BmpFile = arg( 1) if BmpFile = '' then -- load default file elseif substr( BmpFile, 2, 2) = ':\' & IsOs2Bmp( BmpFile) then -- if fully qualified and valid -- load specified file else 'SayError Filename for background bitmap not valid' BmpFile = '' -- load default file endif if BmpFile = '' then -- load the default bitmap call windowmessage( 0, getpminfo( EPMINFO_EDITCLIENT), 5454, 0, 0) else -- load an external bitmap call windowmessage( 0, getpminfo( EPMINFO_EDITCLIENT), 5499, -- EPM_EDIT_SETDTBITMAPFROMFILE put_in_buffer( BmpFile), 0) endif bm_filename = BmpFile bitmap_present = 1 ; --------------------------------------------------------------------------- ; Doesn't work with eCS, ...? /* defc drop_bitmap, drgdrptyp_Bitmap, dragdrop_bmp universal bm_filename parse arg x y bm_filename 'Load_Dt_Bitmap' bm_filename */ ; --------------------------------------------------------------------------- defc SetBackgroundBitmap universal bitmap_present universal bm_filename universal app_hini universal appname arg1 = strip( arg( 1)) fSetBmp = 0 fNewBmp = 0 if upcase( arg1) = 'SELECT' then BitmapDir = '' if bm_filename > '' then lp = lastpos( '\', bm_filename) BitmapDir = substr( bm_filename, 1, lp - 1) endif if NepmdDirExists( BitmapDir) <> 1 then BootDrive = NepmdQuerySysInfo( 'BOOTDRIVE') BitmapDir = BootDrive'\os2\bitmap' endif 'FileDlg Select a background bitmap file, SetBackgroundBitmap, 'BitmapDir'\*.bmp' return elseif wordpos( upcase( arg1), '0 OFF') then bitmap_present = 0 fSetBmp = 1 elseif wordpos( upcase( arg1), '1 ON') then bitmap_present = 1 fSetBmp = 1 elseif wordpos( upcase( arg1), 'TOGGLE') then bitmap_present = not bitmap_present fSetBmp = 1 else fNewBmp = 1 endif if fSetBmp then if bitmap_present then -- activate it 'Load_Dt_Bitmap' bm_filename else -- deactivate it call windowmessage( 0, getpminfo( EPMINFO_EDITCLIENT), 5498, 0, 0) endif endif if fNewBmp then 'Load_Dt_Bitmap' arg( 1) if bitmap_present then KeyPath = '\NEPMD\User\Appearance\BackgroundBitmap\Filename' call WriteConfigKey( KeyPath, bm_filename) endif endif if fSetBmp | fNewBmp then KeyPath = '\NEPMD\User\Appearance\BackgroundBitmap' call WriteConfigKey( KeyPath, bitmap_present) endif ; --------------------------------------------------------------------------- defproc IsOs2Bmp SigList = 'BMP BM BA' ret = 0 Filename = arg( 1) if upcase( GetFileSpec( 'E', Filename)) = 'BMP' then Result = CheckSig( Filename, SigList) if Result = 1 then ret = 1 elseif rc <> 0 then --'SayError CheckSig returned rc = 'rc endif endif return ret ; --------------------------------------------------------------------------- defproc QueryControl( controlid) return windowmessage( 1, getpminfo( EPMINFO_EDITCLIENT), -- Send message to edit client 5388, -- EPM_EDIT_CONTROLTOGGLE controlid, 1) ; --------------------------------------------------------------------------- defc CursorOff call CursorOff() -- Turn cursor off ; --------------------------------------------------------------------------- defproc CursorOff -- Turn cursor off 'togglecontrol 14 0' -- doesn't work in current EPM ; --------------------------------------------------------------------------- ; Trim window so it's an exact multiple of the font size. defc Trim call WindowSize1( .windowheight, .windowwidth, 0, 0, 1) ; EPM bug: ; o During startup, before file loading, .windowwidth, .windowheight and ; .fontwidth are not set correctly. During defmain, after initialization, ; they have alternating values. That's why Trim and WindowSize1 can't be ; used at that point. It works later. ; o See MAIN.E for a workaround with NepmdQueryWindowPos and ; NepmdSetFrameWindowPos. ; --------------------------------------------------------------------------- defc WindowSize1 parse arg row col x y flag junk if x = '' | junk <> '' then 'SayError -263' -- Invalid argument else call WindowSize1( row, col, x, y, flag) endif ; --------------------------------------------------------------------------- defproc WindowSize1( row, col, x, y) if upcase( leftstr( row, 1)) = 'P' then -- Already in pels cy = substr( row, 2) else cy = .fontheight * row -- convert row into y coordinate in pels endif if upcase( leftstr( col, 1)) = 'P' then -- Already in pels cx = substr( col, 2) else cx = .fontwidth * col -- convert col into x coordinate in pels endif if arg( 5) <> '' then opts = arg( 5) else opts = 3 -- Default = SWP_SIZE ( 1) + SWP_MOVE ( 2) endif if opts // 2 then -- Don't bother calculating unless SWP_SIZE on swp1 = copies( \0, 36) swp2 = swp1 call dynalink32( 'PMWIN', '#837', GethWndC( EPMINFO_EDITCLIENT) || address( swp1)) call dynalink32( 'PMWIN', '#837', GethWndC( EPMINFO_EDITFRAME) || address( swp2)) cx = cx + ltoa( substr( swp2, 9, 4), 10) - ltoa( substr( swp1, 9, 4), 10) cy = cy + ltoa( substr( swp2, 5, 4), 10) - ltoa( substr( swp1, 5, 4), 10) endif call dynalink32( 'PMWIN', '#875', GethWndC( EPMINFO_EDITFRAME) || atol( 3) || /* HWND_TOP */ atol( x) || atol( y) || atol( cx) || atol( cy) || atol( opts)) /* SWP_MOVE | SWP_SIZE */ ; --------------------------------------------------------------------------- ; - This accepts arg( 1) = flag for JustInstalled (1 or other). ; - It trims the frame window size to full cols and lines. That avoids some ; scrolling on moving the cursor. ; - It checks if the frame window is completely outside of the desktop and ; then retrieves the frame window. ; - On retrieving the frame window or if JustInstalled, the frame window ; is centered on the desktop. defc TrimFrameWindow JustInstalled = (strip( arg( 1)) = 1) -- Query window pos. and size -- (Desktop workarea would require to use the undocumented PMMERGE.5469 -- function WinQueryDesktopWorkarea. See XWP for that.) cxd = NepmdQuerySysInfo( 'CXSCREEN') cyd = NepmdQuerySysInfo( 'CYSCREEN') FramePos = NepmdQueryWindowPos( EPMINFO_EDITFRAME) ClientPos = NepmdQueryWindowPos( EPMINFO_EDITCLIENT) parse value FramePos with xf yf cxf cyf parse value ClientPos with xc yc cxc cyc dcx = cxf - cxc dcy = cyf - cyc Flag = 3 -- Change pos. and size -- New frame window size -- EPM bug: Sometimes .fontwidth is set to 3. -- Ignore small sizes: if .fontwidth > 3 then -- Trim window so it's an exact multiple of the font size. This should -- avoid scrolling caused by temp. cursor pos. changes and restore. KeyPath = '\NEPMD\User\EditWindow\MaxCols' MaxCols = QueryConfigKey( KeyPath) if MaxCols > 0 then -- Limit edit window width to MaxCols and trim to full cols Newcxc = Min( MaxCols, cxc % .fontwidth) * .fontwidth else -- Trim to full cols Newcxc = (cxc % .fontwidth) * .fontwidth endif -- Trim to full lines Newcyc = (cyc % .fontheight) * .fontheight -- New frame window width and height Newcxf = Newcxc + dcx Newcyf = Newcyc + dcy else -- Keep old frame window size Flag = Flag - 1 Newcxf = cxf Newcyf = cyf endif -- New frame window pos. -- Check if frame window is completely out of the desktop fOutside = 0 do once = 1 to 1 -- Right frame window edge if xf + Newcxf < 0 then fOutside = 1 -- Left frame window edge elseif xf > cxd then fOutside = 1 -- Bottom frame window edge elseif yf > cyd then fOutside = 1 -- Top frame window edge elseif yf + Newcyf < 0 then fOutside = 1 endif enddo if fOutside | JustInstalled then -- Limit frame window size to the desktop size Newcxf = Min( cxd, Newcxf) Newcyf = Min( cyd, Newcyf) -- Center frame window Newxf = Max( 0, cxd - Newcxf) / 2 Newyf = Max( 0, cyd - Newcyf) / 2 else -- Keep frame window pos. Flag = Flag - 2 Newxf = xf Newyf = yf endif -- Set new frame window pos. and/or size if Flag > 0 then call NepmdSetFrameWindowPos( Newxf, Newyf, Newcxf, Newcyf, Flag) endif ; --------------------------------------------------------------------------- ; arg( 1) = number. Opens dialog if no arg. defc LimitEditWindowWidth universal menuloaded do once = 1 to 1 KeyPath = '\NEPMD\User\EditWindow\MaxCols' CurNum = QueryConfigKey( KeyPath) Num = strip( arg( 1)) if IsNum( Num) then NewNum = Num if NewNum = 0 then call DeleteConfigKey( KeyPath) else call WriteConfigKey( KeyPath, NewNum) endif else Title = 'Maximal window width on start' Buttons = '/~Set/~Reset/'CANCEL__MSG Text = 'Width in columns. Specify 0 for no limitation.' Text = Text''copies( ' ', Max( 0, 100 - length( Text))) Entry = CurNum parse value EntryBox( Title, Buttons, Entry, 0, 240, atoi( 1) || atoi( 0) || atol( 0) || Text) with Button 2 NewNum \0 -- Parse return string Button = asc( Button) NewNum = strip( NewNum) if Button = 1 then if NewNum <> CurNum then if IsNum( NewNum) then call WriteConfigKey( KeyPath, NewNum) else 'SayError Max. number of cols not changed.' endif endif elseif Button = 2 then call DeleteConfigKey( KeyPath) NewNum = '' else leave endif endif if menuloaded & NewNum <> CurNum then CurNum = QueryConfigKey( KeyPath) Text = GetConditionalMenuText( 'startwithmaxcols', CurNum) SetMenuVarTextFromText( 'startwithmaxcols', Text, CurNum) endif enddo ; --------------------------------------------------------------------------- compile if 0 -- Unused, so don't waste space. LAM defc QControl if QueryControl( arg( 1)) then 'SayError control on' else 'SayError control off' endif compile endif ; --------------------------------------------------------------------------- ; Opens a dialog to edit and apply font styles. ; This dialog uses several callback commands that are defined below. defc FontList call windowmessage( 0, getpminfo( APP_HANDLE), 5130, -- EPM_POPFONTDLG Put_In_Buffer( queryfont( .font)'.'Trunc( .textcolor // 16)'.'.textcolor % 16), 0) ; --------------------------------------------------------------------------- /* ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ³ what's it called: commandline syntax: commandline [optional text] ³ ³ ³ ³ what does it do : ask EPM.EXE to pop up its internal commandline control. ³ ³ This is done by posting a EPM_POPCMDLINE message to the ³ ³ EPM Book window. ³ ³ An optional string of text can be specified. If a string³ ³ is specified then it will be inserted on the command line³ ³ ³ ³ (All EPM_EDIT_xxx messages are defined in the ETOOLKT ³ ³ PACKAGE available on PCTOOLS.) ³ ³ ³ ³ who and when : Jerry C. 2/27/89 ³ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ */ defc CommandLine -- The application will free the buffer allocated by this macro parse arg cmd -- try to keep trailing spaces 'VSyncCursor' call windowmessage( 0, getpminfo( APP_HANDLE), 5124, -- EPM_POPCMDLINE 0, Put_In_Buffer( cmd)) -- trailing spaces are always stripped before execution ; --------------------------------------------------------------------------- /* ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ³ what's it called: PostCmdToEditWindow( cmd, winhandle [, mp2 [, buflg]] ) ³ ³ ³ ³ what does it do : ask EPM.EXE to post a command to an edit window. MP2 is ³ ³ optional MP2 for the WinPostMsg. Default is 1 (EPM ³ ³ should free the command buffer). 4 means process ³ ³ synchronously (not safe), and 8 means that EPM should do ³ ³ a DosGetBuf to get the buffer. Optional 4th argument is ³ ³ passed to put_in_buffer (flag for DosAllocSeg; see ³ ³ put_in_buffer routine for details). ³ ³ ³ ³ who and when : Larry M. 7/23/90 ³ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ */ defproc PostCmdToEditWindow( cmd, winhndl) if arg( 3) <> '' then mp2 = arg( 3) else mp2 = 1 endif call windowmessage( 0, winhndl, 5377, -- EPM_EDIT_COMMAND Put_In_Buffer( cmd, arg( 4)), mp2) ; --------------------------------------------------------------------------- /* ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ³ what's it called: PostMe syntax: PostMe command ³ ³ ³ ³ what does it do : Ask EPM.EXE to post a command to the current edit window.³ ³ Useful if you want to send a command on an OPEN but ³ ³ don't want to tie up the main queue while the command is ³ ³ executing. By posting the command back to the window, ³ ³ it will execute from the EI queue, and not keep everyone ³ ³ else waiting. ³ ³ ³ ³ Example of usage: ³ ³ "open 'PostMe long_running_command'" ³ ³ ³ ³ who and when : Larry M. 89/08/14 ³ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ */ defc PostMe -- Workaround for posted '*defload*' commands: Execute 'AtNextLoad' -- instead of 'postme', because 'postme' causes a defload action being -- executed at the following defselect only. Applies to e.g. TeX Front -- End's defload. if pos( 'DEFLOAD', upcase( arg( 1))) then 'AtNextLoad' arg( 1) else call PostCmdToEditWindow( arg( 1), getpminfo( EPMINFO_EDITCLIENT)) --dprintf( 'POSTME', 'arg( 1) = 'arg( 1)) endif ; See also: HOOKS.E:"defc AfterStartup" ; --------------------------------------------------------------------------- defc PostTo parse arg hwnd Cmd Cmd = strip( Cmd) call PostCmdToEditWindow( Cmd, hwnd) ; --------------------------------------------------------------------------- ; This is not used. /* ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ³ what's it called: buffer_command syntax: buffer_command buff_address ³ ³ ³ ³ what does it do : Executes the command that's stored in the buffer, then ³ ³ frees the buffer. Useful if you want to send a command ³ ³ to another window but don't want to worry about length ³ ³ or invalid characters. ³ ³ ³ ³ Example of usage: ³ ³ 'open buffer_command' put_in_buffer( cmd_string) ³ ³ ³ ³ who and when : Larry M. 91/09/03 ³ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ */ defc Buffer_Command parse arg buff . if not buff then -- Null pointer = no command return endif buffer_long = atol( buff) peekz( buffer_long) -- Get the command from the buffer, & execute it call dynalink32( 'DOSCALLS', -- Dynamic link library name '#304', -- Dos32FreeMem buffer_long) ; --------------------------------------------------------------------------- ; This is not used. defc Buff_Link parse arg buff . if not buff then return endif rc = dynalink32( 'DOSCALLS', '#302', -- Dos32GetSharedMem atol( buff) || -- Base address atol( 1)) -- PAG_READ if rc then MessageNWait( 'DosGetSharedMem' ERROR__MSG rc) endif buff_ofs = 4 buff_len = ltoa( peek32( buff, 0, 4), 10) do while buff_len > buff_ofs link_file = peekz32( buff, buff_ofs) if upcase( link_file) <> 'EPM.EX' then if linked( link_file) < 0 then -- Not already linked 'linkverify' link_file endif endif buff_ofs = buff_ofs + length( link_file) + 1 -- +1 for ASCIIZ null enddo ; --------------------------------------------------------------------------- ; This us used to allocate mem for a buffer and to copy an E string to it. ; E strings are limitted to 1600 B only, so larger buffers don't make sense. defproc Put_In_Buffer( String) if String = '' then return 0 endif StringLen = length( String) if arg( 2) = '' then ShareFlags = 83 -- PAG_READ | PAG_WRITE | PAG_COMMIT | OBJ_TILE else ShareFlags = arg( 2) endif -- Initialize string pointer StringBuffer = '????' -- 4 digits = max. 64 KiB = 16 bit rcx = dynalink32( 'DOSCALLS', -- Dynamic link library name '#299', -- Dos32AllocMem address( StringBuffer) || atol( StringLen + 1) || -- Number of bytes requested atol( ShareFlags)) if rcx then 'SayError 'ERROR__MSG rcx ALLOC_HALTED__MSG stop endif StringBuffer = itoa( substr( StringBuffer, 3, 2), 10) poke StringBuffer, 0, String -- Copy string to new allocated buf poke StringBuffer, length( String), \0 -- Add a null at the end return MpFrom2Short( StringBuffer, 0) -- Return a long pointer to buffer ; --------------------------------------------------------------------------- ; This command opens a dialog with the past messages. /* ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ³ what's it called: messagebox syntax: messagebox [optional string] ³ ³ ³ ³ what does it do : ask EPM.EXE to pop up its internal message box control. ³ ³ This is done by posting a EPM_POPMSGBOX message to the ³ ³ EPM Book window. ³ ³ An optional string of text can be specified. If a ³ ³ string is specified then it will be inserted into the ³ ³ message box. ³ ³ ³ ³ (All EPM_EDIT_xxx messages are defined in the ETOOLKT ³ ³ PACKAGE available on PCTOOLS.) ³ ³ ³ ³ who and when : Jerry C. 2/27/89 ³ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ */ ; The application will free the buffer allocated by this macro. defc MessageBox call windowmessage( 0, getpminfo( APP_HANDLE), 5125, -- EPM_POPMSGBOX 0, Put_In_Buffer( arg( 1))) 'PostMe HighlightCursor' ; --------------------------------------------------------------------------- ; Unused (with WPS anyway) /* ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ³ what's it called: processdragdrop ³ ³ ³ ³ what does it do : this defc is automatically called by the ³ ³ toolkit when a drag drop event is successfully made ³ ³ ³ ³ what are the args: cmdid = 1 - epm edit window ³ ³ 2 - File icon window (self) ³ ³ 3 - epm book icon ³ ³ 4 - system editor ³ ³ 5 - File Manager folder ³ ³ 10 - Print manager ³ ³ ³ ³ hwnd = handle of target window's frame ³ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ */ defc ProcessDragDrop parse arg cmdid hwnd --dprintf( 'ProcessDragDrop', 'cmdid = 'cmdid', hwnd = 'hwnd) ; hwnd = atol_swap( hwnd) if cmdid = 10 then call windowmessage( 0, getpminfo( APP_HANDLE), 5144, -- EPM_PRINTDLG hwnd = 'M', 0) elseif cmdid = 1 and hwnd <> getpminfo( EPMINFO_EDITFRAME) and leftstr( .filename, 1) <> '.' then call PostCmdToEditWindow( 'e '.filename, hwnd, 9, 2) -- Get-able elseif cmdid = 3 then if .filename = GetUnnamedFilename() then name = '' else name = .filename endif call windowmessage( 0, getpminfo( APP_HANDLE), 5386, -- EPM_EDIT_NEWFILE Put_In_Buffer( name, 2), -- share = GETable 9) -- EPM does a GET first & a FREE after. elseif cmdid = 4 then call WinMessageBox( SYS_ED__MSG, SYS_ED1__MSG\10 || ' :-)', 16406) -- CANCEL + ICONQUESTION + MB_MOVEABLE elseif cmdid = 5 then str = leftstr( '', MAXCOL) len = dynalink32( 'PMWIN', '#841', -- 'WINQUERYWINDOWTEXT', atol( hwnd) || atol( MAXCOL) || address( str), 2) p = lastpos( '\', leftstr( str, len)) if p then str = leftstr( str, p)' = ' call parse_filename( str, .filename) if Exist( str) then if 1 <> WinMessageBox( str, EXISTS_OVERLAY__MSG, 16417) then -- OKCANCEL + CUANWARNING + MOVEABLE return -- 1 = MB OK endif endif 'Save' str if not rc then 'SayError 'SAVED_TO__MSG str endif else call WinMessageBox( '"'leftstr( str, len)'"', NO_SLASH__MSG, 16406) -- CANCEL + ICONQUESTION + MB_MOVEABLE endif endif ; --------------------------------------------------------------------------- /* ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ³ what's it called: Repaint_Window ³ ³ ³ ³ what does it do : send a paint message to the editor. ³ ³ ³ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ */ defproc Repaint_Window call windowmessage( 0, getpminfo( EPMINFO_EDITCLIENT), 35, -- WM_PAINT 0, 0) ; --------------------------------------------------------------------------- /* ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ³ what's it called: ShowWindow ³ ³ ³ ³ what does it do : allows the edit window to become invisible or visible ³ ³ ³ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ */ defproc ShowWindow -- post the EPM_EDIT_SHOW message call windowmessage( 0, getpminfo( EPMINFO_EDITCLIENT), 5385, upcase( arg( 1)) <> 'OFF', -- 0 if OFF, else 1 0) ; --------------------------------------------------------------------------- /* ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ³ what's it called: WinMessageBox ³ ³ ³ ³ what does it do : This routine issues a PM WinMessageBox call and returns ³ ³ the result. ³ ³ ³ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ */ ; Style: ; -- Constants for WinMessageBox ; MB_OK = 0 -- Pick one of the following for the ; MB_OKCANCEL = 1 -- buttons you want on the message box ; MB_RETRYCANCEL = 2 ; MB_ABORTRETRYIGNORE = 3 ; MB_YESNO = 4 ; MB_YESNOCANCEL = 5 ; MB_CANCEL = 6 ; MB_ENTER = 7 ; MB_ENTERCANCEL = 8 ; ; MB_NOICON = 0 -- Add one of the following for the ; MB_CUANOTIFICATION = 0 -- icon you want in the message box ; MB_ICONQUESTION = 16 ; MB_ICONEXCLAMATION = 32 ; MB_CUAWARNING = 32 ; MB_ICONASTERISK = 48 ; MB_ICONHAND = 64 ; MB_CUACRITICAL = 64 ; MB_QUERY = MB_ICONQUESTION ; MB_WARNING = MB_CUAWARNING ; MB_INFORMATION = MB_ICONASTERISK ; MB_CRITICAL = MB_CUACRITICAL ; MB_ERROR = MB_CRITICAL ; ; MB_DEFBUTTON1 = 0 -- This specifies which button is the ; MB_DEFBUTTON2 = 256 -- default if Enter is pressed. ; MB_DEFBUTTON3 = 512 ; ; MB_APPLMODAL = 0000 -- Application modal ; MB_SYSTEMMODAL = 4096 -- System modal ; MB_HELP = 8192 ; MB_MOVEABLE = 16384 -- The message box can be moved. ; ; Returns the id of the pressed button: ; MBID_OK = 1 -- Message box return codes ; MBID_CANCEL = 2 -- (correspond with the button pressed) ; MBID_ABORT = 3 ; MBID_RETRY = 4 ; MBID_IGNORE = 5 ; MBID_YES = 6 ; MBID_NO = 7 ; MBID_HELP = 8 ; MBID_ENTER = 9 ; MBID_ERROR = 65535 defproc WinMessageBox( Title, Text) if arg( 3) then Style = arg( 3) else Style = MB_OK + MB_NOICON * MB_DEFBUTTON1 + MB_APPLMODAL + MB_MOVEABLE endif -- The appending of a null char must be processed before the DLL call: Title = Title\0 Text = Text\0 Button = dynalink32( 'PMWIN', '#789', -- WinMessageBox atol( 1) || -- Parent GethWndC( EPMINFO_EDITFRAME) || -- edit frame handle address( Text) || address( Title) || atol( 0) || -- Window atol( Style)) 'PostMe HighlightCursor' return Button ; --------------------------------------------------------------------------- ; Syntax: 'ErrorMsgBox ErrorTitle,ErrorText' ; Leading and trailing spaces are stripped. ; Allow for opening an error MsgBox from REXX. defc ErrorMsgBox parse arg ErrorTitle','ErrorText ErrorTitle = strip( ErrorTitle) ErrorText = strip( ErrorText) call NepmdErrorMsgBox( ErrorText, ErrorTitle) 'PostMe HighlightCursor' ; --------------------------------------------------------------------------- defc InfoMsgBox parse arg Title','Text Title = strip( Title) Text = strip( Text) Style = MB_OK + MB_INFORMATION + MB_DEFBUTTON1 + MB_MOVEABLE Button = WinMessageBox( Title, Text, Style) ; --------------------------------------------------------------------------- defproc MpFrom2Short( MpHigh, MpLow) return ltoa( atoi( MpLow)''atoi( MpHigh), 10) ; --------------------------------------------------------------------------- ; Returns the edit window handle as a 4-byte hex string. ; Usually GetHWndC is used. GetHWnd is only used by the outdated ftpload and ; ftpsave commands. ; ; String handling in E language ; EdithWnd = '1235:1234' <- Address in string form ; atol( EdithWnd) = '11GF' <- Four byte pointer, represented ; as its ascii character equivalent. ; Flipping (substr( ...)) <- Places 4 bytes in correct order. ; Note: 2-byte vars are converted with atoi ie. USHORT ; Note: 4-byte vars are converted with atol ie. HWND,HAB defproc GethWnd( w) --EditHwnd = getpminfo( w) -- get edit window handle -- o get edit window handle -- o convert string to string pointer -- o interchange upper two bytes with lower two bytes. (flip words) return atol_swap( getpminfo( w)) ; --------------------------------------------------------------------------- defproc GethWndC( w) return atol( getpminfo( w)) ; --------------------------------------------------------------------------- ; popbook doesn't work in EPM 6.03b /* defc PopBook call windowmessage( 0, getpminfo( APP_HANDLE), 13, -- WM_ACTIVATE 1, getpminfo( APP_HANDLE)) */ ; --------------------------------------------------------------------------- defc PrintDlg call windowmessage( 0, getpminfo( APP_HANDLE), 5144, -- EPM_PRINTDLG arg( 1) = 'M', 0) ; --------------------------------------------------------------------------- defc PrintFile if arg( 1) <> '' then 'xcom Save /s /ne' arg( 1) -- Save the file to the printer endif ; --------------------------------------------------------------------------- defc Process_QPrint universal vEPM_POINTER if arg( 1) = '' then 'SayError 'PRINTER__MSG /*printername*/ NO_QUEUE__MSG else mouse_setpointer WAIT_POINTER qprint arg( 1) mouse_setpointer vEPM_POINTER endif ; --------------------------------------------------------------------------- ; Flags ; F = File ; M 1 = marked area (default = entire file) ; ! 2 = print immediately; don't wait for print dialog's OK ; 4 = queue name given ; 8 = PRINTOPTS structure given (binary structure; can't be done via this cmd) ; (6.03a or above, only) defc QPrint parse arg what queue_name w = wordpos( upcase( what), 'M M! F F! !') if w then flags = word( '1 3 0 2 2', w) else -- Not a flag; queue_name = arg( 1) -- assume part of the queue name flags = 0 -- and use default options. endif if queue_name <> '' then flags = flags + 4; endif call windowmessage( 0, getpminfo(APP_HANDLE), 5144, -- EPM_PRINTDLG flags, Put_In_Buffer( queue_name)) ; --------------------------------------------------------------------------- defc IbmMsg ever = EVERSION if \0 = rightstr( EVERSION, 1) then ever = leftstr( EVERSION, length( eversion) - 1) endif call WinMessageBox( EDITOR__MSG, EDITOR_VER__MSG ver( 0)\13 || MACROS_VER__MSG ever\13\13 || COPYRIGHT__MSG, 16384) ; --------------------------------------------------------------------------- defproc LoadVersionString( var buff, var modname) hmodule = \0\0\0\0 if arg( 3) then modname = arg( 3)\0 rc = dynalink32( 'DOSCALLS', '#318', -- Dos32LoadModule atol( 0) || -- Buffer address atol( 0) || -- Buffer length address( modname) || address( hmodule)) endif buff = copies( \0, 255) res = dynalink32( 'PMWIN', '#781', -- Win32LoadString GethWndC( EPMINFO_HAB) || hmodule || -- NULLHANDLE atol( 65535) || -- IDD_BUILDDATE atol( length( buff)) || address( buff), 2) buff = leftstr( buff, res) if arg( 3) then modname = copies( \0, 260) call dynalink32( 'DOSCALLS', -- dynamic link library name '#320', -- DosQueryModuleName hmodule || -- module handle atol( length( modname)) || -- Buffer length address( modname)) -- Module we've loading call dynalink32( 'DOSCALLS', '#322', -- Dos32FreeModule hmodule) parse value modname with modname \0 endif ; --------------------------------------------------------------------------- defc VersionCheck -- Get EPM.EXE build date LoadVersionString( buff, modname) -- Get ETKEnnn.DLL build date LoadVersionString( buffe, modname, E_DLL) -- Get ETKRnnn.DLL build date LoadVersionString( buffr, modname, ERES2_DLL) -- Get ETKRnnn.DLL build date LoadVersionString( buffc, modname, ERES_DLL) /* -- Get EPMMRI.DLL build date LoadVersionString( buffm, modname, 'EPMMRI') */ call WinMessageBox( 'EPM Build', EDITOR_VER__MSG ver( 0)\13 || MACROS_VER__MSG EVERSION\13 || '('wheredefc( 'versioncheck')')'\13\13 || 'EPM.EXE' buff\13 || E_DLL'.DLL' buffe\13 || ERES2_DLL'.DLL' buffr\13 || ERES_DLL'.DLL' buffc\13 || /*'EPMMRI.DLL' buffm\13*/\13 || COPYRIGHT__MSG, 16384) ; --------------------------------------------------------------------------- ; Example output to .EPM Build: ; Editor version 6.03b ; Macros version 6.03b ; (F:\APPS\NEPMD\MYEPM\EX\EPM.EX) ; ; EPM.EXE (C:\OS2\APPS\EPM.EXE) ; ETKE603.DLL (F:\APPS\NEPMD\MYEPM\DLL\ETKE603.DLL) ; ETKR603.DLL (C:\OS2\APPS\DLL\ETKR603.DLL) ; ETKC603.DLL (C:\OS2\APPS\DLL\ETKC603.DLL) defc VersionCheck_File 'xcom e /c /q tempfile' if rc <> -282 then -- sayerror( 'New file') 'SayError 'ERROR__MSG rc BAD_TMP_FILE__MSG sayerrortext( rc) return endif .autosave = 0 .filename = ".EPM Build" browse_mode = browse() -- query current state if browse_mode then call browse( 0) endif insertline EDITOR_VER__MSG ver( 0), 1 insertline MACROS_VER__MSG EVERSION, 2 insertline '('wheredefc( 'versioncheck')')', 3 LoadVersionString( buff, modname) insertline 'EPM.EXE ' buff '('find_epm_exec()')', .last + 1 LoadVersionString( buff, modname, E_DLL) insertline E_DLL'.DLL' buff '('modname')', .last + 1 LoadVersionString( buff, modname, ERES2_DLL) insertline ERES2_DLL'.DLL' buff '('modname')', .last + 1 LoadVersionString( buff, modname, ERES_DLL) insertline ERES_DLL'.DLL' buff '('modname')', .last + 1 /* LoadVersionString( buff, modname, 'ETKUCMS') insertline 'ETKUCMS.DLL' buff '('modname')', .last + 1 LoadVersionString( buff, modname, 'EPMMRI') insertline 'EPMMRI.DLL' buff '('modname')', .last + 1 */ .modify = 0 if browse_mode then call browse( 1) endif ; --------------------------------------------------------------------------- ; Allow other (maybe linked) packages to query the macro version of EPM.E. ; Used by NepmdInfo. ; Example: 6.03b defproc GetEVersion return EVERSION ; --------------------------------------------------------------------------- ; Allow other (maybe linked) packages to query the version of NEPMD. ; Used by NepmdInfo. ; Example: 1.21 defproc GetNepmdVersion return NEPMD ; --------------------------------------------------------------------------- ; Returns the ISO date of the EPM loader. ; Used by NepmdInfo to compare versions. defproc GetEpmLoaderDate EpmLoader = NepmdScanEnv( 'NEPMD_LOADEREXECUTABLE') MDateTime = NepmdQueryPathInfo( EpmLoader, 'MTIME') parse value MDateTime with MDate MTime return MDate ; --------------------------------------------------------------------------- defproc Find_Epm_Exec pib = 1234 tid = 1234 call dynalink32( 'DOSCALLS', -- dynamic link library name '#312', -- ordinal value for DOS32GETINFOBLOCKS address( tid) || address( pib), 2) return peekz( peek32( ltoa( pib, 10), 12, 4)) ; --------------------------------------------------------------------------- defc CheckNepmdVersion parse value DateTime() with CurDate CurTime KeyPath = '\NEPMD\Var\VersionCheck' parse value QueryConfigKey( KeyPath'\CheckDateTime') with LastDate LastTime do once = 1 to 1 fQuery = 0 -- Compare ISO datetimes DiffDays = DateTimeDiff( LastDate LastTime, CurDate CurTime, 'd') if DiffDays >= 1 then fQuery = 1 endif --dprintf( 'CheckNepmdVersion: fQuery = 'fQuery) if fQuery then CheckResult = 1 -- 1 = failure, default value call WriteConfigKey( KeyPath'\Result', CheckResult) WgetCmd = '' do once2 = 1 to 1 Wget = FindTool( 'wget.exe') if Wget = '' then call EditNepmdVersionLine( 'wget not found. See tools below') leave endif KeyPathCheckUrl = '\NEPMD\User\VersionCheck\CheckUrl' CheckUrl = QueryConfigKey( KeyPathCheckUrl) p1 = lastpos( '/', CheckUrl) Name = substr( CheckUrl, p1 + 1) -- Write Url to UrlFile UrlFile = GetTmpDir()'\nepmd\tmp.url' call WriteFile( UrlFile, CheckUrl) TmpFile = GetTmpPath()''Name EnqTmpFile = EnquoteFileSpec( TmpFile) if Exist( TmpFile) then call EraseTemp( TmpFile) endif KeyPath = '\NEPMD\User\Tools' WgetTemplate = QueryConfigKey( KeyPath'\wget\Template') WgetCall = ExpandTemplate( WgetTemplate, 'uf='UrlFile, 'of='TmpFile) -- Can't use EpmTemplate here, because date and time are appended EpmCall = "start epm /r 'postme VersionParseTmpFile "EnqTmpFile CurDate CurTime"'" -- Single quotes in the calls must be doubled additionally here, -- because the lines below are surrounded with single quotes themselves. WgetCall = DoubleCharInStr( "'", WgetCall) EpmCall = DoubleCharInStr( "'", EpmCall) -- Create a temp. cmd file that executes wget and EPM with a posted command. -- That ensures that the EPM command is executed after wget has completed. CmdFile = GetTmpPath()'getversion.cmd' if Exist( CmdFile) then call DeleteFile( CmdFile) endif getfileid cmdfid, CmdFile if cmdfid <> '' then activatefile cmdfid .modify = 0 'xcom q' endif 'xcom e /c 'CmdFile if rc <> -282 then -- sayerror( 'New file') 'SayError 'ERROR__MSG rc BAD_TMP_FILE__MSG sayerrortext( rc) return endif .autosave = 0 insertline "/**/" insertline "do 1" insertline " '"WgetCall"'" --insertline " if rc <> 0 then" --insertline " leave" insertline " '"EpmCall"'" insertline "end" insertline "'@DEL "CmdFile"'" -- Delete itself insertline "exit" 'xcom s' 'xcom q' -- Execute CmdFile --dprintf( 'CmdFile = 'CmdFile', WgetCall = 'WgetCall) call EditNepmdVersionLine( 'Checking for new version...') 'postme os2 /c /min 'CmdFile enddo else --call EditNepmdVersionResult() 'postme EditNepmdVersionResult' endif enddo return ; --------------------------------------------------------------------------- defc VersionParseTmpFile do once = 1 to 1 parse arg TmpFile CurDate CurTime if leftstr( TmpFile, 1) = '"' then parse arg '"'TmpFile'"' CurDate CurTime endif Language = Get_Env( 'NEPMD_LANGUAGE') if Language = '' then Language = 'eng' endif Version = '' Date = '' Url = '' CheckResult = 1 getfileid tmpfid, TmpFile if tmpfid <> '' then activatefile tmpfid .modify = 0 'xcom q' endif 'xcom e' EnquoteFileSpec( TmpFile) if rc then --dprintf( 'VersionParseTmpFile: leave, rc for "xcom e' TmpFile'" = 'rc) leave endif --dprintf( 'VersionParseTmpFile: loaded file 'TmpFile) getfileid tmpfid .visible = 0 .autosave = 0 --dprintf( 'VersionParseTmpFile: tmpfid = 'tmpfid', .last = '.last) fSectionFound = 0 do i = 1 to .last ThisLine = strip( textline( i)) --dprintf( 'ThisLine = 'ThisLine) if leftstr( ThisLine, 1) = ';' then iterate endif parse value ThisLine with '['ThisSection']' if not fSectionFound then if ThisSection = Language then --dprintf( 'ThisSection = Language = 'Language) fSectionFound = 1 endif iterate endif parse value ThisLine with ThisVar '=' ThisVal ThisVar = strip( ThisVar) ThisVal = strip( ThisVal) if ThisVar = 'Version' then Version = ThisVal elseif ThisVar = 'Date' then Date = ThisVal elseif ThisVar = 'URL' then Url = ThisVal endif enddo --dprintf( 'VersionParseTmpFile: Version = 'Version', Date = 'Date', Url = 'Url) activatefile tmpfid .modify = 0 'xcom q' call DeleteFile( TmpFile) KeyPath = '\NEPMD\Var\VersionCheck' -- Save as last check data to ini call WriteConfigKey( KeyPath'\Version', Version) call WriteConfigKey( KeyPath'\ReleaseDate', Date) call WriteConfigKey( KeyPath'\Url', Url) -- Save current date as last check date call WriteConfigKey( KeyPath'\CheckDateTime', CurDate CurTime) if Version = '' then elseif Date = '' then elseif Url = '' then else -- Change CheckResult to 0 (success) CheckResult = 0 endif call WriteConfigKey( KeyPath'\Result', CheckResult) --call EditNepmdVersionResult() 'postme EditNepmdVersionResult' enddo ; --------------------------------------------------------------------------- ; Called by CheckNepmdVersion and by VersionParseTmpFile. defc EditNepmdVersionResult do once = 1 to 1 KeyPath = '\NEPMD\Var\VersionCheck' CheckResult = QueryConfigKey( KeyPath'\Result') Version = QueryConfigKey( KeyPath'\Version') ReleaseDate = QueryConfigKey( KeyPath'\ReleaseDate') Url = QueryConfigKey( KeyPath'\Url') CheckDateTime = QueryConfigKey( KeyPath'\CheckDateTime') EpmLoaderDate = GetEpmLoaderDate() KeyPathCheckUrl = '\NEPMD\User\VersionCheck\CheckUrl' CheckUrl = QueryConfigKey( KeyPathCheckUrl) --dprintf( 'EditNepmdVersionResult: CheckResult = 'CheckResult', Version = 'Version', NepmdVersion = 'GetNepmdVersion()) --dprintf( ' ReleaseDate = 'ReleaseDate', CheckDateTime = 'CheckDateTime', EpmLoaderDate = 'EpmLoaderDate) CheckedOn = '(checked on 'CheckDateTime')' if CheckResult <> 0 then Text = 'Connection failed: 'CheckUrl CheckedOn elseif Url = '' then Text = 'Check failed, URL is missing' else fNewVersion = 0 if Version < GetNepmdVersion() then fNewVersion = 0 elseif Version > GetNepmdVersion() then fNewVersion = 1 elseif IsoDateToBaseDate( ReleaseDate) > IsoDateToBaseDate( EpmLoaderDate) then fNewVersion = 1 endif if fNewVersion then Text = 'New version 'Version': 'Url CheckedOn else Text = 'This is the latest version' CheckedOn endif endif call EditNepmdVersionLine( Text) enddo return ; --------------------------------------------------------------------------- ; Called by CheckNepmdVersion and EditNepmdVersionResult. defproc EditNepmdVersionLine Text = arg( 1) InfoFilename = '.NEPMD_INFO' SearchStr = 'NEPMD version:' do once = 1 to 1 getfileid InfoFid, InfoFilename if InfoFid = '' then 'NepmdInfo NOCHECK' else activatefile InfoFid endif do l = 1 to .last LineStr = textline( l) StrippedLineStr = strip( LineStr) if leftstr( StrippedLineStr, length( SearchStr)) = SearchStr then --dprintf( l': StrippedLineStr = 'StrippedLineStr) parse value LineStr with StartStr(SearchStr)RestStr' - ' NewLineStr = StartStr''SearchStr''RestStr' - 'Text --dprintf( l': NewLineStr = 'NewLineStr) replaceline NewLineStr, l .modify = 0 .line = l leave endif enddo enddo return ; --------------------------------------------------------------------------- ;compile if defined( BLOCK_ALT_KEY) defc Beep a = arg( 1) do while a <> '' parse value a with pitch duration a call Beep( pitch, duration) enddo ;compile endif ; --------------------------------------------------------------------------- ; Send EPM window a help message ; Arg = help panel #, 9100,... (see MENUHELP.H) ; 10 = Help index ; 4000 = General help ; 0 or * = Using help ; 1000 = Keys help ; 2000 = Commands help ; -1 or unknown = TOC only, better use General help defc HelpPanel, HelpMenu call windowmessage( 0, getpminfo( APP_HANDLE), 5133, -- EPM_HelpMgrPanel arg( 1), -- mp1 0) -- mp2 = NULL ; --------------------------------------------------------------------------- ; Add a .hlp file to EPM.HLP for the help manager. The specified file is not ; added, if it was already added before. ; This is also required by menu items, independent from ; INCLUDE_WORKFRAME_SUPPORT. ; Moved from BOOKMARK.E: defc compiler_help_add. ; Opening a help panel of an added .hlp file doesn't work for menu items. ; Maybe there is EPM.HLP hardcoded. defc HelpPanel can be used instead. defc AddToHelp, compiler_help_add universal CurrentHLPFiles do once = 1 to 1 rest = arg( 1) AddHlpFiles = '' do while rest <> '' rest = strip( rest) -- Parse at double quotes or at words ch = leftstr( rest, 1, 1) if ch = '"' then parse value rest with '"'next'"' rest else parse value rest with next rest endif -- Add double quotes, if required HlpFile = EnquoteFilespec( next) -- Append to AddHlpFiles if not present if not pos( upcase( ' 'HlpFile' '), upcase( ' 'CurrentHLPFiles' ')) then if AddHlpFiles = '' then AddHlpFiles = HlpFile else AddHlpFiles = AddHlpFiles HlpFile endif endif enddo if AddHlpFiles = '' then leave endif hwndHelpInst = windowmessage( 1, getpminfo( APP_HANDLE), 5429, -- EPM_Edit_Query_Help_Instance 0, 0) if hwndHelpInst == 0 then -- There isn't a help instance deal with 'SayError 'NO_HELP_INSTANCE__MSG'.' return endif newlistZ = CurrentHLPFiles AddHlpFiles\0 retval = windowmessage( 1, hwndHelpInst, 557, -- HM_SET_HELP_LIBRARY_NAME ltoa( offset( newlistZ) || selector( newlistZ), 10), 0) if retval then 'SayError 'ERROR__MSG retval ERROR_ADDING_HELP__MSG AddHlpFiles'.' -- Revert to the previous version of the HLP list newlistZ = CurrentHLPFiles\0 retval2 = windowmessage( 1, hwndHelpInst, 557, -- HM_SET_HELP_LIBRARY_NAME ltoa( offset( newlistZ) || selector( newlistZ), 10), 0) if retval2 then 'SayError 'ERROR__MSG retval ERROR_REVERTING__MSG CurrentHLPFiles'.' endif return else -- OK, extend universal CurrentHLPFiles = CurrentHLPFiles AddHlpFiles endif enddo ; --------------------------------------------------------------------------- defc QueryHlp, QueryHelpFiles 'SayError Helpfiles = 'QueryCurrentHlpFiles() defproc QueryCurrentHlpFiles() universal CurrentHLPFiles return CurrentHLPFiles ; --------------------------------------------------------------------------- defc SetHlp, SetHelpFiles call SetCurrentHlpFiles( arg( 1)) if rc then 'SayError Error: rc = 'rc', Helpfiles = 'QueryCurrentHlpFiles() else 'SayError Helpfiles = 'QueryCurrentHlpFiles() endif defproc SetCurrentHlpFiles( newlist) universal CurrentHLPFiles rc = 0 hwndHelpInst = windowmessage( 1, getpminfo( APP_HANDLE), 5429, -- EPM_Edit_Query_Help_Instance 0, 0) if hwndHelpInst == 0 then -- There isn't a help instance deal with rc = 13 'SayError Error: EPM_Edit_Query_Help_Instance returned no help instance.' return endif newlistZ = newlist\0 retval = windowmessage( 1, hwndHelpInst, 557, -- HM_SET_HELP_LIBRARY_NAME ltoa( offset( newlistZ)''selector( newlistZ), 10), 0) if retval == 0 then -- It worked, now remember what you told it CurrentHLPFiles = newlist return else -- Failed for some reason. Anyway, we had better revert to -- the previous version of the HLP list. if CurrentHLPFiles == '' then CurrentHLPFiles = ' ' endif newlistZ = CurrentHLPFiles\0 retval2 = windowmessage( 1, hwndHelpInst, 557, -- HM_SET_HELP_LIBRARY_NAME ltoa( offset( newlistZ)''selector( newlistZ), 10), 0) if retval2 == 0 then -- We were able to revert to the old list rc = retval 'SayError Error: HM_SET_HELP_LIBRARY_NAME returned rc = 'retval'.' return else rc = retval2 'SayError Errors: HM_SET_HELP_LIBRARY_NAME returned rc = 'retval' and 'retval2'.' return endif endif ; --------------------------------------------------------------------------- ; Internally called when a color or a font is dropped on a window. ; This is always followed by a SaveFont or SaveColor command. The internally ; defined SaveColor command will be ignored, because its standard args EDIT, ; MSG or STAT are not precise enough. Therefore SaveColor is executed from ; here additionally. defc SetPresParam universal msgfont universal statfont universal vmessagecolor universal vstatuscolor universal vmodifiedstatuscolor universal vreadonlystatuscolor universal vdesktopcolor fModified = (.modify > 0) --dprintf( 'SETPRESPARAM', 'arg( 1) = ['arg( 1)']') -- SETPRESPARAM: arg( 1) = [MSGBGCOLOR hwnd=-2147483054 x=175 y=12 rgb=16777215 clrattr=15 oldfgattr=3 oldbgattr=7] -- SETPRESPARAM: arg( 1) = [MSGFONTSIZENAME hwnd=-2147483054 x=41 y=8 string=10.Helv] -- SETPRESPARAM: arg( 1) = [STATFONTSIZENAME hwnd=-2147483058 x=636 y=9 string=10.System Proportional Non-ISO] -- SETPRESPARAM: arg( 1) = [EDITFONTSIZENAME hwnd=-2147483047 x=676 y=179 string=12.System VIO] parse value arg( 1) with whichctrl ' hwnd='hwnd ' x='x 'y='y rest -- Font: statusbar, messagebar if (whichctrl == 'STATFONTSIZENAME') or (whichctrl == 'MSGFONTSIZENAME') then parse value rest with 'string='psize'.'facename'.'attr -- psize is pointsize, facename is facename, attr is 'Bold' etc 'SetStatFace' hwnd facename 'SetStatPtSize' hwnd psize newfont = substr( rest, 8) if leftstr( whichctrl, 1) = 'S' then -- 'STATFONTSIZENAME' statfont = newfont else -- 'MSGFONTSIZENAME' msgfont = newfont 'SayError 'MESSAGELINE_FONT__MSG endif -- Foreground color: statusbar, messagebar elseif (whichctrl == 'STATFGCOLOR') or (whichctrl == 'MSGFGCOLOR') then parse value rest with 'rgb='rgb 'clrattr='clrattr 'oldfgattr='oldfgattr 'oldbgattr='oldbgattr call windowmessage( 0, hwnd, 4099, -- STATWNDM_SETCOLOR clrattr, oldbgattr) newcolor = clrattr + 16 * oldbgattr if leftstr( whichctrl, 1) = 'M' then 'SayError 'MESSAGELINE_FGCOLOR__MSG --dprintf( 'SETPRESPARAM', 'MsgFgColor') vmessagecolor = newcolor 'SaveColor MESSAGE' elseif not fModified then if .readonly then --dprintf( 'SETPRESPARAM', 'StatFgColor, readonly') vreadonlystatuscolor = newcolor 'SaveColor READONLYSTATUS' else --dprintf( 'SETPRESPARAM', 'StatFgColor, normal') vstatuscolor = newcolor 'SaveColor STATUS' endif else --dprintf( 'SETPRESPARAM', 'StatFgColor, modified') vmodifiedstatuscolor = newcolor 'SaveColor MODIFIEDSTATUS' endif -- Background color: statusbar, messagebar elseif (whichctrl == 'STATBGCOLOR') or (whichctrl == 'MSGBGCOLOR') then parse value rest with 'rgb='rgb 'clrattr='clrattr 'oldfgattr='oldfgattr 'oldbgattr='oldbgattr call windowmessage( 0, hwnd, 4099, -- STATWNDM_SETCOLOR oldfgattr, clrattr) newcolor = oldfgattr + clrattr * 16 if leftstr( whichctrl, 1) = 'M' then 'SayError 'MESSAGELINE_BGCOLOR__MSG --dprintf( 'SETPRESPARAM', 'MsgBgColor') vmessagecolor = newcolor 'SaveColor MESSAGE' elseif not fModified then if .readonly then --dprintf( 'SETPRESPARAM', 'StatBgColor, readonly') vreadonlystatuscolor = newcolor 'SaveColor READONLYSTATUS' else --dprintf( 'SETPRESPARAM', 'StatBgColor, normal') vstatuscolor = newcolor 'SaveColor STATUS' endif else --dprintf( 'SETPRESPARAM', 'StatBgColor, modified') vmodifiedstatuscolor = newcolor 'SaveColor MODIFIEDSTATUS' endif -- Background color: editwindow elseif (whichctrl == 'EDITBGCOLOR') then parse value rest with 'rgb='rgb 'clrattr='clrattr 'oldfgattr='oldfgattr 'oldbgattr='oldbgattr map_point 5, x, y, off, comment -- 5 = Win2LCO line = x col = y if line < 1 | col > .last then --dprintf( 'SETPRESPARAM', 'EditBgColor, background') vdesktopcolor = clrattr call windowmessage( 0, getpminfo( EPMINFO_EDITCLIENT), 5497, clrattr, 0) 'SaveColor BACKGROUND' else if InMark( line, col) then --dprintf( 'SETPRESPARAM', 'EditBgColor, text, in mark') .markcolor = (.markcolor // 16) + 16 * clrattr 'SaveColor MARK' else --dprintf( 'SETPRESPARAM', 'EditBgColor, text, not in mark') .textcolor = (.textcolor // 16) + 16 * clrattr 'SaveColor TEXT' endif endif -- Foreground color: editwindow elseif (whichctrl == 'EDITFGCOLOR') then parse value rest with 'rgb='rgb 'clrattr='clrattr 'oldfgattr='oldfgattr 'oldbgattr='oldbgattr map_point 5, x, y, off, comment -- 5 = Win2LCO line = x col = y if InMark( line, col) then --dprintf( 'SETPRESPARAM', 'EditFgColor, text, in mark') .markcolor = .markcolor - (.markcolor // 16) + clrattr 'SaveColor MARK' else --dprintf( 'SETPRESPARAM', 'EditFgColor, text, not in mark') .textcolor = .textcolor - (.textcolor // 16) + clrattr 'SaveColor TEXT' endif -- Font: editwindow elseif whichctrl == 'EDITFONTSIZENAME' then parse value rest with 'string='psize'.'facename'.'attr -- psize is pointsize, facename is facename, attr is 'Bold' etc fontsel = 0 do while attr <> '' parse value attr with thisattr '.' attr if thisattr = 'Italic' then fontsel = fontsel + 1 elseif thisattr = 'Underscore' then fontsel = fontsel + 2 elseif thisattr = 'Outline' then fontsel = fontsel + 8 elseif thisattr = 'Strikeout' then fontsel = fontsel + 16 elseif thisattr = 'Bold' then fontsel = fontsel + 32 endif enddo .font = registerfont( facename, psize, fontsel) else 'SayError 'UNKNOWN_PRESPARAM__MSG whichctrl return endif --'SayError Set presparm with 'hwnd' as the window 'arg( 1) ; --------------------------------------------------------------------------- ; Called by SetPresParam for message- or statusbar fontname. defc SetStatFace parse value arg( 1) with hwnd face return windowmessage( 0, hwnd /*getpminfo( EPMINFO_EDITFRAME)*/, -- Post message to edit client 4104, -- STATWNDM_PREFFONTFACE Put_In_Buffer( face), 1) -- COMMAND_FREESEL ; --------------------------------------------------------------------------- ; Called by SetPresParam for message- or statusbar fontsize. defc SetStatPtSize parse value arg( 1) with hwnd ptsize if leftstr( ptsize, 1) = 'D' then -- Decipoints parse value ptsize with 'DD' ptsize 'HH' parse value ptsize with ptsize 'WW' ptsize = ptsize % 10 -- convert decipoints to points endif return windowmessage( 0, hwnd /*getpminfo( EPMINFO_EDITFRAME)*/, -- Post message to edit client 4106, -- STATWNDM_PREFFONTPTSIZE ptsize, 0) ; --------------------------------------------------------------------------- ; Syntax: ; Font = Convert2EFont( .[[[.[ ]].fgcolor].bgcolor]) ; or ; Font = Convert2EFont( .[[[.]].fgcolor].bgcolor]) ; Both font specs are valid: '12.System VIO' or 'System VIO.DD120HH16WW8BB' ; + or are allowed as separator for . can be ; specified as number or as name. ; Different from SetTextColor and SetMarkColor, the appended values for ; colors must be separated by a period and go both from 0 to 15. ; The returned syntax is used as arg for ProcessFontRequest and could be used ; for style settings. ; Notes: registerfont uses a different syntax: .. ; fgcol'.'bgcol for e.g. .textcolor can be converted with ; trunc( .textcolor//16)'.'.textcolor%16 defproc ConvertToEFont --dprintf( 'CONVERTTOEFONT', 'arg( 1) = 'arg( 1)) parse arg name '.' size '.' rest next = upcase( size) next = translate( next, '', 'XDHWB', '0') if not IsNum( next) then --'Sayerror size = "'size'" is num, arg( 1) = 'arg( 1) -- toggle name and size parse arg size '.' name '.' endif --'SayError name = "'name'", size = "'size'", next = "'next'", arg( 1) = 'arg( 1) parse value upcase( size) with h 'X' w if h <> '' & w <> '' then size = 'HH'h'WW'w endif attrib = 0 fIsColor = 0 fgcol = 0 bgcol = 0 do while rest <> '' if fIsColor then --dprintf( 'CONVERTTOEFONT', 'colors = 'rest) parse value rest with fgcol '.' bgcol if fgcol = '' then elseif not IsNum( fgcol) then fgcol = ColorNameToNum( fgcol) if rc then fgcol = '' endif endif if bgcol = '' then elseif not IsNum( bgcol) then bgcol = ColorNameToNum( bgcol) if rc then bgcol = '' endif endif if (not IsNum( fgcol)) | (not IsNum( bgcol)) then fIsColor = 0 -- don't append font segments on error endif leave else parse value rest with segment '.' rest attriblist = translate( segment, ' ', '+') -- allow '+' as separator --dprintf( 'CONVERTTOEFONT', 'attriblist = 'attriblist) do a = 1 to words( attriblist) next = word( attriblist, a) if IsNum( next) then attrib = attrib + next elseif next = 'Normal' then -- attrib = attrib + 0 elseif next = 'Italic' then attrib = attrib + 1 elseif next = 'Underscore' then attrib = attrib + 2 elseif next = 'Outline' then attrib = attrib + 8 elseif next = 'Strikeout' then attrib = attrib + 16 elseif next = 'Bold' then attrib = attrib + 32 endif enddo -- Check following segment for another attribut name parse value rest with test '.' junk if test = '' then leave elseif wordpos( test, 'Normal Italic Underscore Strikeout Bold') then else fIsColor = 1 -- try to resolve the following segments as colors --dprintf( 'CONVERTTOEFONT', 'test = 'test', fIsColor = 'fIsColor) endif iterate endif enddo if fIsColor then EFont = name'.'size'.'attrib'.'fgcol'.'bgcol else EFont = name'.'size'.'attrib endif --dprintf( 'CONVERTTOEFONT', 'EFont = 'EFont) return EFont ; --------------------------------------------------------------------------- defproc ConvertToOs2Font --dprintf( 'CONVERTTOOS2FONT', 'arg( 1) = 'arg( 1)) parse arg name'.'size'.'attriblist next = upcase( size) next = translate( next, '', 'XDHWB', '0') if not IsNum( next) then -- toggle name and size parse arg size'.'name'.' endif if leftstr( size, 1) = 'D' then -- Decipoints parse value size with 'DD' size 'HH' parse value size with size 'WW' size = size % 10 -- convert decipoints to points endif if attriblist = 0 then attriblist = '' endif if attriblist <> '' then attriblist = upcase( attriblist) attriblist = translate( attriblist, ' ', '+.') -- allow '+' or '.' as separator attrib = 0 do a = 1 to words( attriblist) next = word( attriblist, a) if IsNum( next) then attrib = attrib + next else if next = 'NORMAL' then -- attrib = attrib + 0 elseif wordpos( next, 'ITALIC OBLIQUE SLANTED') then attrib = attrib + 1 elseif next = 'UNDERSCORE' then attrib = attrib + 2 elseif next = 'OUTLINE' then attrib = attrib + 8 elseif next = 'STRIKEOUT' then attrib = attrib + 16 elseif next = 'BOLD' then attrib = attrib + 32 endif endif enddo attriblist = '' rest = attrib next = rest - 32 if next >= 0 then attriblist = attriblist'.Bold' rest = next endif next = rest - 16 if next >= 0 then attriblist = attriblist'.Strikeout' rest = next endif next = rest - 8 if next >= 0 then attriblist = attriblist'.Outline' rest = next endif next = rest - 2 if next >= 0 then attriblist = attriblist'.Underscore' rest = next endif next = rest - 1 if next >= 0 then attriblist = attriblist'.Italic' rest = next endif endif Os2Font = size'.'name''attriblist --dprintf( 'CONVERTTOOS2FONT', 'Os2Font = 'Os2Font) return Os2Font ; --------------------------------------------------------------------------- defc ShowFont universal default_font universal statfont universal msgfont FontId = '' -- The next 3 specs are equivalent: --FontId = registerfont( 'System VIO', 'WW8HH16', 0) --FontId = registerfont( 'System VIO', 'DD12', 0) FontId = registerfont( 'System VIO', '12', 0) -- registerfont handles all variants as new fonts and assigns the next -- font id to it. For a non-existing font, it returns 0. -- For a non-existing font id, queryfont always returns the spec of -- font id 1. dprintf( 'FontId = 'FontId' = 'queryfont( FontId)', default_font = 'default_font' = 'queryfont( default_font)', .font = '.font' = 'queryfont( .font)) dprintf( '0 = 'queryfont( 0)', 1 = 'queryfont( 1)', 2 = 'queryfont( 2)', 3 = 'queryfont( 3)) dprintf( '1 = 'queryfont( 1)' = 'ConvertToOs2Font( queryfont( 1))', 2 = 'queryfont( 2)' = 'ConvertToOs2Font( queryfont( 2))) dprintf( 'statfont = 'statfont', msgfont = 'msgfont) -- > FontId = 2 = System VIO.DD120WW0HH0BB.0, default_font = 2 = System VIO.DD120WW0HH0BB.0, .font = 2 = System VIO.DD120WW0HH0BB.0 -- > 0 = WarpSans.DD90WW0HH0BB.0, 1 = WarpSans.DD90WW0HH0BB.0, 2 = System VIO.DD120WW0HH0BB.0, 3 = WarpSans.DD90WW0HH0BB.0 -- > 1 = WarpSans.DD90WW0HH0BB.0 = 9.WarpSans, 2 = System VIO.DD120WW0HH0BB.0 = 12.System VIO -- > statfont = 10.System Proportional Non-ISO, msgfont = 10.Helv ; --------------------------------------------------------------------------- ; This works even for fonts that don't exist in the next size. ; 8.Helv and Midori Sans have the problem that after MinSize = 2 is reached, ; no further change is possible. An unknown E statement causes the error msg ; 'Divide by zero'. Then drop a font from the color palette onto the edit ; window and restart EPM. ; After scrolling to the text font sizes of a dropped font, and after ; several dropped fonts, the try to change the font again may not work ; anymore and 9.WarpSans is applied instead. It seems as if E runs out of ; font ids. After an EPM restart, it starts to work again. defc NextFontSize universal default_font do once = 1 to 1 -- Several fonts have the problem that after MinSize = 2 is applied, -- any further change causes 'Divide by zero'. MinSize = 3 MaxSize = 18 Direction = arg( 1) if Direction = '' then Direction = '+' else Direction = upcase( leftstr( Direction, 1)) if pos( Direction, '-PB') then Direction = '-' else Direction = '+' endif endif ThisFontId = .font if not ThisFontId then ThisFontId = default_font endif ETextFont = queryfont( ThisFontId) TextFont = ConvertToOs2Font( ETextFont) parse value TextFont with TextSize '.' Rest if not IsNum( TextSize) then leave endif NextTextFont = '' if Direction = '+' then if TextSize >= MaxSize then leave endif NextTextSize = TextSize + 1 NextTextFont = NextTextSize'.'Rest else if TextSize <= MinSize then leave endif NextTextSize = TextSize - 1 NextTextFont = NextTextSize'.'Rest endif --dprintf( '.font = '.font', ETextFont = 'ETextFont', TextFont = 'TextFont', NextTextFont = 'NextTextFont) if NextTextFont = '' then leave endif parse value ConvertToEFont( NextTextFont) with Name'.'Size'.'Sel FontId = registerfont( Name, Size, Sel) if FontId = 0 then leave endif 'SayHint Text font: 'NextTextFont if .font = default_font | not .font then -- Default font fApplyToAllFiles = 1 else -- Special font fApplyToAllFiles = 0 endif if fApplyToAllFiles then -- Apply font to all files in the ring that have the default font getfileid startfid display -1 dprintf( 'RINGCMD', 'NextFontSize') 'VSyncCursor' do i = 1 to filesinring( 1) if .font = default_font then .font = FontId endif nextfile getfileid curfid if curfid = startfid then leave endif enddo -- Loop through all files in ring activatefile startfid -- Make sure we're back where we started (in case was .HIDDEN) display 1 default_font = FontId -- Save font to ini 'SaveFont TEXT' else -- Use file setting when a special font was set before 'SetTextFont 'NextTextFont endif enddo ; --------------------------------------------------------------------------- ; Called internally by the config dialog, when a font was changed. ; Called internally by the style dialog when a font or color is applied ; without applying a registered style. ; On dropping a font from the font palette onto the edit window, this cmd is ; not executed. That change is made internally. This has the bug that the ; font of the popup menu is changed, too. It's restored back to the PM ; default menu font on restart of EPM. ; This cmd can also be used directly to change the fonts or to add color ; attributes to marked text. defc ProcessFontRequest universal default_font universal statfont universal msgfont parse value arg( 1) with fontname '.' fontsize '.' fontsel '.' fsetfont '.' type '.' fgcol '.' bgcol --dprintf( 'ProcessFontRequest: fontname = 'fontname', fontsize = 'fontsize', fontsel = 'fontsel', arg( 1) = "'arg( 1)'"') if type < 2 then fontid = registerfont( fontname, fontsize, fontsel) endif if type = 2 then -- Statusline font statfont = ConvertToOs2Font( fontsize'.'fontname'.'fontsel) hwnd = getpminfo( EPMINFO_EDITSTATUSHWND) 'SetStatFace' hwnd fontname 'SetStatPtSize' hwnd fontsize if fsetfont then 'SaveFont STATUS' endif elseif type = 3 then -- Messageline font msgfont = ConvertToOs2Font( fontsize'.'fontname'.'fontsel) hwnd = getpminfo( EPMINFO_EDITMSGHWND) 'SetStatFace' hwnd fontname 'SetStatPtSize' hwnd fontsize if fsetfont then 'SaveFont MESSAGE' endif elseif type = 1 then -- Insert font attribute within marked area only call ApplyFontColorToMark( fontid, fgcol, bgcol) else if not fsetfont then -- Apply font to current file only .font = fontid else -- Apply font to all files in the ring that have the default font getfileid startfid 'VSyncCursor' display -1 dprintf( 'RINGCMD', 'ProcessFontRequest') do i = 1 to filesinring( 1) if .font = default_font then .font = fontid endif nextfile getfileid curfid if curfid = startfid then leave endif enddo -- Loop through all files in ring activatefile startfid -- Make sure we're back where we started (in case was .HIDDEN) display 1 default_font = fontid -- Save font to ini 'SaveFont TEXT' endif endif ; --------------------------------------------------------------------------- const compile if not defined( MONOFONT_STRINGS) MONOFONT_STRINGS = 'MONO VIO FIX COURIER LETTER MINCHO TYPEWRITER' compile endif ; --------------------------------------------------------------------------- ; This is a hack and should be replaced, because is checks names. defproc IsMonoFont parse value queryfont( .font) with fontname '.' fontsize '.' fMonoFont = 0 StringList = upcase( MONOFONT_STRINGS) Name = upcase( fontname) -- Ignore MONOTYPE, because it's a brand name wp = wordpos( 'MONOTYPE', Name) if wp > 0 then Name = delword( Name, wp, 1) endif do w = 1 to words( StringList) String = word( StringList, w) if pos( String, Name) > 0 then fMonoFont = 1 leave endif enddo if fMonoFont = 0 then if rightstr( fontsize, 2) = 'BB' then -- Bitmapped font parse value fontsize with 'DD' decipoints 'WW' width 'HH' height 'BB' if width & height then -- It's fixed pitch fMonoFont = 1 endif endif endif return fMonoFont ; --------------------------------------------------------------------------- const compile if not defined( STD_MONOFONT) ; STD_MONOFONT = SYS_MONOSPACED_SIZE'.System Monospaced' STD_MONOFONT = '12.System VIO' -- 'DD120HH16WW8BB' compile endif ; --------------------------------------------------------------------------- ; This is a hack and should be replaced, because is checks names. defc Monofont universal app_hini NewFont = '' getfileid fid call SetAVar( fid'.monofont', 1) -- Query Monofont from font styles and always use it, if defined MonoFontList = 'MonoFont Monofont MONOFONT monofont' do w = 1 to words( MonoFontList) Wrd = word( MonoFontList, w) next = queryprofile( app_hini, 'Style', Wrd) -- case-sensitive if next <> '' then -- Strip color attributes parse value next with name'.'size'.'attrib'.'fgcol'.'bgcol NewFont = name'.'size'.'attrib leave endif enddo -- If Monofont style is not defined, take default Monofont, but only -- if current font is not already a monospaced font. if NewFont = '' then if not IsMonofont() then NewFont = STD_MONOFONT endif endif if NewFont <> '' then 'SetTextFont' NewFont -- SetTextFont is defined in MODEEXEC.E endif ; --------------------------------------------------------------------------- ; setfont doesn't work in EPM 6.03b /* ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ³ what's it called: setfont ³ ³ ³ ³ what does it do : Send change font message to editor. ³ ³ Arguments are the font cell width and the font cell ³ ³ height. Example: setfont( 7, 15) ³ ³ ³ ³ ³ ³ who and when : Jerry C. 11/04/89 ³ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ */ /* defproc SetFont( width, height) call windowmessage( 0, getpminfo( EPMINFO_EDITCLIENT), -- Post message to edit client 5381, -- EPM_EDIT_CHANGEFONT height, width) */ ; --------------------------------------------------------------------------- const COLOR_CONVERSION_LIST = '' || 'BLACK' || '/' || '0' || '/' || 'BLUE' || '/' || '1' || '/' || 'GREEN' || '/' || '2' || '/' || 'CYAN' || '/' || '3' || '/' || 'RED' || '/' || '4' || '/' || 'MAGENTA' || '/' || '5' || '/' || 'BROWN' || '/' || '6' || '/' || 'LIGHT_GRAY' || '/' || '7' || '/' || 'DARK_GRAY' || '/' || '8' || '/' || 'LIGHT_BLUE' || '/' || '9' || '/' || 'LIGHT_GREEN' || '/' || '10' || '/' || 'LIGHT_CYAN' || '/' || '11' || '/' || 'LIGHT_RED' || '/' || '12' || '/' || 'LIGHT_MAGENTA' || '/' || '13' || '/' || 'YELLOW' || '/' || '14' || '/' || 'WHITE' || '/' || '15' || '/' ; --------------------------------------------------------------------------- ; Syntax: ColorNum = ColorNameToNum( [+ ]) ; are color names or numbers. The resulting Color is the summed ; value of all. ; Sets rc = 0 if color was resolved, else rc = 1. defproc ColorNameToNum( Args) rc = 0 ColorNum = 0 do once = 1 to 1 if Args = '' | Args = 'DEFAULT' then -- Don't return 0 = BLACK ColorNum = Args leave elseif IsNum( Args) then ColorNum = Args leave endif -- Uppercase Names = upcase( Args) -- Remove spaces Names = RmSpaces( Names) do while Names <> '' -- Parse every arg at '+' boundaries parse value Names with ColorName '+' Names fFound = 0 fBackground = 0 if IsNum( ColorName) then ColorNum = ColorNum + ColorName -- add fFound = 1 iterate endif -- Parse trailing 'B' if rightstr( ColorName, 1) = 'B' then fBackground = 1 ColorName = leftstr( ColorName, length( ColorName) - 1) endif -- Add underscore after 'LIGHT', 'DARK' or 'PALE', if missing parse value ColorName with 'LIGHT'next if next <> '' & leftstr( next, 1) <> '_' then ColorName = 'LIGHT_'next else parse value ColorName with 'DARK'next if next <> '' & leftstr( next, 1) <> '_' then ColorName = 'DARK_'next else parse value ColorName with 'PALE'next if next <> '' & leftstr( next, 1) <> '_' then ColorName = 'PALE_'next endif endif endif -- Change synonyms ColorName = ChangeStr( 'GREY', ColorName, 'GRAY') ColorName = ChangeStr( 'PALE_GRAY', ColorName, 'LIGHT_GRAY') if ColorName = 'GRAY' then ColorName = 'LIGHT_GRAY' endif -- Parse list rest = COLOR_CONVERSION_LIST do while rest <> '' parse value rest with next1'/'next2'/'rest -- Compare if ColorName = next1 then if not fBackground then ColorNum = ColorNum + next2 -- add foreground color fFound = 1 leave else ColorNum = ColorNum + 16 * next2 -- add background color fFound = 1 leave endif endif enddo if fFound = 0 then rc = 1 'SayError Error: ColorNameToNum: "'ColorName'" is not a color specification.' leave endif enddo enddo return ColorNum ; --------------------------------------------------------------------------- ; Syntax: ColorName = ColorNameToNum( ) ; is a color number. ; Sets rc = 0 if colornum was resolved, else rc = 1. defproc ColorNumToName( Args) rc = 0 ColorName = '' FgColorName = '' BgColorName = '' do once = 1 to 1 if not IsNum( Args) then rc = 1 'SayError Error: ColorNumToName: "'Args'" is not a color number.' leave endif FgColorNum = Args // 16 BgColorNum = Args % 16 do c = 1 to 2 fFound = 0 if c = 1 then ColorNum = FgColorNum elseif c = 2 then ColorNum = BgColorNum endif -- Parse list rest = COLOR_CONVERSION_LIST do while rest <> '' parse value rest with next1'/'next2'/'rest -- Compare if ColorNum = next2 then if c = 1 then FgColorName = next1 elseif c = 2 then BgColorName = next1 endif fFound = 1 leave endif enddo if fFound = 0 then rc = 1 'SayError Error: ColorNumToName: "'ColorNum'" is not a fore- or background color number.' leave endif enddo if rc then leave endif -- Assemble E color name ColorName = FgColorName'+'BgColorName'B' enddo return ColorName ; --------------------------------------------------------------------------- ; Opens a listbox to select a color palette. The list of color palettes is ; parsed by COLORS.ERX from both NEPMD.INI and existing palette objects. ; Uses also COLORS.ERX to patch ETKE603.DLL on applying a color set. defc SelectColorPal NumItems = 0 ListBoxData = '' Next = RxResult( 'colors.erx L') if Next <> '' then -- Get number of items Sep = leftstr( Next, 1) Check = translate( translate( Next, '_', ' '), ' ', Sep) NumItems = words( Check) ListBoxData = Next endif DefaultItem = 1 DefaultButton = 1 HelpId = 0 Title = 'Change color palette' Text = 'Select a color palette from the list below:' Buttons = '/~Set/~Open/~Copy.../~Delete/'CANCEL__MSG refresh Result = ListBox( Title, ListBoxData, Buttons, 0, 0, --5, 5, -- top, left, Min( NumItems, 15), 50, -- height, width GethWndC( APP_HANDLE) || atoi( DefaultItem) || atoi( DefaultButton) || atoi( HelpId) || Text) refresh -- Parse return string parse value Result with Button 2 Select \0 Button = asc( Button) ColorPal = Select if pos( ' ', ColorPal) then ColorPal = '"'ColorPal'"' endif if Button = 1 then -- Set rcx = RxResult( 'colors.erx S' ColorPal) --'SayError RxResult from "rx colors.erx' ColorPal'" = 'rcx elseif Button = 2 then -- Open rcx = RxResult( 'colors.erx O' ColorPal) elseif Button = 3 then -- Copy 'EnterColorPalName' ColorPal elseif Button = 4 then -- Delete rcx = RxResult( 'colors.erx D' ColorPal) 'SelectColorPal' else -- Cancel -- nop endif return ; --------------------------------------------------------------------------- defc EnterColorPalName ColorPal = arg( 1) if leftstr( ColorPal, 1) == '"' then parse value ColorPal with '"'ColorPal'"' endif Title = 'Copy color palette "'ColorPal'"' Text = 'Enter a new name:' OldEntry = '' Buttons = '/'OK__MSG'/'CANCEL__MSG DefButton = 1 Title = leftstr( Title, 100)'.' -- Add spaces to fit the text in titlebar HelpId = 0 ret = EntryBox( Title, Buttons, OldEntry, '', 255, -- Length atoi( DefButton) || atoi( HelpId) || GethWndC( APP_HANDLE) || Text) -- Parse return string parse value ret with Button 2 Select \0 Button = asc( Button) NewEntry = strip( Select) if Button = 2 | Button = 0 then -- 0 = Esc, 2 = Cancel 'SelectColorPal' elseif Button = 1 then -- 1 = OK if ColorPalNameExists( NewEntry) | NewEntry = '' then 'EnterColorPalName' ColorPal -- call this command again else -- Handle spaces in name if pos( ' ', ColorPal) then ColorPal = '"'ColorPal'"' endif if pos( ' ', NewEntry) then NewEntry = '"'NewEntry'"' endif rcx = RxResult( 'colors.erx C' ColorPal NewEntry) 'SelectColorPal' endif endif ; --------------------------------------------------------------------------- defproc ColorPalNameExists universal nepmd_hini PalName = arg( 1) -- Don't override existing names KeyPath = '\NEPMD\User\Colors\Highlighting' fNameExists = 0 if not fNameExists then -- Compare NewEntry with default names do NextNum = 101 to 200 NextName = QueryConfigKey( KeyPath'\'NextNum'\Name') if NextName = '' then leave endif if PalName = NextName then fNameExists = 1 leave endif enddo endif if not fNameExists then -- Compare NewEntry with user names SearchOption = 'C' NextNum = '' FoundNum = '' do while NepmdGetNextConfigKey( nepmd_hini, KeyPath, SearchOption, NextNum) if not IsNum( NextNum) then iterate endif NextName = QueryConfigKey( KeyPath'\'NextNum'\Name') if NextName = '' then iterate endif if PalName = NextName then fNameExists = 1 leave endif enddo endif return fNameExists ; --------------------------------------------------------------------------- ; Thunk is used for host support only. defproc Thunk( pointer) return atol_swap( dynalink32( E_DLL, 'FlatToSel', pointer, 2)) ; --------------------------------------------------------------------------- defc EchoBack parse arg postorsend hwnd messageid mp1 mp2 . call windowmessage( postorsend, hwnd, messageid, mp1, mp2) ; --------------------------------------------------------------------------- defc Dyna_Cmd parse arg library entrypoint cmdargs if entrypoint = '' then 'SayError -257' -- 'Invalid number of parameters' return endif rc = 0 cmdargs = cmdargs\0 rcx = dynalink32( library, entrypoint, GethWndC( EPMINFO_EDITCLIENT) || address( cmdargs), 2) ; --------------------------------------------------------------------------- defc DynaFree rc = dynafree( arg( 1)) if rc then 'SayError 'ERROR__MSG rc endif ; --------------------------------------------------------------------------- ; Some PMWIN.H constants: #define QW_NEXT 0 #define QW_PREV 1 #define QW_TOP 2 #define QW_BOTTOM 3 #define QW_OWNER 4 #define QW_PARENT 5 #define QW_NEXTTOP 6 #define QW_PREVTOP 7 #define QW_FRAMEOWNER 8 #define FID_CLIENT 0x8008 #define HWND_DESKTOP 1 #define HWND_TOP 3 #define HWND_BOTTOM 4 #define QWL_STYLE (-2) #define SWP_SIZE 0x0001 #define SWP_MOVE 0x0002 #define SWP_ZORDER 0x0004 #define SWP_ACTIVATE 0x0080 #define SWP_RESTORE 0x1000 #define WS_MINIMIZED 0x01000000 ; --------------------------------------------------------------------------- ; Syntax: hWnd = QueryFocus() or hWnd = QueryFocus( hWndParent) defproc QueryFocus rc = 1 if arg() = 1 then hWndParent = arg( 1) else hWndParent = 1 -- HWND_DESKTOP endif hWnd = dynalink32( 'PMWIN', -- dynamic link library name '#817', -- Win32QueryFocus atol( hWndParent), 2) if hWnd then rc = 0 endif return hWnd defc QueryFocus hWnd = QueryFocus() dprintf( 'QueryFocus: hWnd = 'hWnd) ; --------------------------------------------------------------------------- ; Syntax: SetFocus( [hWnd]) or SetFocus( hWndParent, hWnd) defproc SetFocus if arg() = 2 then hWndParent = arg( 1) hWnd = arg( 2) else hWnd = arg( 1) hWndParent = 1 -- HWND_DESKTOP endif if hWnd = '' then hWnd = 1 -- Default is HWND_DESKTOP endif rc = 1 rcx = dynalink32( 'PMWIN', -- dynamic link library name '#860', -- Win32SetFocus atol( hWndParent) || atol( hWnd)) if rcx = 1 then rc = 0 endif return defc SetFocus call SetFocus( arg( 1)) ; --------------------------------------------------------------------------- defc SetFocusToThisWindow hWndFrame = getpminfo( EPMINFO_EDITFRAME) hWndClient = getpminfo( EPMINFO_EDITCLIENT) -- Clicks with MB 1: -- Using the cmd 'SetFocus' here seems to work more stable than the proc -- 'SetFocus'. A cmd is executed somehow delayed. Usually in this case, -- PostMe is used. But the entire cmd 'SetFocusToThisWindow' is already -- posted in MH_SingleClick. If it's still not stable enough, use PostMe -- also for SetFocus: 'PostMe MakeWindowTopmost' hWndFrame 'PostMe SetFocus' hWndClient ; --------------------------------------------------------------------------- defc SetFocusToEditClient hWndClient = getpminfo( EPMINFO_EDITCLIENT) 'SetFocus' hWndClient ; --------------------------------------------------------------------------- defproc QueryParent hWnd = arg( 1) hwndFrame = dynalink32( 'PMWIN', '#834', -- Win32QueryWindow atol( hwnd) || atol( QW_PARENT), 2) return hwndFrame defc QueryParent hWndParent = QueryParent( arg( 1)) dprintf( 'Parent of 'arg( 1)' = 'hwndParent) ; --------------------------------------------------------------------------- defproc SetParent hWnd = arg( 1) hWndNewParent = arg( 2) rcx = dynalink32( 'PMWIN', -- dynamic link library name '#865', -- Win32SetParent atol( hWnd) || atol( hWndNewParent)) return rcx defc SetParent parse arg hWnd hWndNewParent rcx = SetParent( hWnd, hWndNewParent) dprintf( 'rcx = 'rcx) -- 1 = success ; --------------------------------------------------------------------------- defproc QueryOwner hWnd = arg( 1) hwndOwner = dynalink32( 'PMWIN', '#834', -- Win32QueryWindow atol( hwnd) || atol( QW_OWNER), 2) return hwndOwner defc QueryOwner hWndOwner = QueryOwner( arg( 1)) dprintf( 'Owner of 'arg( 1)' = 'hwndOwner) ; --------------------------------------------------------------------------- defproc SetOwner hWnd = arg( 1) hWndNewOwner = arg( 2) rcx = dynalink32( 'PMWIN', -- dynamic link library name '#864', -- Win32SetOwner atol( hWnd) || atol( hWndNewOwner)) return rcx defc SetOwner parse arg hWnd hWndNewOwner rcx = SetOwner( hWnd, hWndNewOwner) dprintf( 'rcx = 'rcx) -- 1 = success ; --------------------------------------------------------------------------- defproc WindowFromId if arg() = 2 then hWndParent = arg( 1) Id = arg( 2) else Id = arg( 1) hWndParent = 1 -- HWND_DESKTOP endif hWnd = dynalink32( 'PMWIN', -- dynamic link library name '#899', -- Win32WindowFromID atol( hWndParent) || atol( Id), 2) return hWnd ; --------------------------------------------------------------------------- defproc QueryCheckValue( hWndParent, Id) hWnd = WindowFromId( hWndParent, Id) rcx = windowmessage( 1, hWnd, 292, -- BM_QUERYCHECK = 0x0124 = 292 0, 0) return rcx ; --------------------------------------------------------------------------- defproc SetCheckValue( hWndParent, Id, fChecked) hWnd = WindowFromId( hWndParent, Id) call windowmessage( 1, hWnd, 293, -- BM_SETCHECK = 0x0125 = 293 fChecked, 0) return ; --------------------------------------------------------------------------- defproc QueryDlgItemText( hWndParent, Id) Buff = copies( \0, 255) Len = dynalink32( 'PMWIN', -- dynamic link library name '#815', -- Win32QueryDlgItemText atol( hWndParent) || atol( Id) || atol( length( Buff)) || address( Buff)) parse value Buff with Text \0 return Text ; --------------------------------------------------------------------------- defproc SetDlgItemText( hWndParent, Id, Text) TextZ = Text\0 rcx = dynalink32( 'PMWIN', -- dynamic link library name '#859', -- Win32SetDlgItemText atol( hWndParent) || atol( Id) || address( TextZ)) return ; --------------------------------------------------------------------------- defproc SetEntryFieldSelect( hWndParent, Id) pStart = arg( 3) pEnd = arg( 4) if pStart = '' then pStart = 0 endif if pEnd = '' then pEnd = 1024 endif -- If pStart = pEnd, then only the cursor pos. is set. hWnd = WindowFromId( hWndParent, Id) call windowmessage( 1, hWnd, 322, -- EM_SETSEL = 0x0142 = 322 MpFrom2Short( pEnd, pStart), 0) return ; --------------------------------------------------------------------------- defproc EnableWindow( hWndParent, Id, Flag) hWnd = WindowFromId( hWndParent, Id) rcx = dynalink32( 'PMWIN', -- dynamic link library name '#735', -- Win32EnableWindow atol( hWnd) || atol( Flag)) return ; --------------------------------------------------------------------------- defproc SetWindowFont( hWndParent, Id, Fontname) FontnameZ = Fontname\0 Len = length( FontnameZ) IdPP = 15 -- PP_FONTNAMESIZE = 15L hWnd = WindowFromId( hWndParent, Id) rcx = dynalink32( 'PMWIN', -- dynamic link library name '#938', -- Win32SetPresParam atol( hWnd) || atol( IdPP) || atol( Len) || address( FontnameZ)) return ; --------------------------------------------------------------------------- ; Close: Let the app cancel the close before it posts quit. ; Quit: Quit the window. defproc CloseWindow hWnd = arg( 1) if hWnd = '' then hWnd = getpminfo( EPMINFO_EDITCLIENT) endif call windowmessage( 0, -- 0 = post, 1 = send hWnd, 41, -- WM_CLOSE = 0x0029 = 41 0, -- mp1 0) -- mp2 return defc CloseWindow CloseWindow( arg( 1)) ; --------------------------------------------------------------------------- ; Window pos. is saved to EPM -> DEFAULTSWP defproc SaveApp call windowmessage( 0, -- 0 = post, 1 = send getpminfo( APP_HANDLE), 62, -- WM_SAVEAPPLICATION = 0x003E = 62 0, -- mp1 0) -- mp2 return defc SaveApp, SaveWindowSize call SaveApp() ; --------------------------------------------------------------------------- defproc MakeWindowTopmost hWnd = arg( 1) if hWnd = '' then hWnd = 1 -- Default is HWND_DESKTOP endif Style = dynalink32( 'PMWIN', '#843', -- Win32QueryWindowULong atol( hWnd) || atol( QWL_STYLE), 2) if Style bitand WS_MINIMIZED then opts = SWP_ZORDER bitor SWP_ACTIVATE bitor SWP_RESTORE else opts = SWP_ZORDER bitor SWP_ACTIVATE endif x = 0 y = 0 cx = 0 cy = 0 rc = 1 rcx = dynalink32( 'PMWIN', '#875', -- Win32SetWindowPos atol( hWnd) || atol( HWND_TOP) || atol( x) || atol( y) || atol( cx) || atol( cy) || atol( opts)) if rcx = 1 then rc = 0 endif return defc MakeWindowTopmost call MakeWindowTopmost( arg( 1)) ; --------------------------------------------------------------------------- ; Ensures that window is visible on the desktop. Sets only window pos, but ; not window size. defproc MoveWindowToDesktop( hWnd) do once = 1 to 1 -- Query window pos. and size rc = 0 swp = copies( \0, 36) -- relative to the desktop rcx = dynalink32( 'PMWIN', '#837', -- Win32QueryWindowPos atol( hWnd) || address( swp)) if not rcx then --dprintf( 'Window doesn''t exist.') rc = 2 leave endif cy = ltoa( substr( swp, 5, 4), 10) cx = ltoa( substr( swp, 9, 4), 10) y = ltoa( substr( swp, 13, 4), 10) x = ltoa( substr( swp, 17, 4), 10) --dprintf( 'x = 'x', y = 'y', cx = 'cx', cy = 'cy) -- Query desktop window size cxd = NepmdQuerySysInfo( 'CXSCREEN') cyd = NepmdQuerySysInfo( 'CYSCREEN') -- Calc Newx fMovex = 1 if x < 0 then Newx = 0 elseif x + cx > cxd then Newx = Max( 0, cxd - cx) else fMovex = 0 Newx = x endif -- Calc Newy fMovey = 1 if y < 0 then Newy = 0 elseif y + cy > cyd then Newy = Max( 0, cyd - cy) else fMovey = 0 Newy = y endif -- Check if move needed if not (fMovex | fMovey) then --dprintf( 'No move needed.') rc = 18 leave endif -- Move window Flags = SWP_MOVE -- Not size rc = 0 rcx = dynalink32( 'PMWIN', '#875', -- Win32SetWindowPos atol( hWnd) || atol( 0) || -- hwndInsertBehind, ignored if SWP_ZORDER not specified atol( Newx) || atol( Newy) || atol( 0) || -- cx, ignored if SWP_SIZE not active atol( 0) || -- cy, ignored if SWP_SIZE not active atol( Flags)) if not rcx then rc = 1 endif enddo return ; --------------------------------------------------------------------------- ; Sets EPM frame window pos and size to the specified pos and size values ; (args 1 ... 4). If an arg is not specified, the current frame window ; values are used. ; Additionally, minimal pos and size values can be specified (args 5 ... 8). ; If an arg is not specified, default values apply. ; Pos and size window limitation takes place ; - if pos and/or size is smaller than specified minimal values ; - if pos or size is larger than desktop values. ; It ensures that the window is at least Minx and Miny pixels visible, that ; the title bar is visible and limits its size to the desktop window. defproc MinWindowPos do once = 1 to 1 x = arg( 1) y = arg( 2) cx = arg( 3) cy = arg( 4) Minx = arg( 5) -- Min. visible pixels at left and right desktop edge Miny = arg( 6) -- Min. visible pixels at bottom and top desktop edge Mincx = arg( 5) -- Min. width Mincy = arg( 8) -- Min. height if not Isnum( Minx) then Minx = 400 endif if not Isnum( Miny) then Miny = 400 endif if not Isnum( Mincx) then Mincx = 600 endif if not Isnum( Mincy) then Mincy = 600 endif -- Query current EPM frame window pos. QueriedWindowPos = NepmdQueryWindowPos( EPMINFO_EDITFRAME) if rc then leave endif parse value QueriedWindowPos with qx qy qcx qcy . --dprintf( 'QueriedWindowPos = 'QueriedWindowPos) if not Isnum( x) then x = qx endif if not Isnum( y) then y = qy endif if not Isnum( cx) then cx = qcx endif if not Isnum( cy) then cy = qcy endif -- Query desktop window size cxd = NepmdQuerySysInfo( 'CXSCREEN') if rc then leave endif cyd = NepmdQuerySysInfo( 'CYSCREEN') if rc then leave endif --dprintf( 'Desktop size = 'cxd cyd) -- Calc Newcx fSizex = 1 if cx < Mincx then -- Set min. width Newcx = Mincx elseif cx > cxd then -- Set max. width Newcx = cxd else Newcx = cx if cx = qcx then endif fSizex = 0 endif -- Calc Newcy fSizey = 1 if cy < Mincy then -- Set min. width Newcy = Mincy elseif cy > cyd then -- Set max. width Newcy = cyd else Newcy = cy if cy = qcy then fSizey = 0 endif endif -- Calc Newx fMovex = 1 if x > cxd - Minx then -- Make visible at the right desktop edge Newx = cxd - Minx elseif x + Newcx < Minx then -- Make visible at the left desktop edge Newx = Minx - Newcx else Newx = x if x = qx then fMovex = 0 endif endif -- Calc Newy fMovey = 1 if y > cyd - Miny then -- Make visible at the top desktop edge Newy = cyd - Miny elseif y + Newcy < Miny then -- Make visible at the bottom desktop edge Newy = Miny - Newcy else Newy = y if y = qy then fMovey = 0 endif endif -- Ensure that title bar is visible if Newy + Newcy > cyd then fMovey = 1 Newy = cyd - Newcy endif --dprintf( 'fMovex = 'fMovex', fMovey = 'fMovey', fSizex = 'fSizex', fSizey = 'fSizey) --dprintf( 'Newx = 'Newx', Newy = 'Newy', Newcx = 'Newcx', Newcy = 'Newcy) -- Get flags and check if repos. or resize is required Flags = 0 if fSizex | fSizey then Flags = Flags bitor SWP_SIZE endif if fMovex | fMovey then Flags = Flags bitor SWP_MOVE endif --dprintf( 'Flags = 'Flags) if Flags = 0 then leave endif -- Set window pos. and size call NepmdSetFrameWindowPos( Newx, Newy, Newcx, Newcy, Flags) enddo ; --------------------------------------------------------------------------- ; Ensures that EPM frame window is accessible. defc MinWindowPos MinPos = strip( arg( 1)) parse value MinPos with Minx Miny Mincx Mincy . call MinWindowPos( '', '', '', '', Minx, Miny, Mincx, Mincy) ; --------------------------------------------------------------------------- ; Sets EPM frame window pos and size to specified values. Ensures that ; window is accessible. defc WindowPos WinPos = strip( arg( 1)) parse value WinPos with x y cx cy . call MinWindowPos( x, y, cx, cy)