...
original commit: a2d49e97ce615683e9aa7ddbc0fb2d50092cf86a
This commit is contained in:
parent
6cb26bc1af
commit
b3730f959f
|
@ -163,7 +163,7 @@
|
||||||
(if (or (not filename) (unbox b))
|
(if (or (not filename) (unbox b))
|
||||||
(bell)
|
(bell)
|
||||||
(let-values ([(start end)
|
(let-values ([(start end)
|
||||||
(if (is-a? edit text%)
|
(if (is-a? edit original:text%)
|
||||||
(values (send edit get-start-position)
|
(values (send edit get-start-position)
|
||||||
(send edit get-end-position))
|
(send edit get-end-position))
|
||||||
(values #f #f))])
|
(values #f #f))])
|
||||||
|
@ -174,7 +174,7 @@
|
||||||
#f)])
|
#f)])
|
||||||
(if status
|
(if status
|
||||||
(begin
|
(begin
|
||||||
(when (is-a? edit text%)
|
(when (is-a? edit original:text%)
|
||||||
(send edit set-position start end))
|
(send edit set-position start end))
|
||||||
(send edit end-edit-sequence))
|
(send edit end-edit-sequence))
|
||||||
(begin
|
(begin
|
||||||
|
@ -311,7 +311,7 @@
|
||||||
(let loop ([edit edit])
|
(let loop ([edit edit])
|
||||||
(let ([snip (send edit get-focus-snip)])
|
(let ([snip (send edit get-focus-snip)])
|
||||||
(if (or (not snip)
|
(if (or (not snip)
|
||||||
(not (is-a? snip editor-snip%)))
|
(not (is-a? snip original:editor-snip%)))
|
||||||
edit
|
edit
|
||||||
(loop (send snip get-this-media)))))))
|
(loop (send snip get-this-media)))))))
|
||||||
(define clear-search-highlight
|
(define clear-search-highlight
|
||||||
|
|
|
@ -146,7 +146,7 @@
|
||||||
(cond
|
(cond
|
||||||
[(<= end pos) eof]
|
[(<= end pos) eof]
|
||||||
[(not snip) eof]
|
[(not snip) eof]
|
||||||
[(is-a? snip string-snip%)
|
[(is-a? snip original:string-snip%)
|
||||||
(let ([t (send snip get-text (- pos (unbox box)) 1)])
|
(let ([t (send snip get-text (- pos (unbox box)) 1)])
|
||||||
(unless (= (string-length t) 1)
|
(unless (= (string-length t) 1)
|
||||||
(error 'read-snips/chars-from-buffer
|
(error 'read-snips/chars-from-buffer
|
||||||
|
|
|
@ -8,7 +8,13 @@
|
||||||
(define single-mixin
|
(define single-mixin
|
||||||
(mixin (area-container<%>) (single<%>) args
|
(mixin (area-container<%>) (single<%>) args
|
||||||
(inherit get-alignment)
|
(inherit get-alignment)
|
||||||
|
(rename [super-on-new-child on-new-child])
|
||||||
(override
|
(override
|
||||||
|
[on-new-child
|
||||||
|
(lambda (c)
|
||||||
|
(if current-active-child
|
||||||
|
(send c show #f)
|
||||||
|
(set! current-active-child c)))]
|
||||||
[container-size
|
[container-size
|
||||||
(lambda (l)
|
(lambda (l)
|
||||||
(values (apply max (map car l)) (apply max (map cadr l))))]
|
(values (apply max (map car l)) (apply max (map cadr l))))]
|
||||||
|
|
|
@ -375,7 +375,7 @@
|
||||||
(if (and (= x -1) pop-out?)
|
(if (and (= x -1) pop-out?)
|
||||||
(pop-out)
|
(pop-out)
|
||||||
(values this x)))]
|
(values this x)))]
|
||||||
[(is-a? current-snip editor-snip%)
|
[(is-a? current-snip original:editor-snip%)
|
||||||
(let-values ([(embedded embedded-pos)
|
(let-values ([(embedded embedded-pos)
|
||||||
(let ([media (send current-snip get-this-media)])
|
(let ([media (send current-snip get-this-media)])
|
||||||
(and (not (null? media))
|
(and (not (null? media))
|
||||||
|
@ -489,7 +489,7 @@
|
||||||
(let loop ([s (find-first-snip)])
|
(let loop ([s (find-first-snip)])
|
||||||
(cond
|
(cond
|
||||||
[(null? s) #f]
|
[(null? s) #f]
|
||||||
[(is-a? s string-snip%)
|
[(is-a? s original:string-snip%)
|
||||||
(loop (send s next))]
|
(loop (send s next))]
|
||||||
[else #t])))])
|
[else #t])))])
|
||||||
(lambda (name format)
|
(lambda (name format)
|
||||||
|
|
|
@ -62,13 +62,26 @@
|
||||||
(lambda (label choices callback)
|
(lambda (label choices callback)
|
||||||
(let* ([panel (make-object vertical-panel% radios '(border))]
|
(let* ([panel (make-object vertical-panel% radios '(border))]
|
||||||
[message (make-object message% label panel)]
|
[message (make-object message% label panel)]
|
||||||
[radio (make-object radio-box% #f choices panel callback)])
|
[radio (make-object radio-box% #f choices panel (lambda (radio _) (callback radio)))]
|
||||||
|
[button (make-object button%
|
||||||
|
"Cycle" panel
|
||||||
|
(lambda (_1 _2)
|
||||||
|
(let ([before (send radio get-selection)]
|
||||||
|
[tot (send radio get-number)])
|
||||||
|
(let loop ([n tot])
|
||||||
|
(unless (zero? n)
|
||||||
|
(send radio set-selection (- tot n))
|
||||||
|
(callback radio)
|
||||||
|
(sleep/yield 1)
|
||||||
|
(loop (- n 1))))
|
||||||
|
(send radio set-selection before)
|
||||||
|
(callback radio))))])
|
||||||
radio))]
|
radio))]
|
||||||
[radio
|
[radio
|
||||||
(make-radio
|
(make-radio
|
||||||
"Active Child"
|
"Active Child"
|
||||||
(map (lambda (x) (send x get-label)) children)
|
(map (lambda (x) (send x get-label)) children)
|
||||||
(lambda (radio evt)
|
(lambda (radio)
|
||||||
(let loop ([n (length children)]
|
(let loop ([n (length children)]
|
||||||
[cs children])
|
[cs children])
|
||||||
(cond
|
(cond
|
||||||
|
@ -88,14 +101,14 @@
|
||||||
(make-radio
|
(make-radio
|
||||||
"Horizontal Alignment"
|
"Horizontal Alignment"
|
||||||
(list "left" "center" "right")
|
(list "left" "center" "right")
|
||||||
(lambda (radio evt)
|
(lambda (radio)
|
||||||
(set! horizontal-alignment (string->symbol (send radio get-item-label (send radio get-selection))))
|
(set! horizontal-alignment (string->symbol (send radio get-item-label (send radio get-selection))))
|
||||||
(update-alignment)))]
|
(update-alignment)))]
|
||||||
[vert
|
[vert
|
||||||
(make-radio
|
(make-radio
|
||||||
"Vertical Alignment"
|
"Vertical Alignment"
|
||||||
(list "top" "center" "bottom")
|
(list "top" "center" "bottom")
|
||||||
(lambda (radio evt)
|
(lambda (radio)
|
||||||
(set! vertical-alignment (string->symbol (send radio get-item-label (send radio get-selection))))
|
(set! vertical-alignment (string->symbol (send radio get-item-label (send radio get-selection))))
|
||||||
(update-alignment)))]
|
(update-alignment)))]
|
||||||
[buttons (make-object horizontal-panel% f)]
|
[buttons (make-object horizontal-panel% f)]
|
||||||
|
|
Loading…
Reference in New Issue
Block a user