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

fixed tabify preferences when identifiers have spaces (or other wierdness)

Browse Source 
svn: r7453

original commit: 959e68015473a7a36719cfcbbcbbb29a6b9ec434
This commit is contained in:
Robby Findler 2007-10-08 16:31:35 +00:00
parent 36ce0dbc68
commit f39aee68e3
1 changed files with 13 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
collects/framework/private/scheme.ss
View File

@ -1148,7 +1148,8 @@
[lam-reg (cadddr pref)]) [lam-reg (cadddr pref)])
(hash-table-get (hash-table-get
ht ht
(string->symbol text) (with-handlers ((exn:fail:read? (λ (x) #f)))
(read (open-input-string text)))
(λ () (λ ()
(cond (cond
[(and beg-reg (regexp-match beg-reg text)) 'begin] [(and beg-reg (regexp-match beg-reg text)) 'begin]
@ -1648,7 +1649,7 @@
(cond (cond
[(null? in) (sort out string<=?)] [(null? in) (sort out string<=?)]
[else (if (eq? wanted (cadr (car in))) [else (if (eq? wanted (cadr (car in)))
(pick-out wanted (cdr in) (cons (symbol->string (car (car in))) out)) (pick-out wanted (cdr in) (cons (format "~s" (car (car in))) out))
(pick-out wanted (cdr in) out))]))]) (pick-out wanted (cdr in) out))]))])
(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)
@ -1687,7 +1688,7 @@
(λ (list-box) (λ (list-box)
(λ (button command) (λ (button command)
(let* ([selections (send list-box get-selections)] (let* ([selections (send list-box get-selections)]
[symbols (map (λ (x) (string->symbol (send list-box get-string x))) selections)]) [symbols (map (λ (x) (read (open-input-string (send list-box get-string x)))) selections)])
(for-each (λ (x) (send list-box delete x)) (reverse selections)) (for-each (λ (x) (send list-box delete x)) (reverse selections))
(let* ([pref (preferences:get 'framework:tabify)] (let* ([pref (preferences:get 'framework:tabify)]
[ht (car pref)]) [ht (car pref)])
@ -1750,16 +1751,15 @@
'lambda 'lambda
lambda-keywords lambda-keywords
(λ (x) (update-pref cdddr x)))) (λ (x) (update-pref cdddr x))))
(define update-list-boxes (define (update-list-boxes hash-table)
(λ (hash-table) (let-values ([(begin-keywords define-keywords lambda-keywords) (get-keywords hash-table)]
(let-values ([(begin-keywords define-keywords lambda-keywords) (get-keywords hash-table)] [(reset) (λ (list-box keywords)
[(reset) (λ (list-box keywords) (send list-box clear)
(send list-box clear) (for-each (λ (x) (send list-box append x)) keywords))])
(for-each (λ (x) (send list-box append x)) keywords))]) (reset begin-list-box begin-keywords)
(reset begin-list-box begin-keywords) (reset define-list-box define-keywords)
(reset define-list-box define-keywords) (reset lambda-list-box lambda-keywords)
(reset lambda-list-box lambda-keywords) #t))
#t)))
(define update-gui (define update-gui
(λ (pref) (λ (pref)
(update-list-boxes (car pref)) (update-list-boxes (car pref))