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 PDF Plugins