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

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

Browse Source
This commit is contained in:
Robby Findler 2013-06-10 22:50:46 -05:00
parent 2b745a914e
commit 09d636c545
8 changed files with 186 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/drracket/private/unit.rkt
View File

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

4
collects/framework/private/main.rkt
View File

@ -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?

44
collects/framework/private/preferences.rkt
View File

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

2
collects/framework/private/sig.rkt
View File

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

94
collects/framework/private/text.rkt
View File

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

16
collects/scribblings/drracket/menus.scrbl
View File

@ -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.

7
collects/scribblings/drracket/prefs.scrbl
View File

@ -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}

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

@ -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"