/*----------------------------------------------------------------------------*/
/*                                                                            */
/* 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
   return WSClipboard("COPY", txt)

::method Paste
   return WSClipboard("PASTE")

::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
