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

adjust the language dialog based on feedback from dev@

Browse Source
This commit is contained in:
Robby Findler 2012-11-05 16:29:17 -06:00
parent 3e8cd0277f
commit 3bbf6035d1
2 changed files with 86 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

127
collects/drracket/private/language-configuration.rkt
View File

@ -1,5 +1,5 @@
#lang racket/base #lang racket/base
(require (prefix-in : mred/mred) ;; ensure that this module is always loaded since it is shared below for pretty big (require (prefix-in : mred/mred) ;; ensure that this module is always loaded since it is shared below for pretty big
racket/unit racket/unit
mrlib/hierlist mrlib/hierlist
racket/class racket/class
@ -11,7 +11,11 @@
string-constants string-constants
framework framework
setup/getinfo setup/getinfo
setup/xref
scribble/xref
net/url
syntax/toplevel syntax/toplevel
browser/external
(only-in mzlib/struct make-->vector)) (only-in mzlib/struct make-->vector))
(define original-output (current-output-port)) (define original-output (current-output-port))
@ -38,16 +42,14 @@
[(shift) (send evt get-shiftdown)] [(shift) (send evt get-shiftdown)]
[(option) (send evt get-alt-down)])) [(option) (send evt get-alt-down)]))
shortcut-prefix)) shortcut-prefix))
(values (string-append (string-constant use-language-in-source) (values (string-append (string-constant the-racket-language)
(format " (~aU)" menukey-string)) (format " (~aR)" menukey-string))
(string-append (string-constant teaching-languages) (string-append (string-constant teaching-languages)
(format " (~aT)" menukey-string)) (format " (~aT)" menukey-string))
(string-append (string-constant other-languages) (string-append (string-constant other-languages)
(format " (~aO)" menukey-string)) (format " (~aO)" menukey-string))
mouse-event-uses-shortcut-prefix?))) mouse-event-uses-shortcut-prefix?)))
(define sc-lang-in-source-discussion (string-constant lang-in-source-discussion))
(provide language-configuration@) (provide language-configuration@)
(define-unit language-configuration@ (define-unit language-configuration@
@ -1105,55 +1107,86 @@
[else #f]))))) [else #f])))))
(define (add-discussion p) (define (add-discussion p)
(let* ([t (new text:standard-style-list%)] (define t (new (text:hide-caret/selection-mixin text:standard-style-list%)))
[c (new editor-canvas% (define c (new editor-canvas%
[stretchable-width #t] [stretchable-width #t]
[horizontal-inset 0] [horizontal-inset 0]
[vertical-inset 0] [vertical-inset 0]
[parent p] [parent p]
[style '(no-border no-vscroll no-hscroll transparent)] [style '(no-border no-vscroll no-hscroll transparent)]
[editor t])]) [editor t]))
(send t set-styles-sticky #f) (send t set-styles-sticky #f)
(send t set-autowrap-bitmap #f) (send t set-autowrap-bitmap #f)
(let* ([size-sd (make-object style-delta% 'change-size (send normal-control-font get-point-size))] (define size-sd (make-object style-delta% 'change-size (send normal-control-font get-point-size)))
[do-insert (define (do-insert str tt-style?)
(λ (str tt-style?) (define before (send t last-position))
(let ([before (send t last-position)]) (send t insert str before before)
(send t insert str before before) (cond
(cond [tt-style?
[tt-style? (send t change-style
(send t change-style (send (send t get-style-list) find-named-style "Standard")
(send (send t get-style-list) find-named-style "Standard") before (send t last-position))]
before (send t last-position))] [else
[else (send t change-style
(send t change-style (send (send t get-style-list) basic-style)
(send (send t get-style-list) basic-style) before (send t last-position))])
before (send t last-position))]) (send t change-style size-sd before (send t last-position)))
(send t change-style size-sd before (send t last-position))))]) (when (send normal-control-font get-size-in-pixels)
(when (send normal-control-font get-size-in-pixels) (send size-sd set-size-in-pixels-on #t))
(send size-sd set-size-in-pixels-on #t)) (let loop ([strs (regexp-split #rx"#lang" (string-constant racket-language-discussion))])
(let loop ([strs (regexp-split #rx"#lang" sc-lang-in-source-discussion)]) (do-insert (car strs) #f)
(do-insert (car strs) #f) (unless (null? (cdr strs))
(unless (null? (cdr strs)) (do-insert "#lang" #t)
(do-insert "#lang" #t) (loop (cdr strs))))
(loop (cdr strs)))))
(send t hide-caret #t) (define xref-chan (make-channel))
(thread
(send t auto-wrap #t) (λ ()
(send t lock #t) (define xref (load-collections-xref))
(send c accept-tab-focus #f) (let loop ()
(send c allow-tab-exit #t) (channel-put xref-chan xref)
c)) (loop))))
(for ([lang (in-list '(racket typed/racket scribble/base))])
(do-insert (format " #lang ~a" lang) #t)
(do-insert " [" #f)
(define before (send t last-position))
(do-insert "docs" #f)
(define after (send t last-position))
(do-insert "]\n" #f)
(send t set-clickback before after
(λ (t start end)
(define-values (path tag) (xref-tag->path+anchor (channel-get xref-chan) `(mod-path ,(symbol->string lang))))
(define url (path->url path))
(define url2 (if tag
(make-url (url-scheme url)
(url-user url)
(url-host url)
(url-port url)
(url-path-absolute? url)
(url-path url)
(url-query url)
tag)
url))
(send-url (url->string url2)))))
(define kmp (send t set-keymap (keymap:get-editor)))
(send t hide-caret #t)
(send t auto-wrap #t)
(send t lock #t)
(send c accept-tab-focus #f)
(send c allow-tab-exit #t)
c)
(define (size-discussion-canvas canvas) (define (size-discussion-canvas canvas)
(let ([t (send canvas get-editor)]) (define t (send canvas get-editor))
(define by (box 0))
(let ([by (box 0)]) (send t position-location
(send t position-location (send t line-end-position (send t last-line))
(send t line-end-position (send t last-line)) #f
#f by)
by) (send canvas min-height (+ (ceiling (inexact->exact (unbox by))) 24)))
(send canvas min-height (+ (ceiling (inexact->exact (unbox by))) 24)))))
(define section-style-delta (make-object style-delta% 'change-bold)) (define section-style-delta (make-object style-delta% 'change-bold))
(send section-style-delta set-delta-foreground "medium blue") (send section-style-delta set-delta-foreground "medium blue")

9
collects/string-constants/private/english-string-constants.rkt
View File

@ -1160,10 +1160,13 @@ please adhere to these guidelines:
(module-language-auto-text "Automatic #lang line") ;; shows up in the details section of the module language (module-language-auto-text "Automatic #lang line") ;; shows up in the details section of the module language
;; for the upper portion of the language dialog ;; for the upper portion of the language dialog
(use-language-in-source "Use the language declared in the source") (the-racket-language "The Racket Language")
(choose-a-language "Choose a language") (choose-a-language "Choose a language")
(lang-in-source-discussion (racket-language-discussion
"The #lang line at the start of a program declares its language. This is the default and preferred mode for DrRacket.") "Start your program with #lang to specify the desired dialect. For example:\n\n")
;; for the 'new drracket user' dialog
(use-language-in-source "Use the language declared in the source")
;;; from the `not a language language' used initially in drscheme. ;;; from the `not a language language' used initially in drscheme.
(must-choose-language "DrRacket cannot process programs until you choose a programming language.") (must-choose-language "DrRacket cannot process programs until you choose a programming language.")