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