Show Posts

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.


Topics - Jan-Erik Lärka

Pages: 1 [2]
16
General Discussion / Open Source / 2
« on: July 07, 2015, 01:31:14 pm »
Hello,

the open source movement is strong and we that use OS/2 and eComStation benefit from several projects that originate or build on open source projects. Martin has done a great job to open source software and collecting sources.

What's the plan and how do we make best use of the source code?! Source code doesn't compile itself, someone has to do it and get a project afloat?

Regards,
//Jan-Erik

17
Programming / Google KML/KMZ to CSV
« on: June 12, 2015, 07:37:55 pm »
Hello,

I've been busy writing scripts that help me extract information from Google Maps.

Here's a script that does the opposite, it take a Google Map KML/KMZ file and convert the information into a csv file that can be used within Lotus 123, OpenOffice Calc etc.

It basically tries to unzip the file if it's a .kmz-file and read and interpret the xml-file into something usable. (See attachment if you're logged on)

Parameter: filename.kml or filename.kmz
Additional parameter: output.txt or something that can be used as output with tab separated values
Defaults to Standard Out on screen
Extra parameter: Tag such as "body" to limit the input between that tag but it only work when the environment variable fiberkartan has been set to 1.

//Jan-Erik

18
Applications / jEdit 5.1.0 filebrowser
« on: January 24, 2015, 11:06:12 am »
Hello,

it's impossible to open and/or save files in jEdit 5.1.0

I suspect that the trailing backslash is the cause of the problem, something that is not allowed in OS/2.
The file browser doesn't list anything and just append the path over and over again, with a trailing backslash.

How can this be fixed, or better yet, get jEdit the developers to rewrite the code to remove trailing backslashes altogether.

//Jan-Erik

19
Mail-News / Send email from commandline (actually a rexx script)
« on: December 13, 2014, 01:20:55 pm »
Hello,

What tool is available to send emails from command line?

I've created a quite large script that at the end has to reply to 12 e-mail addresses.
The text in the body has to contain national characters such as å, ä and ö and a png image (each different) as attachement.

1. PMMail run a filter that detect a certain file from a certain sender
2. PMMail launch my rexx script
3. My rexx script use a python script to convert the xlsx-file into a csv-file
4. My rexx script interpret the file and get the coordinates of addresses from google (maps api) specified in the csv-file
5. My rexx script write 1 + 4 × 10 different files based on areas, contacting info, misspelled addresses etc.
6. My rexx script start an OpenOffice .ods file that use a series of macros to (among other things) export 12 charts to a ftp-server through netdrive.
7. My rexx script should send an email to give a brief update and notify each person about the current status and attach a chart (png image) exported from the .ods-file by the macros to show how far they've come.

Suggestions?

No, PMMSend remove å, ä and ö, so it has to be fixed first.
Yes, they fixed the = ? encoding problem yesterday.

Ohh, yes, I need the solution up and running by tomorrow (Sunday 14 December 2014)  :P

Regards,
//Jan-Erik

20
Programming / Rexx script to enable OpenOffice Macro support!
« on: April 16, 2014, 11:28:30 pm »
Hello,

I've used OpenOffice.org for quite some time and consider myself as a power user when it come to designing spreadsheets, so the disabled support for macros in OpenOffice.org has been annoying to say the least

I today found the relevant post how to enable marco security and now written a rexx script and tested it successfully. You can test and use it as well!

You need a macro in your spreadsheet to see that it actually work, so follow the steps below to add the relevant but very simple code to your spreadsheet

Regards,
//Jan-Erik

OpenOffice.org Calc
Menu:Tools -> Macros -> Organize macros -> OpenOffice.org Basic...
Window:OpenOffice.org Basic Macros
Area:Macro from
Treeview:[-]<Select your spreadsheet>
Mark:[-] Standard
Button:[  New  ]
Window:New Module
Field:Name:
Keyboard:GetSheetName
Button:[  OK  ]
Window:<Your spreadsheets name> - OpenOffice.org Basic
Cut & Paste:
Code: [Select]
Function GetSheetName( i )
On Error Goto trap
GetSheetName = ThisComponent.Sheets(i-1).Name
Exit Function
trap:
GetSheetName = erl()
End Function
Menu:File -> Save
Menu:File -> Close
Spreadsheet:Select a cell
Keyboard:=getsheetname(3)
Keyboard:Enter
As you press enter the cell will show #VALUE
Save the spreadsheet and run the script below and set it to 1
Higher value mean higher security but also more restrictions
Reopen the spreadsheet
Allow it to run the macro
You should now see the name of the third tab in your spreadsheet in the cell.
====

You will see a window that ask if you want to enable macros if you set the security level to 1.
You can rerun this script if you like to increase or decrease the security level.
Code: [Select]
/*
 * Filename: OOorgMacro.cmd
 *   Author: JAN-ERIK
 *  Created: Wed Apr 16 2014
 *  Purpose: Add macro security tag to configuration file to be able to run Macros in the OS/2 and eComstaiton version of OpenOffice.org
 *  Changes:
 */

/* Load RexxUtil Library */
IF RxFuncQuery('SysLoadFuncs') THEN
DO
    CALL RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
    CALL SysLoadFuncs
END
CALL SysCls
CALL LINEOUT 'STDERR', 'OpenOffice.org for OS/2 and eComstation'
CALL LINEOUT 'STDERR', "doesn't contain a utility to allow you to enable macros"
CALL LINEOUT 'STDERR', ''
CALL LINEOUT 'STDERR', 'This script will attempt to enable macro security for you.'
CALL LINEOUT 'STDERR', ''
CALL LINEOUT 'STDERR', 'Please do note that you should be aware that macros may'
CALL LINEOUT 'STDERR', "be harmful so don't open files from unknown sources or"
CALL LINEOUT 'STDERR', 'files that may contain macros.'
CALL LINEOUT 'STDERR', ''
CALL LINEOUT 'STDERR', "Don't blame the author of this script for any harm caused!"
CALL LINEOUT 'STDERR', ''
CALL CHAROUT 'STDERR', 'Do you want to continue (yes/No)? (N by default) '
PARSE PULL answer
IF TRANSLATE( LEFT( answer, 1 ) ) <> 'Y' THEN RETURN 0
level = ' '
DO WHILE \DATATYPE( level, 'W' )
    CALL LINEOUT 'STDERR', ''
    CALL LINEOUT 'STDERR', 'Valid values are: 0 - the lowest; 1 - the lower; 2 - default; 3 - the highest'
    CALL LINEOUT 'STDERR', ''
    CALL CHAROUT 'STDERR', 'Specify the security level to use (4 and above to abort): '
    PARSE PULL level
    IF level = '' THEN level = 2
    IF level < 0 THEN level = ' '
    IF level > 3 THEN RETURN level
END

newln = D2C(10)
add.1 = '<node oor:name="Security">'
add.2 = '  <node oor:name="Scripting">'
add.3 = '   <prop oor:name="MacroSecurityLevel" oor:type="xs:int">'
add.4 = '    <value>'||level||'</value>'
add.5 = '   </prop>'
add.6 = '  </node>'
add.7 = '</node>'
add.8 = '</oor:component-data>'
add.0 = 8

CALL CHAROUT 'STDERR', '.'
home_dir = VALUE( 'HOME',, 'OS2ENVIRONMENT' )

IF SysFileTree( home_dir||'\*common.xcu', 'file.', 'SFO' ) = 0 THEN
DO i = 1 TO file.0
    f_size = STREAM( file.i, 'C', 'QUERY SIZE' )
    IF f_size = 0 THEN ITERATE
    input = CHARIN( file.i, 1, f_size )
    CALL STREAM file.i, 'C', 'CLOSE'
    PARSE VALUE input WITH pre(add.8).
    PARSE VALUE pre WITH pre(add.1).
    DO j = 1 TO add.0
        CALL CHAROUT 'STDERR', '.'
        pre = pre||add.j
        IF j < add.0 THEN
            pre = pre||newln
    END
    IF SysFileDelete( file.i ) = 0 THEN
        CALL CHAROUT file.i, pre
    CALL CHAROUT 'STDERR', '.'
END

21
Programming / Schedule Wake Up with DragText 3.x
« on: February 06, 2014, 03:51:35 pm »
Hello,

I use my computer to wake me up in the morning.

The excellent DragText 3.9 add convenient drag & drop functions that I sometime forget is not present elsewhere when I have to use other systems. DragText also contain a scheduler and the documentation is straight forward and mention how to set the variables, but I can't find a way to complete the setup with the script as the text for REPEAT puzzle me a bit.

"REPEAT = ON | OFF
Set the object to reopen on a regular basis. The year must have 4 digits; the month and day must have 2."

The only possible settings for REPEAT is therefore ON or OFF.

How do I set the repeat interval with the information above, or...?



The code below should create Program objects in your Utilities folder that point to a script called AxelF.cmd placed in the same folder as this script. Day, date and start time will be set, but it can't quite yet complete the setup unless you set the interval by hand and activate each scheduled Program Object.

//Jan-Erik
Code: [Select]
/*
 * Filename: wakeup.cmd
 *   Author: JAN-ERIK
 *  Created: Sun Jan 26 2014
 *  Purpose: Script to create schedule of wake up tunes.
 *  Changes:
 */

/* Load RexxUtil Library */
IF RxFuncQuery( 'SysLoadFuncs' ) THEN
DO
    CALL RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
    CALL SysLoadFuncs
END

folder = '<WP_TOOLS>'
prefix = 'Alarm '
app = DIRECTORY()||'\AxelF.cmd'

day.1 = 'MONDAY'
day.2 = 'TUESDAY'
day.3 = 'WEDNESDAY'
day.4 = 'THURSDAY'
day.5 = 'FRIDAY'
day.6 = 'SATURDAY'
day.7 = 'SUNDAY'
day.0 = 7

/* Set the wake up Time */
day.1.t = '06:00:00'
day.2.t = '05:10:00'
day.3.t = '06:00:00'
day.4.t = '05:10:00'
day.5.t = '06:00:00'
day.6.t = '08:00:00'
day.7.t = '08:00:00'

/* Translate to your own language */
day.1.n = 'Monday'
day.2.n = 'Tuesday'
day.3.n = 'Wednesday'
day.4.n = 'Thursday'
day.5.n = 'Friday'
day.6.n = 'Saturday'
day.7.n = 'Sunday'

today = TRANSLATE( DATE( 'W' ) )
PARSE VALUE DATE( 'S' ) WITH yyyy +4 mm +2 dd
DO i = 1 TO day.0
    IF today = day.i THEN LEAVE
END
IF i < 7 THEN
DO j = i + 1 TO day.0
    CALL CreateSchedule prefix||day.j.n, folder, 'EXENAME='||app||';OBJECTID=<ALARM_'||day.j||'>;SCHEDULE=ON;DATE='||Unbase( CalcBaseDate( DATE( 'S' ) ) + j )||';TIME='||day.j.t||';REPEAT=ON;ALWAYSOPEN=ON;'
    CALL SysSleep 1
END
IF i > 2 THEN
DO j = 1 TO i
    CALL CreateSchedule prefix||day.j.n, folder, 'EXENAME='||app||';OBJECTID=<ALARM_'||day.j||'>;SCHEDULE=ON;DATE='||Unbase( CalcBaseDate( DATE( 'S' ) ) + j )||';TIME='||day.j.t||';REPEAT=ON;ALWAYSOPEN=ON;'
    CALL SysSleep 1
END
RETURN 0

CreateSchedule: PROCEDURE
/* Remove or Comment out the next line when the code has been completed */
    SAY ARG(3)
    IF SysCreateObject( 'WPProgram', ARG(1), ARG(2), ARG(3), 'U' ) THEN
        SAY '"'||ARG(1)||'" has been created'
    ELSE SAY "Couldn't create "||'"'||ARG(1)||'"'
RETURN 0

DATED: PROCEDURE
    PARSE VALUE DATE( 'S' ) WITH yyyy +4 mm +2 dd
    today = DATE( 'D' )

RETURN 0
PARSE VALUE DATE( 'S' ) WITH yyyy +4 mm +2 dd

UnBase: Procedure
    PARSE ARG x
    If x > 3652058 then Return 'BAD'
    /*  Numeric digits 14 */
    opy = 400  * ( x + 1 ) % 146097
    ddd = x + 1 - ( opy * 365 + opy % 4 - opy % 100 + opy % 400 )
    If ddd = 366 then
    Do
        NLeapYear = ( ( ( opy + 1 ) // 4 ) <> 0 )
        opy = opy + NLeapYear
        If NLeapYear then ddd = 1
    End
    If ddd = 0 then
    Do
        LeapYear = opy // 400 = 0 | ( opy // 4 = 0 & opy // 100 <> 0 )
        ddd = 365 + LeapYear
        opy = opy - 1
    End
Return ISODate( right( opy + 1, 4, 0 ) || right( ddd, 3, 0 ) )

Syntax:
    say 'At line' sigl':' errortext(rc)
Return 'BAD'

ISODate: Procedure
    Parse arg yyyy 5 ddd .
    LeapYear = yyyy // 400 = 0 | ( yyyy // 4 = 0 & yyyy // 100 <> 0 )
    If ddd > 59 + LeapYear then y = 2 - LeapYear
    Else y = 0
    z = ddd + y + 91
    m = (z * 100 ) % 3055
    d = z - ( m * 3055 ) % 100
Return yyyy'/'right( m - 2, 2, 0 )'/'right( d, 2, 0 )

CalcBaseDate: PROCEDURE
  NonLeap.   = 31
  NonLeap.0  = 12
  NonLeap.2  = 28
  NonLeap.4  = 30
  NonLeap.6  = 30
  NonLeap.9  = 30
  NonLeap.11 = 30

  parse arg cyear +4 cmonth +2 cdate

  if length( cyear ) <= 2 then
    if cyear < 80 then
      fullyear = "20" || cyear
    else
      fullyear = "19" || cyear
  else
    fullyear = cyear

  numyears = fullyear -1
  basedays = numyears * 365
  QuadCentury = numyears % 400
  Century = numyears % 100
  LeapYears = numyears % 4
  basedays = basedays + (((LeapYears - Century) + QuadCentury) - 1)

  do i = 1 to (cmonth -1)
    if i <> "2" then
      basedays = basedays + NonLeap.i
    else /* find if it's a leap year or not */
      if (fullyear // 4) > 0 then
        basedays=basedays + 28
      else
        if ((fullyear // 100) = 0) & ((fullyear // 400) > 0) then
        do
                        /* century not divisble by 400                */
          basedays = basedays + 28
        end /* if */
        else
        do
                        /* quad century or regular leap year          */
          basedays = basedays + 29
        end /* else */
  end /* do */

  basedays = basedays + cdate
return basedays

22
Programming / rexx Screen Capture
« on: December 01, 2013, 06:20:57 pm »
Hello,

I've managed to write a function in a rexx dll that can capture the screen and save it to a file.

I can post the source code and file here, but would first get your help how to find out the names of open windows (folders, applications etc.) to add that option as well.

Selection of screen coordinates would be nice as well, but I'll await your code before I post the .dll.

Regards,
//Jan-Erik

23
Programming / Rename files and set long name
« on: November 17, 2013, 09:59:08 am »
Hello,

I've searched for a function in rexx to rename files and eventually found the answer...
SysSetObjectData with the second parameter TITLE= together with the new name.
It's quite easy to rename the file/folder that way and to write a rename.cmd

CALL SysSetObjectData file_path_and_name, 'TITLE='||new_name

Recovery scripts and tools ( DFSee, JRescuer ) rely on EA's (Extended Attribute) to restore file names since JFS doesn't have the backup information about the file name within the fs itself. The functions below synchronize the file name and the EA so that such tools can help you in case of problems when you need to recover files. You do however need to run and set the EA before any problem arise that require recovery.

Please do note that I've added code that will remove unwanted characters from the actual file name that annoy me (files from the internet, other OSes etc.) , but you may want to keep those, extend them or tweak it further by altering the function "CleanString".

//Jan-Erik

Code: [Select]
setLongName: PROCEDURE
/* File/Folder name as the first and only parameter (full path) */
    file_name = FILESPEC( 'N', ARG(1) )
/* Read the EA entry for .LONGNAME from the File/Folder */
    rc = SysGetEA( ARG(1), '.LONGNAME', 'EAValue' )
/* Was it possible to read the EA entry for .LONGNAME successfully? */
    IF rc = 0 & EAValue <> '' THEN
    DO
/* Split the information up for further use */
        PARSE VAR EAValue EAType +2 EALength +2 EAValue
/* Does it contain a valid name, then set it */
        IF EAType = 'FDFF'x THEN
        DO
            longName = STRIP( EAValue, 'T', '00'x )
/* Remove unwanted charaters */
           cleanLongName = CleanString( longName )
/* Any changes between the long name and cleaned name? */
           IF cleanLongName <> longName THEN
           DO
/* Set the long name to the one of the cleaned */
               longName = cleanLongName
/* and write the information back */
               CALL SysPutEA ARG(1), '.LONGNAME', 'FDFF'x || D2C( LENGTH( longName ) ) || '00'x || longName
           END
/* If the name is different from the long name */
           IF longName <> file_name THEN
/* If the file/folder can be renamed to the long name, then set the new name */
              IF SysSetObjectData( ARG(1), 'TITLE='||longName ) THEN
                 file_name = longName
        END
        ELSE
            CALL SysPutEA ARG(1), '.LONGNAME', 'FDFF'x || D2C( LENGTH( file_name ) ) || '00'x || file_name
    END
    ELSE
        CALL SysPutEA ARG(1), '.LONGNAME', 'FDFF'x || D2C( LENGTH( file_name ) ) || '00'x || file_name
/* Above: Just write the current name to the EA if none has been set */
/* and return the file/folder with path */
RETURN FILESPEC( 'D', ARG(1) )||FILESPEC( 'P', ARG(1) )||file_name

/* String function */
CleanString: PROCEDURE
    haystack = ARG(1)
/* Clean out % and replace %20 = space, %28 = [, %29 = ] etc. */
    DO WHILE POS( '%', haystack ) > 0
        PARSE VALUE haystack WITH pre'%' +1 hex_val +2 post
        IF DATATYPE( hex_val, 'X' ) & SPACE( hex_val, 0 ) <> '' THEN
            haystack = pre||X2C( hex_val )||post
        ELSE haystack = pre||hex_val||post
    END
/* 35 = #, 36 = $, 58 = :, 91 = [, 92 = \, 93 = ], 123 = {, 125 = } etc. */
    clean = '35 36 58 91 92 93 123 125 127'
    DO i = 1 TO WORDS( clean )
        needle = D2C( SUBWORD( clean, i, 1 ) )
        DO WHILE POS( needle, haystack ) > 0
            PARSE VALUE haystack WITH pre(needle)post
            haystack = pre||post
        END
    END
RETURN haystack

24
Programming / Install TTF Fonts with Rexx
« on: June 07, 2013, 03:03:07 pm »
Hello,

you should all have alot of packages with ttf-fonts that you want to add to your system.
The script here will unpack and add them so you can use them after the next reboot.

//Jan-Erik

Code: [Select]
/*
 * Filename: InstFonts.cmd
 *   Author: JAN-ERIK
 *  Created: Sun Mar 31 2013
 *  Purpose: Unpack .zip-files that contain .ttf fonts and add them to your OS/2-eCS system
 *  Changes:
 */

ttfs = 'C:\PSFONTS\TTF' /* Unpack/Install to path */

IF RxLoadLib( 'UZLoadFuncs', 'UNZIP32' ) <> '' THEN
DO
    IF DATATYPE( STRIP( unzipver ), 'N' ) THEN exeunzip = 1
    ELSE exeunzip = -1
END
ELSE exeunzip = 0

IF exeunzip < 0 THEN
DO
    CALL LINEOUT 'STDERR', 'UnZip not found, please install it'
    RETURN 1
END

IF RxLoadLib( 'SysLoadFuncs', 'rexxutil' ) <> '' THEN
DO
    CALL LINEOUT 'STDERR', 'RexxUtil not found, please install it'
    RETURN 2
END

PARSE ARG path
path = STRIP( path, 'T', '\' )
PARSE SOURCE . . this
this = STRIP( FILESPEC( 'D', this )||FILESPEC( 'P', this ), 'T', '\' )
IF LENGTH( path ) = 0 THEN RETURN Usage()
IF DIRECTORY( path ) = '' THEN RETURN Usage()
CALL DIRECTORY this

rc = SysFileTree( path||'\*.zip', 'pkg.', 'SFO' )
DO i = 1 TO pkg.0 + 1
    CALL rxWorking 1, 'Processing '||pkg.i
    CALL rxProgress 2, ( i - 1 ) / ( pkg.0 + 1 ), 0
    IF exeunzip = 0 THEN
        CALL UZUnZip '-n -j '||pkg.i||' *.ttf -d '||ttfs, 'font.'
    ELSE IF exeunzip = 1 THEN
    DO
        DO WHILE QUEUED() > 0; PARSE PULL; END;
        '@UNZIP -n -j '||pkg.i||' *.ttf -d '||ttfs||'|RXQUEUE'
        j = 0
        DO WHILE QUEUED() > 0
            j = j + 1
            font.j = LINEIN( 'QUEUE:' )
            font.0 = j
        END
        DO WHILE QUEUED() > 0; PARSE PULL; END;
    END
    DO j = 1 TO font.0
        CALL rxProgress 2, i / ( pkg.0 + 1 ), ( i - 1 + j / font.0 ) / ( pkg.0 + 1 )
        PARSE VALUE REVERSE( font.j ) WITH ext'.'filename'/'filepath' :'.
        IF TRANSLATE( STRIP( ext ) ) = 'FTT' THEN
        DO
            font.j.fontname = REVERSE( filename )
            CALL rxWorking 1, 'Adding "'||font.j.fontname||'"'
            CALL RegisterFont font.j.fontname, TRANSLATE( REVERSE( filepath ), '\', '/' )||'\'||font.j.fontname||'.ttf'
        END
    END
END
rc = SysFileTree( path||'\*.ttf', 'file.', 'SFO' )
DO i = 1 TO file.0
    CALL rxProgress 2, pkg.0 / ( pkg.0 + 1 ), ( pkg.0 + i / file.0 / ( pkg.0 + 1 ) )
    IF SysCopyObject( file.i, ttfs ) THEN
    DO
        PARSE VALUE REVERSE( file.i ) WITH .'.'filename'\'
        filename = REVERSE( filename )
        CALL rxWorking 1, 'Adding "'||filename||'"'
        CALL RegisterFont filename, file.i
    END
END
CALL CleanupInstalledFonts
CALL rxProgress 2, 1
RETURN

Usage: PROCEDURE
    PARSE SOURCE . . scriptname
    PARSE VALUE REVERSE( FILESPEC( 'N', scriptname ) ) WITH .'.'scriptname
    CALL LINEOUT 'STDOUT', 'Usage:'
    CALL LINEOUT 'STDOUT', '      '||REVERSE( scriptname )||' C:\My\Zipped\Fonts'
RETURn 0

RxLoadLib: PROCEDURE
    SIGNAL ON SYNTAX NAME Faulty
    CALL RxFuncAdd ARG(1), ARG(2), ARG(1)
    INTERPRET 'CALL '||ARG(1)
RETURN ''
Faulty:
RETURN "Couldn't load "||ARG(2)||".dll and register "||ARG(1)||"!"

/* display_on_row, part  */
rxProgress: PROCEDURE EXPOSE  __meter. !_sqleng_!. !_tmp_table_!
    IF TRACE() = '?I' THEN RETURN 0
    row = ARG(1)
    IF SYMBOL( "__meter.row.t_stamp" ) = "VAR" THEN
        IF __meter.row.t_stamp + 1 > TIME( 'S' ) THEN RETURN 0
    chr = 'Û²±°þÛ ' /* you may have to replace the varaible value with ░▒▓█■█ */
    IF SYMBOL( "__meter.width" ) <> "VAR" THEN
        PARSE VALUE SysTextScreenSize() WITH __meter.height __meter.width
    ELSE IF \DATATYPE( __meter.width, 'W' ) THEN
        PARSE VALUE SysTextScreenSize() WITH __meter.height __meter.width
    DO i = 2 TO MIN( ARG(), LENGTH( chr ) )
        j = i - 1
        IF LENGTH( ARG(i) ) = 0 THEN progress.j = 1
        ELSE IF \DATATYPE( ARG(i), 'N' ) THEN RETURN 0
        ELSE progress.j = FORMAT( ARG(i),,, 0 )
        IF LENGTH( FORMAT( 100 * progress.j,, 0, 0 ) ) > 3 THEN
            RETURN 0
    END
    progress.0 = j
    processed.0 = 0
    output = ''
    CALL SysStemSort 'progress'
    DO i = 1 TO MIN( progress.0, LENGTH( chr ) )
        j = i - 1
        processed.i = FORMAT( MIN( ( __meter.width - 4 ) * progress.i , __meter.width - 4 ),, 0, 0 )
        progress.i = FORMAT( 100 * progress.i, 3, 0, 0 )

        IF processed.i > processed.j THEN
            output = output||COPIES( SUBSTR( chr, i, 1 ), processed.i - processed.j )
    END
    i = i - 1
    output = output||COPIES( SUBSTR( chr, LENGTH( chr ), 1 ), __meter.width - 4 - processed.i )
    CALL rxOut ARG(1), output||RIGHT( progress.1||'%', 4 )
RETURN 0

/* display_on_row, text  */
rxWorking: PROCEDURE EXPOSE __meter. !_sqleng_!. !_tmp_table_!
    IF TRACE() = '?I' THEN RETURN 0
    PARSE ARG row, txt
    IF SYMBOL( "__meter."||row||".t_stamp" ) <> "VAR" THEN
        __meter.row.t_stamp = TIME( 'S' )
    ELSE IF \DATATYPE( __meter.row.t_stamp , 'N' ) THEN
        __meter.row.t_stamp = TIME( 'S' )
    IF __meter.row.t_stamp + 1 < TIME( 'S' ) THEN
    DO
        SELECT
            WHEN __meter.counter = 1 THEN
                CALL rxOut row, '/ '||txt
            WHEN __meter.counter = 2 THEN
                CALL rxOut row, '- '||txt
            WHEN __meter.counter = 3  THEN
                CALL rxOut row, '\ '||txt
            OTHERWISE
            __meter.counter = 0
            CALL rxOut row, '| '||txt
        END
        __meter.counter = __meter.counter + 1
    END
RETURN 0

/* display_on_row, text  */
rxOut: PROCEDURE EXPOSE __meter. !_sqleng_!. !_tmp_table_!
    IF TRACE() = '?I' THEN RETURN 0
    PARSE ARG row, txt
    IF SYMBOL( "__meter.width" ) <> "VAR" THEN
        PARSE VALUE SysTextScreenSize() WITH __meter.height __meter.width
    IF SYMBOL( "__meter."||row||".t_stamp" ) <> "VAR" THEN
        __meter.row.t_stamp = TIME( 'S' )
    IF \DATATYPE( __meter.row.t_stamp, 'W' ) | \DATATYPE( __meter.width, 'W' ) THEN
        PARSE VALUE SysTextScreenSize() WITH __meter.height __meter.width
    isNum = DATATYPE( row, 'W' )
    IF isNum THEN
    DO
        IF DATATYPE( __meter.row.t_stamp, 'W' ) THEN
            IF __meter.row.t_stamp + 1 > TIME( 'S' ) THEN RETURN 0
        PARSE VALUE SysCurPos( row, 0 ) with prev_row prev_col
    END
            ELSE IF DATATYPE( __meter.row.t_stamp, 'W' ) THEN
                IF __meter.row.t_stamp + 1 > TIME( 'S' ) THEN RETURN 0
    CALL CHAROUT 'STDERR', LEFT( txt, MAX( __meter.width, MIN( LENGTH( txt ), __meter.width ) ) )
    IF isNum THEN
    DO
        CALL SysCurPos prev_row, prev_col
        __meter.row.t_stamp = TIME( 'S' )
    END
    ELSE
        __meter.row.t_stamp = TIME( 'S' )
RETURN 0

/* Register a font in the desktop INI file.  The font will be available to PM
 * after the next startup.
 */
RegisterFont: PROCEDURE EXPOSE log1
    PARSE ARG fontname, filename

    inirc = SysIni( 'USER', 'PM_Fonts', fontname, filename || '00'x )
    IF inirc == '' THEN
        CALL rxOut 1, ' - Registered "'fontname'" in profile.'
    ELSE
        CALL rxOut 3, ' - Failed to register "'fontname'" in profile:' inirc
RETURN 0

/* Check all registered fonts in OS2.INI and make sure they're actually
 * installed.  Deregister any non-existent font.
 */
CleanupInstalledFonts: PROCEDURE EXPOSE log1

    ok = SysIni( 'USER', 'PM_Fonts', 'ALL:', 'regfonts.' )
    IF ok == 'ERROR:' THEN RETURN 1

    CALL rxOut 1, 'Verifying' regfonts.0 'registered fonts...'
    DO i = 1 TO regfonts.0
        PARSE VALUE SysIni( 'USER', 'PM_Fonts', regfonts.i ) WITH _font '00'x .
        IF _font == 'ERROR:' THEN ITERATE
        IF STREAM( _font, 'C', 'QUERY EXISTS' ) == '' THEN DO
            CALL rxOut 3, 'Registered font' _font 'does not exist - deregistering.'
            ok = SysIni( 'USER', 'PM_Fonts', regfonts.i, 'DELETE:' )
            IF ok == 'ERROR:' THEN CALL rxOut 3, 'Deregistering of font' _font 'failed!'
        END
    END

RETURN 0

25
Programming / JSon to Rexx (stem)
« on: February 24, 2013, 09:06:58 am »
Hello,

couldn't hold back, had to write some rexx code to parse a JSon file.
I've tested and adjusted the code to handle variations to it, so it should be quite stable.
It should cope with incomplete input as well, but it will then return a non 0 value to indicate how far from complete the input is.

There are many services out there that pass data in JSon format.
Code: [Select]
/*
 * Filename: JSon2Rx.cmd
 *   Author: Jan-Erik
 *  Created: Sat Feb 23 2013
 *  Purpose: Interpret a JSon-file and place in stem
 *  Changes:
 */

IF ARG() > 0 THEN
    IF STREAM( ARG(1), 'C', 'QUERY EXISTS' ) <> '' THEN
        f_name = ARG(1)
    ELSE
        f_name = 'london.json'
ELSE
    f_name = 'london.json'

IF STREAM( f_name, 'C', 'QUERY EXISTS' ) = '' THEN RETURN 1
f_size = STREAM( f_name, 'C', 'QUERY SIZE' )
f_input = CHARIN( f_name, 1, f_size )
CALL STREAM f_name, 'C', 'CLOSE'

stem = 'json.'
DO WHILE fromJSon( f_input ) > 0
    CALL CHAROUT 'STDERR', 'Parts of the file missing! Press Enter to read it again. '
    PARSE PULL
    f_size = STREAM( f_name, 'C', 'QUERY SIZE' )
    f_input = CHARIN( f_name, 1, f_size )
    CALL STREAM f_name, 'C', 'CLOSE'
END
   
DO i = 1 TO json.0
    SAY json.i '=' VALUE( json.i )
END

RETURN 0

fromJSon: PROCEDURE EXPOSE (stem)
    !_str_json_! = ARG(1)
    !_stem_counter_! = 0
    !_not_in_key_range_! = SPACE( TRANSLATE( XRANGE(),, XRANGE( 'a', 'z' )||XRANGE( 'A', 'Z' )||XRANGE( 0, 9 )||'_' ), 0 )
    IF SYMBOL( stem ) <> 'LIT' THEN
        stem = 'STEM'
    stem = STRIP( TRANSLATE( stem ), 'T', '.' )
    !_s_name_! = stem
    DO WHILE LENGTH( !_str_json_! ) > 0
        PARSE VALUE !_str_json_! WITH !_key_!':'!_str_json_!
        IF POS( '{', STRIP( !_key_! ) ) = 1 THEN
        DO
            PARSE VALUE !_key_! WITH '{'!_key_!
            !_key_! = SPACE( TRANSLATE( !_key_!,, !_not_in_key_range_! ), 0 )
        END
        CALL calc4Pos
        IF !_strt_brkt_! < !_key_val_del_! & !_strt_brkt_! < !_end_brkt_! & 0 < !_strt_brkt_! THEN
        DO
            PARSE VALUE !_str_json_! WITH '{'!_str_json_!
            !_key_! = SPACE( TRANSLATE( !_key_!,, !_not_in_key_range_! ), 0 )
            IF !_strt_sqr_brkt_! < !_strt_brkt_! & 0 < !_strt_sqr_brkt_! THEN
            DO
                !_s_name_! = !_s_name_!'.'TRANSLATE( !_key_! )'.0'
                IF POS( '.', !_s_name_! ) > 0 THEN
                DO
                    PARSE VALUE REVERSE( !_s_name_! ) WITH !_n_!'.'!_s_name_!
                    !_n_! = REVERSE( !_n_! )
                    !_s_name_! = REVERSE( !_s_name_! )
                    IF DATATYPE( !_n_!, 'W' ) THEN
                    DO
                        !_n_! = !_n_! + 1
                        CALL VALUE !_s_name_!'.0', !_n_!
                    END
                    !_s_name_! = !_s_name_!'.'!_n_!
                END
                ELSE
                    !_s_name_! = !_s_name_!'.'STRIP( TRANSLATE( !_key_! ),, '"' )
            END
            ELSE
                !_s_name_! = !_s_name_!'.'STRIP( TRANSLATE( !_key_! ),, '"' )
            ITERATE
        END
        !_stem_counter_! = !_stem_counter_! + 1
        PARSE VALUE !_str_json_! WITH !_val_!','!_str_json_!
        PARSE VALUE !_val_! WITH !_val_!'}'!_rest_!
        !_key_! = SPACE( TRANSLATE( !_key_!,, !_not_in_key_range_! ), 0 )
        IF POS( '"', !_val_! ) > 0 THEN
            PARSE VALUE !_val_! WITH '"'!_val_!'"'
        !_val_! = STRIP( STRIP( STRIP( STRIP( STRIP( STRIP( !_val_! ), 'T', D2C(10) ), 'T', D2C(13) ) ),, '"' ) )
        CALL VALUE !_s_name_!'.'TRANSLATE( !_key_! ), !_val_!
        CALL VALUE VALUE( stem )'.'!_stem_counter_!, !_s_name_!'.'TRANSLATE( !_key_! )
        CALL VALUE VALUE( stem )'.0', !_stem_counter_!
        IF ( !_end_brkt_! < !_key_val_sep_! | !_key_val_sep_! = 0 )  & ( !_end_brkt_! < !_end_sqr_brkt_! | !_end_sqr_brkt_! = 0 ) THEN
        DO
            !_n_! = ''
            !_rest_! = '}'||SPACE( TRANSLATE( !_rest_!,, SPACE( TRANSLATE( XRANGE(),, '}]' ), 0 ) ), 0 )
            DO WHILE LENGTH( !_rest_! ) > 0
                PARSE VALUE !_rest_! WITH !_sign_! +1 !_rest_!
                IF POS( '.', !_s_name_! ) > 0 THEN
                DO
                    PARSE VALUE REVERSE( !_s_name_! ) WITH !_n_!'.'!_s_name_!
                    !_s_name_! = REVERSE( !_s_name_! )
                    !_n_! = REVERSE( !_n_! )
                    IF DATATYPE( !_n_!, 'W' ) & LEFT( !_rest_!, 1 ) <> ']' THEN
                    DO
                        !_n_! = !_n_! + 1
                        !_s_name_! = !_s_name_!'.'!_n_!
                    END
                END
            END
        END
    END
RETURN COUNTSTR( '.', !_s_name_! ) /* IF retval > 0 THEN INCOMPLETE FILE OR ERROR IN FUNCTION */

calc4Pos:
    !_strt_sqr_brkt_! = POS( '[', !_str_json_! )
    !_end_sqr_brkt_! = POS( ']', !_str_json_! )
    !_strt_brkt_! = POS( '{', !_str_json_! )
    !_end_brkt_! = POS( '}', !_str_json_! )
    !_key_val_sep_! = POS( ',', !_str_json_! )
    !_key_val_del_! = POS( ':', !_str_json_! )
RETURN 0


/* Count the number of occurances of needle in haystack from start pos to end pos (whole string by default) */
COUNTSTR: PROCEDURE /* needle, haystack< <, startpos>, endpos> */
    IF TRACE() = '?I' THEN CALL TRACE 'O'
    IF ARG() < 2 THEN RETURN -1
    IF DATATYPE( ARG(3), 'W' ) THEN
        next = ARG(3)
    ELSE
        next = 1
    needle = ARG(1)
    haystack = ARG(2)
    IF DATATYPE( ARG(4), 'W' ) THEN
        haystack = SUBSTR( haystack, next, ABS( ARG(4) - next ) )
    next = 1
    count = 0
    DO WHILE next > 0
        next = POS( needle, haystack, next )
        IF next > 0 THEN DO
            next = next + LENGTH( needle )
            count = count + 1
        END
    END
RETURN count

It's much easier to update a rexx script than a compiled application if they change something.
The rexx script should however pass the collected data to the desktop application.

Wouldn't mind to have a weather widget in eCS to show the weather and forecasts. OpenWeatherMap
I know there are additions to eCenter, but wouldn't mind something more than text.

Anyone feel up to write a eCenter/SysTray/Desktop widget with graphics?
I'd suggest to combine it with transparent png's to make it pleasant to use and look at!

//Jan-Erik

26
Programming / Suspend
« on: February 08, 2013, 07:52:38 pm »
Hello,

The documentation for Warp 4 mention that it was possible to suspend the system and boot into something else as it then would wake up afterward. Forget about the mentioned systems in the text below and instead concentrate on what it would allow the system to do.

Quote
Dedicated DOS/Windows Session -- Enables a user to quickly switch from OS/2 Warp to a dedicated DOS or Windows environment and back again, using suspend/resume technology. This technology can also be used to suspend/resume OS/2 Warp instead of shutting down/rebooting. Program objects can be created to invoke this function from the OS/2 Warp desktop. Dedicated DOS/Windows Session function is supported for IDE/FAT systems only. Networking connections are not maintained when OS/2 is suspended.

It doesn't seem to rely on the hardware (and why should it?!).

Would it be possible (if one had the actual code from IBM) to rip some code from it and make the system work with other file systems (like JFS) and close down nicely and then when it reach the "boot into the other system"-part just suspend (ACPI) and/or "boot" into something that would only respond to "Enter Key Stroke" and return and wake the system in an orderly fashion when required!

//Jan-Erik

Pages: 1 [2]