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

Added a preferences list for identifiers which behave like ellipses.

Browse Source
This commit is contained in:
Georges Dupéron 2016-09-22 13:10:57 +02:00
parent de03f1a98f
commit fa11e0774e
2 changed files with 30 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gui-lib/framework/private/main.rkt
View File

@ -378,6 +378,8 @@
(preferences:set-default 'framework:fixup-open-parens #f boolean?)
(preferences:set-default 'framework:paren-match #t boolean?)
(let ([defaults-ht (make-hasheq)])
(for-each (λ (x) (hash-set! defaults-ht x '...))
'(... … ...+ …+ ::...))
(for-each (λ (x) (hash-set! defaults-ht x 'for/fold))
'(for/fold for/fold: for*/fold for*/fold:))
(for-each (λ (x) (hash-set! defaults-ht x 'define))
@ -458,8 +460,9 @@
(preferences:set-default
'framework:tabify
(list defaults-ht #rx"^begin" #rx"^def" #rx"^(for\\*?(/|$)|with-)" #f)
(list/c (hash/c symbol? (or/c 'for/fold 'define 'begin 'lambda) #:flat? #t)
(or/c #f regexp?) (or/c #f regexp?) (or/c #f regexp?) (or/c #f regexp?)))
(cons/c (hash/c symbol? (or/c 'for/fold 'define 'begin 'lambda '...) #:flat? #t)
(or/c (list/c (or/c #f regexp?) (or/c #f regexp?) (or/c #f regexp?) (or/c #f regexp?))
(list/c (or/c #f regexp?) (or/c #f regexp?) (or/c #f regexp?) (or/c #f regexp?) (or/c #f regexp?)))))
(define old-style-pred? (listof (list/c symbol? symbol?)))
(define new-style-pred?

31
gui-lib/framework/private/racket.rkt
View File

@ -752,13 +752,22 @@
(and snd-end
(let ([snd-start (get-backward-sexp snd-end)])
(and snd-start
(equal? (get-text snd-start snd-end)
"...")
(text-is-ellipsis? (get-text snd-start snd-end))
(let ([thrd-start (get-forward-sexp snd-end)])
(and (or (not thrd-start)
(not (= (position-paragraph thrd-start)
(position-paragraph snd-start)))))))))))))
(define/private (text-is-ellipsis? text)
(define pref (preferences:get 'framework:tabify))
(define ht (car pref))
(define ...-reg (and (> (length pref) 5) (list-ref pref 5)))
(hash-ref
ht
(with-handlers ((exn:fail:read? (λ (x) #f)))
(read (open-input-string text)))
(λ () (and ...-reg (regexp-match ...-reg text)))))
(define/private (first-sexp-is-keyword? contains)
(let ([fst-end (get-forward-sexp contains)])
(and fst-end
@ -2173,8 +2182,9 @@
(values (pick-out 'begin all-keywords null)
(pick-out 'define all-keywords null)
(pick-out 'lambda all-keywords null)
(pick-out 'for/fold all-keywords null))))
(define-values (begin-keywords define-keywords lambda-keywords for/fold-keywords)
(pick-out 'for/fold all-keywords null)
(pick-out '... all-keywords null))))
(define-values (begin-keywords define-keywords lambda-keywords for/fold-keywords ellipses-keywords)
(get-keywords (car (preferences:get 'framework:tabify))))
(define ((add-button-callback keyword-type keyword-symbol list-box) button command)
(define new-one
@ -2276,8 +2286,13 @@
'for/fold
for/fold-keywords
(λ (x) (update-pref 4 x))))
(define-values (ellipses-list-box ellipses-regexp-text)
(make-column "Ellipses"
'...
ellipses-keywords
(λ (x) (update-pref 5 x))))
(define (update-list-boxes hash-table)
(define-values (begin-keywords define-keywords lambda-keywords for/fold-keywords)
(define-values (begin-keywords define-keywords lambda-keywords for/fold-keywords ellipses-keywords)
(get-keywords hash-table))
(define (reset list-box keywords)
(send list-box clear)
@ -2286,6 +2301,7 @@
(reset define-list-box define-keywords)
(reset lambda-list-box lambda-keywords)
(reset for/fold-list-box for/fold-keywords)
(reset ellipses-list-box ellipses-keywords)
#t)
(define update-gui
(λ (pref)
@ -2293,7 +2309,10 @@
(send begin-regexp-text set-value (or (object-name (list-ref pref 1)) ""))
(send define-regexp-text set-value (or (object-name (list-ref pref 2)) ""))
(send lambda-regexp-text set-value (or (object-name (list-ref pref 3)) ""))
(send for/fold-regexp-text set-value (or (object-name (list-ref pref 4)) ""))))
(send for/fold-regexp-text set-value (or (object-name (list-ref pref 4)) ""))
(send ellipses-regexp-text set-value (or (and (> (length pref) 5)
(object-name (list-ref pref 5)))
""))))
(preferences:add-callback 'framework:tabify (λ (p v) (update-gui v)))
(update-gui (preferences:get 'framework:tabify))
main-panel)