add a column-width guide; defaults to 102 characters, but disabled

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)

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?

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)))
   

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

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))

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.
    

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}
 

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"