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

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

@ -752,13 +752,22 @@
(and snd-end (and snd-end
(let ([snd-start (get-backward-sexp snd-end)]) (let ([snd-start (get-backward-sexp snd-end)])
(and snd-start (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)]) (let ([thrd-start (get-forward-sexp snd-end)])
(and (or (not thrd-start) (and (or (not thrd-start)
(not (= (position-paragraph thrd-start) (not (= (position-paragraph thrd-start)
(position-paragraph snd-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) (define/private (first-sexp-is-keyword? contains)
(let ([fst-end (get-forward-sexp contains)]) (let ([fst-end (get-forward-sexp contains)])
(and fst-end (and fst-end
@ -2173,8 +2182,9 @@
(values (pick-out 'begin all-keywords null) (values (pick-out 'begin all-keywords null)
(pick-out 'define all-keywords null) (pick-out 'define all-keywords null)
(pick-out 'lambda all-keywords null) (pick-out 'lambda all-keywords null)
(pick-out 'for/fold all-keywords null)))) (pick-out 'for/fold all-keywords null)
(define-values (begin-keywords define-keywords lambda-keywords for/fold-keywords) (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)))) (get-keywords (car (preferences:get 'framework:tabify))))
(define ((add-button-callback keyword-type keyword-symbol list-box) button command) (define ((add-button-callback keyword-type keyword-symbol list-box) button command)
(define new-one (define new-one
@ -2276,8 +2286,13 @@
'for/fold 'for/fold
for/fold-keywords for/fold-keywords
(λ (x) (update-pref 4 x)))) (λ (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 (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)) (get-keywords hash-table))
(define (reset list-box keywords) (define (reset list-box keywords)
(send list-box clear) (send list-box clear)
@ -2286,6 +2301,7 @@
(reset define-list-box define-keywords) (reset define-list-box define-keywords)
(reset lambda-list-box lambda-keywords) (reset lambda-list-box lambda-keywords)
(reset for/fold-list-box for/fold-keywords) (reset for/fold-list-box for/fold-keywords)
(reset ellipses-list-box ellipses-keywords)
#t) #t)
(define update-gui (define update-gui
(λ (pref) (λ (pref)
@ -2293,7 +2309,10 @@
(send begin-regexp-text set-value (or (object-name (list-ref pref 1)) "")) (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 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 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))) (preferences:add-callback 'framework:tabify (λ (p v) (update-gui v)))
(update-gui (preferences:get 'framework:tabify)) (update-gui (preferences:get 'framework:tabify))
main-panel) main-panel)