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

fixed a bug in define popdown (PR 8083) and a bug in undoing the [ thing (PR 8073)

Browse Source 
svn: r3185
This commit is contained in:
Robby Findler 2006-06-02 15:20:30 +00:00
parent f3ecc118f0
commit c1239c146e
2 changed files with 16 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/drscheme/private/unit.ss
View File

@ -13,13 +13,13 @@ module browser threading seems wrong.
(module unit mzscheme (module unit mzscheme
(require (lib "contract.ss") (require (lib "contract.ss")
(lib "unitsig.ss") (lib "unitsig.ss")
(lib "class.ss") (lib "class.ss")
(lib "file.ss") (lib "file.ss")
(lib "etc.ss") (lib "etc.ss")
(lib "list.ss") (lib "list.ss")
(lib "port.ss") (lib "port.ss")
(lib "string-constant.ss" "string-constants") (lib "string-constant.ss" "string-constants")
(lib "framework.ss" "framework") (lib "framework.ss" "framework")
(lib "name-message.ss" "mrlib") (lib "name-message.ss" "mrlib")
(lib "bitmap-label.ss" "mrlib") (lib "bitmap-label.ss" "mrlib")
@ -604,10 +604,9 @@ module browser threading seems wrong.
(λ (menu editor event) (λ (menu editor event)
(when (is-a? editor text%) (when (is-a? editor text%)
(let* ([canvas (send editor get-canvas)] (let* ([canvas (send editor get-canvas)]
[frame (and canvas (send canvas get-frame))]) [frame (and canvas (send canvas get-top-level-window))])
(unless (is-a? frame -frame<%>) (when (is-a? frame -frame<%>)
(let* ([tab (send frame get-current-tab)] (let* ([language-settings (send (send frame get-definitions-text) get-next-settings)]
[language-settings (send (send tab get-definitions-text) get-next-settings)]
[new-language (drscheme:language-configuration:language-settings-language language-settings)] [new-language (drscheme:language-configuration:language-settings-language language-settings)]
[capability-info (send new-language capability-value 'drscheme:define-popup)]) [capability-info (send new-language capability-value 'drscheme:define-popup)])
(when capability-info (when capability-info
@ -1031,7 +1030,8 @@ module browser threading seems wrong.
on-tab-change on-tab-change
enable-evaluation enable-evaluation
disable-evaluation disable-evaluation
get-definitions/interactions-panel-parent)) get-definitions/interactions-panel-parent
register-capability-menu-item))
(define frame-mixin (define frame-mixin
(mixin (drscheme:frame:<%> frame:searchable-text<%> frame:delegate<%> frame:open-here<%>) (mixin (drscheme:frame:<%> frame:searchable-text<%> frame:delegate<%> frame:open-here<%>)

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

@ -1229,11 +1229,12 @@
;; on the context where it is typed in. ;; on the context where it is typed in.
(define (insert-paren text) (define (insert-paren text)
(let* ([pos (send text get-start-position)] (let* ([pos (send text get-start-position)]
[change-to [real-char #\[]
(λ (c) [change-to (λ (c) (set! real-char c))]
(send text insert c pos (+ pos 1)))]) [start-pos (send text get-start-position)]
(send text begin-edit-sequence) [end-pos (send text get-end-position)])
(send text insert #\[ pos (send text get-end-position)) (send text begin-edit-sequence #f #f)
(send text insert "[" start-pos 'same #f)
(when (eq? (send text classify-position pos) 'parenthesis) (when (eq? (send text classify-position pos) 'parenthesis)
(let* ([before-whitespace-pos (send text skip-whitespace pos 'backward #t)] (let* ([before-whitespace-pos (send text skip-whitespace pos 'backward #t)]
[backward-match (send text backward-match before-whitespace-pos 0)]) [backward-match (send text backward-match before-whitespace-pos 0)])
@ -1320,7 +1321,9 @@
(change-to #\()]))] (change-to #\()]))]
[else [else
(change-to #\()])))) (change-to #\()]))))
(send text end-edit-sequence))) (send text delete pos (+ pos 1) #f)
(send text end-edit-sequence)
(send text insert real-char start-pos end-pos)))
;; beginning-of-sequence? : text number -> boolean ;; beginning-of-sequence? : text number -> boolean
;; determines if this position is at the beginning of a sequence ;; determines if this position is at the beginning of a sequence