suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

a few little cleanups

Browse Source 
svn: r7297
This commit is contained in:
Robby Findler 2007-09-08 19:24:45 +00:00
parent 34244b80e1
commit defd4349fc
1 changed files with 66 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

113
collects/framework/private/auto-complete.ss
View File

@ -19,20 +19,12 @@ memory and more time to build the initial data structure.
===
autocomplete-mixin: mixin (editor<%> -> editor<%>)
The autocomplete-text mixin produces a class that implements
editor<%> and provides the following extra public methods:
autocomplete<%>
=new methods=
get-completions : string -> autocompletion-cursor<%>
given a word, produces a cursor that describes
all possible completions. The default implementation
returns all strings in the parameter autocomplete-word-list (below)
that have the given string as a prefix; it performs a
linear-search at every narrow/widen.
get-all-words : -> (listof string)
returns a list of all of the possible words that the completion should choose from
get-autocomplete-border-color : -> color string
returns the color for the border of the autocompletion menu
@ -43,6 +35,13 @@ returns the background color for the autocompletion menu
get-autocomplete-selected-color : -> color string
returns the selected color for the autocompletion menu
===
autocomplete-mixin: mixin (editor<%> -> editor<%>)
The autocomplete-text mixin produces a class that implements
editor<%> and provides the following extra public methods:
=overridden methods=
on-paint
@ -108,15 +107,11 @@ configuration parameters
These configuration parameters customize autocompletion behavior.
autocomplete-append-after : string parameter
designates text to insert after a completion. Default " "
designates text to insert after a completion. Default: ""
autocomplete-limit : positive int parameter
designates the maximum number of completions to show at a time. Default: 15
autocomplete-word-list : (listof string) parameter
designates the list of valid completions used by the default implementation of
autocompletion-cursor<%>.
completion-mode-key : character parameter
designates the character that triggers autocompletion
@ -131,18 +126,26 @@ designates the character that triggers autocompletion
(prefix srfi1: (lib "1.ss" "srfi")))
(provide autocomplete-mixin
autocomplete<%>
autocompletion-cursor<%>
autocompletion-cursor%
autocomplete-append-after
autocomplete-limit
autocomplete-word-list)
autocomplete-limit)
(define autocomplete<%>
(interface ((class->interface text%))
get-autocomplete-border-color
get-autocomplete-background-color
get-autocomplete-selected-color
completion-mode-key-event?
get-all-words))
;; ============================================================
;; auto-complete-text (mixin) implementation
(define autocomplete-mixin
(mixin ((class->interface text%)) ((class->interface text%))
(mixin ((class->interface text%)) (autocomplete<%>)
(inherit invalidate-bitmap-cache get-dc get-start-position get-end-position
find-wordbreak get-text position-location insert dc-location-to-editor-location)
@ -160,17 +163,28 @@ designates the character that triggers autocompletion
(define/public (get-autocomplete-selected-color) "orange")
(define/public (completion-mode-key-event? key-event)
(eq? (send key-event get-key-code) #\tab))
(and (eq? (send key-event get-key-code) #\.)
(send key-event get-control-down)))
(define/public (get-all-words)
(get-completions/manuals
'("framework" "foreign" "scribble" "mzlib" "mrlib" "mzscheme" "mred" "r5rs")))
(define completions-box #f) ; completions-box% or #f if no completions box is active right now
(define word-start-pos #f) ; start pos of that word, or #f if no autocompletion
(define word-end-pos #f) ; end pos of that word, or #f if none
; string -> scrolling-cursor<%> given a prefix, returns the possible completions
(define/public (get-completions word)
(new autocompletion-cursor% [word word]))
; given a word, produces a cursor that describes
; all possible completions. The default implementation of autocompletion-cursor%
; returns all strings from the get-all-words method (below)
; that have the given string as a prefix; it performs a
; linear-search at every narrow/widen.
(define/private (get-completions word)
(new autocompletion-cursor%
[word word]
[all-words (get-all-words)]))
(define/override (on-paint before? dc left top right bottom dx dy draw-caret)
(super on-paint before? dc left top right bottom dx dy draw-caret)
(when (and completions-box (not before?))
@ -206,7 +220,7 @@ designates the character that triggers autocompletion
[completions (new scroll-manager% [cursor cursor])]
[menu-x (unbox x)]
[menu-y (+ (unbox y) 2)]
[parent this]))
[editor this]))
(send completions-box redraw)))
;; on-char must handle inputs for two modes: normal text mode and in-the-middle-of-autocompleting mode
@ -323,25 +337,28 @@ designates the character that triggers autocompletion
(define autocompletion-cursor%
(class* object% (autocompletion-cursor<%>)
(init-field word)
(init [manuals '("framework" "foreign" "scribble" "mzlib" "mrlib" "mzscheme" "mred" "r5rs")])
(init-field word all-words)
(define/private (starts-with prefix)
(let ([re (regexp (string-append "^" (regexp-quote prefix)))])
(λ (w) (regexp-match re w))))
(define all-completions (filter (starts-with word) (get-completions/manuals manuals)))
(define all-completions (filter (starts-with word) all-words))
(define all-completions-length (length all-completions))
(define/public (narrow c)
(new autocompletion-cursor% [word (string-append word (list->string (list c)))]))
(new autocompletion-cursor%
[word (string-append word (list->string (list c)))]
[all-words all-words]))
(define/public (widen)
(let ([strlen (string-length word)])
(cond
[(< strlen 2) #f]
[else
(new autocompletion-cursor% [word (substring word 0 (- (string-length word) 1))])])))
(new autocompletion-cursor%
[word (substring word 0 (- (string-length word) 1))]
[all-words all-words])])))
(define/public (get-completions) all-completions)
(define/public (get-length) all-completions-length)
@ -445,7 +462,7 @@ designates the character that triggers autocompletion
(init-field completions ; scroll-manager% the possible completions (all of which have base-word as a prefix)
menu-x ; int the menu's top-left x coordinate
menu-y ; int the menu's top-left y coordinate
parent ; editor<%> the owner of this completion box
editor ; editor<%> the owner of this completion box
)
(define/private (compute-geometry)
@ -470,16 +487,20 @@ designates the character that triggers autocompletion
(set! vec v))]))
(define-values (editor-width editor-height)
(let* ([canvas (send parent get-active-canvas)]
[w (- (send canvas get-width)
(* (send canvas horizontal-inset) 2))]
[h (send canvas get-height)])
(values w h)))
(let* ([wb (box 0)]
[hb (box 0)]
[admin (send editor get-admin)])
(if admin
(begin
(send admin get-view #f #f wb hb)
(values (unbox wb)
(unbox hb)))
(values 10 10))))
(let* ([num-completions (send completions get-length)]
[shown-completions (send completions get-visible-completions)])
(define-values (w h)
(let ([dc (send parent get-dc)])
(let ([dc (send editor get-dc)])
(let loop ([pc shown-completions]
[w 0]
[h 0]
@ -526,8 +547,8 @@ designates the character that triggers autocompletion
(define/public (draw dc dx dy)
(let ([old-pen (send dc get-pen)]
[old-brush (send dc get-brush)])
(send dc set-pen (send parent get-autocomplete-border-color) 1 'solid)
(send dc set-brush (send parent get-autocomplete-background-color) 'solid)
(send dc set-pen (send editor get-autocomplete-border-color) 1 'solid)
(send dc set-brush (send editor get-autocomplete-background-color) 'solid)
(let-values ([(mx my tw th) (get-menu-coordinates)])
(send dc draw-rectangle (+ mx dx) (+ my dy) tw th)
(let loop ([item-number 0] [y my] [pc (send completions get-visible-completions)])
@ -544,7 +565,7 @@ designates the character that triggers autocompletion
(let-values ([(w h d a) (send dc get-text-extent c)])
(when (= item-number highlighted-menu-item)
(send dc set-pen "black" 1 'transparent)
(send dc set-brush (send parent get-autocomplete-selected-color) 'solid)
(send dc set-brush (send editor get-autocomplete-selected-color) 'solid)
(send dc draw-rectangle (+ mx dx 1) (+ dy y menu-padding-y 1) (- tw 2) (- h 1)))
(send dc draw-text c (+ mx dx menu-padding-x) (+ menu-padding-y y dy))
(loop (add1 item-number) (+ y h) (cdr pc))))])))
@ -555,7 +576,7 @@ designates the character that triggers autocompletion
;; tells the parent to refresh enough of itself to redraw this menu
(define/public (redraw)
(let-values ([(x y w h) (get-menu-coordinates)])
(send parent invalidate-bitmap-cache x y w h)))
(send editor invalidate-bitmap-cache x y w h)))
;; get-menu-coordinates : -> (values int int int int)
;; get the menu's x, y, w, h coordinates with respect to its parent
@ -605,7 +626,7 @@ designates the character that triggers autocompletion
[composite-y1 (min old-y1 new-y1)]
[composite-x2 (max old-x2 new-x2)]
[composite-y2 (max old-y2 new-y2)])
(send parent invalidate-bitmap-cache
(send editor invalidate-bitmap-cache
composite-x1
composite-y1
(- composite-x2 composite-x1)
@ -676,12 +697,10 @@ designates the character that triggers autocompletion
(format "parameter ~a: expected ~a, given: ~e" name description v))))]))))
(define autocomplete-append-after
(make-guarded-parameter 'append-after "string" " " string?))
(make-guarded-parameter 'append-after "string" "" string?))
(define autocomplete-limit
(make-guarded-parameter 'limit "positive integer" 15 (λ (x) (and (integer? x) (> x 0)))))
(define autocomplete-word-list
(make-guarded-parameter 'word-list "list of strings" '() (λ (x) (or (pair? x) (null? x)))))
;; ============================================================
;; read keywords from manuals
@ -709,11 +728,11 @@ designates the character that triggers autocompletion
;; ============================================================
;; testing code
#;
(begin
(define all-words (get-completions/manuals
'("framework" "foreign" "scribble" "mzlib" "mrlib" "mzscheme" "mred" "r5rs")))
(autocomplete-word-list all-words)
(let* ([f (new frame% (label "Test") (height 400) (width 400))]
[e (new (autocomplete-mixin text%))]
[c (new editor-canvas% (editor e) (parent f))])