Just Another AutoComplete for string gadgets

[netmaestro]

Update July 26

When I came up with the idea of tapping SQLite for an easy search of text matches, it didn't occur to me that there might be a penalty. In fact, there was. The penalty came in the form of 405 kb being added to the executable size, just for autocompletes. So I looked at the other option I had considered, that of the linked list. Because this is an OOP-interface object, I remember rejecting the linked list on account of not being able to pass a list in an interface. Also, the last thing I wanted was to set up global lists for the gadgets. That's just ugly imho. But wait wait wait! With 4.50+ you can put a list inside a structure! The structure can be passed in an interface. So - SQLite is out, the database in the object structure is replaced with a linked list and all works fine- sans 405 thousand extra bytes of bloat.

Update July 24

Fixed a bug where if you used AutoAdditions too many words would get added:

e.g. new word: Experience

result:
Exp
Expe
Exper
Experi
Experie
Experien
Experienc
Experience

Ack. Anyway, fixed. This is the last bug I can find for now after hours of trying with varying numbers of instances active. I think it's getting close touch wood.

Update July 23

- This update brings a couple of new features:
1) You can navigate from the string gadget to and throughout the list and back again with the arrow keys, select w/space or tab (thanks dige)
2) You can delete an item from the list for a given gadget now with a rightclick (thanks rsts)

- Fixed a bug in the mousehook handling where under certain circumstances the listbox would stay up when it shouldn't

Update July 21

- The mousehook is reworked, it no longer needs shared vars and it can distinguish between multiple instances now. Also, there is only one mouse hook regardless of the number of instances of the object in use.

- Auto-dynamic additions are tweaked to accept a minimum-length in order to qualify for addition to the popup list. The current default is 3 but you can put anything in there that suits you, of course.

- Multiple instances are so far tested working, but we need more keybangers banging away to find any bugs. The current test prog uses 2.

- Thanks to everyone helping to get this project to a solid release, it's appreciated!

Original Post July 21

Code: Select all

;==================================================================
;
; Library:           AutoComplete v. 0.9 alpha (WIP)
; Author:            Lloyd Gallant (netmaestro)
; Date:              July 21, 2010
; Target OS:         Microsoft Windows All
; Target Compiler:   PureBasic 4.50 and later
; license:           Free, unrestricted, no warranty whatsoever
;                    credit appreciated but not required
;
; Contributors:      rsts ( DeleteString )
;                    dige ( keyboard navigation )
;
;==================================================================

Import ""
  PB_Gadget_GetRootWindow(hwnd)                ; Find root window of gadgetid
EndImport

Structure MSLLHOOKSTRUCT
  pt.point
  mouseData.l
  flags.l
  time.l
  dwExtraInfo.l
EndStructure

Structure stringdb
  gadget.i
  prompt.s
EndStructure

Structure AutoCompleteObject
  *vTable
  List pstr.stringdb() ; db for strings
  subclass_oldproc.i   ; oldproc for string gadget (to set back on release)
  gadget.i             ; string gadget#
  popwin.i             ; popup window# for list
  listbox.i            ; gadget# for popup listview
  listbox_oldproc.i    ; oldproc for listbox
  parent.i             ; root window of application
  dynamic.b            ; bool for auto-add content to list on stringgadget lostfocus, 1=add, 0=no add
  minlength.b          ; minimum number of chars for text to be added to popup list
EndStructure

Interface iAutoCompleteObject
  Attach    ( gadget, *strings, size )
  AddString ( gadget, *string )
  DeleteString ( gadget, *string )
  Release   ()
EndInterface

Global _nmAC_Hook, _nmAC_ListFont = LoadFont(#PB_Any, "MS San Serif", 8)
Global NewList _nmAC_Pops()

Procedure AddString(*this.AutoCompleteObject, gadget, *string )
  text$ = PeekS(*string)
  ForEach *this\pstr()
    If UCase(*this\pstr()\prompt) = UCase(text$)
      ProcedureReturn 0
    EndIf
  Next
  AddElement(*this\pstr())
  *this\pstr()\gadget = gadget
  *this\pstr()\prompt = PeekS(*string)
  SortStructuredList(*this\pstr(), #PB_Sort_Ascending, OffsetOf(stringdb\prompt), #PB_Sort_String)
  ProcedureReturn 1
EndProcedure

Procedure ShowPopupList(hwnd, *this.AutoCompleteObject)
  Protected NewList strings.s()
  text$ = GetGadgetText(*this\gadget)
  If text$ <> ""
    ForEach *this\pstr()
      If Left(UCase(*this\pstr()\prompt), Len(text$)) = UCase(text$)
        AddElement(strings())
        strings()= *this\pstr()\prompt
      EndIf
    Next
    If ListSize(strings())
      GetWindowRect_(hwnd, @wr.RECT)
      parent = PB_Gadget_GetRootWindow(hwnd)
      With wp.point
        \x = GadgetX(*this\gadget)
        \y = GadgetY(*this\gadget)+GadgetHeight(*this\gadget)
      EndWith
      ClientToScreen_(parent, @wp)
      hdc = CreateCompatibleDC_(0)
      lastwidth = 0
      ForEach strings()
        GetTextExtentPoint32_(hdc, strings(), Len(strings()), @sz.size)
        If sz\cx > lastwidth
          lastwidth = sz\cx
        EndIf
      Next
      DeleteDC_(hdc)
      popwinheight = 15*ListSize(strings())+3
      If popwinheight > 500
        popwinheight = 500
      EndIf
      ResizeWindow(*this\popwin, wp\x,wp\y,lastwidth, popwinheight)
      ResizeGadget(*this\listbox, 0,0, WindowWidth(*this\popwin),WindowHeight(*this\popwin))
      ClearGadgetItems(*this\listbox)
      ForEach strings()
        AddGadgetItem(*this\listbox, -1, strings())
      Next
      HideWindow(*this\popwin,0)
      SetFocus_(hwnd)
    Else
      ClearList(strings())
      ClearGadgetItems(*this\listbox)
      If IsWindowVisible_(WindowID(*this\popwin))
        HideWindow(*this\popwin, 1)
      EndIf
    EndIf
  Else
    ClearList(strings())
    ClearGadgetItems(*this\listbox)
    If IsWindowVisible_(WindowID(*this\popwin))
      HideWindow(*this\popwin, 1)
    EndIf
  EndIf
  
EndProcedure

Procedure _nmAC_StringProc(hwnd, msg, wparam, lparam)
  *this.AutoCompleteObject = GetProp_(hwnd, "acdata")
  Protected oldproc = *this\subclass_oldproc
  
  Select msg
    Case #WM_NCDESTROY
      RemoveProp_(hwnd, "oldproc")
      
    Case #WM_LBUTTONUP, #WM_KEYUP
      ForEach _nmAC_Pops()
        HideWindow(_nmAC_Pops(), 1)
      Next
      ShowPopupList(hwnd, *this)
      
      If msg=#WM_KEYUP
        Select wParam
          Case #VK_DOWN
            If IsWindowVisible_(WindowID(*this\popwin))
              SetActiveGadget(*this\listbox)
              SetGadgetState(*this\listbox,0)
            EndIf
            
          Case #VK_ESCAPE
            ForEach _nmAC_Pops()
              HideWindow(_nmAC_Pops(), 1)
            Next
            
        EndSelect
      EndIf
      
    Case #WM_KILLFOCUS
      If *this\dynamic
        If wParam <> WindowID(*this\popwin) And wParam <> hwnd
          text$ = GetGadgetText(*this\gadget)
          If Len(text$)>=*this\minlength
            AddString(*this, *this\gadget, @text$)
          EndIf      
        EndIf
      EndIf
      
  EndSelect
  
  
  ProcedureReturn CallWindowProc_(oldproc, hwnd, msg, wparam, lparam)
EndProcedure

Procedure DeleteString(*this.AutoCompleteObject, gadget, *string )
  text$ = PeekS(*string)
  If text$
    ForEach *this\pstr()
      If UCase(*this\pstr()\prompt) = UCase(text$)
        DeleteElement(*this\pstr())
        ProcedureReturn  1
      EndIf
    Next
    ProcedureReturn 0
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

Procedure _nmAC_ListProc(hwnd, msg, wparam, lparam)
  Static hold=1 ; Logical device to prevent premature jump to String Gadget
  *this.AutoCompleteObject = GetProp_(hwnd, "acdata")
  oldproc = *this\listbox_oldproc
  Select msg
    Case #WM_NCDESTROY
      RemoveProp_(hwnd, "oldproc")
      
    Case #WM_KEYUP
      If wParam = #VK_TAB Or wParam = #VK_SPACE Or wparam = #VK_RETURN 
        text$ = GetGadgetText(*this\listbox)
        SetGadgetText(*this\gadget, text$)
        HideWindow(*this\popwin, 1)
      ElseIf wparam = #VK_ESCAPE
        HideWindow(*this\popwin, 1)
      ElseIf wparam = #VK_UP
        If GetGadgetState(*this\listbox) = 0
          If Not hold
            SetGadgetState(*this\listbox, -1)
            SetActiveGadget(*this\gadget)
          EndIf
        EndIf
      EndIf
      
    Case #WM_KEYDOWN
      If GetGadgetState(*this\listbox) = 0
        hold=0
      Else
        hold=1
      EndIf
      
    Case #WM_LBUTTONDBLCLK
      text$ = GetGadgetText(*this\listbox)
      SetGadgetText(*this\gadget, text$)
      HideWindow(*this\popwin, 1)
      
    Case #WM_RBUTTONUP
      text$ = GetGadgetText(*this\listbox)
      If text$
        If MessageRequester("Autocomplete:","Remove  "+Chr(34)+text$+Chr(34)+"  from this List?", #MB_YESNO) = #PB_MessageRequester_Yes
          Deletestring(*this, *this\gadget, @text$)
        EndIf
      EndIf
      SetFocus_(*this\gadget)
      ShowPopupList(GadgetID(*this\gadget), *this)
      
  EndSelect   
  ProcedureReturn CallWindowProc_(oldproc, hwnd, msg, wparam, lparam)
EndProcedure

Procedure MouseHook(nCode, wParam, lParam)
  
  If wParam = #WM_LBUTTONDOWN
    *ms.MSLLHOOKSTRUCT = lparam
    clickwindow = WindowFromPoint_(*ms\pt\x|(*ms\pt\y<<32)) 
    If Not GetProp_(clickwindow, "acdata")
      wn$ = Space(100)
      GetWindowText_(clickwindow, @wn$, 99)
      If wn$ <> "Autocomplete:" And wn$ <> "&Yes" And wn$<> "&No"
        ForEach _nmAC_Pops()
          HideWindow(_nmAC_Pops(), 1)
        Next
      EndIf
    EndIf
    
  EndIf
  ProcedureReturn CallNextHookEx_(_nmAC_Hook, nCode, wParam, lParam)
EndProcedure

Procedure Attach(*this.AutoCompleteObject, gadget, *strings, size )
  
  Protected fail_status = #False
  *ptr = *strings
  For i=1 To size
    AddElement(*this\pstr())
    *this\pstr()\gadget = gadget
    *this\pstr()\prompt = PeekS(PeekL(*ptr))
    *ptr+SizeOf(integer)
  Next
  SortStructuredList(*this\pstr(), #PB_Sort_Ascending, OffsetOf(stringdb\prompt), #PB_Sort_String)
  If IsGadget(gadget) And GadgetType(gadget) = #PB_GadgetType_String
    *this\gadget = gadget
    SetProp_(GadgetID(gadget), "acdata", *this )
    *this\subclass_oldproc = SetWindowLongPtr_(GadgetID(gadget), #GWL_WNDPROC, @_nmAC_StringProc())
    *this\parent = PB_Gadget_GetRootWindow(hwnd)
    *this\popwin = OpenWindow(#PB_Any, 0,0,200,100,"ACPopup",#PB_Window_BorderLess|#PB_Window_Invisible, *this\parent)
    AddElement(_nmAC_Pops())
    _nmAC_Pops() = *this\popwin
    SetWindowLongPtr_(WindowID(*this\popwin), #GWL_EXSTYLE, GetWindowLongPtr_(WindowID(*this\popwin), #GWL_EXSTYLE)|#WS_EX_TOOLWINDOW|#WS_EX_STATICEDGE)
    SetWindowPos_(WindowID(*this\popwin), 0,0,0,0,0,#SWP_NOMOVE|#SWP_NOSIZE|#SWP_NOZORDER|#SWP_FRAMECHANGED)
    StickyWindow(*this\popwin, 1)
    old = UseGadgetList(0)
    *this\listbox = ListViewGadget(#PB_Any,0,0,200,100)
    UseGadgetList(old)
    SetGadgetFont(*this\listbox, FontID(_nmAC_ListFont))
    SetProp_(GadgetID(*this\listbox), "acdata", *this )
    *this\listbox_oldproc = SetWindowLongPtr_(GadgetID(*this\listbox), #GWL_WNDPROC, @_nmAC_ListProc())
    If Not _nmAC_Hook
      _nmAC_Hook = SetWindowsHookEx_(#WH_MOUSE_LL, @MouseHook(), 0, 0)
    EndIf
  Else
    fail_status = #True
  EndIf
  
  ProcedureReturn 1-fail_status ; 1=success, 0=failed
  
EndProcedure

Procedure NewObject_Autocomplete(dynamic=0, minlength=3) ; ( [dynamic], [minlength] )
  *newobject.AutoCompleteObject = AllocateMemory(SizeOf(AutoCompleteObject))
  If *newobject
    InitializeStructure(*newobject, AutoCompleteObject)
    With *newobject
      \vTable    = ?AutoComplete_Methods
      \dynamic   = dynamic
      \minlength = minlength
    EndWith
    ProcedureReturn *newobject
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

Procedure Release(*this.AutoCompleteObject)
  If *this\subclass_oldproc
    SetWindowLongPtr_(GadgetID(*this\gadget),#GWL_WNDPROC, *this\subclass_oldproc)
  EndIf
  If IsWindow(*this\popwin)
    CloseWindow(*this\popwin)
  EndIf
  ClearStructure(*this, AutoCompleteObject)
  FreeMemory(*this)
EndProcedure

DataSection
  AutoComplete_Methods:
  Data.l @Attach(), @AddString(), @DeleteString(), @Release()
EndDataSection

;=================================================================
;                    END OF INCLUDE CODESECTION
;=================================================================

And a test program:

Code: Select all

XIncludeFile "Autocomplete_Object.pbi"

Dim Strings.s(17)
Strings(0)  = "Else"
Strings(1)  = "ElseIf"
Strings(2)  = "EnableDebugger"
Strings(3)  = "EnableExplicit"
Strings(4)  = "End"
Strings(5)  = "EndDataSection"
Strings(6)  = "EndEnumeration"
Strings(7)  = "EndIf"
Strings(8)  = "EndImport"
Strings(9)  = "EndInterface"
Strings(10) = "EndMacro"
Strings(11) = "EndProcedure"
Strings(12) = "EndSelect"
Strings(13) = "EndStructure"
Strings(14) = "EndStructureUnion"
Strings(15) = "EndWith"
Strings(16) = "Enumeration"

w=OpenWindow(#PB_Any,0,0,640,480,"",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
StringGadget(6, 10,10, 300,20,"")
StringGadget(7, 10,50, 300,20,"")

prompts.iAutoCompleteObject = NewObject_Autocomplete(1)
prompts\Attach(6, @strings(), 17 )

prompts\AddString(6, @"Excellent")

prompts2.iAutoCompleteObject = NewObject_Autocomplete()
prompts2\Attach(7, @strings(), 17 )


SetActiveGadget(6)

Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow

prompts\Release()
prompts2\Release()

[rsts]

Great work. Pretty sure I can live with this one.

I imagine you had fun with this one.

Many thanks for the solution and the approach. Some clever "outside the box" thinking here.

cheers

[netmaestro]

Thanks, you know me all too well. I did enjoy this one and I hope you can make use of it. I know I will, it's already part of my coming PureRAD project.

[srod]

Very nice.

[Kwai chang caine]

Great !!!!
And works the first time also with KCC, it's a sign of quality



Thanks a lot, for always sharing your enormous knowledge

[dige]

thank you netmeastro - well done! But how about a possibility
to select one item with keyboard keys like jump to the
choice box with tabkey and then select one with up and down key?

[rsts]

Or, since you've posted the source, you could make it one of those "code improvement" contests.

I've already made a change to eliminate the taskbar entry for the popup window.

nevermind. best if you make the changes.

cheers

[srod]

I've only had a cursory glance at the code (nice use of SQLite memory databases!) and am just wondering why the mouse-hook?

Could you not simply watch out for #WM_KILLFOCUS on the string gadget instead?

Just curious.

**EDIT : I'll answer my own question having just tried it! #WM_KILLFOCUS does not always fire at the appropriate times! When I drag the window around the damn listbox stays put because #WM_KILLFOCUS wasn't sent!

[netmaestro]

I think the reason I didn't use that is because it gets a WM_KILLFOCUS when you click the listbox and I didn't want that to make the list go away. However, now that you mention it, WM_KILLFOCUS comes with a nice wParam value to tell you where the focus went. I could test that and if it's the list window, ignore it. Good idea, and thanks. I'll try it.

[edit] Ok, maybe not!

[srod]

Aye, it nearly worked!

Actually, I think it would work with a little care. The thing is that I just don't like using hooks... though I see the attraction of using one in this case.

I'd be interested in knowing how Freak implemented code-completion lists with PB's IDE because I know he rolled his own. Did he use a similar hook for similar reasons?

[netmaestro]

No idea what he did, though his implementation does work well. I use it all the time and it's never done anything unexpected. I'd think twice about the hook if I had to compile it to a dll knowing it'll get injected into every process on the desktop but in this case I can live with it. Although, perhaps with the judicious use of SetCapture one might extend the KillFocus approach and make the hook unnecessary. I'm somewhat irritated with the hook anyway because it currently can't distinguish between multiple instances of the object. That's the only thing that's preventing the concurrent use of several AutoComplete objects for now.

[srod]

I'm somewhat irritated with the hook anyway because it currently can't distinguish between multiple instances of the object. That's the only thing that's preventing the concurrent use of several AutoComplete objects for now.

There will only ever be one such object on view at a time anyhow so I don't see a problem there providing the shared popwindow variable points to the window currently shown etc.

Incidentally, if you use a regular mouse hook (#WH_MOUSE) as opposed to a low level one then your hook procedure can be simplified somewhat :

Code: Select all

Procedure MouseHook(nCode, wParam, lParam)
  Shared hook, popwindow, stringg
  If wParam = #WM_LBUTTONDOWN
    *ms.MOUSEHOOKSTRUCT = lparam 
    If *ms\hwnd <> WindowID(popwindow) And *ms\hwnd <> GadgetID(stringg)
      HideWindow(popwindow, 1)
    EndIf
  EndIf
  ProcedureReturn CallNextHookEx_(hook, nCode, wParam, lParam)
EndProcedure

Works fine here.

I would also consider just using a single hook rather than create a new one for each control etc. That really is a resource hog! Set aside a structure to hold some globals. Into this place the handle of a single hook. Also place a pointer to the current object whose auto-complete list is on show etc. and that way the hook can access the object if it needs it.

[netmaestro]

Agreed on the single hook but I tried a standard mousehook initially and found that it worked fine as long as the window I clicked was mine. If I moved right off my window and clicked on a foreign window it wouldn't register. That's why I switched to the lowlevel one. But I can revisit it if you're sure it's working for you, maybe I had something else amiss and tricked myself into believing I needed a better hook.

[srod]

Confirmed!

Doh, just forget my ramblings today... too much coffee... brain running faster than usual... too fast for my own good...

That's my excuse anyhow.

It's a great piece of work... could be very useful indeed.

[netmaestro]

Thanks for the kind words, folks! Project is updated and details/code are in the first post.

I've already made a change to eliminate the taskbar entry for the popup window.
nevermind. best if you make the changes.

That's implemented. Thanks for the heads up!