Changeset 3008


Ignore:
Timestamp:
May 9, 2018, 11:17:44 AM (7 years ago)
Author:
Andreas Schnellbacher
Message:
  • Finished move of config keys to *.CFG to NEPMD.INI.
  • Major rewrite of COLORS.ERX.
  • Improved error reporting for COLORS.ERX.
  • Handle sync. of color palettes specially if USER.CFG was just imported. (Code for import function is still missing.)
Location:
trunk/src/netlabs
Files:
2 deleted
3 edited

Legend:

Unmodified
Added
Removed

  • TabularUnified trunk/src/netlabs/bin/colors.erx

    r3004 r3008  
    1515* synchronization was added to manage that in most cases.
    1616*
    17 * At every call of this macro three arrays were created:
    18 *    StdCfg.  names and colors from Colors.cfg file
    19 *    AddCfg.  names and colors from MyColors.cfg file
    20 *    Pal.     names and colors from the palette objects
    21 * After that, the automatic asynchronization between the Cfg files and the
     17* At every call of this macro two arrays were created:
     18*    Cfg.  names and colors from NEPMD.INI
     19*    Pal.  names and colors from the palette objects
     20* After that, the automatic synchronization between the config keys and the
    2221* palette objects is executed.
    2322*
    … …  
    102101DestDllDir    = UserDir'\dll'
    103102TmpDir        = UserDir'\tmp'  /* Better use a unique name in %TMP%? */
    104 NepmdIni      = UserDir'\bin\NEPMD.INI'  /* Full filename of NEPMD.INI */
    105 
    106 DllName            = 'etke603.dll'
    107 Signature          = 'GpiCreatePS failed'
    108 SaveFileExt        = 'sav'
    109 
    110 StdCfg.            = ''
    111 AddCfg.            = ''
    112 StdCfg._Name       = 'colors.cfg'
    113 AddCfg._Name       = 'mycolors.cfg'
    114 AddCfg._fChanged   = 0
    115 StdCfg._Section.0  = 0
    116 AddCfg._Section.0  = 0
    117 
    118 Pal.               = ''
    119 Pal._Name.0        = 0
    120 
    121 PalTitlePrefix     = 'EPM color palette - '  /* previously used */
    122 ObjectIdPrefix     = 'EPM_PAL_'
     103
     104DllName           = 'etke603.dll'
     105Signature         = 'GpiCreatePS failed'
     106SaveFileExt       = 'sav'
     107
     108Ini._Filename     = UserDir'\bin\nepmd.ini'
     109Ini._RegKeys      = 'RegKeys'
     110Ini._RegContainer = 'RegContainer'
     111Ini._RegDefaults  = 'RegDefaults'
     112Ini._Install      = 'Install'
     113Ini._UserCfgJustImported = 'UserCfgJustImported'
     114Key._MainPath     = '\NEPMD\User\Colors\Highlighting'
     115Key._Name         = 'Name'
     116
     117PalTitlePrefix    = 'EPM color palette - '  /* previously used */
     118ObjectIdPrefix    = 'EPM_PAL_'
    123119
    124120/* The OS/2 color palette starts with the bottom line. Therefore the 8 top colors   */
    … …  
    126122/* to make it easy for use with the words and wordpos functions. Note that the      */
    127123/* predefined values go from 0 to 15. In the docs LIGHT_GREY is called 'pale grey'. */
    128 /* That is not defined.                                                             */
    129 PalIndexList       = ,
     124/* That is not defined. In NEPMD, the word 'gray' is used instead of 'GREY'.        */
     125PalIndexList      = ,
    130126   '9 10 11 12 13 14 15 16' ||,
    131127   ' 1 2 3 4 5 6 7 8'
    132 ColorList          = ,
    133    'BLACK BLUE GREEN CYAN RED MAGENTA BROWN LIGHT_GREY' ||,
    134    ' DARK_GREY LIGHT_BLUE LIGHT_GREEN LIGHT_CYAN LIGHT_RED LIGHT_MAGENTA YELLOW WHITE'
     128ColorList         = ,
     129   'black blue green cyan red magenta brown light_gray' ||,
     130   ' dark_gray light_blue light_green light_cyan light_red light_magenta yellow white'
    135131/* -------------------------------------------- */
    136132
    137 GlobalVars = GlobalVars 'ErrorQueueName ErrorMessage StdCfg. AddCfg. Pal.'
     133GlobalVars = GlobalVars 'ErrorQueueName ErrorMessage'
     134GlobalVars = GlobalVars 'Ini. Key. DefaultKey. Cfg. Pal. Stem.'
    138135GlobalVars = GlobalVars 'PalTitlePrefix ObjectIdPrefix'
    139136GlobalVars = GlobalVars 'PalIndexList ColorList'
    140 GlobalVars = GlobalVars 'WorkDir TmpDir DllName NepmdIni rc Lxlite Unlock'
     137GlobalVars = GlobalVars 'WorkDir TmpDir DllName rc Lxlite Unlock'
    141138/* rc was made global to allow functions return other values */
    142139
    … …  
    152149   /* Parse args */
    153150   PARSE ARG Action Rest
     151/*
     152saydebug( OVERLAY( 'COLORS.ERX: args = 'Action Rest, COPIES( '-', 78)))
     153*/
    154154   Action = TRANSLATE( Action)
    155155
    … …  
    176176   IF rc <> ERROR.NO_ERROR THEN LEAVE
    177177
    178    /* Make colors.cfg in the user tree replace the netlabs file */
    179    IF FileExist( UserBinDir'\'StdCfg._Name) THEN
    180       StdCfg._Fullname = UserBinDir'\'StdCfg._Name
    181    ELSE
    182       StdCfg._Fullname = NetlabsBinDir'\'StdCfg._Name
    183 
    184    /* Additional colors from mycolors.cfg */
    185    AddCfg._Fullname = UserBinDir'\'AddCfg._Name
    186 
    187    /* Read colors.cfg into stem 'StdCfg.' */
    188    rc  = ReadIni( StdCfg._Fullname, 'StdCfg.')
    189    IF rc <> ERROR.NO_ERROR THEN LEAVE
    190    rcx = AddHexColorsToCfgStem( 'StdCfg.')
    191 
    192    /* Read mycolors.cfg into stem 'AddCfg.', ignore errors */
    193    IF FileExist( AddCfg._Fullname) THEN
    194    DO
    195       rcx = ReadIni( AddCfg._Fullname, 'AddCfg.')
    196       rcx = AddHexColorsToCfgStem( 'AddCfg.')
    197    END
     178   /* Init stem vars */
     179   DO c = 1 TO WORDS( ColorList)
     180      Cfg.c. = ''
     181   END
     182   Cfg._HexColors. = ''
     183   Cfg._NameFound. = ''
     184   Cfg._ColorsEqual. = ''
     185   Cfg._Group. = ''
     186   Cfg._Name. = ''
     187   Cfg._Name.0 = 0
     188
     189   Pal._HexColors. = ''
     190   Pal._NameFound. = ''
     191   Pal._ColorsEqual. = ''
     192   Pal._Name. = ''
     193   Pal._Name.0 = 0
     194
     195   /* Get all user keys */
     196   CALL GetUserGroups
     197
     198   /* Get all default keys */
     199   /* This fills also the DefaultKey. array */
     200   CALL GetDefaultGroups
     201
     202   /* Get names for all available groups */
     203   CALL GetGroupNames
     204
     205   /* Add user and default hex colors to stem 'Cfg.' */
     206   CALL BuildRegKeyArray
    198207
    199208   /* Read colors of palette objects into stem 'Pal.' */
    200    rcx = ReadPalettes()
    201 
    202    /* Find new or changed palettes or new cfg sections */
    203    rcx = ComparePalReg()
    204 
    205    /* Auto-sync new palettes or cfg sections */
    206    /* Changed palettes need manual sync      */
    207    rcx = AutoSyncNewPalReg()
     209   rc = ReadPalettes()
     210
     211   /* Find new or changed palettes or new reg sections */
     212   rc = ComparePalRegKey()
     213
     214   /* Sync palettes and reg sections */
     215   rc = SyncPalRegKey()
    208216
    209217   /* Execute Action */
    … …  
    224232         CALL DeletePal Arg2
    225233
    226       /* Init: copy NEPMD palette to MyColors, if it doesn't exist */
     234/*
     235/* Not used anymore */
     236      /* Init: create default and MyColors palettes, if they don't exist */
    227237      WHEN ABBREV( Action, 'I') THEN
    228238         CALL InitPal
    229 
     239*/
     240/*
     241/* Functions were removed */
    230242      /* Sync: pal -> reg (P = palette object) */
    231243      WHEN ABBREV( Action, 'P') THEN
    232          CALL SyncPal2Cfg Arg2
     244         CALL SyncPal2Reg Arg2
    233245
    234246      /* Sync: reg -> pal (R = registry keys) */
    235247      WHEN ABBREV( Action, 'R') THEN
    236          CALL SyncCfg2Pal Arg2
     248         CALL SyncReg2Pal Arg2
     249*/
    237250
    238251      /* Select palette, patch DLL */
    … …  
    274287         /* Get color string for DLL */
    275288         HexColors = GetHexColors( PalName)
     289         IF HexColors = '' THEN
     290         DO
     291            ErrorMessage = PalName 'not found in array. HexColors is empty.'
     292            rc = ERROR.INVALID_DATA
     293            LEAVE
     294         END
    276295
    277296         DllColors = HexColorsToDllColors( HexColors)
    278297         IF DllColors = '' THEN
    279298         DO
    280             ErrorMessage = PalName 'not found in array.'
     299            ErrorMessage = PalName 'not found in array. DllColors is empty.'
    281300            rc = ERROR.INVALID_DATA
    282301            LEAVE
    283302         END
     303
     304/*
     305saydebug( 'PalName      = 'PalName)
     306saydebug( 'HexColors    = 'HexColors)
     307/* DllColors can't be displayed */
     308*/
    284309
    285310         /* Patch work DLL */
    … …  
    307332
    308333/* ----------------------------------------------------------------------- */
    309 /* Read a text ini into the stem var 'Ini.'                                */
    310 /* An alternate stem name can be specified as arg 2.                       */
    311 /*    Ini._Section.0   number of sections                                  */
    312 /*    Ini._Section.s   name of section number s                            */
    313 /*    Ini._Key.s.0     number of keys in section s                         */
    314 /*    Ini._Key.s.k     name of key number k in section s                   */
    315 /*    Ini._Val.s.k     value of key number k in section s                  */
    316 ReadIni: PROCEDURE EXPOSE (GlobalVars)
    317    PARSE ARG IniFile, Stem
    318 
    319    IF Stem = '' THEN
    320       Stem = 'Ini.'
    321    IF RIGHT( Stem, 1) <> '.' THEN
    322       Stem = Stem'.'
    323 
    324    /* Init global vars at first */
    325    s = 0
    326    CALL VALUE Stem'_Section'.0, s
    327 
    328    IF IniFile = '' THEN
    329    DO
    330       ErrorMessage = 'Error: No ini file specified.'
    331       RETURN( ERROR.INVALID_PARAMETER)
    332    END
    333 
    334    next = STREAM( IniFile, 'c', 'open read')
    335    IF next <> 'READY:' THEN
    336    DO
    337       PARSE VAR next 'ERROR:'rc
    338       ErrorMessage = 'Error: Could not open ini file "'IniFile'", rc = 'rc'.'
    339       RETURN( rc)
    340    END
    341 
    342    k = 0
    343    DO WHILE LINES( IniFile) <> 0
    344       ThisLine = LINEIN( IniFile)
    345 
    346       /* Ignore comments */
    347       IF LEFT( ThisLine, 1) = ';' THEN
     334GetUserGroups: PROCEDURE EXPOSE (GlobalVars)
     335
     336   rc = ERROR.NO_ERROR
     337
     338   /* Get user sub keys from RegContainer */
     339   UserSubKeys = ''
     340   next = SysIni( Ini._Filename, Ini._RegContainer, Key._MainPath)
     341   next = STRIP( next, 'T', '00'x)
     342   IF \(next = '' | next = 'ERROR:') THEN
     343      UserSubKeys = next
     344
     345   /* Add user groups to Cfg._Group. */
     346   rest = UserSubKeys
     347   DO FOREVER
     348      PARSE VAR rest SubKey'00'x rest
     349      IF SubKey = '' THEN
     350         LEAVE
     351
     352      /* Check items for integer > 0 */
     353      IF VERIFY( SubKey, '0123456789') <> 0 THEN          /* Group id */
    348354         ITERATE
    349 
    350       /* Convert tabs to spaces */
    351       ThisLine = TRANSLATE( ThisLine, ' ', '09'x)
    352       ThisLine = STRIP( ThisLine)
    353 
    354       /* Ignore blank lines */
    355       IF ThisLine = '' THEN
     355      IF SubKey = 0 THEN
    356356         ITERATE
    357357
    358       SELECT
    359          /* Find section */
    360          WHEN LEFT( ThisLine, 1) = '[' THEN
    361          DO
    362             p2 = POS( ']', ThisLine)
    363             IF p2 > 0 THEN
     358      /* Check if SubKey is present in Cfg._Group. */
     359      fFound = 0
     360      DO n = 1 TO Cfg._Name.0
     361         IF SubKey = Cfg._Group.n THEN
     362         DO
     363            fFound = 1
     364            LEAVE
     365         END
     366      END
     367      IF fFound = 0 THEN
     368      DO
     369         /* Add SubKey to Cfg._Group. */
     370         n = Cfg._Name.0 + 1
     371         Cfg._Group.n = SubKey
     372         Cfg._Name.0 = n
     373      END
     374   END
     375
     376   RETURN( rc)
     377
     378/* ----------------------------------------------------------------------- */
     379GetDefaultGroups: PROCEDURE EXPOSE (GlobalVars)
     380
     381   rc = ERROR.NO_ERROR
     382
     383   /* Get all default keys */
     384   DefaultKey.  = ''
     385   DefaultKey.0 = ''
     386   next = SysIni( Ini._Filename, Ini._RegDefaults, 'ALL:', 'DefaultKey.')
     387   SearchKey = Key._MainPath'\'
     388   SearchLen = LENGTH( SearchKey)
     389   DO k = 1 TO DefaultKey.0
     390      /* Find keys that start with SearchKey */
     391      IF LEFT( DefaultKey.k, SearchLen) = SearchKey THEN
     392      DO
     393         /* Get reamaining key string */
     394         SubKey = SUBSTR( DefaultKey.k, SearchLen + 1)
     395         /* Get first path segment */
     396         PARSE VAR SubKey SubKey'\'.
     397
     398         /* Check items for integer > 0 */
     399         IF VERIFY( SubKey, '0123456789') <> 0 THEN          /* Group id */
     400            ITERATE
     401         IF SubKey = 0 THEN
     402            ITERATE
     403
     404         /* Check if SubKey is present in Cfg._Group. */
     405         fFound = 0
     406         DO n = 1 TO Cfg._Name.0
     407            IF SubKey = Cfg._Group.n THEN
    364408            DO
    365                ThisSection = SUBSTR( ThisLine, 2, p2 - 2)
    366                IF ThisSection = '' THEN
    367                   ITERATE
    368                /* Save section name */
    369                s = s + 1
    370                CALL VALUE Stem'_Section'.0, s
    371                CALL VALUE Stem'_Section'.s, ThisSection
    372                /* Init keys for this section */
    373                k = 0
    374                CALL VALUE Stem'_Key.'s'.'0, k
     409               fFound = 1
     410               LEAVE
    375411            END
    376412         END
    377          /* Ignore lines before the first section */
    378          WHEN s = 0 THEN
    379             ITERATE
    380       OTHERWISE
    381          /* This must be a 'Key' or 'Key = Val' line */
    382          PARSE VALUE ThisLine WITH ThisKey'='ThisVal
    383 
    384          /* Strip blanks */
    385          ThisKey = STRIP( ThisKey)
    386          ThisVal = STRIP( ThisVal)
    387 
    388          /* Save key and value */
    389          k = k + 1
    390          CALL VALUE Stem'_Key'.s.0, k
    391          CALL VALUE Stem'_Key'.s.k, ThisKey
    392          CALL VALUE Stem'_Val'.s.k, ThisVal
    393       END
    394 
    395    END
    396    next = STREAM( IniFile, 'c', 'close')
    397 
    398    RETURN( ERROR.NO_ERROR)
    399 
    400 /* ----------------------------------------------------------------------- */
    401 AddHexColorsToCfgStem: PROCEDURE EXPOSE (GlobalVars)
    402    rc = ERROR.NO_ERROR
    403    PARSE ARG Stem
    404 
    405    IF Stem = '' THEN
    406       RETURN( ERROR.INVALID_PARAMETER)
    407    IF RIGHT( Stem, 1) <> '.' THEN
    408       Stem = Stem'.'
    409 
    410    DO s = 1 to VALUE( Stem'_Section'.0)
     413         IF fFound = 0 THEN
     414         DO
     415            /* Add SubKey to Cfg._Group. */
     416            n = Cfg._Name.0 + 1
     417            Cfg._Group.n = SubKey
     418            Cfg._Name.0 = n
     419         END
     420      END
     421   END
     422
     423   RETURN( rc)
     424
     425/* ----------------------------------------------------------------------- */
     426GetGroupNames: PROCEDURE EXPOSE (GlobalVars)
     427
     428   rc = ERROR.NO_ERROR
     429
     430   /* Get names for all available groups */
     431   Cfg._Name. = ''
     432   DO n = 1 TO Cfg._Name.0
     433      /* Use saved group id to query names */
     434      g = Cfg._Group.n
     435/*
     436saydebug( 'GetGroupNames: n = 'n', g = 'g)
     437*/
     438      /* Query user key */
     439      next = SysIni( Ini._Filename, Ini._RegKeys, Key._MainPath'\'g'\'Key._Name)
     440      next = STRIP( next, 'T', '00'x)
     441      IF \(next = '' | next = 'ERROR:') THEN
     442      DO
     443         Cfg._Name.n = next
     444/*
     445saydebug( 'GetGroupNames: RegKeys: n = 'n', g = 'g', Cfg._Name.'n' = 'Cfg._Name.n)
     446*/
     447         ITERATE
     448      END
     449
     450
     451      /* Query default key */
     452      next = SysIni( Ini._Filename, Ini._RegDefaults, Key._MainPath'\'g'\'Key._Name)
     453      next = STRIP( next, 'T', '00'x)
     454      IF \(next = '' | next = 'ERROR:') THEN
     455      DO
     456         Cfg._Name.n = next
     457/*
     458saydebug( 'GetGroupNames: RegDefaults: n = 'n', g = 'g', Cfg._Name.'n' = 'Cfg._Name.n)
     459*/
     460         ITERATE
     461      END
     462      Cfg._Name.n = '<Name not specified>'
     463/*
     464saydebug( 'GetGroupNames: n = 'n', g = 'g', Cfg._Name.'n' = 'Cfg._Name.n)
     465*/
     466   END
     467
     468   RETURN( rc)
     469
     470/* ----------------------------------------------------------------------- */
     471GetPalNameList: PROCEDURE EXPOSE (GlobalVars)
     472
     473   ListBoxData = ''
     474
     475   /* Create lists of palette names */
     476   DO n = 1 TO Cfg._Name.0
     477      ListBoxData = ListBoxData'|'Cfg._Name.n
     478   END
     479
     480   RETURN( ListBoxData)
     481
     482/* ----------------------------------------------------------------------- */
     483BuildRegKeyArray: PROCEDURE EXPOSE (GlobalVars)
     484
     485   rc = ERROR.NO_ERROR
     486   /* If a user color value wasn't specified, take that color value */
     487   /* from the 'NEPMD' color group, which has the id 101. */
     488   DefaultGroup = 101
     489
     490   DO n = 1 to Cfg._Name.0
     491      g = Cfg._Group.n
     492
     493      /* Init stem var */
     494      Cfg.n. = ''
     495
     496      /* Add user colors to Cfg.g. */
     497      DO c = 1 TO WORDS( ColorList)
     498         SubKey = WORD( ColorList, c)
     499         Cfg.c.n = '0 0 0'  /* Default color value, if unset */
     500
     501         DO 1
     502            /* Query key */
     503            next = SysIni( Ini._Filename, Ini._RegKeys, Key._MainPath'\'g'\'SubKey)
     504            next = STRIP( next, 'T', '00'x)
     505            IF \(next = '' | next = 'ERROR:') THEN
     506               LEAVE
     507
     508            /* User color key missing, try to get default key for this color from DefaultKeys */
     509            next = SysIni( Ini._Filename, Ini._RegDefaults, Key._MainPath'\'g'\'SubKey)
     510            next = STRIP( next, 'T', '00'x)
     511            IF \(next = '' | next = 'ERROR:') THEN
     512               LEAVE
     513
     514            /* Color key missing, get default key for this color from 'NEPMD' colors */
     515            next = SysIni( Ini._Filename, Ini._RegDefaults, Key._MainPath'\'DefaultGroup'\'SubKey)
     516            next = STRIP( next, 'T', '00'x)
     517            IF \(next = '' | next = 'ERROR:') THEN
     518               LEAVE
     519         END
     520
     521         IF \(next = '' | next = 'ERROR:') THEN
     522         DO
     523            /* Add next to Cfg.c.n */
     524            Cfg.c.n = next
     525         END
     526      END
    411527
    412528      HexColors = ''
    … …  
    414530      RGBhex. = ''
    415531      RGBhex.0 = 0
    416       DO k = 1 to VALUE( Stem'_Key'.s.0)
    417          ThisKey = VALUE( Stem'_Key'.s.k)
    418          ThisVal = VALUE( Stem'_Val'.s.k)
    419 
    420          IF WORDPOS( ThisKey, ColorList) > 0 THEN
    421          DO
    422             ColorName = ThisKey
    423             red       = WORD( ThisVal, 1)
    424             green     = WORD( ThisVal, 2)
    425             blue      = WORD( ThisVal, 3)
    426             redhex    = RIGHT( D2X( red), 2, '0')
    427             greenhex  = RIGHT( D2X( green), 2, '0')
    428             bluehex   = RIGHT( D2X( blue), 2, '0')
    429             n   = WORDPOS( ColorName, ColorList)
    430             idx = WORDPOS( n, PalIndexList)      /* idx = 1...16 */
    431             RGBhex.idx = '0x'redhex''greenhex''bluehex
    432             RGBhex.0 = RGBhex.0 + 1
    433          END
     532      DO c = 1 to WORDS( ColorList)
     533         ColorName = WORD( ColorList, c)
     534         IF ColorName = '' THEN
     535            ITERATE
     536         ColorVal = Cfg.c.n
     537         red       = WORD( ColorVal, 1)
     538         green     = WORD( ColorVal, 2)
     539         blue      = WORD( ColorVal, 3)
     540         redhex    = RIGHT( D2X( red), 2, '0')
     541         greenhex  = RIGHT( D2X( green), 2, '0')
     542         bluehex   = RIGHT( D2X( blue), 2, '0')
     543         idx = WORDPOS( c, PalIndexList)      /* idx = 1...16 */
     544         RGBhex.idx = '0x'redhex''greenhex''bluehex
     545         RGBhex.0 = RGBhex.0 + 1
    434546      END
    435547
    … …  
    441553      END
    442554
    443       CALL VALUE Stem'_HexColors.'s, HexColors
    444 
    445    END
    446 
    447    RETURN( rc)
     555      CALL VALUE 'Cfg._HexColors.'n, HexColors
     556/*
     557saydebug( 'HexCol : n = 'n', g = 'g', Cfg._HexColors.'n' = 'Cfg._HexColors.n)
     558*/
     559
     560   END
     561
     562   RETURN( rc)
     563
     564/* ----------------------------------------------------------------------- */
     565GetHexColors: PROCEDURE EXPOSE (GlobalVars)
     566   PARSE ARG PalName
     567
     568   rc = ERROR.NO_ERROR
     569   HexColors = ''
     570   DO 1
     571      DO n = 1 TO Cfg._Name.0
     572         Name = Cfg._Name.n
     573/*
     574saydebug( 'n = 'n', check Name = 'Cfg._Name.n' for equalness to PalName = 'PalName)
     575*/
     576         IF PalName = Cfg._Name.n THEN
     577         DO
     578/*
     579saydebug( 'n = 'n', found Name = 'Cfg._Name.n)
     580*/
     581            HexColors = VALUE( 'Cfg._HexColors.'n)
     582            LEAVE
     583         END
     584      END
     585
     586      IF HexColors = '' THEN
     587      DO
     588         rc = ERROR.INVALID_DATA
     589         LEAVE
     590      END
     591   END
     592
     593   RETURN( HexColors)
    448594
    449595/* ----------------------------------------------------------------------- */
    … …  
    451597   PARSE ARG HexColors
    452598
    453    n   = 0
     599   c   = 0
    454600   idx = 0
     601   BGRchar. = ''
    455602   DllColors = ''
    456603   Rest = HexColors
    … …  
    461608      PARSE VAR Next 1 redhex 3 greenhex 5 bluehex
    462609      /* Re-arrange colors according to PalIndexList */
    463       n = n + 1
    464       idx = WORD( PalIndexList, n)
     610      c = c + 1
     611      idx = WORD( PalIndexList, c)
    465612      BGRchar.idx = X2C( bluehex)''X2C( greenhex)''X2C( redhex)'00'x
    466613   END
    … …  
    482629   Pal._Name.0 = 0
    483630   DO a = 1 TO AbstractObj.0
     631      Class = ''
    484632      rcx = WPToolsQueryObject( AbstractObj.a, 'Class', 'Title', 'Setup', 'Location')
    485633      IF Class <> 'WPColorPalette' THEN ITERATE
    … …  
    510658
    511659/* ----------------------------------------------------------------------- */
     660/* Replaced by automatic sync */
     661/*
     662InitPal: PROCEDURE EXPOSE (GlobalVars)
     663
     664   rc = ERROR.NO_ERROR
     665
     666   fNewNameFound = 0
     667   SrcPalName = 'NEPMD'
     668   NewPalName = 'MyColors'
     669
     670   /* Ensure that new palette name exists */
     671   IF \PalNameExists( NewPalName) THEN
     672      rc = CopyPal( SrcPalName, NewPalName)
     673
     674   RETURN( rc)
     675*/
     676/* ----------------------------------------------------------------------- */
     677PalNameExists: PROCEDURE EXPOSE (GlobalVars)
     678
     679   rc = ERROR.NO_ERROR
     680   fExists = 0
     681   PARSE ARG PalName
     682
     683   DO n = 1 to Cfg._Name.0
     684      IF Cfg._Name.n = PalName THEN
     685      DO
     686         fExists = 1
     687         LEAVE
     688      END
     689   END
     690
     691   RETURN( fExists)
     692
     693/* ----------------------------------------------------------------------- */
     694CopyPal: PROCEDURE EXPOSE (GlobalVars)
     695
     696   rc = ERROR.NO_ERROR
     697   PARSE ARG PalName, NewPalName
     698
     699   HexColors = ''
     700   DO 1
     701      /* Search PalName */
     702      nFound = 0
     703      DO n = 1 TO Cfg._Name.0
     704         IF Cfg._Name.n = PalName THEN
     705         DO
     706            nFound = n
     707            LEAVE
     708         END
     709      END
     710      IF nFound = 0 THEN
     711      DO
     712         rc = ERROR.FILE_NOT_FOUND
     713         LEAVE
     714      END
     715
     716      /* Find last used group id for user colors */
     717      LastGroup = 0
     718      LastUserNumber = 0
     719      DO n = Cfg._Name.0 TO 1 BY -1
     720         IF Cfg._Group.n > 100 THEN
     721            ITERATE
     722         IF Cfg._Group.n <> '' THEN
     723         DO
     724            LastGroup = Cfg._Group.n
     725            LastUserNumber = n
     726            LEAVE
     727         END
     728      END
     729
     730      /* Use next free group id */
     731      g = LastGroup + 1
     732      n = LastUserNumber + 1
     733
     734      /* Move default groups to the bottom to make room after the last user group */
     735      rc = MoveRegKeyNumber( 1, n, Cfg._Name.0)
     736
     737      /* Copy Cfg. and write config keys */
     738      DO c = 1 TO WORDS( ColorList)
     739         SubKey = WORD( ColorList, c)
     740         ColorVal = Cfg.c.nFound
     741         Cfg.c.n = ColorVal
     742         rc = WriteConfigKey( Key._MainPath'\'g'\'SubKey, ColorVal)
     743      END
     744
     745      /* Set HexColors to Cfg. */
     746      HexColors = Cfg._HexColors.nFound
     747      Cfg._HexColors.n = HexColors
     748
     749      /* Set name to Cfg. and write config key */
     750      Cfg._Name.n = NewPalName
     751      rc = WriteConfigKey( Key._MainPath'\'g'\'Key._Name, NewPalName)
     752
     753      /* Create new palette or overwrite it */
     754      rc = CreatePalObj( NewPalName, HexColors)
     755
     756      /* Set Pal. array (not required, because comprism is only made ast startup) */
     757      p = Pal._Name.0 + 1
     758      Pal._Name.0 = p
     759      Pal._Name.p = NewPalName
     760      Pal._HexColors.p = HexColors
     761
     762   END
     763
     764   RETURN( rc)
     765
     766/* ----------------------------------------------------------------------- */
     767DeletePal: PROCEDURE EXPOSE (GlobalVars)
     768
     769   rc = ERROR.NO_ERROR
     770   PARSE ARG PalName
     771
     772   HexColors = ''
     773   DO 1
     774      /* Search PalName */
     775      nFound = 0
     776      DO n = 1 TO Cfg._Name.0
     777         IF Cfg._Name.n = PalName THEN
     778         DO
     779            nFound = n
     780            LEAVE
     781         END
     782      END
     783/*
     784saydebug( 'DeletePal: PalName = 'PalName', nFound = 'nFound', g = 'Cfg._Group.nFound)
     785*/
     786      IF nFound = 0 THEN
     787      DO
     788         rc = ERROR.FILE_NOT_FOUND
     789         LEAVE
     790      END
     791      n = nFound
     792      g = Cfg._Group.n
     793
     794      /* Don't delete default color palettes */
     795      IF g > 100 THEN
     796         ITERATE
     797
     798      /* Delete color config keys */
     799      DO c = 1 TO WORDS( ColorList)
     800         SubKey = WORD( ColorList, c)
     801         rc = DeleteConfigKey( Key._MainPath'\'g'\'SubKey)
     802      END
     803
     804      /* Delete config key */
     805      rc = DeleteConfigKey( Key._MainPath'\'g'\'Key._Name)
     806
     807      /* Delete palette */
     808      rc = DeletePalObj( PalName)
     809
     810      /* Move all following stems */
     811      rc = MoveRegKeyNumber( -1, n, Cfg._Name.0)
     812
     813      /* Set Pal. array (not required, because comprism is only made ast startup) */
     814      Lastp = Pal._Name.0
     815      DO p = 1 TO Pal._Name.0
     816         IF p > Lastp THEN
     817            LEAVE
     818
     819         /* Search PalName */
     820         Foundp = 0
     821         IF Pal._Name.p = PalName THEN
     822            Foundp = p
     823
     824         IF Foundp > 0 THEN
     825         /* Move all following stems */
     826         DO
     827            Newp = p - 1
     828            Pal._Name.Newp = Pal._Name.p
     829            Pal._HexColors.Newp = Pal._HexColors.p
     830            Lastp = Lastp - 1
     831         END
     832      END
     833      Pal._Name.0 = Newp
     834
     835   END
     836
     837   RETURN( rc)
     838
     839/* ----------------------------------------------------------------------- */
    512840CreatePalObj: PROCEDURE EXPOSE (GlobalVars)
    513841
     842   rc = ERROR.NO_ERROR
    514843   PARSE ARG PalName, HexColors
    515844
    … …  
    540869   rcx = SysSaveObject( ObjectId, AsyncFlag)
    541870
    542    RETURN( ERROR.NO_ERROR)
     871   RETURN( rc)
    543872
    544873/* ----------------------------------------------------------------------- */
    545874DeletePalObj: PROCEDURE EXPOSE (GlobalVars)
    546875
     876   rc = ERROR.NO_ERROR
    547877   PARSE ARG PalName
    548878
    … …  
    552882   rcx = SysDestroyObject( ObjectId)
    553883
    554    RETURN( ERROR.NO_ERROR)
    555 
    556 /* ----------------------------------------------------------------------- */
    557 ComparePalReg: PROCEDURE EXPOSE (GlobalVars)
    558 
    559    rc = ERROR.NO_ERROR
    560 
    561    /* Find new or changed palettes */
    562    Pal._New     = ''           /* Maybe todo: ask on changed which to sync */
    563    Pal._Changed = ''
     884   RETURN( rc)
     885
     886/* ----------------------------------------------------------------------- */
     887WriteConfigKey: PROCEDURE EXPOSE (GlobalVars)
     888   PARSE ARG KeyPath, KeyVal
     889
     890   rc = ERROR.NO_ERROR
     891   DO 1
     892      /* Write to RegKeys */
     893/*
     894saydebug( 'next = SysIni( 'Ini._Filename', 'Ini._RegKeys', 'KeyPath', 'KeyVal'.)')
     895*/
     896      next = SysIni( Ini._Filename, Ini._RegKeys, KeyPath, KeyVal'00'x)
     897      IF (next = 'ERROR:') THEN
     898      DO
     899         rc = ERROR.WRITE_FAULT
     900         LEAVE
     901      END
     902
     903      /* Write RegContainer */
     904      ThisKeyPath   = ''
     905      /* Set ThisContainer to first segment */
     906      PARSE VALUE KeyPath WITH '\'ThisContainer'\'rest
     907      DO FOREVER
     908         ThisKeyPath = ThisKeyPath'\'ThisContainer
     909/*
     910saydebug( 'ThisKeyPath = 'ThisKeyPath', ThisContainer = 'ThisContainer)
     911*/
     912         /* The last entry for ThisKeyPath in RegContainer is the parent path of KeyPath */
     913         IF LENGTH( ThisKeyPath) >= LENGTH( KeyPath) THEN
     914            LEAVE
     915
     916         Startp = LENGTH( ThisKeyPath) + 1
     917         p = POS( '\', KeyPath, Startp + 1)  /* + 1 to ignore the leading backslash */
     918         IF p == 0 THEN
     919            p = LENGTH( KeyPath) + 1
     920
     921         IF Startp > LENGTH( KeyPath) THEN
     922         DO
     923            ThisContainer = ''
     924            LEAVE
     925         END
     926         ELSE
     927            ThisContainer = SUBSTR( KeyPath, Startp + 1, p - Startp - 1)
     928
     929         /* Query RegContainer for ThisKeyPath */
     930         next = SysIni( Ini._Filename, Ini._RegContainer, ThisKeyPath)
     931         next = STRIP( next, 'T', '00'x)
     932         IF (next = 'ERROR:') THEN
     933            Containers = ''
     934         ELSE
     935            Containers = next
     936/*
     937saydebug( 'ThisContainer = 'ThisContainer', Containers = 'TRANSLATE( Containers, '.', '00'x))
     938*/
     939         /* Search ThisContainer in Containers */
     940         cp = POS( '00'x''ThisContainer'00'x, '00'x''Containers'00'x)
     941         IF cp > 0 THEN
     942            ITERATE
     943
     944         /* Append ThisContainer to Containers */
     945         IF Containers = '' THEN
     946            rest = ThisContainer
     947         ELSE
     948            rest = Containers'00'x''ThisContainer
     949
     950         /* Convert Containers to stem for sorting */
     951         i = 0
     952         Stem.  = ''
     953         Stem.0 = 0
     954         DO FOREVER
     955            PARSE VAR rest SubKey'00'x rest
     956            IF SubKey = '' THEN
     957               LEAVE
     958            i = i + 1
     959            Stem.i = SubKey
     960            Stem.0 = i
     961
     962         /* Sort Container stem */
     963         CALL SortStem
     964
     965         /* Reconvert Containers to zero-separated list */
     966         NewContainers = ''
     967         DO i = 1 TO Stem.0
     968            IF NewContainers == '' THEN
     969               NewContainers = Stem.i
     970            ELSE
     971               NewContainers = NewContainers'00'x''Stem.i
     972         END
     973
     974         /* Write to RegContainer */
     975/*
     976saydebug( 'next = SysIni( 'Ini._Filename', 'Ini._RegContainer', 'ThisKeyPath', 'TRANSLATE( NewContainers, '.', '00'x)'.)')
     977*/
     978         next = SysIni( Ini._Filename, Ini._RegContainer, ThisKeyPath, NewContainers'00'x)
     979         IF (next = 'ERROR:') THEN
     980         DO
     981            rc = ERROR.WRITE_FAULT
     982            LEAVE
     983         END
     984
     985      END
     986   END
     987   RETURN( rc)
     988
     989/* ----------------------------------------------------------------------- */
     990DeleteConfigKey: PROCEDURE EXPOSE (GlobalVars)
     991   PARSE ARG KeyPath
     992
     993   rc = ERROR.NO_ERROR
     994   DO 1
     995      /* Delete from RegKeys */
     996/*
     997saydebug( 'next = SysIni( 'Ini._Filename', 'Ini._RegKeys', 'KeyPath', DELETE:)')
     998*/
     999      next = SysIni( Ini._Filename, Ini._RegKeys, KeyPath, 'DELETE:')
     1000      /* No error from here, to continue with RegContainer even if RegKey doesn't exist */
     1001
     1002      /* Query all RegKeys for to check if a RegContainer key can be deleted */
     1003      TestKeys. = ''
     1004      AllKeysResult = SysIni( Ini._Filename, Ini._RegKeys, 'ALL:', 'TestKeys.')
     1005
     1006      NextKeyPath = KeyPath
     1007      /* Remove ThisContainer from ParentPath value */
     1008      DO FOREVER
     1009         ThisKeyPath = NextKeyPath
     1010
     1011         /* Query RegContainer for ParentPath */
     1012         lp = LASTPOS( '\', ThisKeyPath)
     1013         IF lp <= 1 THEN
     1014            LEAVE
     1015
     1016         ThisContainer = SUBSTR( ThisKeyPath, lp + 1)
     1017         ParentPath    = SUBSTR( ThisKeyPath, 1, lp - 1)
     1018         NextKeyPath = ParentPath
     1019         next = SysIni( Ini._Filename, Ini._RegContainer, ParentPath)
     1020         next = STRIP( next, 'T', '00'x)
     1021         IF (next = 'ERROR:') THEN
     1022            ITERATE
     1023         Containers = next
     1024/*
     1025saydebug( 'ThisContainer = 'ThisContainer', Containers = 'TRANSLATE( Containers, '.', '00'x))
     1026*/
     1027         /* Search ThisContainer in Containers */
     1028         cp = POS( '00'x''ThisContainer'00'x, '00'x''Containers'00'x)
     1029         IF cp == 0 THEN
     1030            ITERATE
     1031
     1032         /* Find ThisKeyPath'\*' keys to check if ThisContainer can be deleted */
     1033         IF (AllKeysResult = 'ERROR:') THEN
     1034            ITERATE
     1035         fThisContainerUsed = 0
     1036         DO k = 1 TO TestKeys.0
     1037            IF LEFT( TestKeys.k, LENGTH( ThisKeyPath'\')) <> ThisKeyPath'\' THEN
     1038               ITERATE
     1039            ELSE
     1040            DO
     1041               fThisContainerUsed = 1
     1042/*
     1043saydebug( 'ThisContainer 'ThisContainer' used by: 'TestKeys.k', ThisKeyPath\ = 'ThisKeyPath'\')
     1044*/
     1045               LEAVE
     1046            END
     1047         END
     1048         IF fThisContainerUsed = 1 THEN
     1049            ITERATE
     1050
     1051         /* Delete ThisContainer from NewContainers */
     1052         NewContainers = SUBSTR( Containers'00'x, 1, cp - 1) ||,
     1053                         SUBSTR( Containers'00'x, cp + LENGTH( ThisContainer) + 1)
     1054         NewContainers = STRIP( NewContainers, 'T', '00'x)
     1055
     1056         IF NewContainers == '' THEN
     1057         DO
     1058            /* Delete RegContainer key */
     1059/*
     1060saydebug( 'next = SysIni( 'Ini._Filename', 'Ini._RegContainer', 'ParentPath', DELETE:)')
     1061*/
     1062            next = SysIni( Ini._Filename, Ini._RegContainer, ParentPath, 'DELETE:')
     1063            IF (next = 'ERROR:') THEN
     1064            DO
     1065               rc = ERROR.WRITE_FAULT
     1066               LEAVE
     1067            END
     1068         END
     1069         ELSE
     1070         DO
     1071            /* Write to RegContainer */
     1072/*
     1073saydebug( 'next = SysIni( 'Ini._Filename', 'Ini._RegContainer', 'ParentPath', 'TRANSLATE( NewContainers, '.', '00'x)'.)')
     1074*/
     1075            next = SysIni( Ini._Filename, Ini._RegContainer, ParentPath, NewContainers'00'x)
     1076            IF (next = 'ERROR:') THEN
     1077            DO
     1078               rc = ERROR.WRITE_FAULT
     1079               LEAVE
     1080            END
     1081         END
     1082      END
     1083   END
     1084
     1085   RETURN( rc)
     1086
     1087/* ----------------------------------------------------------------------- */
     1088/* SysStemSort isn't contained in older REXXUTIL.DLL versions. */
     1089SortStem: PROCEDURE EXPOSE (GlobalVars)
     1090/*
     1091DO i = 1 TO Stem.0
     1092   saydebug( 'SortStem before: 'Stem.i)
     1093END
     1094*/
     1095   CALL SortStem2 1, Stem.0
     1096/*
     1097DO i = 1 TO Stem.0
     1098   saydebug( 'SortStem sorted: 'Stem.i)
     1099END
     1100*/
     1101   RETURN
     1102
     1103/* ----------------------------------------------------------------------- */
     1104/* Mainly from html2ipf.cmd by Andrew Zabolotny. */
     1105SortStem2: PROCEDURE EXPOSE (GlobalVars)
     1106   ARG iFirst, iLast
     1107
     1108   iLeft   = iFirst
     1109   iRight  = iLast
     1110   iMiddle = (iLeft + iRight) % 2
     1111
     1112   DO UNTIL iLeft > iRight
     1113      DO WHILE Stem.iLeft < Stem.iMiddle
     1114         iLeft = iLeft + 1
     1115      END
     1116
     1117      DO WHILE Stem.iRight > Stem.iMiddle
     1118         iRight = iRight - 1
     1119      END
     1120
     1121      IF iLeft <= iRight THEN
     1122      DO
     1123         tmp         = Stem.iLeft
     1124         Stem.iLeft  = Stem.iRight
     1125         Stem.iRight = tmp
     1126         iLeft  = iLeft + 1
     1127         iRight = iRight - 1
     1128      END
     1129   END
     1130
     1131   IF iFirst < iRight THEN
     1132      CALL SortStem2 iFirst, iRight
     1133
     1134   IF iLeft < iLast THEN
     1135      CALL SortStem2 iLeft, iLast
     1136
     1137   RETURN
     1138
     1139/* ----------------------------------------------------------------------- */
     1140ComparePalRegKey: PROCEDURE EXPOSE (GlobalVars)
     1141
     1142   rc = ERROR.NO_ERROR
     1143
     1144   /* Compare Pal. with Cfg. */
    5641145   DO p = 1 TO Pal._Name.0
    5651146      PalName   = Pal._Name.p
    5661147      HexColors = Pal._HexColors.p
    567       fNameFound   = 0
    568       fColorsEqual = 0
    569 
    570       /* Compare name with StdCfg sections */
    571       IF \fNameFound THEN
    572       DO s = 1 TO StdCfg._Section.0
    573          IF PalName = StdCfg._Section.s THEN
    574          DO
    575             fNameFound = 1
    576             /* For found names, compare also colors */
    577             IF HexColors = StdCfg._HexColors.s THEN
    578                fColorsEqual = 1
    579             ITERATE
    580          END
    581       END
    582 
    583       /* Compare name with AddCfg sections */
    584       IF \fNameFound THEN
    585       DO s = 1 TO AddCfg._Section.0
    586          IF PalName = AddCfg._Section.s THEN
    587          DO
    588             fNameFound = 1
    589             /* For found names, compare also colors */
    590             IF HexColors = AddCfg._HexColors.s THEN
    591                fColorsEqual = 1
    592             ITERATE
    593          END
    594       END
    595 
    596       /* Add to list of new palettes */
    597       IF \fNameFound THEN
    598          Pal._New = STRIP( Pal._New p)
    599       /* Add to list of changed palettes */
    600       IF \fColorsEqual THEN
    601          Pal._Changed = STRIP( Pal._Changed p)
    602    END
    603 
    604    /* Find new StdCfg sections */
    605    StdCfg._New = ''
    606    DO s = 1 TO StdCfg._Section.0
    607       CfgName = StdCfg._Section.s
    608       fNameFound = 0
    609 
    610       /* Compare name with palette names */
    611       IF \fNameFound THEN
     1148      Pal._NameFound.p   = 0
     1149      Pal._ColorsEqual.p = 0
     1150      DO n = 1 TO Cfg._Name.0
     1151         /* Compare Name */
     1152         IF Pal._NameFound.p == 0 THEN
     1153         DO
     1154            IF PalName = Cfg._Name.n THEN
     1155               Pal._NameFound.p = n
     1156         END
     1157         /* Compare HexColors */
     1158         IF Pal._ColorsEqual.p == 0 THEN
     1159         DO
     1160            IF HexColors = Cfg._HexColors.n THEN
     1161               Pal._ColorsEqual.p = n
     1162         END
     1163      END
     1164   END
     1165
     1166   /* Compare Cfg. with Pal. */
     1167   DO n = 1 TO Cfg._Name.0
     1168      PalName   = Cfg._Name.n
     1169      HexColors = Cfg._HexColors.n
     1170      Cfg._NameFound.n   = 0
     1171      Cfg._ColorsEqual.n = 0
    6121172      DO p = 1 TO Pal._Name.0
    613          IF CfgName = Pal._Name.p THEN
    614          DO
    615             fNameFound = 1
    616             ITERATE
    617          END
    618       END
    619 
    620       /* Add to list of new palettes */
    621       IF \fNameFound THEN
    622          StdCfg._New = STRIP( StdCfg._New s)
    623    END
    624 
    625    /* Find new AddCfg sections */
    626    AddCfg._New = ''
    627    DO s = 1 TO AddCfg._Section.0
    628       CfgName = AddCfg._Section.s
    629       fNameFound = 0
    630 
    631       /* Compare name with palette names */
    632       IF \fNameFound THEN
    633       DO p = 1 TO Pal._Name.0
    634          IF CfgName = Pal._Name.p THEN
    635          DO
    636             fNameFound = 1
    637             ITERATE
    638          END
    639       END
    640 
    641       /* Add to list of new palettes */
    642       IF \fNameFound THEN
    643          AddCfg._New = STRIP( AddCfg._New s)
    644    END
    645 
    646    RETURN( rc)
    647 
    648 /* ----------------------------------------------------------------------- */
    649 AutoSyncNewPalReg: PROCEDURE EXPOSE (GlobalVars)
    650 
    651    rc = ERROR.NO_ERROR
    652 
    653    /* New StdCfg sections */
    654    DO w = 1 to WORDS( StdCfg._New)
    655       s = WORD( StdCfg._New, w)
    656       PalName   = StdCfg._Section.s
    657       HexColors = StdCfg._HexColors.s
    658 
    659       /* Create missing palette */
    660       rcx = CreatePalObj( PalName, HexColors)
    661       p = Pal._Name.0 + 1
    662       Pal._Name.p      = PalName
    663       Pal._HexColors.p = HexColors
    664       Pal._Name.0      = p
    665    END
    666    /* Reset list */
    667    StdCfg._New = ''
    668 
    669    /* New AddCfg sections */
    670    DO w = 1 to WORDS( AddCfg._New)
    671       s = WORD( AddCfg._New, w)
    672       PalName   = AddCfg._Section.s
    673       HexColors = AddCfg._HexColors.s
    674 
    675       /* Create missing palette */
    676       rcx = CreatePalObj( PalName, HexColors)
    677       p = Pal._Name.0 + 1
    678       Pal._Name.p      = PalName
    679       Pal._HexColors.p = HexColors
    680       Pal._Name.0      = p
    681    END
    682    /* Reset list */
    683    AddCfg._New = ''
    684 
    685    /* New palette names */
    686    DO w = 1 to WORDS( Pal._New)
    687       p = WORD( Pal._New, w)
     1173         /* Compare Name */
     1174         IF Cfg._NameFound.n == 0 THEN
     1175         DO
     1176            IF PalName = Pal._Name.p THEN
     1177               Cfg._NameFound.n = p
     1178         END
     1179         /* Compare HexColors */
     1180         IF Cfg._ColorsEqual.n == 0 THEN
     1181         DO
     1182            IF HexColors = Pal._HexColors.p THEN
     1183               Cfg._ColorsEqual.n = p
     1184         END
     1185      END
     1186   END
     1187
     1188   RETURN( rc)
     1189
     1190/* ----------------------------------------------------------------------- */
     1191SyncPalRegKey: PROCEDURE EXPOSE (GlobalVars)
     1192
     1193   rc = ERROR.NO_ERROR
     1194
     1195   /* Query UserCfgJustImported */
     1196   fUserCfgJustImported = 0
     1197   next = SysIni( Ini._Filename, Ini._Install, Ini._UserCfgJustImported)
     1198   next = STRIP( next, 'T', '00'x)
     1199   IF (next = 'ERROR:') THEN
     1200      /* Don't report error here */
     1201      NOP
     1202   ELSE
     1203      fUserCfgJustImported = (next = 1)
     1204
     1205   /* Reset UserCfgJustImported */
     1206   next = SysIni( Ini._Filename, Ini._Install, Ini._UserCfgJustImported, 0'00'x)
     1207   IF (next = 'ERROR:') THEN
     1208      /* Don't report error here */
     1209      NOP
     1210/*
     1211fUserCfgJustImported = 1
     1212*/
     1213
     1214   /* Find last used group id for user colors */
     1215   LastGroup = 0
     1216   LastUserNumber = 0
     1217   DO n = Cfg._Name.0 TO 1 BY -1
     1218      IF Cfg._Group.n > 100 THEN
     1219         ITERATE
     1220      IF Cfg._Group.n <> '' THEN
     1221      DO
     1222         LastGroup = Cfg._Group.n
     1223         LastUserNumber = n
     1224         LEAVE
     1225      END
     1226   END
     1227
     1228   DO p = 1 TO Pal._Name.0
    6881229      PalName   = Pal._Name.p
    6891230      HexColors = Pal._HexColors.p
    6901231
    691       /* Add missing AddCfg section */
    692       s = AddCfg._Section.0 + 1
    693       AddCfg._Section.s = PalName
    694       AddCfg._HexColors.s = HexColors
    695       AddCfg._Section.0 = s
    696       AddCfg._fChanged = 1
    697    END
    698    /* Reset list */
    699    Pal._New = ''
    700 
    701    /* Save AddCfg if changed */
    702    IF AddCfg._fChanged THEN
     1232      /* Create missing RegKey or overwrite with colors from palette */
     1233      SELECT
     1234
     1235         WHEN Pal._NameFound.p == 0 THEN
     1236         DO
     1237            /* Use next free group id */
     1238            g = LastGroup + 1
     1239            n = LastUserNumber + 1
     1240
     1241            /* Move default groups to the bottom to make room after the last user group */
     1242            rc = MoveRegKeyNumber( 1, n, Cfg._Name.0)
     1243
     1244            /* Set colors to Cfg. and write config keys */
     1245            rc = HexColorsToRegKeys( n, g, PalName, HexColors)
     1246
     1247            /* Set name to Cfg. and write config key */
     1248            Cfg._Name.n = PalName
     1249            rc = WriteConfigKey( Key._MainPath'\'g'\'Key._Name, PalName)
     1250
     1251            /* Reset comparism result for source (just cosmetic) */
     1252            Pal._NameFound.p = n
     1253            Pal._ColorsEqual.p = n
     1254
     1255            /* Reset comparism result for destination (just cosmetic) */
     1256            Cfg._NameFound.n = p
     1257            Cfg._ColorsEqual.n = p
     1258         END
     1259
     1260         WHEN Pal._ColorsEqual.p == 0 THEN
     1261         DO
     1262            /* Get n from comparism */
     1263            n = Pal._NameFound.p
     1264
     1265            /* Get group id */
     1266            g = Cfg._Group.n
     1267
     1268            /* For default colors, always sync from Cfg. to Pal. */
     1269            IF g > 100 THEN
     1270               ITERATE
     1271
     1272            /* After importing user.cfg, sync from Cfg. to Pal. */
     1273            IF fUserCfgJustImported THEN
     1274               ITERATE
     1275
     1276            /* Set colors to Cfg. and write config keys */
     1277            rc = HexColorsToRegKeys( n, g, PalName, HexColors)
     1278
     1279            /* Reset comparism result for source (just cosmetic) */
     1280            Pal._ColorsEqual.p = n
     1281
     1282            /* Reset comparism result for destination */
     1283            Cfg._ColorsEqual.n = p
     1284         END
     1285
     1286         OTHERWISE
     1287            NOP
     1288      END
     1289   END
     1290
     1291   /* Last used palette number */
     1292   LastPal = Pal._Name.0
     1293
     1294   DO n = 1 TO Cfg._Name.0
     1295      PalName   = Cfg._Name.n
     1296      HexColors = Cfg._HexColors.n
     1297
     1298      /* Create missing palette or overwrite with colors from RegKey */
     1299      SELECT
     1300
     1301         WHEN Cfg._NameFound.n == 0 THEN
     1302         DO
     1303            /* Use next free pal number */
     1304            LastPal = LastPal + 1
     1305
     1306            /* Advance pal counter */
     1307            p = LastPal
     1308            Pal._Name.0 = p
     1309
     1310            /* Set colors to Pal. and write palette objects */
     1311            rc = HexColorsToPalette( p, PalName, HexColors)
     1312
     1313            /* Reset comparism result for source (just cosmetic) */
     1314            Cfg._NameFound.n = p
     1315            Cfg._ColorsEqual.n = p
     1316
     1317            /* Reset comparism result for destination (just cosmetic) */
     1318            Pal._NameFound.p = n
     1319            Pal._ColorsEqual.p = n
     1320         END
     1321
     1322         WHEN Cfg._ColorsEqual.n == 0 THEN
     1323         DO
     1324            /* Get p from comparism */
     1325            p = Cfg._NameFound.n
     1326
     1327            /* Set colors to Pal. and write palette objects */
     1328            rc = HexColorsToPalette( p, PalName, HexColors)
     1329
     1330            /* Reset comparism result for source (just cosmetic) */
     1331            Cfg._ColorsEqual.n = p
     1332
     1333            /* Reset comparism result for destination */
     1334            Pal._ColorsEqual.p = n
     1335         END
     1336
     1337         OTHERWISE
     1338            NOP
     1339      END
     1340   END
     1341
     1342   RETURN( rc)
     1343
     1344/* ----------------------------------------------------------------------- */
     1345MoveRegKeyNumber: PROCEDURE EXPOSE (GlobalVars)
     1346   PARSE ARG nAmount, nStartMove, nEndMove
     1347
     1348   rc = ERROR.NO_ERROR
     1349
     1350   IF nAmount > 0 THEN
    7031351   DO
    704       rcx = SaveAddCfg()
    705    END
    706    /* Reset flag */
    707    AddCfg._fChanged = 0
    708 
    709    RETURN( rc)
    710 
    711 /* ----------------------------------------------------------------------- */
    712 /* Todo: Check for each entry if colors are equal to a same-named */
    713 /* section in StdCfg or Remove it already before call to this func from */
    714 /* AddCfg array */
    715 SaveAddCfg: PROCEDURE EXPOSE (GlobalVars)
    716 
    717    rc = ERROR.NO_ERROR
    718    p1 = LASTPOS( '\', AddCfg._Fullname)
    719    TmpFile = LEFT( AddCfg._Fullname, p1)'MyColors.tmp'
    720 
    721    /* Write new color cfg to TmpFile */
    722    DO 1
    723       IF FileExist( TmpFile) THEN
    724          rcx = FileDelete( TmpFile)
    725       next = STREAM( TmpFile, 'C', 'OPEN WRITE')
    726       IF next <> 'READY:' THEN
    727       DO
    728          rc = ERROR.ACCESS_DENIED
    729          LEAVE
    730       END
    731       DO s = 1 TO AddCfg._Section.0
    732          PalName   = AddCfg._Section.s
    733          HexColors = AddCfg._HexColors.s
    734          CALL LINEOUT TmpFile, '['PalName']'
    735          CALL LINEOUT TmpFile, LEFT( '; Name in EPM', 13)'   -R- -G- -B-'
    736          rest = HexColors
    737          n = 0
    738          ColorName.0 = 0
    739          ColorValues. = ''
    740          DO WHILE rest <> ''
    741             PARSE VALUE rest WITH '0x'next','rest
    742             PARSE VALUE next WITH redhex +2 greenhex +2 bluehex
    743             IF redhex = '' | greenhex = '' | bluehex = '' THEN
    744                RETURN 1
    745             red   = X2D( redhex)
    746             green = X2D( greenhex)
    747             blue  = X2D( bluehex)
    748             n = n + 1
    749             ColorName.n = WORD( ColorList, n)
    750             ColorName.0 = n
    751             idx = WORD( PalIndexList, n)
    752             ColorValues.idx = RIGHT( red, 3)' 'RIGHT( green, 3)' 'RIGHT( blue, 3)
    753          END
    754          DO n = 1 TO ColorName.0
    755             CALL LINEOUT TmpFile, LEFT( ColorName.n, 13)' = 'ColorValues.n
    756          END
    757          CALL LINEOUT TmpFile, ''
    758       END
    759       next = STREAM( TmpFile, 'C', 'CLOSE')
    760       IF \FileExist( TmpFile) THEN
    761       DO
    762          rc = ERROR.WRITE_FAULT
    763          LEAVE
    764       END
    765 
    766       /* Rename TmpFile to AddCfg file */
    767       rcx = FileDelete( AddCfg._Fullname)
    768       rc = FileRename( TmpFile, AddCfg._Name)
    769    END
    770 
    771    RETURN( rc)
    772 
    773 /* ----------------------------------------------------------------------- */
    774 GetPalNameList: PROCEDURE EXPOSE (GlobalVars)
    775 
    776    /* Create lists of palette names */
    777    AddCfg.PalNames = ''
    778    DO s = 1 TO AddCfg._Section.0
    779       ThisName = AddCfg._Section.s
    780       AddCfg.PalNames = AddCfg.PalNames ThisName
    781    END
    782    AddCfg.PalNames = STRIP( AddCfg.PalNames)
    783 
    784    StdCfg.PalNames = ''
    785    DO s = 1 TO StdCfg._Section.0
    786       ThisName = StdCfg._Section.s
    787       /* Ignore user-redefined cfg sections with the same name. */
    788       /* This allows for overriding the Netlabs file, as it     */
    789       /* applies for macro files.                               */
    790       IF WORDPOS( ThisName, AddCfg.PalNames) > 0 THEN ITERATE
    791       StdCfg.PalNames = StdCfg.PalNames ThisName
    792    END
    793    StdCfg.PalNames = STRIP( StdCfg.PalNames)
    794 
    795    ListBoxData = '|'TRANSLATE( STRIP( AddCfg.PalNames StdCfg.PalNames), '|', ' ')
    796    IF ListBoxData = '|' THEN
    797       ListBoxData = ''
    798 
    799    RETURN( ListBoxData)
    800 
    801 /* ----------------------------------------------------------------------- */
    802 CopyPal: PROCEDURE EXPOSE (GlobalVars)
    803 
    804    PARSE ARG PalName, NewPalName
    805    rc = ERROR.NO_ERROR
    806 
    807    /* Find palette */
    808    HexColors = ''
    809    fNameFound = 0
    810    fNewNameFound = 0
    811 
    812    /* Compare name with StdCfg sections */
    813    IF \fNameFound THEN
    814    DO s = 1 TO StdCfg._Section.0
    815       IF TRANSLATE( PalName) = TRANSLATE( StdCfg._Section.s) THEN
    816       DO
    817          fNameFound = 1
    818          HexColors = StdCfg._HexColors.s
    819          LEAVE
    820       END
    821    END
    822 
    823    /* Compare name with AddCfg sections */
    824    IF \fNameFound THEN
    825    DO s = 1 TO AddCfg._Section.0
    826       IF TRANSLATE( PalName) = TRANSLATE( AddCfg._Section.s) THEN
    827       DO
    828          fNameFound = 1
    829          HexColors = AddCfg._HexColors.s
    830          LEAVE
    831       END
    832    END
    833 
    834    IF fNameFound THEN
     1352      nFirst = nEndMove
     1353      nLast  = nStartMove
     1354      nStep  = -1
     1355   END
     1356   ELSE
    8351357   DO
    836       /* Check if new palette name already exists in AddCfg file */
    837       DO s = 1 TO AddCfg._Section.0
    838          IF TRANSLATE( NewPalName) = TRANSLATE( AddCfg._Section.s) THEN
    839          DO
    840             fNewNameFound = 1
    841             /* Use colors from source palette */
    842             AddCfg._HexColors.s = HexColors
    843             LEAVE
    844          END
    845       END
    846 
    847       IF \fNewNameFound THEN
    848       DO
    849          /* Append to AddCfg array */
    850          s = AddCfg._Section.0 + 1
    851          AddCfg._Section.s   = NewPalName
    852          AddCfg._HexColors.s = HexColors
    853          AddCfg._Section.0   = s
    854 
    855          /* Append to Pal array */
    856          p = Pal._Name.0 + 1
    857          Pal._Name.p      = PalName
    858          Pal._HexColors.p = HexColors
    859          Pal._Name.0      = p
    860       END
    861 
    862       /* Create missing palette or overwrite it */
    863       rcx = CreatePalObj( NewPalName, HexColors)
    864 
    865       /* Write AddCfg file */
    866       rcx = SaveAddCfg()
     1358      nFirst = nStartMove
     1359      nLast  = nEndMove
     1360      nStep  = 1
     1361   END
     1362
     1363   DO n = nFirst TO nLast BY nStep
     1364      nNew = n + nAmount
     1365      DO c = 1 TO WORDS( ColorList)
     1366         Cfg.c.nNew = Cfg.c.n
     1367      END
     1368      Cfg._HexColors.nNew = Cfg._HexColors.n
     1369      Cfg._Name.nNew = Cfg._Name.n
     1370      Cfg._Group.nNew = Cfg._Group.n
     1371      Cfg._NameFound.nNew = Cfg._NameFound.n
     1372      Cfg._ColorsEqual.nNew = Cfg._ColorsEqual.n
     1373   END
     1374
     1375   IF nAmount < 0 THEN
     1376   DO n = Cfg._Name.0 + nAmount TO Cfg._Name.0
     1377      /* Reset unused vars */
     1378      DO c = 1 TO WORDS( ColorList)
     1379         Cfg.c.n = ''
     1380      END
     1381      Cfg._HexColors.n = ''
     1382      Cfg._Name.n = ''
     1383      Cfg._Group.n = ''
     1384      Cfg._NameFound.n = ''
     1385      Cfg._ColorsEqual.n = ''
     1386   END
     1387
     1388   Cfg._Name.0 = Cfg._Name.0 + nAmount
     1389
     1390   RETURN( rc)
     1391
     1392/* ----------------------------------------------------------------------- */
     1393MovePalNumber: PROCEDURE EXPOSE (GlobalVars)
     1394   PARSE ARG pAmount, pStartMove, pEndMove
     1395
     1396   rc = ERROR.NO_ERROR
     1397
     1398   IF pAmount > 0 THEN
     1399   DO
     1400      pFirst = pEndMove
     1401      pLast  = pStartMove
     1402      pStep  = -1
    8671403   END
    8681404   ELSE
    869       rc = ERROR.FILE_NOT_FOUND
    870 
    871    RETURN( rc)
    872 
    873 /* ----------------------------------------------------------------------- */
    874 DeletePal: PROCEDURE EXPOSE (GlobalVars)
    875 
    876    PARSE ARG PalName
    877    rc = ERROR.NO_ERROR
    878 
    879    /* Find palette */
    880    fNameFound   = 0
    881    FoundSection = ''
    882 
    883    /* Compare name with AddCfg sections */
    884    IF \fNameFound THEN
    885    DO s = 1 TO AddCfg._Section.0
    886       IF TRANSLATE( PalName) = TRANSLATE( AddCfg._Section.s) THEN
    887       DO
    888          fNameFound = 1
    889          FoundSection = s
    890          ITERATE
    891       END
    892    END
    893 
    894    /* Compare name with StdCfg sections to give useful error message only */
    895    IF \fNameFound THEN
    896    DO s = 1 TO StdCfg._Section.0
    897       IF TRANSLATE( PalName) = TRANSLATE( StdCfg._Section.s) THEN
    898       DO
    899          fNameFound = 1
    900          rc = ERROR.ACCESS_DENIED
    901          ITERATE
    902       END
    903    END
    904 
    905    IF fNameFound THEN
    9061405   DO
    907       IF rc = ERROR.NO_ERROR THEN
    908       DO
    909          /* Remove from AddCfg array */
    910          t = 0
    911          smax = AddCfg._Section.0
    912          DO s = 1 TO smax
    913             IF s <> FoundSection THEN
    914             DO
    915                t = t + 1
    916                AddCfg._Section.t   = AddCfg._Section.s
    917                AddCfg._HexColors.t = AddCfg._HexColors.s
    918                AddCfg._Section.0   = t
    919             END
    920          END
    921 
    922          /* Remove from Pal array */
    923          q = 0
    924          pmax = Pal._Name.0
    925          DO p = 1 TO pmax
    926             IF TRANSLATE( PalName) <> TRANSLATE( Pal._Name.p) THEN
    927             DO
    928                q = q + 1
    929                Pal._Name.q      = Pal._Name.p
    930                Pal._HexColors.q = Pal._HexColors.p
    931                Pal._Name.0      = q
    932             END
    933          END
    934 
    935          /* Remove palette object */
    936          rcx = DeletePalObj( PalName)
    937 
    938          /* Write AddCfg file */
    939          rcx = SaveAddCfg()
    940       END
    941    END
    942    ELSE
    943       rc = ERROR.FILE_NOT_FOUND
    944 
    945    RETURN( rc)
    946 
    947 /* ----------------------------------------------------------------------- */
    948 InitPal: PROCEDURE EXPOSE (GlobalVars)
    949 
    950    rc = ERROR.NO_ERROR
    951 
    952    fNewNameFound = 0
    953    SrcPalName = 'NEPMD'
    954    NewPalName = 'MyColors'
    955 
    956    /* Check if new palette name already exists in AddCfg file */
    957    DO s = 1 TO AddCfg._Section.0
    958       IF TRANSLATE( NewPalName) = TRANSLATE( AddCfg._Section.s) THEN
    959       DO
    960          fNewNameFound = 1
    961          LEAVE
    962       END
    963    END
    964 
    965    IF \fNewNameFound THEN
    966       rc = CopyPal( SrcPalName, NewPalName)
    967 
    968    RETURN( rc)
    969 
    970 /* ----------------------------------------------------------------------- */
    971 SyncPal2Cfg: PROCEDURE EXPOSE (GlobalVars)
    972 
    973    PARSE ARG PalName
    974    rc = ERROR.NO_ERROR
    975 
    976    HexColors = ''
    977    fNameFound = 0
    978    fNewNameFound = 0
    979 
    980    /* Find palette in Pal array */
    981    DO p = 1 TO Pal._Name.0
    982       IF TRANSLATE( Pal._Name.p) = TRANSLATE( PalName) THEN
    983       DO
    984          HexColors = Pal._HexColors.p
    985          fNameFound = 1
    986          LEAVE
    987       END
    988    END
    989 
    990    IF fNameFound THEN
    991    DO
    992       /* Compare name with AddCfg sections */
    993       DO s = 1 TO AddCfg._Section.0
    994          IF TRANSLATE( PalName) = TRANSLATE( AddCfg._Section.s) THEN
    995          DO
    996             fNewNameFound = 1
    997             /* Use colors from palette object */
    998             AddCfg._HexColors.s = HexColors
    999             LEAVE
    1000          END
    1001       END
    1002 
    1003       IF \fNewNameFound THEN
    1004       DO
    1005          /* Append to AddCfg array */
    1006          s = AddCfg._Section.0 + 1
    1007          AddCfg._Section.s   = PalName
    1008          AddCfg._HexColors.s = HexColors
    1009          AddCfg._Section.0   = s
    1010       END
    1011 
    1012       /* Write AddCfg file */
    1013       rc = SaveAddCfg()
    1014    END
    1015 
    1016    RETURN( rc)
    1017 
    1018 /* ----------------------------------------------------------------------- */
    1019 SyncCfg2Pal: PROCEDURE EXPOSE (GlobalVars)
    1020 
    1021    PARSE ARG PalName
    1022    rc = ERROR.NO_ERROR
    1023 
    1024    HexColors = ''
    1025    fNameFound = 0
    1026    fNewNameFound = 0
    1027 
    1028    /* Compare name with StdCfg sections */
    1029    IF \fNameFound THEN
    1030    DO s = 1 TO StdCfg._Section.0
    1031       IF TRANSLATE( PalName) = TRANSLATE( StdCfg._Section.s) THEN
    1032       DO
    1033          fNameFound = 1
    1034          HexColors = StdCfg._HexColors.s
    1035          LEAVE
    1036       END
    1037    END
    1038 
    1039    /* Compare name with AddCfg sections */
    1040    IF \fNameFound THEN
    1041    DO s = 1 TO AddCfg._Section.0
    1042       IF TRANSLATE( PalName) = TRANSLATE( AddCfg._Section.s) THEN
    1043       DO
    1044          fNameFound = 1
    1045          HexColors = AddCfg._HexColors.s
    1046          LEAVE
    1047       END
    1048    END
    1049 
    1050    IF fNameFound THEN
    1051    DO
    1052 
    1053       /* Find palette in Pal array */
    1054       DO p = 1 TO Pal._Name.0
    1055          IF TRANSLATE( Pal._Name.p) = TRANSLATE( PalName) THEN
    1056          DO
    1057             fNewNameFound = 1
    1058             /* Use colors from cfg file */
    1059             Pal._HexColors.p = HexColors
    1060             LEAVE
    1061          END
    1062       END
    1063 
    1064       IF \fNewNameFound THEN
    1065       DO
    1066          /* Append to Pal array */
    1067          p = Pal._Name.0 + 1
    1068          Pal._Name.p      = PalName
    1069          Pal._HexColors.p = HexColors
    1070          Pal._Name.0      = p
    1071       END
    1072 
    1073       /* Create missing palette or overwrite it */
    1074       rc = CreatePalObj( PalName, HexColors)
    1075 
    1076       AsyncFlag = 0
    1077       DO i = 1 to 4
    1078          CALL SysSleep 0.5
    1079          rcx = SysSaveObject( ObjectId, AsyncFlag)
    1080       END
    1081    END
    1082 
    1083    RETURN( rc)
    1084 
    1085 /* ----------------------------------------------------------------------- */
    1086 GetHexColors: PROCEDURE EXPOSE (GlobalVars)
    1087    PARSE ARG PalName
    1088 
    1089    rc = ERROR.NO_ERROR
    1090    HexColors = ''
    1091    DO 1
    1092       /* Find palette in Pal array */
    1093       IF HexColors = '' THEN
    1094       DO p = 1 TO Pal._Name.0
    1095          IF TRANSLATE( PalName) = TRANSLATE( Pal._Name.p) THEN
    1096          DO
    1097             HexColors = Pal._HexColors.p
    1098             LEAVE
    1099          END
    1100       END
    1101 
    1102       /* Find palette in AddCfg array */
    1103       IF HexColors = '' THEN
    1104       DO s = 1 TO AddCfg._Section.0
    1105          IF TRANSLATE( PalName) = TRANSLATE( AddCfg._Section.s) THEN
    1106          DO
    1107             HexColors = AddCfg._HexColors.s
    1108             LEAVE
    1109          END
    1110       END
    1111 
    1112       /* Find palette in StdCfg array */
    1113       IF HexColors = '' THEN
    1114       DO s = 1 TO StdCfg._Section.0
    1115          IF TRANSLATE( PalName) = TRANSLATE( StdCfg._Section.s) THEN
    1116          DO
    1117             HexColors = StdCfg._HexColors.s
    1118             LEAVE
    1119          END
    1120       END
    1121 
    1122       IF HexColors = '' THEN
     1406      pFirst = pStartMove
     1407      pLast  = pEndMove
     1408      pStep  = 1
     1409   END
     1410
     1411   DO p = pFirst TO pLast BY pStep
     1412      pNew = p + pAmount
     1413      Pal._Name.pNew = Pal._Name.p
     1414      Pal._HexColors.pNew = Pal._HexColors.p
     1415      Pal._NameFound.pNew = Pal._NameFound.p
     1416      Pal._ColorsEqual.pNew = Pal._ColorsEqual.p
     1417   END
     1418
     1419   IF pAmount < 0 THEN
     1420   DO p = Pal._Name.0 + pAmount TO Pal._Name.0
     1421      /* Reset unused vars */
     1422      Pal._Name.p = ''
     1423      Pal._HexColors.p = ''
     1424      Pal._NameFound.p = ''
     1425      Pal._ColorsEqual.p = ''
     1426   END
     1427
     1428   Pal._Name.0 = Pal._Name.0 + pAmount
     1429
     1430   RETURN( rc)
     1431
     1432/* ----------------------------------------------------------------------- */
     1433HexColorsToRegKeys: PROCEDURE EXPOSE (GlobalVars)
     1434   PARSE ARG n, g, PalName, HexColors
     1435
     1436   rc = ERROR.NO_ERROR
     1437
     1438   /* Copy Cfg. and write config keys */
     1439   rest = HexColors
     1440   c = 0
     1441   ColorValues. = ''
     1442   DO WHILE rest <> ''
     1443      PARSE VALUE rest WITH '0x'next','rest
     1444      PARSE VALUE next WITH redhex +2 greenhex +2 bluehex
     1445      IF redhex = '' | greenhex = '' | bluehex = '' THEN
    11231446      DO
    11241447         rc = ERROR.INVALID_DATA
    11251448         LEAVE
    11261449      END
    1127    END
    1128 
    1129    RETURN( HexColors)
     1450      red   = X2D( redhex)
     1451      green = X2D( greenhex)
     1452      blue  = X2D( bluehex)
     1453      c = c + 1
     1454      ColorVal = RIGHT( red, 3)' 'RIGHT( green, 3)' 'RIGHT( blue, 3)
     1455      Cfg.c.n = ColorVal
     1456      SubKey = WORD( ColorList, c)
     1457      rc = WriteConfigKey( Key._MainPath'\'g'\'SubKey, ColorVal)
     1458   END
     1459
     1460   /* Set HexColors to Cfg. */
     1461   Cfg._HexColors.n = HexColors
     1462
     1463   RETURN( rc)
     1464
     1465/* ----------------------------------------------------------------------- */
     1466HexColorsToPalette: PROCEDURE EXPOSE (GlobalVars)
     1467   PARSE ARG p, PalName, HexColors
     1468
     1469   rc = ERROR.NO_ERROR
     1470
     1471   /* Create new palette or overwrite it */
     1472   rc = CreatePalObj( PalName, HexColors)
     1473
     1474   /* Set HexColors to Pal. */
     1475   Pal._HexColors.p = HexColors
     1476
     1477   RETURN( rc)
    11301478
    11311479/* ----------------------------------------------------------------------- */
    … …  
    11401488      IF rc <> 0 THEN
    11411489      DO
    1142          ErrorMessage 'Backup: "'DllFullName'" not copied to work dir "'WorkDir'". rc = 'rc
     1490         ErrorMessage 'Backup: "'DllFullName'" not copied to work dir "'WorkDir'". rc = 'rc'.'
    11431491         LEAVE
    11441492      END
    … …  
    11611509         IF rc <> 0 THEN
    11621510         DO
    1163             ErrorMessage = 'Backup: "'DllFullName'" not copied to "'BackupName'". rc = 'rc
     1511            ErrorMessage = 'Backup: "'DllFullName'" not copied to "'BackupName'". rc = 'rc'. '
    11641512            LEAVE
    11651513         END
    11661514         DO s = 1 TO 3
    11671515            IF FileExist( BackupFile) THEN LEAVE
    1168             CALL SysSleep SysSleepAmount
    1169          END
    1170       END
    1171       CALL SysSetObjectData BackupFullName, 'TITLE='BackupName';'
     1516            CALL SysSleep 0.5
     1517         END
     1518      END
     1519      CALL SysSetObjectData BackupFile, 'TITLE='BackupName';'
    11721520   END
    11731521
    … …  
    12981646   DO 1
    12991647      WorkDll = WorkDllFullName
    1300       Lxlite '/YDL /YUR /x' WorkDll
     1648
     1649      /* First, check for errors, because LxLite doesn't return a useful rc */
     1650      IF \FileExist( WorkDll) THEN
     1651      DO
     1652         rc = ERROR.FILE_NOT_FOUND
     1653         ErrorMessage = 'WorkDll "'WorkDll'" doesn''t exist, rc = 'rc'.'
     1654         LEAVE
     1655      END
     1656      IF STREAM( WorkDll, 'C', 'OPEN') <> 'READY:' THEN
     1657      DO
     1658         rc = ERROR.ACCESS_DENIED
     1659         ErrorMessage = 'WorkDll "'WorkDll'" can''t be opened, rc = 'rc'.'
     1660         LEAVE
     1661      END
     1662      ELSE
     1663         CALL STREAM WorkDll, 'C', 'CLOSE'
     1664
     1665      /* Unpack DLL with LxLite */
     1666      LxLite '/YDL /YUR /x' WorkDll
    13011667      IF rc <> 0 THEN
    13021668      DO
    1303          /*ErrorMessage = 'lxLite returned on expansion of "'WorkDll'" with rc = 'rc*/
    1304          ErrorMessage = 'Lxlite = 'Lxlite
     1669         /* LxLite 1.3.3 always returns rc = 0. With 'CALL' it returns rc = 0. */
     1670         /* LxLite 1.3.9 always returns rc = 5. With 'CALL' it returns rc = 99. */
     1671         /*
     1672         ErrorMessage = 'lxLite returned on expansion of "'WorkDll'" with rc = 'rc'.'
    13051673         LEAVE
     1674         */
     1675         rc = ERROR.NO_ERROR
    13061676      END
    13071677
    … …  
    13231693      IF p2 = 0 THEN
    13241694      DO
    1325          ErrorMessage = 'Signature "'Signature'" not found in 'WorkDllFullName
     1695         ErrorMessage = 'Signature "'Signature'" not found in 'WorkDllFullName'.'
    13261696         rc = ERROR.INVALID_DATA
    13271697         LEAVE
    … …  
    13401710      CALL STREAM WorkDll, 'C', 'CLOSE'
    13411711
    1342       Lxlite '/YDL /YUR' WorkDll
     1712      /* Pack DLL with LxLite */
     1713      LxLite '/YDL /YUR' WorkDll
    13431714      IF rc <> 0 THEN
    13441715      DO
    1345          ErrorMessage = 'lxLite returned on compression of "'WorkDll'" with rc = 'rc
     1716         /* LxLite 1.3.3 always returns rc = 0. With 'CALL' it returns rc = 0. */
     1717         /* LxLite 1.3.9 always returns rc = 5. With 'CALL' it returns rc = 99. */
     1718         /*
     1719         ErrorMessage = 'lxLite returned on compression of "'WorkDll'" with rc = 'rc'.'
    13461720         LEAVE
     1721         */
     1722         rc = ERROR.NO_ERROR
    13471723      END
    13481724
    … …  
    14631839      /* This key can be used as a reference to another exe */
    14641840      KeyPath = '\NEPMD\User\Tools\'Tool'\ToolBaseName'
    1465       next = SysIni( NepmdIni, 'RegKeys', KeyPath)
     1841      next = SysIni( Ini._Filename, Ini._RegKeys, KeyPath)
    14661842      IF next = 'ERROR:' THEN
    14671843         CfgToolBaseName = ''
    … …  
    14871863      KeyPath = '\NEPMD\User\Tools\'ToolBaseName
    14881864
    1489       next = SysIni( NepmdIni, 'RegKeys', KeyPath'\Exe')
     1865      next = SysIni( Ini._Filename, Ini._RegKeys, KeyPath'\Exe')
    14901866      IF next = 'ERROR:' THEN
    14911867         Exe = ''
    … …  
    14931869         Exe = STRIP( next, 'T', '00'x)
    14941870
    1495       next = SysIni( NepmdIni, 'RegKeys', Keypath'\Parameters')
     1871      next = SysIni( Ini._Filename, Ini._RegKeys, Keypath'\Parameters')
    14961872      IF next = 'ERROR:' THEN
    14971873         Parameters = ''
    … …  
    14991875         Parameters = STRIP( next, 'T', '00'x)
    15001876
    1501       next = SysIni( NepmdIni, 'RegKeys', KeyPath'\WorkingDir')
     1877      next = SysIni( Ini._Filename, Ini._RegKeys, KeyPath'\WorkingDir')
    15021878      IF next = 'ERROR:' THEN
    15031879         WorkingDir = ''
    … …  
    15051881         WorkingDir = STRIP( next, 'T', '00'x)
    15061882
    1507       next= SysIni( NepmdIni, 'RegKeys', KeyPath'\DefaultCmd')
     1883      next= SysIni( Ini._Filename, Ini._RegKeys, KeyPath'\DefaultCmd')
    15081884      IF next = 'ERROR:' THEN
    15091885         DefaultCmd = ''

  • TabularUnified trunk/src/netlabs/bin/defaults.cfg

    r2992 r3008  
    311311\NEPMD\User\ProgramObjects\Assocs\3\7    = <WP_EPM>, Type:Pascal Code
    312312
     313; Highlighting colors
     314; Note: Default colors sets start at 101 as id number.
     315;       User colors sets can start at 1 or any other number below 101.
     316;       To create own color sets, one option is to start with copying one of
     317;       the following ones to user.cfg. Then change the id number and the name.
     318;       Another option is to copy a palette object or to use the dialog.
     319
     320\NEPMD\User\Colors\Highlighting\101\Name          = NEPMD
     321;                                 Name in EPM     -R- -G- -B-
     322\NEPMD\User\Colors\Highlighting\101\black         =   0   0   0
     323\NEPMD\User\Colors\Highlighting\101\blue          =   0   0 153
     324\NEPMD\User\Colors\Highlighting\101\green         =   0 162  66
     325\NEPMD\User\Colors\Highlighting\101\cyan          =   0 154 156
     326\NEPMD\User\Colors\Highlighting\101\red           = 207   0  62
     327\NEPMD\User\Colors\Highlighting\101\magenta       = 153   0 153
     328\NEPMD\User\Colors\Highlighting\101\brown         = 173 158  99
     329\NEPMD\User\Colors\Highlighting\101\light_gray    = 204 204 204
     330\NEPMD\User\Colors\Highlighting\101\dark_gray     = 132 109 173
     331\NEPMD\User\Colors\Highlighting\101\light_blue    =   0   0 255
     332\NEPMD\User\Colors\Highlighting\101\light_green   = 228 153  23
     333\NEPMD\User\Colors\Highlighting\101\light_cyan    =   0 139 232
     334\NEPMD\User\Colors\Highlighting\101\light_red     = 255   0   0
     335\NEPMD\User\Colors\Highlighting\101\light_magenta = 236   0 171
     336\NEPMD\User\Colors\Highlighting\101\yellow        = 239 239 198
     337\NEPMD\User\Colors\Highlighting\101\white         = 239 239 239
     338
     339\NEPMD\User\Colors\Highlighting\102\Name          = Standard
     340;                                 Name in EPM     -R- -G- -B-
     341\NEPMD\User\Colors\Highlighting\102\black         =   0   0   0
     342\NEPMD\User\Colors\Highlighting\102\blue          =   0   0 153
     343\NEPMD\User\Colors\Highlighting\102\green         =   0 153   0
     344\NEPMD\User\Colors\Highlighting\102\cyan          =   0 153 153
     345\NEPMD\User\Colors\Highlighting\102\red           = 153   0   0
     346\NEPMD\User\Colors\Highlighting\102\magenta       = 153   0 153
     347\NEPMD\User\Colors\Highlighting\102\brown         = 153 153   0
     348\NEPMD\User\Colors\Highlighting\102\light_gray    = 204 204 204
     349\NEPMD\User\Colors\Highlighting\102\dark_gray     = 128 128 128
     350\NEPMD\User\Colors\Highlighting\102\light_blue    =   0   0 255
     351\NEPMD\User\Colors\Highlighting\102\light_green   =   0 255   0
     352\NEPMD\User\Colors\Highlighting\102\light_cyan    =   0 255 255
     353\NEPMD\User\Colors\Highlighting\102\light_red     = 255   0   0
     354\NEPMD\User\Colors\Highlighting\102\light_magenta = 255   0 255
     355\NEPMD\User\Colors\Highlighting\102\yellow        = 255 255   0
     356\NEPMD\User\Colors\Highlighting\102\white         = 255 255 255
     357
    313358; ---------------------------------------------------------------------------
    314359

  • TabularUnified trunk/src/netlabs/install/cleanup.cmd

    r2940 r3008  
    138138   rcx = SysDestroyObject( NetlabsDir'\bin\defaults.dat')
    139139   rcx = SysDestroyObject( NetlabsDir'\bin\objects.ini')
     140   rcx = SysDestroyObject( NetlabsDir'\bin\objects.cfg')
     141   rcx = SysDestroyObject( NetlabsDir'\bin\colors.cfg')
    140142   rcx = SysDestroyObject( NetlabsDir'\bin\md5.exe')
    141143   rcx = SysDestroyObject( NetlabsDir'\bin\md5-readme.txt')
Note: See TracChangeset for help on using the changeset viewer.