/*----------------------------------------------------------------------------*/
/*                                                                            */
/* Copyright (c) 1995, 2004 IBM Corporation. All rights reserved.             */
/* Copyright (c) 2005-2014 Rexx Language Association. All rights reserved.    */
/*                                                                            */
/* This program and the accompanying materials are made available under       */
/* the terms of the Common Public License v1.0 which accompanies this         */
/* distribution. A copy is also available at the following address:           */
/* https://www.oorexx.org/license.html                         */
/*                                                                            */
/* Redistribution and use in source and binary forms, with or                 */
/* without modification, are permitted provided that the following            */
/* conditions are met:                                                        */
/*                                                                            */
/* Redistributions of source code must retain the above copyright             */
/* notice, this list of conditions and the following disclaimer.              */
/* Redistributions in binary form must reproduce the above copyright          */
/* notice, this list of conditions and the following disclaimer in            */
/* the documentation and/or other materials provided with the distribution.   */
/*                                                                            */
/* Neither the name of Rexx Language Association nor the names                */
/* of its contributors may be used to endorse or promote products             */
/* derived from this software without specific prior written permission.      */
/*                                                                            */
/* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS        */
/* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT          */
/* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS          */
/* FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT   */
/* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,      */
/* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED   */
/* TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,        */
/* OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY     */
/* OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING    */
/* NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS         */
/* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.               */
/*                                                                            */
/*----------------------------------------------------------------------------*/


::requires 'rxwinsys' LIBRARY

::class 'WindowsRegistry' public

::attribute Local_Machine get external "LIBRARY rxwinsys getLocal_Machine"
::attribute Current_User get external "LIBRARY rxwinsys getCurrent_User"
::attribute Users get external "LIBRARY rxwinsys getUsers"
::attribute Classes_Root get external "LIBRARY rxwinsys getClasses_Root"
::attribute Performance_Data get external "LIBRARY rxwinsys getPerformance_Data"
::attribute Current_Config get external "LIBRARY rxwinsys getCurrent_Config"

::attribute Current_Key external "LIBRARY rxwinsys"

-- This is here to support some long time ago previous version.
::attribute CurrentKey external "LIBRARY rxwinsys Current_Key"

::method init external "LIBRARY rxwinsys WSRegistry_init"
::method open external "LIBRARY rxwinsys WSRegistry_open"
::method deleteKey external "LIBRARY rxwinsys WSRegistry_delete"
::method delete external "LIBRARY rxwinsys WSRegistry_delete"


::method Create
   use arg hkey, name
   if arg(1,'o') = 1 then hkey = self~Current_Key
   retc = WSRegistryKey("CREATE", hkey, name)
   if (retc \= 0) then self~Current_Key = retc
   return retc

::method Close
   use arg hkey
   if arg(1,'o') = 1 then hkey = self~Current_Key
   retc = WSRegistryKey("CLOSE", hkey)
   return retc

::method Query
   use arg hkey
   if arg(1,'o') = 1 then hkey = self~Current_Key
   retc = WSRegistryKey("QUERY", hkey)
   if (retc \= 0) then do
      parse var retc classname", "subk", "vals", "adate", "atime
      retstem.Class = classname
      retstem.SubKeys = SubK
      retstem.Values = vals
      retstem.date = aDate
      retstem.time = aTime
      return retstem.
   end
   else return 0

::method List
   use arg hkey, astem.
   if arg(1,'o') = 1 then hkey = self~Current_Key
   drop InternKeyStem.
   retc = WSRegistryKey("LIST", hkey, "InternKeyStem")
   if retc = 0 then do i over InternKeyStem.
      astem.i = InternKeyStem.i
   end
   return retc

::method Flush
   use arg hkey
   if arg(1,'o') = 1 then hkey = self~Current_Key
   retc = WSRegistryKey("FLUSH", hkey)
   return retc

::method SetValue
   use arg hkey, name, valu, atype
   if arg(1,'o') = 1 then hkey = self~Current_Key
   if arg(2,'o') = 1 then name = ""
   if arg(4,'o') = 1 then atype = "NORMAL"
   retc = WSRegistryValue("SET", hkey, name, valu, atype~translate)
   return retc

::method GetValue
   use arg hkey, name
   if arg(1,'o') = 1 then hkey = self~Current_Key
   if arg(2,'o') = 1 then name = ""
   retc = WSRegistryValue("QUERY", hkey, name)
   if (retc \= 0) then do
      parse var retc atype", "valu   /* swapped for feature 358 */
      retstem.Data = valu
      retstem.Type = atype
      return retstem.
   end
   else return 0

::method ListValues
   use arg hkey, astem.
   if arg(1,'o') = 1 then hkey = self~Current_Key
   drop InternValStem.
   retc = WSRegistryValue("LIST", hkey, "InternValStem")
   if retc = 0 then do i over InternValStem.
      astem.i = InternValStem.i
   end
   return retc

::method DeleteValue
   use arg hkey, name
   if arg(1,'o') = 1 then hkey = self~Current_Key
   if arg(2,'o') = 1 then name = ""
   retc = WSRegistryValue("DELETE", hkey, name)
   return retc

::method Connect
   use arg hkey, computername
   retc = WSRegistryFile("CONNECT", hkey, computername)
   return retc

::method Load
   use arg hkey, subkeyname, filename
   if arg(1,'o') = 1 then hkey = self~Local_Machine
   retc = WSRegistryFile("LOAD", hkey, subkeyname, filename)
   return retc

::method Save
   use arg hkey, filename
   if arg(1,'o') = 1 then hkey = self~Current_Key
   retc = WSRegistryFile("SAVE", hkey, filename)
   return retc

::method Restore
   use arg hkey, filename, opt /* opt can be VOLATILE */
   if arg(1,'o') = 1 then hkey = self~Current_Key
   retc = WSRegistryFile("RESTORE", hkey, filename, opt~translate)
   return retc

::method Replace
   use arg hkey, subkeyname, fnnew, fnold
   if arg(1,'o') = 1 then hkey = self~Current_Key
   if arg(2,'o') = 1 then subkeyname = "%NULL%"
   retc = WSRegistryFile("REPLACE", hkey, subkeyname, fnnew, fnold)
   return retc

::method UnLoad
   use arg hkey, subkeyname
   if arg(1,'o') = 1 then hkey = self~Current_Key
   retc = WSRegistryFile("UNLOAD", hkey, subkeyname)
   return retc

-- Deprecated.  Provided for backwards compatibility, does nothing.
::method deinstall

-- Deprecated.  Provided for backwards compatiblity, will always return 0
::attribute initCode get
  return 0


/*********************************** WindowsProgramManager ****************************************/

::class 'WindowsProgramManager' public inherit VirtualKeyCodes

::method AddGroup
   use arg name
   return WSProgManager("ADDGROUP", name, "")

::method DeleteGroup
   use arg name
   return WSProgManager("DELGROUP", name)

::method ShowGroup
   use arg name, cmd
   cmd = cmd~translate
   return WSProgManager("SHOWGROUP", name, cmd)

::method AddItem
   use arg name, prog, iconfile, iconnr, workdir, placelast, minimized, hotkey

   if arg(3,'o') = 1 then iconfile = ""
   if arg(4,'o') = 1 then iconnr = 0
   if arg(5,'o') = 1 then workdir = ""
   if arg(6,'o') = 1 then placelast = 0
   if arg(7,'o') = 1 then minimized = 0
   if arg(8,'o') = 1 then hotkey = ""

    scModifier = 0
    scKey = 0

    if hotkey \= "" then do
        hotkey = hotkey~translate
        /* if hotkey contains any modifier key (SHIFT,CONTROL,...) */
        if hotkey~pos('+') = 0 then do
            scKey = self~VCode(hotkey)
            /* only F1 to F24 are allowed without modification characters */
            /* for all others keys use Ctrl+ ALT                          */
            if scKey > self~VCode("F12") | scKey < self~VCode("F1") then do
                scModifier = 02~x2d
                scModifier = scModifier + 04~x2d
            end
        end
        else do
         /* When any modifier key is specified, use it ! Dont care if it gets any problem */
         /* EXT not supported, because it dos not function correctly */
            scKey = self~VCode(hotkey~substr(hotkey~lastpos('+') + 1))
            if hotkey~pos('SHIFT')   \= 0 then scModifier = scModifier + 01~x2d
            if hotkey~pos('CONTROL') \= 0 then scModifier = scModifier + 02~x2d
            if hotkey~pos('ALT')     \= 0 then scModifier = scModifier + 04~x2d
        end
    end

   return WSProgManager("ADDITEM", prog, name, iconfile, iconnr, workdir, placelast, scKey, scModifier, minimized)

::method DeleteItem
   use arg name
   return WSProgManager("DELITEM", name)

::method Close
   parse upper arg savegrp
   return WSProgManager("LEAVE", savegrp)

::method DeleteDesktopIcon
   use arg name, location
   if arg(2,'o') = 1 then location = "PERSONAL"
   return WSProgManager("DELDESKTOPICON", name, location )


::method AddDesktopIcon
   use arg name, prog, iconfile, iconnr, workdir, location, arguments, hotkey, run
   if arg(3,'o') = 1 then iconfile   = ""
   if arg(4,'o') = 1 then iconnr     =  0
   if arg(5,'o') = 1 then workdir    = ""
   if arg(6,'o') = 1 then location   = "PERSONAL"
   if arg(7,'o') = 1 then arguments  = ""
   if arg(8,'o') = 1 then hotkey     = ""
   if arg(9,'o') = 1 then run        = ""

    scModifier = 0
    scKey = 0

    if hotkey \= "" then do
        hotkey = hotkey~translate
        /* if hotkey contains any modifier key (SHIFT,CONTROL,...) */
        if hotkey~pos('+') = 0 then do
            scKey = self~VCode(hotkey)
            /* only F1 to F24 are allowed without modification characters */
            /* for all others keys use Ctrl+ ALT                          */
            if scKey > self~VCode("F12") | scKey < self~VCode("F1") then do
                scModifier = 02~x2d
                scModifier = scModifier + 04~x2d
            end
        end
        else do
         /* When any modifier key is specified, use it ! Dont care if it gets any problem */
         /* EXT not supported, because it dos not function correctly */
            scKey = self~VCode(hotkey~substr(hotkey~lastpos('+') + 1))
            if hotkey~pos('SHIFT')   \= 0 then scModifier = scModifier + 01~x2d
            if hotkey~pos('CONTROL') \= 0 then scModifier = scModifier + 02~x2d
            if hotkey~pos('ALT')     \= 0 then scModifier = scModifier + 04~x2d
        end
    end
   return WSProgManager("ADDDESKTOPICON", name, prog, iconfile, iconnr, workdir, location, arguments, scKey, scModifier, run)

::method AddShortCut
   arga = Arg(1,"A")
   newarg = .array~new(Arg()+1)
   do i = Arg() to 6 by -1; if arga~hasindex(i) = 1 then newarg[i+1] = arga[i]; end   /* shift arguments up by 1 */
   newarg[6] = ""  /* not COMMON nor PERSONAL */
   do i = 5 to 1 by -1; if arga~hasindex(i) = 1 then newarg[i] = arga[i]; end   /* copy first 5 */
   forward message "AddDesktopIcon" Arguments (newarg)

-- Deprecated.  Provided for backwards compatibility, does nothing.
::method deinstall

-- Deprecated.  Provided for backwards compatiblity, will always return 0
::attribute initCode get
  return 0



::class 'WindowsEventLog' public

::attribute currentHandle private
::attribute events get
::attribute minimumReadBuffer get
::attribute minimumReadMin get
::attribute minimumReadMax get

::method init external "LIBRARY rxwinsys WSEventLog_init"
::method uninit external "LIBRARY rxwinsys WSEventLog_uninit"
::method open external "LIBRARY rxwinsys WSEventLog_open"
::method close external "LIBRARY rxwinsys WSEventLog_close"
::method getNumber external "LIBRARY rxwinsys WSEventLog_getNumber"
::method getFirst external "LIBRARY rxwinsys WSEventLog_getFirst"
::method getLast external "LIBRARY rxwinsys WSEventLog_getLast"
::method getLogNames external "LIBRARY rxwinsys WSEventLog_getLogNames"
::method isFull external "LIBRARY rxwinsys WSEventLog_isFull"
::method clear external "LIBRARY rxwinsys WSEventLog_clear"
::method write external "LIBRARY rxwinsys WSEventLog_write"
::method readRecords external "LIBRARY rxwinsys WSEventLog_readRecords"
::method minimumRead external "LIBRARY rxwinsys WSEventLog_minimumReadGet"
::method "minimumRead=" external "LIBRARY rxwinsys WSEventLog_minimumReadSet"

-- Deprecated.  Provided for backwards compatibilty.  Use readRecords() instead.
::method Read
  forward message "readRecords" continue
  ret = result
  if ret == 0 then return self~events
  else return .nil

-- Deprecated.  Provided for backwards compatibility, does nothing.
::method deinstall

-- Deprecated.  Provided for backwards compatiblity, will always return 0
::attribute initCode get

-- Internal test method, do not use.
::method test external "LIBRARY rxwinsys WSEventLog_test"



/***********  VirtualKeyCodes **********************/

::class 'VirtualKeyCodes' mixinclass Object public

::method VCode
   parse arg k
   k = k~translate
   select
      when k = "LBUTTON"  then code = 01~x2d
      when k = "RBUTTON"  then code = 02~x2d
      when k = "CANCEL"  then code = 03~x2d
      when k = "MBUTTON"  then code = 04~x2d
      when k = "BACK"  then code = 08~x2d
      when k = "TAB" then code = 09~x2d
      when k = "CLEAR"  then code = 0C~x2d
      when k = "RETURN"  then code = 0D~x2d
      when k = "SHIFT"  then code = 10~x2d
      when k = "CONTROL"  then code = 11~x2d
      when k = "MENU"  then code = 12~x2d
      when k = "PAUSE"  then code = 13~x2d
      when k = "CAPITAL"  then code = 14~x2d
      when k = "ESCAPE"  then code = 1B~x2d
      when k = "SPACE" | k = " "  then code = 20~x2d
      when k = "PRIOR"  then code = 21~x2d
      when k = "NEXT"  then code = 22~x2d
      when k = "END"    then code = 23~x2d
      when k = "HOME"  then code = 24~x2d
      when k = "LEFT"  then code = 25~x2d
      when k = "UP"  then code = 26~x2d
      when k = "RIGHT"  then code = 27~x2d
      when k = "DOWN"  then code = 28~x2d
      when k = "SELECT"  then code = 29~x2d
      when k = "EXECUTE"  then code = 2B~x2d
      when k = "SNAPSHOT"  then code = 2C~x2d
      when k = "INSERT"  then code = 2D~x2d
      when k = "DELETE"  then code = 2E~x2d
      when k = "HELP"  then code = 2F~x2d
      when k = "0"  then code = 30~x2d
      when k = "1"  then code = 31~x2d
      when k = "2"  then code = 32~x2d
      when k = "3"  then code = 33~x2d
      when k = "4"  then code = 34~x2d
      when k = "5"  then code = 35~x2d
      when k = "6"  then code = 36~x2d
      when k = "7"  then code = 37~x2d
      when k = "8"  then code = 38~x2d
      when k = "9"  then code = 39~x2d
      when k = "A"  then code = 41~x2d
      when k = "B"  then code = 42~x2d
      when k = "C"  then code = 43~x2d
      when k = "D"  then code = 44~x2d
      when k = "E"  then code = 45~x2d
      when k = "F"  then code = 46~x2d
      when k = "G"  then code = 47~x2d
      when k = "H"  then code = 48~x2d
      when k = "I"  then code = 49~x2d
      when k = "J"  then code = 4A~x2d
      when k = "K"  then code = 4B~x2d
      when k = "L"  then code = 4C~x2d
      when k = "M"  then code = 4D~x2d
      when k = "N"  then code = 4E~x2d
      when k = "O"  then code = 4F~x2d
      when k = "P"  then code = 50~x2d
      when k = "Q"  then code = 51~x2d
      when k = "R"  then code = 52~x2d
      when k = "S"  then code = 53~x2d
      when k = "T"  then code = 54~x2d
      when k = "U"  then code = 55~x2d
      when k = "V"  then code = 56~x2d
      when k = "W"  then code = 57~x2d
      when k = "X"  then code = 58~x2d
      when k = "Y"  then code = 59~x2d
      when k = "Z"  then code = 5A~x2d
      when k = "NUMPAD0"  then code = 60~x2d
      when k = "NUMPAD1"  then code = 61~x2d
      when k = "NUMPAD2"  then code = 62~x2d
      when k = "NUMPAD3"  then code = 63~x2d
      when k = "NUMPAD4"  then code = 64~x2d
      when k = "NUMPAD5"  then code = 65~x2d
      when k = "NUMPAD6"  then code = 66~x2d
      when k = "NUMPAD7"  then code = 67~x2d
      when k = "NUMPAD8"  then code = 68~x2d
      when k = "NUMPAD9"  then code = 69~x2d
      when k = "MULTIPLY"  then code = 6A~x2d
      when k = "ADD" then code = 6B~x2d
      when k = "SEPARATOR"  then code = 6C~x2d
      when k = "SUBTRACT"  then code = 6D~x2d
      when k = "DECIMAL"  then code = 6E~x2d
      when k = "DIVIDE"  then code = 6F~x2d
      when k = "F1"  then code = 70~x2d
      when k = "F2"  then code = 71~x2d
      when k = "F3"  then code = 72~x2d
      when k = "F4"  then code = 73~x2d
      when k = "F5"  then code = 74~x2d
      when k = "F6"  then code = 75~x2d
      when k = "F7"  then code = 76~x2d
      when k = "F8"  then code = 77~x2d
      when k = "F9"  then code = 78~x2d
      when k = "F10"  then code = 79~x2d
      when k = "F11"  then code = 7A~x2d
      when k = "F12"  then code = 7B~x2d
      when k = "F13"  then code = 7C~x2d
      when k = "F14"  then code = 7D~x2d
      when k = "F15"  then code = 7E~x2d
      when k = "F16"  then code = 7F~x2d
      when k = "F17"  then code = 80~x2d
      when k = "F18"  then code = 81~x2d
      when k = "F19"  then code = 82~x2d
      when k = "F20"  then code = 83~x2d
      when k = "F21"  then code = 84~x2d
      when k = "F22"  then code = 85~x2d
      when k = "F23"  then code = 86~x2d
      when k = "F24"  then code = 87~x2d
      when k = "NUMLOCK"  then code = 90~x2d
      when k = "SCROLL"  then code = 91~x2d
      otherwise code = 255
   end
   return code


::method KeyName
   parse arg code
   k = k~translate
   select
      when code = 01~x2d   then k = "LBUTTON"
      when code = 02~x2d   then k = "RBUTTON"
      when code = 03~x2d   then k = "CANCEL"
      when code = 04~x2d   then k = "MBUTTON"
      when code = 08~x2d   then k = "BACK"
      when code = 09~x2d   then k = "TAB" then
      when code = 0C~x2d   then k = "CLEAR"
      when code = 0D~x2d   then k = "RETURN"
      when code = 10~x2d   then k = "SHIFT"
      when code = 11~x2d   then k = "CONTROL"
      when code = 12~x2d   then k = "MENU"
      when code = 13~x2d   then k = "PAUSE"
      when code = 14~x2d   then k = "CAPITAL"
      when code = 1B~x2d   then k = "ESCAPE"
      when code = 20~x2d   then k = "SPACE"
      when code = 21~x2d   then k = "PRIOR"
      when code = 22~x2d   then k = "NEXT"
      when code = 23~x2d   then k = "END"
      when code = 24~x2d   then k = "HOME"
      when code = 25~x2d   then k = "LEFT"
      when code = 26~x2d   then k = "UP"
      when code = 27~x2d   then k = "RIGHT"
      when code = 28~x2d   then k = "DOWN"
      when code = 29~x2d   then k = "SELECT"
      when code = 2B~x2d   then k = "EXECUTE"
      when code = 2C~x2d   then k = "SNAPSHOT"
      when code = 2D~x2d   then k = "INSERT"
      when code = 2E~x2d   then k = "DELETE"
      when code = 2F~x2d   then k = "HELP"
      when code = 30~x2d   then k = "0"
      when code = 31~x2d   then k = "1"
      when code = 32~x2d   then k = "2"
      when code = 33~x2d   then k = "3"
      when code = 34~x2d   then k = "4"
      when code = 35~x2d   then k = "5"
      when code = 36~x2d   then k = "6"
      when code = 37~x2d   then k = "7"
      when code = 38~x2d   then k = "8"
      when code = 39~x2d   then k = "9"
      when code = 41~x2d   then k = "A"
      when code = 42~x2d   then k = "B"
      when code = 43~x2d   then k = "C"
      when code = 44~x2d   then k = "D"
      when code = 45~x2d   then k = "E"
      when code = 46~x2d   then k = "F"
      when code = 47~x2d   then k = "G"
      when code = 48~x2d   then k = "H"
      when code = 49~x2d   then k = "I"
      when code = 4A~x2d   then k = "J"
      when code = 4B~x2d   then k = "K"
      when code = 4C~x2d   then k = "L"
      when code = 4D~x2d   then k = "M"
      when code = 4E~x2d   then k = "N"
      when code = 4F~x2d   then k = "O"
      when code = 50~x2d   then k = "P"
      when code = 51~x2d   then k = "Q"
      when code = 52~x2d   then k = "R"
      when code = 53~x2d   then k = "S"
      when code = 54~x2d   then k = "T"
      when code = 55~x2d   then k = "U"
      when code = 56~x2d   then k = "V"
      when code = 57~x2d   then k = "W"
      when code = 58~x2d   then k = "X"
      when code = 59~x2d   then k = "Y"
      when code = 5A~x2d   then k = "Z"
      when code = 60~x2d   then k = "NUMPAD0"
      when code = 61~x2d   then k = "NUMPAD1"
      when code = 62~x2d   then k = "NUMPAD2"
      when code = 63~x2d   then k = "NUMPAD3"
      when code = 64~x2d   then k = "NUMPAD4"
      when code = 65~x2d   then k = "NUMPAD5"
      when code = 66~x2d   then k = "NUMPAD6"
      when code = 67~x2d   then k = "NUMPAD7"
      when code = 68~x2d   then k = "NUMPAD8"
      when code = 69~x2d   then k = "NUMPAD9"
      when code = 6A~x2d   then k = "MULTIPLY"
      when code = 6B~x2d   then k = "ADD"
      when code = 6C~x2d   then k = "SEPARATOR"
      when code = 6D~x2d   then k = "SUBTRACT"
      when code = 6E~x2d   then k = "DECIMAL"
      when code = 6F~x2d   then k = "DIVIDE"
      when code = 70~x2d   then k = "F1"
      when code = 71~x2d   then k = "F2"
      when code = 72~x2d   then k = "F3"
      when code = 73~x2d   then k = "F4"
      when code = 74~x2d   then k = "F5"
      when code = 75~x2d   then k = "F6"
      when code = 76~x2d   then k = "F7"
      when code = 77~x2d   then k = "F8"
      when code = 78~x2d   then k = "F9"
      when code = 79~x2d   then k = "F10"
      when code = 7A~x2d   then k = "F11"
      when code = 7B~x2d   then k = "F12"
      when code = 7C~x2d   then k = "F13"
      when code = 7D~x2d   then k = "F14"
      when code = 7E~x2d   then k = "F15"
      when code = 7F~x2d   then k = "F16"
      when code = 80~x2d   then k = "F17"
      when code = 81~x2d   then k = "F18"
      when code = 82~x2d   then k = "F19"
      when code = 83~x2d   then k = "F20"
      when code = 84~x2d   then k = "F21"
      when code = 85~x2d   then k = "F22"
      when code = 86~x2d   then k = "F23"
      when code = 87~x2d   then k = "F24"
      when code = 90~x2d   then k = "NUMLOCK"
      when code = 91~x2d   then k = "SCROLL"
      otherwise k = ""
   end
   return k



/********************* WindowsManager **********************/

::class 'WindowsManager' public

::method DeskTopWindow
   hw = WSCtrlWindow("DESK")
   if hw = 0 then return .nil
   else return .WindowObject~new(hw)

::method Find
   parse arg title
   hw = WSCtrlWindow("FIND", title)
   if hw = 0 then return .nil
   else return .WindowObject~new(hw)

::method ForegroundWindow
   hW = WSCtrlWindow("GETFG")
   if hw = 0 then return .nil
   else return .WindowObject~new(hw)

::method WindowAtPosition
   use arg x, y
   hW = WSCtrlWindow("ATPOS", x, y)
   if hw = 0 then return .nil
   else return .WindowObject~new(hw)

::method ConsoleTitle
   return WSCtrlWindow("TITLE", 0)

::method "ConsoleTitle="
   use arg title
   return WSCtrlWindow("TITLE", 0, title)

::Method SendTextToWindow
   use arg title, text
   w = self~find(title)
   if w \= .nil then w~SendText(text)

::method PushButtonInWindow
   use arg title, text
   w = self~find(title)
   if w \= .nil then do
       cW = w~FindChild(text)
       if cW \= .nil then cW~SendKey("SPACE")
   end

::method ProcessMenuCommand
   if Arg() < 2 then return 0
   if Arg() = 2 then do
       wnd = self~Find(Arg(1))
       if wnd = .nil then return 0
       men = wnd~Menu
       if men = .nil then return 0
       men~ProcessItem(men~FindItem(Arg(1)))
   end
   else do
       wnd = self~Find(Arg(1))
       if wnd = .nil then return 0
       sub = wnd~Menu
       if sub = .nil then return 0
       do i = 2 to Arg()-1
           sub = sub~FindSubMenu(Arg(i))
       end
       if sub = .nil then return 0
       sub~ProcessItem(sub~FindItem(Arg(Arg())))
   end

/**
 * Send the WM_SETTINGSCHANGE message to all top-level windows.  The format is:
 *
 *   SendMessage(HWND_BROADCAST, WM_SETTINGCHANGE, 0, "Environment")
 *
 * HWND_BROADCAST == 0xffff, WM_SETTINGCHANGE == 0x001A.
*/
::method BroadcastSettingChanged
   use arg milliseconds
   if Arg(1, 'O') then do
       ret = WSCtrlSend("MSG", "0xFFFF", "0x001A", "0x0", "0x0", 'E')
       if ret > 0 then ret = -ret
       return ret
   end

   if \ milliseconds~datatype('W') then milliseconds = 5000
   if milliseconds < 1 then milliseconds = 5000
   return WSCtrlSend("TO", "0xFFFF", "0x001A", "0x0", "0x0", milliseconds, 'E')

-- Deprecated.  Provided for backwards compatibility, does nothing.
::method deinstall

-- Deprecated.  Provided for backwards compatiblity, will always return 0
::attribute initCode get
  return 0


/********************* WindowsObject **********************/

::class 'WindowObject' public inherit VirtualKeyCodes

::method hwnd attribute

::method Init
   use arg hwnd
   self~hwnd = hwnd

::method AssocWindow
   use arg hwnd
   self~hwnd = hwnd

::method Handle
   return self~hwnd

::method Title
   return WSCtrlWindow("TITLE", self~hwnd)

::method "Title="
   use arg title
   return WSCtrlWindow("TITLE", self~hwnd, title)

::method WClass
   return WSCtrlWindow("CLASS", self~hwnd)

::method Id
   return WSCtrlWindow("ID", self~hwnd)

::method Coordinates
   return WSCtrlWindow("RECT", self~hwnd)

::method State
   return WSCtrlWindow("GETSTATE", self~hwnd)

::method getStyle
   return WSCtrlWindow("GETSTYLE", self~hwnd)

::method Restore
   return WSCtrlWindow("SHOW", self~hwnd, "RESTORE")

::method Hide
   return WSCtrlWindow("SHOW", self~hwnd, "HIDE")

::method Minimize
   return WSCtrlWindow("SHOW", self~hwnd, "MIN")

::method Maximize
   return WSCtrlWindow("SHOW", self~hwnd, "MAX")

::method Enable
   return WSCtrlWindow("ENABLE", self~hwnd, 1)

::method Disable
   return WSCtrlWindow("ENABLE", self~hwnd, 0)

::method MoveTo
   use arg x, y
   return WSCtrlWindow("MOVE", self~hwnd, x, y)

::method Resize
   use arg cx, cy
   return WSCtrlWindow("SIZE", self~hwnd, cx, cy)

::method ToForeground
   return WSCtrlWindow("SETFG", self~hwnd)

::method FocusNextItem
   self~SendMessage("0x0028", 0,0)

::method FocusPreviousItem
   self~SendMessage("0x0028", 1,0)

::method FocusItem
   use arg hItem
   self~SendMessage("0x0028", hItem~Handle, 1)

::method FindChild
   parse arg title
   hw = WSCtrlWindow("FINDCHILD", self~hwnd, title)
   if hw = 0 then return .nil
   else return .WindowObject~new(hw)

::method ChildAtPosition
   use arg x, y
   hw = WSCtrlWindow("ATPOS", x, y, self~hwnd)
   if hw = 0 then return .nil
   else return .WindowObject~new(hw)

::method Next
   hw = WSCtrlWindow("HNDL", self~hwnd, "NEXT")
   if hw = 0 then return .nil
   else return .WindowObject~new(hw)

::method Previous
   hw = WSCtrlWindow("HNDL", self~hwnd, "PREVIOUS")
   if hw = 0 then return .nil
   else return .WindowObject~new(hw)

::method First
   hw = WSCtrlWindow("HNDL", self~hwnd, "FIRST")
   if hw = 0 then return .nil
   else return .WindowObject~new(hw)

::method FirstChild
   hw = WSCtrlWindow("HNDL", self~hwnd, "FIRSTCHILD")
   if hw = 0 then return .nil
   else return .WindowObject~new(hw)

::method Last
   hw = WSCtrlWindow("HNDL", self~hwnd, "LAST")
   if hw = 0 then return .nil
   else return .WindowObject~new(hw)

::method Owner
   hw = WSCtrlWindow("HNDL", self~hwnd, "OWNER")
   if hw = 0 then return .nil
   else return .WindowObject~new(hw)

::method EnumerateChildren
   fc = self~FirstChild
   cnt = 0
   wndlist.0 = 0
   if fc = .Nil then return wndlist.
   ac = fc
   do while ac \= .Nil
       cnt = cnt + 1
       wndlist.cnt.!Handle = ac~Handle
       wndlist.cnt.!Title = ac~Title
       wndlist.cnt.!Class = ac~WClass
       wndlist.cnt.!State = ac~State
       wndlist.cnt.!Coordinates = ac~Coordinates
       if ac~FirstChild \= .Nil then wndlist.cnt.!Children = 1
       else wndlist.cnt.!Children = 0
       wndlist.cnt.!Id = ac~Id
       ac = ac~Next
   end
   wndlist.0 = cnt
   return wndlist.

::method SendMessage
   use arg message, wParam, lParam
   return WSCtrlSend("MSG", self~hwnd, message, wParam, lParam)

::method SendCommand
   use arg cmd
   self~SendMessage("0x111", cmd~d2x, 0)

::method SendMenuCommand
   use arg cmd
   self~SendMessage("0x111", ("10000"~x2D + cmd)~d2x, 0)

::method SendSysCommand
   use arg command
   command = command~translate
   select
      when command = "SIZE" then cmd = "0xF000"
      when command = "MOVE" then cmd = "0xF010"
      when command = "MINIMIZE" then cmd = "0xF020"
      when command = "MAXIMIZE" then cmd = "0xF030"
      when command = "NEXTWINDOW" then cmd = "0xF040"
      when command = "PREVWINDOW" then cmd = "0xF050"
      when command = "CLOSE" then cmd = "0xF060"
      when command = "VSCROLL" then cmd = "0xF070"
      when command = "HSCROLL" then cmd = "0xF080"
      when command = "ARRANGE" then cmd = "0xF110"
      when command = "RESTORE"  then cmd = "0xF120"
      when command = "TASKLIST"  then cmd = "0xF130"
      when command = "SCREENSAVE" then cmd = "0xF140"
      when command = "MONITORPOWER" then cmd = "0xF170"
      when command = "CONTEXTHELP" then cmd = "0xF180"
      otherwise cmd = 0
   end
   if cmd \= 0 then self~SendMessage("0x112", cmd, 0)

::method SendMouseClick
    use arg which, kind, x, y, ext
    which = which~translate
    kind = kind~translate
    wp = 0
    select
        when kind = "DOWN" then cmd = 1
        when kind = "UP" then cmd = 2
        otherwise cmd = 3
    end
    select
        when which = "RIGHT" then do
            s = "203"~x2d
            if cmd = 1 then wp = 2
        end
        when which = "MIDDLE" then do
            s = "206"~x2d
            if cmd = 1 then wp = 10
        end
        otherwise do
            s = "200"~x2d
            if cmd = 1 then wp = 1
        end
    end
    if arg(5,'e') then do
        ext = ext~translate
        if ext~pos("LEFTDOWN") > 0 & which \= "LEFT" then wP = wP + 1
        if ext~pos("RIGHTDOWN") > 0 & which \= "RIGHT" then wP = wP + 2
        if ext~pos("MIDDLEDOWN") > 0 & which \= "MIDDLE" then wP = wP + 10
        if ext~pos("SHIFT") > 0 then wP = wP + 4
        if ext~pos("CONTROL") > 0 then wP = wp + 8
    end
    self~SendMessage((s + cmd)~d2x, wP~d2x, (y * "10000"~x2d + x)~d2x)

::method PushButton
   use arg text
   cW = self~FindChild(text)
   if cW \= .Nil then cW~SendKey("SPACE")

::method SendKey
   use arg char, alt, ext
   if Arg(3,'o') = 1 then ext = 0
   code = self~VCode(char)
   if ext = 1 then do
       if alt = 1 then
         alt = "0x21000000";
       else
         alt = "0x01000000"
   end
   else
      if alt = 1 then
        alt = "0x20000000";
      else
        alt = 0

   if (char~length = 1 &  (char >= "a" & char <= "z")) | code = 255 then
     cc = char~c2d;
   else
     cc = WSCtrlSend("MAP", code)
   if cc \= 0 then
     if char~length > 1 then
       do
         ret = self~SendKeyDown(char, ext)
         ret = self~SendKeyUp(char, ext)
       end
     else
      ret = WSCtrlSend("KEY", self~hwnd, cc, "C", alt)
   else
     ret = self~SendKeyDown(char, ext)
   return ret

::method SendChar
   use arg char, alt
   if Arg(2,'o') = 1 then return WSCtrlSend("KEY", self~hwnd, char~c2d, "C")
   if alt = 1 then alt = "0x20000000"
   return WSCtrlSend("KEY", self~hwnd, char~c2d, "C", alt)

::method SendKeyDown
   use arg code, ext
   if Arg(2,'o') = 1 then ext = 0
   if ext = 1 then ext = "0x01000000"
   return WSCtrlSend("KEY", self~hwnd, self~VCode(code), "D", ext)

::method SendKeyUp
   use arg code, ext
   if Arg(2,'o') = 1 then ext = 0
   if ext = 1 then ext = "0x01000000"
   return WSCtrlSend("KEY", self~hwnd, self~VCode(code), "U", ext)

::Method SendText
   use arg text
   if Arg(1,'o') = 1 then return -1
   do i = 1 to text~length
       c = text~substr(i,1)
       self~SendKey(c)
   end

::method Menu
   hw = WSCtrlMenu("GET", self~hwnd)
   if hw = 0 then do
       return .nil
   end
   else do
       obj = .MenuObject~new(hw, self)
       if obj~IsMenu = 0 then return .nil
       else return obj
   end

::method SystemMenu
   hw = WSCtrlMenu("SYS", self~hwnd)
   if hw = 0 then do
       return .nil
   end
   else do
       obj = .MenuObject~new(hw, self)
       if obj~IsMenu = 0 then return .nil
       else return obj
   end

::method IsMenu
   return WSCtrlMenu("STATE", self~hwnd)

::method ProcessMenuCommand
   if Arg() < 1 then return 0
   if Arg() = 1 then do
       men = self~Menu
       if men = .Nil then return 0
       men~ProcessItem(men~FindItem(Arg(1)))
   end
   else do
       sub = self~Menu
       if sub = .Nil then return 0
       do i = 1 to Arg()-1
           sub = sub~FindSubMenu(Arg(i))
       end
       if sub = .Nil then return 0
       sub~ProcessItem(sub~FindItem(Arg(Arg())))
   end


/********************* MenuObject **********************/

::class 'MenuObject' subclass WindowObject public

::method MainWnd attribute

::method Init
   use arg hwnd, main
   self~hwnd = hwnd
   self~MainWnd = main

::method IsMenu
   return WSCtrlMenu("STATE", self~hwnd)

::method IsSubMenu
   use strict arg pos
   return WSCtrlMenu("STATE", self~hwnd, "MENU", pos)

/* This method can not be 100% reliable.  Some applications do not set the check
 * mark for a menu item until the menu is displayed.  To be confident of the
 * result, the user should first test how a specific application behaves.
 */
::method IsChecked
   use strict arg pos
   return WSCtrlMenu("STATE", self~hwnd, "CHECK", pos)

::method IsSeparator
   use strict arg pos
   return WSCtrlMenu("STATE", self~hwnd, "SEPARTOR", pos)

::method IdOf
   use arg pos
   if Arg(1,'o') = 1 then return 0
   return WSCtrlMenu("ID", self~hwnd, pos)

::method Items
   return WSCtrlMenu("CNT", self~hwnd)

::method TextOf
   use arg pos
   if Arg(1,'o') = 1 then return ""
   return WSCtrlMenu("TEXT", self~hwnd, pos, "P")

::method TextOfId
   use arg id
   if Arg(1,'o') = 1 then return ""
   return WSCtrlMenu("TEXT", self~hwnd, id, "C")

::method SubMenu
   use arg pos
   if Arg(1,'o') = 1 then return .Nil
   hw = WSCtrlMenu("SUB", self~hwnd, pos)
   if hw = 0 then return .Nil
   else return .MenuObject~new(hw, self~MainWnd)

::method FindSubMenu
   use arg text
   if Arg(1,'o') = 1 then return .Nil
   cnt = self~Items
   do i = 0 to cnt-1
      mtext = self~TextOf(i)
      tabpos = mtext~pos("9"x)
      if text = mtext then return self~SubMenu(i)
      else if text~pos("9"x) = 0 & tabpos > 0 then if text = mtext~left(mtext~pos("9"x)-1) then return self~SubMenu(i)
   end
   return .Nil

::method FindItem
   use arg text
   if Arg(1,'o') = 1 then return 0
   cnt = self~Items
   do i = 0 to cnt-1
       mtext = self~TextOf(i)
       tabpos = mtext~pos("9"x)
       if text = mtext then return self~IdOf(i)
       else if text~pos("9"x) = 0 & tabpos > 0 then if text = mtext~left(mtext~pos("9"x)-1) then return self~IdOf(i)
   end
   return 0

::method ProcessItem
   use arg cmd
   if cmd \= 0 then self~MainWnd~SendMessage("0x111", ("10000"~x2D + cmd)~d2x, 0)




/********************* WindowsClipboard **********************/

::class 'WindowsClipboard' public

::method Copy
   use arg txt, codepage="", translateflags=""
   if codepage == "" then return WSClipboard("COPY", txt) -- conversion to Unicode done by the system
   if codepage~caselessEquals("UNICODE") then do
       if arg(3, "e") then raise syntax 88.900 array('The translateflags argument is not supported when the codepage argument is "UNICODE"')
       ustr = txt -- txt is already UTF-16
   end
   else if txt == "" then ustr = txt -- SysToUnicode doesn't support empty strings
   else do
       -- conversion to Unicode driven by the user
       -- can't pass the default value of translateflags because SysToUnicode raises an error if translateflags is empty
       if arg(3, "e") then error = SysToUnicode(txt, codepage, translateflags, "str")
                      else error = SysToUnicode(txt, codepage,               , "str")
       if error \== 0 then raise syntax 93.900 array("SysToUnicode error" error":" SysGetErrorText(error))
       ustr = str.!text
   end
   return WSClipboard("COPY UNICODE", ustr)

::method Paste
   use arg codepage="", mappingflags="", defaultchar=""
   if codepage == "" then return WSClipboard("PASTE") -- conversion to ANSI code page done by the system
   ustr = WSClipboard("PASTE UNICODE") -- UTF-16
   if codepage~caselessEquals("UNICODE") then do
       if arg(2, "e") then raise syntax 88.900 array('The mappingflags argument is not supported when the codepage argument is "UNICODE"')
       if arg(3, "e") then raise syntax 88.900 array('The defaultchar argument is not supported when the codepage argument is "UNICODE"')
       return ustr -- raw (UTF-16)
   end
   if ustr == "" then return ustr -- SysFromUnicode doesn't support empty strings
   error = SysFromUnicode(ustr, codepage, mappingflags, defaultchar, "str") -- conversion from Unicode driven by the user
   if error \== 0 then raise syntax 93.900 array("SysFromUnicode error" error":" SysGetErrorText(error))
   return str.!text

::method Locale
   ustr = WSClipboard("LOCALE") -- name in UTF-16 format
   if ustr == "" then return ustr -- SysFromUnicode doesn't support empty strings
   error = SysFromUnicode(ustr, "UTF8", "", "", "str")
   if error \== 0 then raise syntax 93.900 array("SysFromUnicode error" error":" SysGetErrorText(error))
   return str.!text

::method Empty
   return WSClipboard("EMPTY")

::method IsDataAvailable
   return WSClipboard("AVAIL")

::method makeArray
   return WSClipboard("PASTE")~makeArray

-- Deprecated.  Provided for backwards compatibility, does nothing.
::method deinstall

-- Deprecated.  Provided for backwards compatiblity, will always return 0
::attribute initCode get
  return 0
