About Global Hotkey 1.2 Source

Class App
Inherits Application
// Properties
Protected Dim e as events
Protected Dim items(0) as item
Dim hotkeys(0) as hotkey
Dim d1 as MyFolderChangedNotificationMBS
Dim d2 as MyFolderChangedNotificationMBS
Dim d3 as MyFolderChangedNotificationMBS
Dim d4 as MyFolderChangedNotificationMBS

// Event implementations
Sub OpenDocument(item As FolderItem) Handles Event

End Sub
Sub NewDocument() Handles Event

End Sub
Sub EnableMenuItems() Handles Event

End Sub
Sub Open() Handles Event
dim f as FolderItem

RegisterPlugins

DebugMessageEnableMBS true

e=new Events
e.init

UseMBSCFPlugin

updatehotkeys


f=GetFolderItem("Applications")

if f<>nil and f.Exists then
d1=new MyFolderChangedNotificationMBS
d1.Subscribe f,2
end if

f=GetFolderItem("AppleScripts")

if f<>nil and f.Exists then
d2=new MyFolderChangedNotificationMBS
d2.Subscribe f,2
end if

f=GetFolderItem("ShellScripts")

if f<>nil and f.Exists then
d3=new MyFolderChangedNotificationMBS
d3.Subscribe f,2
end if

f=GetFolderItem("Clipboard")

if f<>nil and f.Exists then
d4=new MyFolderChangedNotificationMBS
d4.Subscribe f,2
end if

End Sub

// Methods
Sub updatehotkeys()
dim f as FolderItem
dim h as Hotkey
dim i,c as integer
dim it as item
dim keymodifier,keycode as integer
dim s as String
dim ii,cc as integer
dim ss as String

System.DebugLog "Loading hotkeys."

redim items(0)
for i=1 to c
h=hotkeys(i)
if h<>nil then
h.RemoveKey
end if
next
redim hotkeys(0)

f=GetFolderItem("Applications")

if f<>nil and f.Exists then
builditems f,0
else
DebugMessageMBS "Global Hotkey: Can't find a folder Applications."
end if

f=GetFolderItem("AppleScripts")

if f<>nil and f.Exists then
builditems f,1
else
DebugMessageMBS "Global Hotkey: Can't find a folder AppleScripts."
end if


f=GetFolderItem("ShellScripts")

if f<>nil and f.Exists then
builditems f,2
else
DebugMessageMBS "Global Hotkey: Can't find a folder ShellScripts."
end if

'// Doesn't Work:
'f=GetFolderItem("TextClips")
'
'if f<>nil and f.Exists then
'builditems f,3
'else
'DebugMessageMBS "Global Hotkey: Can't find a folder TextClips."
'end if

f=GetFolderItem("Clipboard")

if f<>nil and f.Exists then
builditems f,4
else
DebugMessageMBS "Global Hotkey: Can't find a folder TextClips."
end if

const activeFlag = 1
const btnState = 128
const cmdKey = 256
const shiftKey = 512
const alphaLock = 1024
const optionKey = 2048
const controlKey = 4096
const rightShiftKey = 8192
const rightOptionKey = 16384
const rightControlKey = 32768

c=UBound(items)
for i=1 to c
it=items(i)

s=it.commandkey

keycode=0
keymodifier=0
cc=CountFields(s," ")
for ii=1 to cc
ss=NthField(s," ",ii)
select case ss
case "command"
keymodifier=Bitwiseor(keymodifier,cmdKey)
case "shift"
keymodifier=Bitwiseor(keymodifier,shiftKey)
case "alphalock"
keymodifier=Bitwiseor(keymodifier,alphaLock)
case "option"
keymodifier=Bitwiseor(keymodifier,optionKey)
case "control"
keymodifier=Bitwiseor(keymodifier,controlKey)
case "right-shift"
keymodifier=Bitwiseor(keymodifier,rightShiftKey)
case "right-option"
keymodifier=Bitwiseor(keymodifier,rightOptionKey)
case "right-control"
keymodifier=Bitwiseor(keymodifier,rightControlKey)
case "esc"
keycode=&h35
case "f1"
keycode=&h7A
case "f2"
keycode=&h78
case "f3"
keycode=&h63
case "f4"
keycode=&h76
case "f5"
keycode=&h60
case "f6"
keycode=&h61
case "f7"
keycode=&h62
case "f8"
keycode=&h64
case "f9"
keycode=&h65
case "f10"
keycode=&h6D
case "f11"
keycode=&h67
case "f12"
keycode=&h6F
case "f13"
keycode=&h69
case "f14"
keycode=&h6b
case "f15"
keycode=&h6f
case "tab"
keycode=&h30
case "space"
keycode=&h31
case "cursor-up"
keycode=&h7E
case "cursor-down"
keycode=&H7D
case "cursor-left"
keycode=&h7B
case "cursor-right"
keycode=&h7C
case "backspace"
keycode=&h33
case "return"
keycode=&h24
case "enter"
keycode=&h24
case "delete"
keycode=&h75
case "help"
keycode=&h72
case "page-up"
keycode=&h74
case "page-down"
keycode=&h79
case "page-start"
keycode=&h73
case "page-end"
keycode=&h77
case "num-lock"
keycode=&h47
case "num-1"
keycode=&h53
case "num-2"
keycode=&h54
case "num-3"
keycode=&h55
case "num-4"
keycode=&h56
case "num-5"
keycode=&h57
case "num-6"
keycode=&h58
case "num-7"
keycode=&h59
case "num-8"
keycode=&h5B
case "num-9"
keycode=&h5C
case "num-0"
keycode=&h52
case "num-="
keycode=&h51
case "num-/"
keycode=&h4B
case "num--"
keycode=&h4E
case "num-+"
keycode=&h45
case "num-enter"
keycode=&h4C
case "num-return"
keycode=&h4C
case "num-,"
keycode=&h41
case "num-*"
keycode=&h43
end Select
next

if keycode<>0 then
h=new Hotkey
h.AddKey keycode,keymodifier,OSTypeFromStringMBS("RBgh"),i
Hotkeys.Append h

if h.HotKeyRef=0 then
DebugMessageMBS "Global Hotkey: Invalid hotkey combination: """+s+""""
else
DebugMessageMBS "Global Hotkey: Registered hotkey """+s+""""
end if
else
DebugMessageMBS "Global Hotkey: no key defined in the filename """+s+""""
end if
next
End Sub
Sub run(sig as integer,id as integer)
dim i as item

if id<=UBound(items) then
i=items(id)
i.run
end if
End Sub
Sub builditems(f as folderItem,type as integer)
dim i,c as integer
dim g,t as FolderItem
dim it as item
dim s as String
dim l as integer

c=f.Count
for i=1 to c
g=f.Item(i)
t=f.trueItem(i)
if g<>Nil and g.Exists and left(g.name,1)<>"." and t<>Nil and t.exists then
it=new item
it.file=g
it.type=type

s=t.name
l=len(s)

if mid(s,l-2,1)="." then
s=left(s,l-3)
l=len(s)
end if

if mid(s,l-3,1)="." then
s=left(s,l-4)
l=len(s)
end if

if mid(s,l-4,1)="." then
s=left(s,l-5)
end if

it.commandkey=s

DebugMessageMBS "Global Hotkey: "+it.commandkey+" -> "+g.Name

items.Append it
end if
next
End Sub
End Class

Class Events
Inherits CarbonApplicationEventsMBS
// Properties
Protected Dim m as menumBS

// Event implementations
Sub ApplicationDeactived() Handles Event

End Sub
Sub ApplicationLaunched(ProcessSerial as memoryblock) Handles Event

End Sub
Sub ApplicationTerminated(ProcessSerial as memoryblock) Handles Event

End Sub
Function ApplicationGetDockTileMenu() As integer Handles Event

End Function
Sub HotKeyPressed(signature as integer, id as integer) Handles Event
DebugMessageMBS "Global Hotkey: Received key event with id "+str(id)
app.run signature,id
End Sub
Sub HotKeyReleased(signature as integer, id as integer) Handles Event

End Sub

// Methods
Sub init()
listen
End Sub
End Class

Class MyTimer
Inherits Timer
End Class

Class Item
// Properties
Dim file as folderItem
Dim type as integer
Dim sh as shell
Dim commandkey as string
Protected Dim a as AppleScriptMBS

// Methods
Sub run()
select case type
case 0 // application
DebugMessageMBS "Global Hotkey: Launch """+file.Name+""""
file.launch
case 1
DebugMessageMBS "Global Hotkey: Run Apple Script """+file.Name+""""
runapplescript
case 2
DebugMessageMBS "Global Hotkey: Run Shell Script """+file.Name+""""
runshellscript
case 3
DebugMessageMBS "Global Hotkey: Insert Text clip """+file.Name+""""
runtextclip
case 4
DebugMessageMBS "Global Hotkey: Put stuff into clipboard """+file.Name+""""
runclipboard
end Select
End Sub
Sub runAppleScript()
dim e as AppleScriptErrorMBS
dim s as String
dim q as String
dim p as ProcessMBS
dim t as TextInputStream

if a=nil then
t=file.OpenAsTextFile
if t=nil then
DebugMessageMBS "Global Hotkey: Can't open script file """+file.Name+""""
else
t.Encoding=Encodings.UTF8
s=t.ReadAll
t.Close
a=new AppleScriptMBS

a.Compile s

DebugMessageMBS "Global Hotkey: Compiled apple script """+file.Name+""" with error code: "+str(a.Lasterror)
if a.Lasterror<>0 then
e=a.Error
if e<>nil then
s=e.Message+", errorcode "+str(e.Errorcode)

if e.RangeAvailable then
q=a.Source
s=s+", lines: "+mid(q,e.RangeStart,e.RangeEnd-e.RangeStart)

end if

debugmessagembs "Global Hotkey: Applescript compile error: """+s+""""
a=nil
Return
end if
end if
end if
end if

if a<>Nil then
// no error
p=new ProcessMBS
p.GetFrontProcess

app.FrontmostMBS=true // move me to front

a.Execute

p.FrontProcess=true // restore front process
DebugMessageMBS "Global Hotkey: Run apple script """+file.Name+""" with error code: "+str(a.Lasterror)
if a.Lasterror<>0 then
s="?"
e=a.Error
if e<>nil then
s=e.Message+", errorcode "+str(e.Errorcode)

if e.RangeAvailable then
q=a.Source
s=s+", lines: "+mid(q,e.RangeStart,e.RangeEnd-e.RangeStart)

end if

debugmessagembs "Global Hotkey: Applescript error: """+s+""""
end if
end if
end if

End Sub
Sub runshellscript()
dim t as TextInputStream
dim s as String

t=file.OpenAsTextFile
if t=nil then
DebugMessageMBS "Global Hotkey: Can't open script file """+file.Name+""""
else
t.Encoding=Encodings.UTF8
s=t.ReadAll
sh=new shell
sh.mode=1
sh.Execute s
t.Close

end if

End Sub
Sub runtextclip()
dim t as TextInputStream
dim s as String
dim p as PresskeyMBS
dim keys as KeyCodesMBS
dim a as String
dim i,c as integer

t=file.OpenAsTextFile
if t=nil then
DebugMessageMBS "Global Hotkey: Can't open text clip file """+file.Name+""""
else
t.Encoding=Encodings.UTF8
s=t.ReadAll

t.Close

// First turn off modifier keys
p=new PresskeyMBS
p.Charcode=0
p.Keycode=&h38
p.PressRaw false // shift

p=new PresskeyMBS
p.Charcode=0
p.Keycode=&h3A
p.PressRaw false // option

p=new PresskeyMBS
p.Charcode=0
p.Keycode=&h37
p.PressRaw false // command

p=new PresskeyMBS
p.Charcode=0
p.Keycode=&h3B
p.PressRaw false // control

DebugMessageMBS s
keys=new KeyCodesMBS
c=len(s)
for i=1 to c
a=mid(s,i,1)
p=new PresskeyMBS
p.Charcode=asc(a)
p.Keycode=keys.AsciiToKeyCode(asc(a))
DebugMessageMBS a+", "+str(p.Charcode)+", "+str(p.Keycode)

p.Press
next
end if

End Sub
Sub runclipboard()
dim p as Picture
dim c as Clipboard
dim t as TextInputStream
dim s as String

if file.IsPictureFileMBS then
p=file.OpenAsPicture
if p<>Nil then
c=new Clipboard
c.Picture=p
c.Close
Return
end if
end if

t=file.OpenAsTextFile
if t=nil then
DebugMessageMBS "Global Hotkey: Can't open file for clipboard """+file.Name+""""
else
t.Encoding=Encodings.UTF8
s=t.ReadAll

t.Close
c=new Clipboard
c.text=s
c.Close

end if

End Sub
End Class

Class Hotkey
Inherits CarbonHotKeyMBS
End Class

Class DummyWindow
Inherits Window
// Controls
ControlInstance StaticText1
End Control

// Event implementations
Sub Open() Handles Event

End Sub
End Class

Class MyFolderChangedNotificationMBS
Inherits FolderChangedNotificationMBS
// Event implementations
Sub DirectoryChanged(message as integer, flags as integer) Handles Event
app.updatehotkeys
End Sub
End Class





Links
MBS Xojo Plugins