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

.

Browse Source 
original commit: d42f7f699022a49695bdf0bacd70e380f2c2c58d
This commit is contained in:
Matthew Flatt 2004-05-24 22:48:33 +00:00
parent fff6db208c
commit e927bacea3
1 changed files with 8 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/hierlist/hierlist-unit.ss
View File

@ -336,6 +336,7 @@
[depth dpth] [depth dpth]
[parent-snip parent-snp] [parent-snip parent-snp]
[children null] [children null]
[last-child #f]
[no-sublists? #f]) [no-sublists? #f])
(private (private
[make-whitespace (lambda () (make-object whitespace-snip%))] [make-whitespace (lambda () (make-object whitespace-snip%))]
@ -349,7 +350,11 @@
(insert (make-whitespace) (last-position))) (insert (make-whitespace) (last-position)))
(insert s (last-position)) (insert s (last-position))
(end-edit-sequence) (end-edit-sequence)
(set! children (append children (list s))) (let ([p (list s)])
(if last-child
(set-cdr! last-child p)
(set! children (append children p)))
(set! last-child p))
(send s get-item)))]) (send s get-item)))])
(public (public
[get-parent-snip (lambda () parent-snip)] [get-parent-snip (lambda () parent-snip)]
@ -382,6 +387,7 @@
(send top ensure-not-selected i) (send top ensure-not-selected i)
(send (car l) deselect-all) (send (car l) deselect-all)
(set! children (append (reverse others) (cdr l))) (set! children (append (reverse others) (cdr l)))
(set! last-child #f)
(let ([s (line-start-position pos)] (let ([s (line-start-position pos)]
[e (line-end-position pos)]) [e (line-end-position pos)])
(delete (if (zero? s) s (sub1 s)) (if (zero? s) (add1 e) e)))] (delete (if (zero? s) s (sub1 s)) (if (zero? s) (add1 e) e)))]
@ -414,6 +420,7 @@
(unless (null? l) (unless (null? l)
(delete)) ; delete last #\newline (delete)) ; delete last #\newline
(set! children l) (set! children l)
(set! last-child #f)
(when to-scroll-to (when to-scroll-to
(send (send to-scroll-to get-item) scroll-to))) (send (send to-scroll-to get-item) scroll-to)))
(end-edit-sequence)))] (end-edit-sequence)))]