diff --git a/collects/drracket/private/unit.rkt b/collects/drracket/private/unit.rkt index 531c2a79c2..ff511d919d 100644 --- a/collects/drracket/private/unit.rkt +++ b/collects/drracket/private/unit.rkt @@ -542,7 +542,8 @@ module browser threading seems wrong. (drracket:rep:drs-autocomplete-mixin (λ (x) x) (text:normalize-paste-mixin - text:info%)))))))))))]) + (text:column-guide-mixin + text:info%))))))))))))]) ((get-program-editor-mixin) (class* definitions-super% (drracket:unit:definitions-text<%>) (inherit get-top-level-window is-locked? lock while-unlocked highlight-first-line @@ -3414,6 +3415,23 @@ module browser threading seems wrong. (show-line-numbers! (not value)))])) (set-show-menu-sort-key show-line-numbers-menu-item 302) + (define show-column-guide-menu-item + (new menu:can-restore-menu-item% + [label ""] + [parent (get-show-menu)] + [demand-callback (λ (itm) + (define pv (preferences:get 'framework:column-guide-width)) + (send itm set-label + (format (if (car pv) + (string-constant hide-column-width-guide) + (string-constant show-column-width-guide)) + (cadr pv))))] + [callback (λ (self evt) + (define ov (preferences:get 'framework:column-guide-width)) + (preferences:set 'framework:column-guide-width + (list (not (car ov)) (cadr ov))))])) + (set-show-menu-sort-key show-column-guide-menu-item 303) + (let () (define (font-adjust adj label key shortcut) (define (adj-font _1 _2) diff --git a/collects/framework/private/main.rkt b/collects/framework/private/main.rkt index 2ff22aecbc..059c763005 100644 --- a/collects/framework/private/main.rkt +++ b/collects/framework/private/main.rkt @@ -24,6 +24,10 @@ (application-preferences-handler (λ () (preferences:show-dialog))) +(preferences:set-default 'framework:column-guide-width + '(#f 102) + (list/c boolean? (and/c exact-integer? (>=/c 2)))) + (preferences:set-default 'framework:aspell-dict #f (λ (x) (or (not x) (string? x)))) (preferences:set-default 'framework:line-spacing-add-gap? diff --git a/collects/framework/private/preferences.rkt b/collects/framework/private/preferences.rkt index f2fc02596a..2b38e75313 100644 --- a/collects/framework/private/preferences.rkt +++ b/collects/framework/private/preferences.rkt @@ -494,6 +494,50 @@ the state transitions / contracts are: (add-check editor-panel 'framework:line-spacing-add-gap? (string-constant add-spacing-between-lines)) + + (let ([hp (new horizontal-panel% [parent editor-panel] [stretchable-height #f])] + [init-pref (preferences:get 'framework:column-guide-width)]) + (define on-cb + (new check-box% + [parent hp] + [label (string-constant maximum-char-width-guide-pref-check-box)] + [value (car init-pref)] + [callback + (λ (x y) + (update-pref) + (update-tf-bkg) + (send tf enable (send on-cb get-value)))])) + (define tf + (new text-field% + [label #f] + [parent hp] + [init-value (format "~a" (cadr init-pref))] + [callback + (λ (x y) + (update-pref) + (update-tf-bkg))])) + (define (update-tf-bkg) + (send tf set-field-background + (send the-color-database find-color + (cond + [(not (send on-cb get-value)) "gray"] + [(good-val? (string->number (send tf get-value))) + "white"] + [else + "yellow"])))) + (define (good-val? n) + (and (exact-integer? n) + (>= n 2))) + (define (update-pref) + (define current (preferences:get 'framework:column-guide-width)) + (define candidate-num (string->number (send tf get-value))) + (preferences:set 'framework:column-guide-width + (list (send on-cb get-value) + (if (good-val? candidate-num) + candidate-num + (cadr current))))) + (update-tf-bkg)) + (editor-panel-procs editor-panel))))]) (add-editor-checkbox-panel))) diff --git a/collects/framework/private/sig.rkt b/collects/framework/private/sig.rkt index f75d722ede..0c156b6d6f 100644 --- a/collects/framework/private/sig.rkt +++ b/collects/framework/private/sig.rkt @@ -187,6 +187,7 @@ foreground-color<%> hide-caret/selection<%> nbsp->space<%> + column-guide<%> normalize-paste<%> delegate<%> wide-snip<%> @@ -227,6 +228,7 @@ foreground-color-mixin hide-caret/selection-mixin nbsp->space-mixin + column-guide-mixin normalize-paste-mixin wide-snip-mixin delegate-mixin diff --git a/collects/framework/private/text.rkt b/collects/framework/private/text.rkt index c88f06fad9..8c49dc58fa 100644 --- a/collects/framework/private/text.rkt +++ b/collects/framework/private/text.rkt @@ -883,6 +883,100 @@ (inner (void) after-insert start len)) (super-new))) +(define column-guide<%> (interface ((class->interface text%)))) +(define column-guide-mixin-pen-size 2) +(define column-guide-mixin + (mixin ((class->interface text%)) (column-guide<%>) + (inherit get-style-list invalidate-bitmap-cache get-dc + begin-edit-sequence end-edit-sequence + get-extent get-padding) + (define char-width #f) + (define pen #f) + ;; these two functions are defined as private fields + ;; because they are weakly held callbacks + (define (bw-cb p v) + (set! pen + (send the-pen-list find-or-create-pen + (if v + (make-object color% 225 225 51) + (make-object color% 204 204 51)) + (* column-guide-mixin-pen-size 2) + 'solid))) + (define (cw-cb p v) + (define new-cw (and (car v) (cadr v))) + (unless (equal? new-cw char-width) + (define (inv cw) + (define x-pos (get-x-spot cw)) + (when x-pos + (invalidate-bitmap-cache + (- x-pos (send pen get-width)) + 0 + (+ x-pos (send pen get-width)) + 'end))) + (define old-char-w char-width) + (set! char-width new-cw) + (begin-edit-sequence) + (inv old-char-w) + (inv char-width) + (end-edit-sequence))) + + (super-new) + + (preferences:add-callback 'framework:white-on-black? bw-cb #t) + (bw-cb 'ignored-arg (preferences:get 'framework:white-on-black?)) + + (preferences:add-callback 'framework:column-guide-width cw-cb #t) + (cw-cb 'ignored-arg (preferences:get 'framework:column-guide-width)) + + (define aw (box 0.0)) + (define ah (box 0.0)) + (define left-padding 0) + + (define/augment (on-change) + (inner (void) on-change) + (define old-aw (unbox aw)) + (define old-ah (unbox ah)) + (get-extent aw ah) + (define-values (left top right bottom) (get-padding)) + (unless (and (= old-aw (unbox aw)) + (= old-ah (unbox ah)) + (= left left-padding)) + (set! left-padding left) + (invalidate-bitmap-cache))) + + (define/override (on-paint before? dc left top right bottom dx dy draw-caret) + (super on-paint before? dc left top right bottom dx dy draw-caret) + (when char-width + (when before? + (define x-pos (get-x-spot char-width)) + (when x-pos + (define old-pen (send dc get-pen)) + (send dc set-pen pen) + (when (< x-pos (- (unbox aw) 3)) + (send dc draw-line + (+ dx x-pos) + (+ dy top column-guide-mixin-pen-size) + (+ dx x-pos) + (+ dy (min (unbox ah) bottom) (- column-guide-mixin-pen-size)))) + (send dc set-pen old-pen))))) + + (define/private (get-x-spot char-width) + (cond + [char-width + (define dc (get-dc)) + (cond + [dc + (define style (or (send (get-style-list) find-named-style "Standard") + (send (get-style-list) find-named-style "Basic"))) + (cond + [style + (define fnt (send style get-font)) + (define-values (xw _1 _2 _3) (send dc get-text-extent "x" fnt)) + (+ left-padding (* xw char-width))] + [else #f])] + [else #f])] + [else #f])))) + (define normalize-paste<%> (interface ((class->interface text%)) ask-normalize? string-normalize)) diff --git a/collects/scribblings/drracket/menus.scrbl b/collects/scribblings/drracket/menus.scrbl index 216d4db4e5..520ca8468c 100644 --- a/collects/scribblings/drracket/menus.scrbl +++ b/collects/scribblings/drracket/menus.scrbl @@ -250,7 +250,21 @@ appears at any time. @item{@defmenuitem{Hide Line Numbers} Hides the line numbers in the definitions window.} - + + @item{@defmenuitem{Show Column Width Guide at 102 Characters} + Shows the column width guide when the current file's width + is greater than 102 characters. + + The number 102 is controlled in the @onscreen{General} + tab of the @onscreen{Editing} tab in the preferences dialog.} + @item{@defmenuitem{Hide Column Width Guide for 102 Characters} + Hides the column width guide, even with the file's width + is greater than 102 characters. + + The number 102 is controlled in the @onscreen{General} + tab of the @onscreen{Editing} tab in the preferences dialog.} + + @item{@defmenuitem{Show Module Browser} Shows the module DAG rooted at the currently opened file in DrRacket. diff --git a/collects/scribblings/drracket/prefs.scrbl b/collects/scribblings/drracket/prefs.scrbl index e9f5c7e9fa..005918d2d1 100644 --- a/collects/scribblings/drracket/prefs.scrbl +++ b/collects/scribblings/drracket/prefs.scrbl @@ -88,7 +88,7 @@ The @onscreen{Editing} panel consists of several sub-panels: @item{@PrefItem{Add one pixel of extra space between lines} --- If checked, then an extra pixel of whitespace is added between lines in the editor. The default value is platform-specific; - some fonts (notably those with ╔══╗ characters) only look right with + some fonts (notably those with @tt{╔══╗} characters) only look right with this unchecked.} @item{@PrefItem{Always use the platform-specific linefeed convention} --- If checked, DrRacket always saves files with CRLF line terminators. @@ -102,13 +102,16 @@ The @onscreen{Editing} panel consists of several sub-panels: This option is only available under Windows. On other operating systems, all files are always saved with LF line terminators.} + @item{@PrefItem{Maximum character width guide} --- If checked, DrRacket + draws a vertical line in files that exceed the given maximum + width. The vertical line shows where the given maximum width is.} @item{@PrefItem{Show line numbers} --- If checked, DrRacket shows line numbers for the file being edited in the left-hand column} @item{@PrefItem{Show definitions/interactions labels} --- If checked, then the teaching languages show big friendly labels indicating which window is the definitions window and which is the interactions - window.]} + window.]}]} @item{@onscreen{Racket} diff --git a/collects/string-constants/private/english-string-constants.rkt b/collects/string-constants/private/english-string-constants.rkt index a7bc57d31c..4d395a7290 100644 --- a/collects/string-constants/private/english-string-constants.rkt +++ b/collects/string-constants/private/english-string-constants.rkt @@ -541,6 +541,9 @@ please adhere to these guidelines: (show-line-numbers-in-definitions "Show All Line Numbers in Definitions") ;; the constant above shows up in the popup menu item in the bottom of ;; the drracket window; controls the line numbers on each line in the definitions; used in a checkable menu item + (maximum-char-width-guide-pref-check-box "Maximum character width guide") + (hide-column-width-guide "Hide Column Width Guide for Files with ~a Columns") + (show-column-width-guide "Show Column Width Guide at ~a Columns") ;; filled with a number > 2 (limit-interactions-size "Limit interactions size") (background-color "Background Color") (default-text-color "Default text") ;; used for configuring colors, but doesn't need the word "color"