diff --git a/collects/drscheme/private/syntax-browser.ss b/collects/drscheme/private/syntax-browser.ss index ac1a007e..624466f8 100644 --- a/collects/drscheme/private/syntax-browser.ss +++ b/collects/drscheme/private/syntax-browser.ss @@ -80,18 +80,18 @@ needed to really make this work: (send text last-position))) (let ([range-pretty-print-pre-hook - (lambda (x v) + (λ (x v) (hash-table-put! range-start-ht x (send output-text last-position)))] [range-pretty-print-post-hook - (lambda (x port) - (let ([range-start (hash-table-get range-start-ht x (lambda () #f))]) + (λ (x port) + (let ([range-start (hash-table-get range-start-ht x (λ () #f))]) (when range-start (hash-table-put! range-ht x (cons (cons range-start (send output-text last-position)) - (hash-table-get range-ht x (lambda () null)))))))]) + (hash-table-get range-ht x (λ () null)))))))]) (parameterize ([current-output-port output-port] [pretty-print-pre-print-hook range-pretty-print-pre-hook] [pretty-print-post-print-hook range-pretty-print-post-hook] @@ -116,7 +116,7 @@ needed to really make this work: (unless (null? properties) (insert/big "Known properties\n") (for-each - (lambda (prop) (show-property stx prop)) + (λ (prop) (show-property stx prop)) properties)))) (define/private (render-mpi mpi) @@ -140,7 +140,7 @@ needed to really make this work: (define/private (piece-of-info label info) (let ([small-newline - (lambda (port text) + (λ (port text) (let ([before-newline (send text last-position)]) (newline port) (send info-text change-style small-style before-newline (+ before-newline 1))))]) @@ -152,12 +152,12 @@ needed to really make this work: ;; but won't work without built-in support for ;; editors as output ports (parameterize ([pretty-print-size-hook - (lambda (val d/p port) + (λ (val d/p port) (if (is-a? val syntax-snip%) (+ (string-length (format "~a" (send val get-syntax))) 2) #f))] [pretty-print-print-hook - (lambda (val d/p port) + (λ (val d/p port) (send info-text insert (send val copy) (send info-text last-position) (send info-text last-position)))]) @@ -276,28 +276,28 @@ needed to really make this work: (apply append (hash-table-map range-ht - (lambda (k vs) + (λ (k vs) (map - (lambda (v) (make-range k (car v) (cdr v))) + (λ (v) (make-range k (car v) (cdr v))) vs)))) - (lambda (x y) + (λ (x y) (>= (- (range-end x) (range-start x)) (- (range-end y) (range-start y)))))]) (for-each - (lambda (range) + (λ (range) (let* ([obj (range-obj range)] - [stx (hash-table-get stx-ht obj (lambda () #f))] + [stx (hash-table-get stx-ht obj (λ () #f))] [start (range-start range)] [end (range-end range)]) (when (syntax? stx) (send output-text set-clickback start end - (lambda (_1 _2 _3) + (λ (_1 _2 _3) (show-range stx start end)))))) ranges) (send outer-t insert (new turn-snip% - [on-up (lambda () (hide-details))] - [on-down (lambda () (show-details))])) + [on-up (λ () (hide-details))] + [on-down (λ () (show-details))])) (send outer-t insert (format "~s\n" main-stx)) (send outer-t insert inner-es) (make-modern outer-t) @@ -323,7 +323,7 @@ needed to really make this work: (k (void))) (let* ([rng (car ranges)] [obj (hash-table-get stx-ht (range-obj rng) - (lambda () + (λ () (k (void))))]) (show-range obj (range-start rng) (range-end rng))))) @@ -478,7 +478,7 @@ needed to really make this work: ht))) (define (syntax-properties stx) - (let ([is-property? (lambda (prop) (syntax-property stx prop))]) + (let ([is-property? (λ (prop) (syntax-property stx prop))]) (filter is-property? '(inferred-name bound-in-source @@ -497,7 +497,7 @@ needed to really make this work: (define (make-text-port text) (make-output-port #f always-evt - (lambda (s start end flush? breaks?) + (λ (s start end flush? breaks?) (send text insert (bytes->string/utf-8 (subbytes s start end)) (send text last-position) (send text last-position)) @@ -517,7 +517,7 @@ needed to really make this work: (span ,(syntax-span stx)) (original? ,(syntax-original? stx)) (properties - ,@(map (lambda (x) `(,x ,(marshall-object (syntax-property stx x)))) + ,@(map (λ (x) `(,x ,(marshall-object (syntax-property stx x)))) (syntax-property-symbol-keys stx))) (contents ,(marshall-object (syntax-e stx))))) @@ -573,7 +573,7 @@ needed to really make this work: [else stx])) (define (unmarshall-object obj) - (let ([unknown (lambda () (string->symbol (format "unknown: ~s" obj)))]) + (let ([unknown (λ () (string->symbol (format "unknown: ~s" obj)))]) (if (and (pair? obj) (symbol? (car obj))) (case (car obj) diff --git a/collects/framework/collapsed-snipclass.ss b/collects/framework/collapsed-snipclass.ss index bef8c03d..4029fd72 100644 --- a/collects/framework/collapsed-snipclass.ss +++ b/collects/framework/collapsed-snipclass.ss @@ -11,7 +11,7 @@ (define/public (read-special file line col pos) (let ([text (make-object text%)]) (for-each - (lambda (s) (send text insert (send s copy) + (λ (s) (send text insert (send s copy) (send text last-position) (send text last-position))) saved-snips) diff --git a/collects/framework/decorated-editor-snip.ss b/collects/framework/decorated-editor-snip.ss index d68b7ee4..61e8864a 100644 --- a/collects/framework/decorated-editor-snip.ss +++ b/collects/framework/decorated-editor-snip.ss @@ -188,7 +188,7 @@ (define/public (make-editor) (make-object text%)) (define/override write - (lambda (stream-out) + (λ (stream-out) (send (get-editor) write-to-file stream-out 0 'eof))) (define/override (copy) diff --git a/collects/framework/framework.ss b/collects/framework/framework.ss index e1ca90b8..397b999c 100644 --- a/collects/framework/framework.ss +++ b/collects/framework/framework.ss @@ -232,9 +232,9 @@ ((union string? (cons/c string? (listof string?))) ((is-a?/c area-container-window<%>) . ->d . - (lambda (parent) - (let ([children (map (lambda (x) x) (send parent get-children))]) - (lambda (child) + (λ (parent) + (let ([children (map (λ (x) x) (send parent get-children))]) + (λ (child) (and (is-a? child area-container-window<%>) (andmap eq? (append children (list child)) @@ -747,7 +747,7 @@ ((-> (is-a?/c frame:editor<%>))) (union false/c (is-a?/c frame:editor<%>))) ((filename) - ((make-default (lambda () ((handler:current-create-new-window) filename))))) + ((make-default (λ () ((handler:current-create-new-window) filename))))) "This function creates a frame or re-uses an existing frame to edit a file. " "" "If the preference \\scheme{'framework:open-here} is set to \\scheme{#t}," @@ -797,7 +797,7 @@ "" "The default setting is this:" "\\begin{schemedisplay}" - "(lambda (filename)" + "(λ (filename)" " (let ([frame (make-object frame:text-info-file% filename)])" " (send frame show #t)" " frame))" diff --git a/collects/framework/gui-utils.ss b/collects/framework/gui-utils.ss index 6334c2bc..e8e058c3 100644 --- a/collects/framework/gui-utils.ss +++ b/collects/framework/gui-utils.ss @@ -17,9 +17,9 @@ (string? (and/c number? positive?) . ->d . - (lambda (str size) + (λ (str size) (and/c string? - (lambda (str) + (λ (str) ((string-length str) . <= . size))))) (str size) "Constructs a string whose size is less" @@ -116,8 +116,8 @@ "(let ([close-down" " (gui-utils:delay-action" " 2" - " (lambda () .. init watch cursor ...)" - " (lambda () .. close watch cursor ...))])" + " (λ () .. init watch cursor ...)" + " (λ () .. close watch cursor ...))])" " ;; .. do action ..." " (close-down))" "\\end{schemedisplay}" @@ -331,13 +331,13 @@ cancel-callback [confirm-str (string-constant ok)] [cancel-str (string-constant cancel)]) - (let ([confirm (lambda () + (let ([confirm (λ () (instantiate button% () (parent parent) (callback confirm-callback) (label confirm-str) (style '(border))))] - [cancel (lambda () + [cancel (λ () (instantiate button% () (parent parent) (callback cancel-callback) @@ -366,7 +366,7 @@ (define next-untitled-name (let ([n 1]) - (lambda () + (λ () (begin0 (cond [(= n 1) (string-constant untitled)] @@ -384,19 +384,19 @@ (local-busy-cursor #f thunk delay))) (define delay-action - (lambda (delay-time open close) + (λ (delay-time open close) (let ([semaphore (make-semaphore 1)] [open? #f] [skip-it? #f]) (thread - (lambda () + (λ () (sleep delay-time) (semaphore-wait semaphore) (unless skip-it? (set! open? #t) (open)) (semaphore-post semaphore))) - (lambda () + (λ () (semaphore-wait semaphore) (set! skip-it? #t) (when open? @@ -411,21 +411,21 @@ (let* ([old-cursor #f] [cursor-off void]) (dynamic-wind - (lambda () + (λ () (set! cursor-off (delay-action delay - (lambda () + (λ () (if win (begin (set! old-cursor (send win get-cursor)) (send win set-cursor watch)) (begin-busy-cursor))) - (lambda () + (λ () (if win (send win set-cursor old-cursor) (end-busy-cursor)))))) - (lambda () (thunk)) - (lambda () (cursor-off))))]))) + (λ () (thunk)) + (λ () (cursor-off))))]))) (define unsaved-warning (opt-lambda (filename action-anyway (can-save-now? #f) (parent #f)) diff --git a/collects/framework/keybinding-lang.ss b/collects/framework/keybinding-lang.ss index 2099114a..52492b32 100644 --- a/collects/framework/keybinding-lang.ss +++ b/collects/framework/keybinding-lang.ss @@ -31,16 +31,16 @@ (format "~a:~a.~a" src line col) (format "~a:~a" src pos))]) (send #%keymap add-function name - (lambda (x y) + (λ (x y) (let ([end-edit-sequence - (lambda () + (λ () (when (is-a? x editor<%>) (let loop () (when (send x in-edit-sequence?) (send x end-edit-sequence) (loop)))))]) (with-handlers ([exn:fail? - (lambda (x) + (λ (x) (end-edit-sequence) (message-box (string-constant drscheme) (format (string-constant user-defined-keybinding-error) diff --git a/collects/framework/private/application.ss b/collects/framework/private/application.ss index 59ffad44..da32f122 100644 --- a/collects/framework/private/application.ss +++ b/collects/framework/private/application.ss @@ -11,7 +11,7 @@ (define current-app-name (make-parameter "MrEd" - (lambda (x) + (λ (x) (unless (string? x) (error 'current-app-name "the app name must be a string")) diff --git a/collects/framework/private/autosave.ss b/collects/framework/private/autosave.ss index 0a62818f..01513a13 100644 --- a/collects/framework/private/autosave.ss +++ b/collects/framework/private/autosave.ss @@ -57,7 +57,7 @@ (when (file-exists? autosave-toc-filename) (copy-file autosave-toc-filename autosave-toc-save-filename)) (call-with-output-file autosave-toc-filename - (lambda (port) + (λ (port) (write new-name-mapping port)) 'truncate 'text)))) @@ -115,13 +115,13 @@ (define (main) (when (file-exists? autosave-toc-filename) ;; Load table from file, and check that the file was not corrupted - (let* ([table (let ([v (with-handlers ([exn:fail? (lambda (x) null)]) + (let* ([table (let ([v (with-handlers ([exn:fail? (λ (x) null)]) (call-with-input-file autosave-toc-filename read))] - [path? (lambda (x) + [path? (λ (x) (and (string? x) (absolute-path? x)))]) (if (and (list? v) - (andmap (lambda (i) + (andmap (λ (i) (and (list? i) (= 2 (length i)) (or (not (car i)) @@ -132,7 +132,7 @@ null))] ;; assume that the autosave file was deleted due to the file being saved [filtered-table - (filter (lambda (x) (file-exists? (cadr x))) table)]) + (filter (λ (x) (file-exists? (cadr x))) table)]) (unless (null? filtered-table) (let* ([f (new final-frame% (label (string-constant recover-autosave-files-frame-title)))] @@ -155,7 +155,7 @@ (make-object button% (string-constant autosave-done) vp - (lambda (x y) + (λ (x y) (when (send f can-close?) (send f on-close) (send f show #f)))) @@ -181,7 +181,7 @@ ;; -> void ;; adds in a line to the overview table showing this pair of files. (define (add-table-line area-container parent) - (lambda (table-entry) + (λ (table-entry) (letrec ([orig-file (car table-entry)] [backup-file (cadr table-entry)] [hp (new horizontal-panel% @@ -210,13 +210,13 @@ (parent msg2-panel))] [details (make-object button% (string-constant autosave-details) hp - (lambda (x y) + (λ (x y) (show-files table-entry)))] [delete (make-object button% (string-constant autosave-delete-button) hp - (lambda (delete y) + (λ (delete y) (when (delete-autosave table-entry) (disable-line) (send msg2 set-label (string-constant autosave-deleted)))))] @@ -224,14 +224,14 @@ (make-object button% (string-constant autosave-recover) hp - (lambda (recover y) + (λ (recover y) (let ([filename-result (recover-file parent table-entry)]) (when filename-result (disable-line) (send msg2 set-label (string-constant autosave-recovered!)) (send msg1 set-label filename-result)))))] [disable-line - (lambda () + (λ () (send recover enable #f) (send details enable #f) (send delete enable #f))]) @@ -252,7 +252,7 @@ (string-constant warning) #f) (with-handlers ([exn:fail? - (lambda (exn) + (λ (exn) (message-box (string-constant warning) (format (string-constant autosave-error-deleting) diff --git a/collects/framework/private/canvas.ss b/collects/framework/private/canvas.ss index 3c319e6d..47592938 100644 --- a/collects/framework/private/canvas.ss +++ b/collects/framework/private/canvas.ss @@ -25,7 +25,7 @@ (define color-mixin (mixin (basic<%>) (color<%>) - (define callback (lambda (p v) (set-canvas-background v))) + (define callback (λ (p v) (set-canvas-background v))) (super-new) (inherit set-canvas-background) (set-canvas-background (preferences:get 'framework:basic-canvas-background)) @@ -89,12 +89,12 @@ [get-width (let ([bl (box 0)] [br (box 0)]) - (lambda (s) + (λ (s) (send edit get-snip-location s bl #f #f) (send edit get-snip-location s br #f #t) (- (unbox br) (unbox bl))))] [calc-after-width - (lambda (s) + (λ (s) (+ 4 ;; this is compensate for an autowrapping bug (let loop ([s s]) (cond @@ -110,7 +110,7 @@ (when edit (send edit run-after-edit-sequence - (lambda () + (λ () (let ([admin (send edit get-admin)]) (send admin get-view #f #f width height) (send s get-margin leftm topm rightm bottomm) @@ -121,7 +121,7 @@ ;; edge is zero. Special case for efficiency in the ;; console printer (let ([fallback - (lambda () + (λ () (send edit get-snip-location s left-edge-box top-edge-box))]) (cond diff --git a/collects/framework/private/color-model.ss b/collects/framework/private/color-model.ss index 8c3be1db..df0d4ddd 100644 --- a/collects/framework/private/color-model.ss +++ b/collects/framework/private/color-model.ss @@ -127,8 +127,8 @@ (when (not (= width-a height-b)) (error 'matrix-multiply "matrix dimensions do not match for multiplication")) (let ([b-t (transpose b)]) - (map (lambda (row) - (map (lambda (col) + (map (λ (row) + (map (λ (col) (inner-product row col)) b-t)) a)))) @@ -201,8 +201,8 @@ ;; (matrix-multiply pre-matrix `((,sigma-r) (,sigma-g) (,sigma-b)))) (define rgb->xyz-matrix - (map (lambda (row) - (map (lambda (row-elt scalar) (* row-elt scalar 1/255)) row `(,sigma-r ,sigma-g ,sigma-b))) + (map (λ (row) + (map (λ (row-elt scalar) (* row-elt scalar 1/255)) row `(,sigma-r ,sigma-g ,sigma-b))) pre-matrix)) (define xyz->rgb-matrix diff --git a/collects/framework/private/color-prefs.ss b/collects/framework/private/color-prefs.ss index 51a9daab..41c93bc2 100644 --- a/collects/framework/private/color-prefs.ss +++ b/collects/framework/private/color-prefs.ss @@ -29,7 +29,7 @@ style-name example-text [update-style-delta - (lambda (func) + (λ (func) (let ([delta (preferences:get pref-sym)]) (func delta) (preferences:set pref-sym delta)))]) @@ -53,7 +53,7 @@ hide-vscroll)))) (define (make-check name on off) - (let* ([c (lambda (check command) + (let* ([c (λ (check command) (if (send check get-value) (update-style-delta on) (update-style-delta off)))] @@ -62,26 +62,26 @@ (define slant-check (make-check (string-constant cs-italic) - (lambda (delta) + (λ (delta) (send delta set-style-on 'slant) (send delta set-style-off 'base)) - (lambda (delta) + (λ (delta) (send delta set-style-on 'base) (send delta set-style-off 'slant)))) (define bold-check (make-check (string-constant cs-bold) - (lambda (delta) + (λ (delta) (send delta set-weight-on 'bold) (send delta set-weight-off 'base)) - (lambda (delta) + (λ (delta) (send delta set-weight-on 'base) (send delta set-weight-off 'bold)))) (define underline-check (make-check (string-constant cs-underline) - (lambda (delta) + (λ (delta) (send delta set-underlined-on #t) (send delta set-underlined-off #f)) - (lambda (delta) + (λ (delta) (send delta set-underlined-off #t) (send delta set-underlined-on #f)))) (define color-button @@ -89,7 +89,7 @@ (make-object button% (string-constant cs-change-color) hp - (lambda (color-button evt) + (λ (color-button evt) (let* ([add (send (preferences:get pref-sym) get-foreground-add)] [color (make-object color% (send add get-r) @@ -102,7 +102,7 @@ color)]) (when users-choice (update-style-delta - (lambda (delta) + (λ (delta) (send delta set-delta-foreground users-choice))))))))) (define style (send (send e get-style-list) find-named-style style-name)) @@ -127,52 +127,52 @@ (map unbox (list b1 b2 b3)))) (define style-delta-get/set - (list (cons (lambda (x) (send x get-alignment-off)) - (lambda (x v) (send x set-alignment-off v))) - (cons (lambda (x) (send x get-alignment-on)) - (lambda (x v) (send x set-alignment-on v))) - (cons (lambda (x) (add/mult-get (send x get-background-add))) - (lambda (x v) (add/mult-set (send x get-background-add) v))) - (cons (lambda (x) (add/mult-get (send x get-background-mult))) - (lambda (x v) (add/mult-set (send x get-background-mult) v))) - (cons (lambda (x) (send x get-face)) - (lambda (x v) (send x set-face v))) - (cons (lambda (x) (send x get-family)) - (lambda (x v) (send x set-family v))) - (cons (lambda (x) (add/mult-get (send x get-foreground-add))) - (lambda (x v) (add/mult-set (send x get-foreground-add) v))) - (cons (lambda (x) (add/mult-get (send x get-foreground-mult))) - (lambda (x v) (add/mult-set (send x get-foreground-mult) v))) - (cons (lambda (x) (send x get-size-add)) - (lambda (x v) (send x set-size-add v))) - (cons (lambda (x) (send x get-size-mult)) - (lambda (x v) (send x set-size-mult v))) - (cons (lambda (x) (send x get-style-off)) - (lambda (x v) (send x set-style-off v))) - (cons (lambda (x) (send x get-style-on)) - (lambda (x v) (send x set-style-on v))) - (cons (lambda (x) (send x get-underlined-off)) - (lambda (x v) (send x set-underlined-off v))) - (cons (lambda (x) (send x get-underlined-on)) - (lambda (x v) (send x set-underlined-on v))) - (cons (lambda (x) (send x get-weight-off)) - (lambda (x v) (send x set-weight-off v))) - (cons (lambda (x) (send x get-weight-on)) - (lambda (x v) (send x set-weight-on v))))) + (list (cons (λ (x) (send x get-alignment-off)) + (λ (x v) (send x set-alignment-off v))) + (cons (λ (x) (send x get-alignment-on)) + (λ (x v) (send x set-alignment-on v))) + (cons (λ (x) (add/mult-get (send x get-background-add))) + (λ (x v) (add/mult-set (send x get-background-add) v))) + (cons (λ (x) (add/mult-get (send x get-background-mult))) + (λ (x v) (add/mult-set (send x get-background-mult) v))) + (cons (λ (x) (send x get-face)) + (λ (x v) (send x set-face v))) + (cons (λ (x) (send x get-family)) + (λ (x v) (send x set-family v))) + (cons (λ (x) (add/mult-get (send x get-foreground-add))) + (λ (x v) (add/mult-set (send x get-foreground-add) v))) + (cons (λ (x) (add/mult-get (send x get-foreground-mult))) + (λ (x v) (add/mult-set (send x get-foreground-mult) v))) + (cons (λ (x) (send x get-size-add)) + (λ (x v) (send x set-size-add v))) + (cons (λ (x) (send x get-size-mult)) + (λ (x v) (send x set-size-mult v))) + (cons (λ (x) (send x get-style-off)) + (λ (x v) (send x set-style-off v))) + (cons (λ (x) (send x get-style-on)) + (λ (x v) (send x set-style-on v))) + (cons (λ (x) (send x get-underlined-off)) + (λ (x v) (send x set-underlined-off v))) + (cons (λ (x) (send x get-underlined-on)) + (λ (x v) (send x set-underlined-on v))) + (cons (λ (x) (send x get-weight-off)) + (λ (x v) (send x set-weight-off v))) + (cons (λ (x) (send x get-weight-on)) + (λ (x v) (send x set-weight-on v))))) (define (marshall-style style) - (map (lambda (fs) ((car fs) style)) style-delta-get/set)) + (map (λ (fs) ((car fs) style)) style-delta-get/set)) (define (unmarshall-style info) (let ([style (make-object style-delta%)]) - (for-each (lambda (fs v) ((cdr fs) style v)) style-delta-get/set info) + (for-each (λ (fs v) ((cdr fs) style v)) style-delta-get/set info) style)) (define (set-default sym code-style) (preferences:set-default sym code-style - (lambda (x) + (λ (x) (is-a? x style-delta%)))) (define (make-style-delta color bold? underline? italic?) @@ -200,7 +200,7 @@ (preferences:add-panel (list (string-constant preferences-colors) (string-constant background-color)) - (lambda (parent) + (λ (parent) (let ([vp (new vertical-panel% (parent parent))]) (add-solid-color-config (string-constant background-color) vp @@ -237,7 +237,7 @@ (make-object button% (string-constant cs-change-color) hp - (lambda (color-button evt) + (λ (color-button evt) (let ([users-choice (get-color-from-user (format sc-choose-color example-text) @@ -261,10 +261,10 @@ (new canvas% (parent hp) (paint-callback - (lambda (c dc) + (λ (c dc) (draw (preferences:get pref-id)))))] [draw - (lambda (clr) + (λ (clr) (let ([dc (send canvas get-dc)]) (let-values ([(w h) (send canvas get-client-size)]) (send dc set-brush (send the-brush-list find-or-create-brush clr 'solid)) @@ -275,7 +275,7 @@ (label (string-constant cs-change-color)) (parent hp) (callback - (lambda (x y) + (λ (x y) (let ([color (get-color-from-user (string-constant choose-a-background-color) (send hp get-top-level-window) @@ -284,14 +284,14 @@ (preferences:set pref-id color))))))]) (preferences:add-callback pref-id - (lambda (p v) (draw v))) + (λ (p v) (draw v))) panel)) ;; add-to-preferences-panel : string (vertical-panel -> void) -> void (define (add-to-preferences-panel panel-name func) (preferences:add-panel (list (string-constant preferences-colors) panel-name) - (lambda (parent) + (λ (parent) (let ([panel (new vertical-panel% (parent parent))]) (func panel) panel)))) @@ -300,10 +300,10 @@ (define (register-color-pref pref-name style-name color) (let ([sd (new style-delta%)]) (send sd set-delta-foreground color) - (preferences:set-default pref-name sd (lambda (x) (is-a? x style-delta%)))) + (preferences:set-default pref-name sd (λ (x) (is-a? x style-delta%)))) (preferences:set-un/marshall pref-name marshall-style unmarshall-style) (preferences:add-callback pref-name - (lambda (sym v) + (λ (sym v) (editor:set-standard-style-list-delta style-name v))) (editor:set-standard-style-list-delta style-name (preferences:get pref-name)))))) diff --git a/collects/framework/private/color.ss b/collects/framework/private/color.ss index 39e60cd4..05994122 100644 --- a/collects/framework/private/color.ss +++ b/collects/framework/private/color.ss @@ -191,7 +191,7 @@ (color (send (get-style-list) find-named-style style-name)) (sp (+ in-start-pos (sub1 new-token-start))) (ep (+ in-start-pos (sub1 new-token-end)))) - (lambda () + (λ () (change-style color sp ep #f))) colors))) ; Using the non-spec version takes 3 times as long as the spec @@ -231,7 +231,7 @@ (+ start-pos orig-token-end change-length))) (set! current-pos (+ start-pos orig-token-start)) (set! up-to-date? #f) - (queue-callback (lambda () (colorer-callback)) #f))) + (queue-callback (λ () (colorer-callback)) #f))) ((>= edit-start-pos invalid-tokens-start) (let-values (((tok-start tok-end valid-tree invalid-tree) (send invalid-tokens split (- edit-start-pos start-pos)))) @@ -259,15 +259,15 @@ #;(printf "new coroutine~n") (set! tok-cor (coroutine - (lambda (enable-suspend) + (λ (enable-suspend) (parameterize ((port-count-lines-enabled #t)) (re-tokenize (open-input-text-editor this current-pos end-pos - (lambda (x) #f)) + (λ (x) #f)) current-pos enable-suspend))))) (set! rev (get-revision-number))) (with-handlers ((exn:fail? - (lambda (exn) + (λ (exn) (parameterize ((print-struct #t)) ((error-display-handler) (format "exception in colorer thread: ~s" exn) @@ -293,7 +293,7 @@ (unless (in-edit-sequence?) (colorer-driver)) (unless up-to-date? - (queue-callback (lambda () (colorer-callback)) #f))))) + (queue-callback (λ () (colorer-callback)) #f))))) ;; Must not be called when the editor is locked (define/private (finish-now) @@ -361,7 +361,7 @@ (begin-edit-sequence #f #f) (finish-now) (send tokens for-each - (lambda (start len type) + (λ (start len type) (when (and should-color? (should-color-type? type)) (let ((color (send (get-style-list) find-named-style (token-sym->style type))) @@ -409,7 +409,7 @@ (= caret-pos (+ start-pos start)))]) (set! clear-old-locations (let ([old clear-old-locations]) - (lambda () + (λ () (old) (off)))))) @@ -619,7 +619,7 @@ (define/public (debug-printout) (let* ((x null) - (f (lambda (a b c) + (f (λ (a b c) (set! x (cons (list a b c) x))))) (send tokens for-each f) (printf "tokens: ~e~n" (reverse x)) @@ -637,7 +637,7 @@ (super lock x) (when (and restart-callback (not x)) (set! restart-callback #f) - (queue-callback (lambda () (colorer-callback))))) + (queue-callback (λ () (colorer-callback))))) (define/override (on-focus on?) @@ -700,7 +700,7 @@ ;; The arguments here are only used to be passed to start-colorer. Refer to its ;; documentation. (init-field (get-token default-lexer) - (token-sym->style (lambda (x) "Standard")) + (token-sym->style (λ (x) "Standard")) (matches null)) (define/override (on-disable-surrogate text) diff --git a/collects/framework/private/comment-box.ss b/collects/framework/private/comment-box.ss index 0f5ad6c5..47fbeade 100644 --- a/collects/framework/private/comment-box.ss +++ b/collects/framework/private/comment-box.ss @@ -74,7 +74,7 @@ (make-object menu-item% (string-constant convert-to-semicolon-comment) menu - (lambda (x y) + (λ (x y) (let ([to-ed (find-containing-editor)]) (when to-ed (let ([this-pos (find-this-position)]) diff --git a/collects/framework/private/editor.ss b/collects/framework/private/editor.ss index 969bc2a4..97b0be3f 100644 --- a/collects/framework/private/editor.ss +++ b/collects/framework/private/editor.ss @@ -67,7 +67,7 @@ internal-filename)) input-filename)]) (with-handlers ([exn:fail? - (lambda (exn) + (λ (exn) (message-box (string-constant error-saving) (string-append @@ -96,7 +96,7 @@ internal-filename)) input-filename)]) (with-handlers ([exn:fail? - (lambda (exn) + (λ (exn) (message-box (string-constant error-loading) (string-append @@ -190,14 +190,14 @@ (loop (send snip-admin get-editor)))] [(send text get-canvas) => - (lambda (canvas) + (λ (canvas) (send canvas get-top-level-window))] [else #f])))) [define edit-sequence-queue null] [define edit-sequence-ht (make-hash-table)] [define in-local-edit-sequence? #f] - [define/public local-edit-sequence? (lambda () in-local-edit-sequence?)] + [define/public local-edit-sequence? (λ () in-local-edit-sequence?)] [define/public run-after-edit-sequence (case-lambda [(t) (run-after-edit-sequence t #f)] @@ -233,46 +233,44 @@ (t)) (void)])] [define/public extend-edit-sequence-queue - (lambda (l ht) - (hash-table-for-each ht (lambda (k t) + (λ (l ht) + (hash-table-for-each ht (λ (k t) (hash-table-put! edit-sequence-ht k t))) (set! edit-sequence-queue (append l edit-sequence-queue)))] - [define/augment on-edit-sequence - (lambda () - (set! in-local-edit-sequence? #t) - (inner (void) on-edit-sequence))] - [define/augment after-edit-sequence - (lambda () - (set! in-local-edit-sequence? #f) - (let ([queue edit-sequence-queue] - [ht edit-sequence-ht] - [find-enclosing-editor - (lambda (editor) - (let ([admin (send editor get-admin)]) - (cond - [(is-a? admin editor-snip-editor-admin<%>) - (send (send (send admin get-snip) get-admin) get-editor)] - [else #f])))]) - (set! edit-sequence-queue null) - (set! edit-sequence-ht (make-hash-table)) - (let loop ([editor (find-enclosing-editor this)]) - (cond - [(and editor - (is-a? editor basic<%>) - (not (send editor local-edit-sequence?))) - (loop (find-enclosing-editor editor))] - [(and editor - (is-a? editor basic<%>)) - (send editor extend-edit-sequence-queue queue ht)] - [else - (hash-table-for-each ht (lambda (k t) (t))) - (for-each (lambda (t) (t)) queue)]))) - (inner (void) after-edit-sequence))] + (define/augment (on-edit-sequence) + (set! in-local-edit-sequence? #t) + (inner (void) on-edit-sequence)) + (define/augment (after-edit-sequence) + (set! in-local-edit-sequence? #f) + (let ([queue edit-sequence-queue] + [ht edit-sequence-ht] + [find-enclosing-editor + (λ (editor) + (let ([admin (send editor get-admin)]) + (cond + [(is-a? admin editor-snip-editor-admin<%>) + (send (send (send admin get-snip) get-admin) get-editor)] + [else #f])))]) + (set! edit-sequence-queue null) + (set! edit-sequence-ht (make-hash-table)) + (let loop ([editor (find-enclosing-editor this)]) + (cond + [(and editor + (is-a? editor basic<%>) + (not (send editor local-edit-sequence?))) + (loop (find-enclosing-editor editor))] + [(and editor + (is-a? editor basic<%>)) + (send editor extend-edit-sequence-queue queue ht)] + [else + (hash-table-for-each ht (λ (k t) (t))) + (for-each (λ (t) (t)) queue)]))) + (inner (void) after-edit-sequence)) [define/override on-new-box - (lambda (type) + (λ (type) (cond [(eq? type 'text) (make-object editor-snip% (make-object text:basic%))] [else (make-object editor-snip% (make-object pasteboard:basic%))]))] @@ -324,19 +322,19 @@ (define (set-font-size size) (update-standard-style - (lambda (scheme-delta) + (λ (scheme-delta) (send scheme-delta set-size-mult 0) (send scheme-delta set-size-add size)))) (define (set-font-name name) (update-standard-style - (lambda (scheme-delta) + (λ (scheme-delta) (send scheme-delta set-delta-face name) (send scheme-delta set-family 'modern)))) (define (set-font-smoothing sym) (update-standard-style - (lambda (scheme-delta) + (λ (scheme-delta) (send scheme-delta set-smoothing-on sym)))) (define (update-standard-style cng-delta) @@ -361,9 +359,9 @@ (set-font-size (preferences:get 'framework:standard-style-list:font-size)) (set-font-name (preferences:get 'framework:standard-style-list:font-name)) (set-font-smoothing (preferences:get 'framework:standard-style-list:smoothing)) - (preferences:add-callback 'framework:standard-style-list:font-size (lambda (p v) (set-font-size v))) - (preferences:add-callback 'framework:standard-style-list:font-name (lambda (p v) (set-font-name v))) - (preferences:add-callback 'framework:standard-style-list:smoothing (lambda (p v) (set-font-smoothing v))) + (preferences:add-callback 'framework:standard-style-list:font-size (λ (p v) (set-font-size v))) + (preferences:add-callback 'framework:standard-style-list:font-name (λ (p v) (set-font-name v))) + (preferences:add-callback 'framework:standard-style-list:smoothing (λ (p v) (set-font-smoothing v))) (unless (member (preferences:get 'framework:standard-style-list:font-name) (get-face-list 'mono)) (preferences:set 'framework:standard-style-list:font-name (get-family-builtin-face 'modern)))) @@ -384,14 +382,14 @@ (define keymap-mixin (mixin (basic<%>) (-keymap<%>) [define/public get-keymaps - (lambda () + (λ () (list (keymap:get-global)))] (inherit set-keymap) (super-instantiate ()) (let ([keymap (make-object keymap:aug-keymap%)]) (set-keymap keymap) - (for-each (lambda (k) (send keymap chain-to-keymap k #f)) + (for-each (λ (k) (send keymap chain-to-keymap k #f)) (get-keymaps))))) (define autowrap<%> (interface (basic<%>))) @@ -420,7 +418,7 @@ [name (if filename (path->string (file-name-from-path (normalize-path filename))) (get-filename/untitled-name))]) - (for-each (lambda (canvas) + (for-each (λ (canvas) (let ([tlw (send canvas get-top-level-window)]) (when (and (is-a? tlw frame:editor<%>) (eq? this (send tlw get-editor))) @@ -501,7 +499,7 @@ (file-old? back-name)) (when (file-exists? back-name) (delete-file back-name)) - (with-handlers ([(lambda (x) #t) void]) + (with-handlers ([(λ (x) #t) void]) (copy-file name back-name))))) (inner (void) on-save-file name format)) (define/augment (on-close) @@ -536,7 +534,7 @@ (when (is-a? this text%) (send this set-file-format 'standard)) (with-handlers ([exn:fail? - (lambda (exn) + (λ (exn) (show-autosave-error exn orig-name) (set! auto-save-error? #t) (when (is-a? this text%) @@ -587,11 +585,11 @@ (super lock x) (run-after-edit-sequence (rec send-frame-update-lock-icon - (lambda () + (λ () (unless callback-running? (set! callback-running? #t) (queue-callback - (lambda () + (λ () (let ([frame (get-top-level-window)]) (when (is-a? frame frame:info<%>) (send frame lock-status-changed))) diff --git a/collects/framework/private/exit.ss b/collects/framework/private/exit.ss index 6a01e0bb..db3efe34 100644 --- a/collects/framework/private/exit.ss +++ b/collects/framework/private/exit.ss @@ -20,9 +20,9 @@ (define on-callbacks '()) (define insert-can?-callback - (lambda (cb) + (λ (cb) (set! can?-callbacks (cons cb can?-callbacks)) - (lambda () + (λ () (set! can?-callbacks (let loop ([cb-list can?-callbacks]) (cond @@ -31,9 +31,9 @@ [else (cons (car cb-list) (loop (cdr cb-list)))])))))) (define insert-on-callback - (lambda (cb) + (λ (cb) (set! on-callbacks (cons cb on-callbacks)) - (lambda () + (λ () (set! on-callbacks (let loop ([cb-list on-callbacks]) (cond @@ -45,8 +45,8 @@ (define (set-exiting b) (set! is-exiting? b)) (define (exiting?) is-exiting?) - (define (can-exit?) (andmap (lambda (cb) (cb)) can?-callbacks)) - (define (on-exit) (for-each (lambda (cb) (cb)) on-callbacks)) + (define (can-exit?) (andmap (λ (cb) (cb)) can?-callbacks)) + (define (on-exit) (for-each (λ (cb) (cb)) on-callbacks)) (define (user-oks-exit) (if (preferences:get 'framework:verify-exit) @@ -68,7 +68,7 @@ [(can-exit?) (on-exit) (queue-callback - (lambda () + (λ () (exit) (set! is-exiting? #f)))] [else diff --git a/collects/framework/private/finder.ss b/collects/framework/private/finder.ss index cbe88566..b6645dfd 100644 --- a/collects/framework/private/finder.ss +++ b/collects/framework/private/finder.ss @@ -25,7 +25,7 @@ (define dialog-parent-parameter (make-parameter #f)) (define filter-match? - (lambda (filter name msg) + (λ (filter name msg) (let-values ([(base name dir?) (split-path name)]) (if (regexp-match-exact? filter (path->bytes name)) #t @@ -37,10 +37,10 @@ (define (get-last-directory) (preferences:get 'framework:last-directory)) (define make-relative - (lambda (s) s)) + (λ (s) s)) (define build-updir - (lambda (dir) + (λ (dir) (let-values ([(base _1 _2) (split-path dir)]) (or base dir)))) @@ -70,10 +70,10 @@ (define current-dir #f) (define/private set-listbox-directory ; sets directory in listbox - (lambda (dir) ; dir is normalized + (λ (dir) ; dir is normalized (when (directory-exists? dir) (gui-utils:show-busy-cursor - (lambda () + (λ () (set! current-dir dir) (set-last-directory dir) (let-values @@ -126,7 +126,7 @@ (send name-list set-selection-and-edit 0)))))) (define/private set-edit - (lambda () + (λ () (let* ([file (send name-list get-string-selection)]) (send directory-field set-value (path->string @@ -135,20 +135,20 @@ current-dir)))))) [define/public do-period-in/exclusion - (lambda (check-box event) + (λ (check-box event) (preferences:set 'framework:show-periods-in-dirlist (send check-box get-value)) (set-listbox-directory current-dir))] [define/public do-dir - (lambda (choice event) + (λ (choice event) (let ([which (send choice get-selection)]) (if (< which (length dirs)) (set-listbox-directory (list-ref dirs which)))))] [define/public do-name-list - (lambda (list-box evt) + (λ (list-box evt) (if (eq? (send evt get-event-type) 'list-box-dclick) (let ([dir (send directory-field get-value)]) (if (directory-exists? dir) @@ -160,10 +160,10 @@ (set-edit))))] [define/public do-result-list - (lambda () #f)] + (λ () #f)] [define/public do-ok - (lambda args + (λ args (if multi-mode? @@ -245,8 +245,8 @@ 'yes)) (let ([normal-path (with-handlers - ([(lambda (_) #t) - (lambda (_) + ([(λ (_) #t) + (λ (_) (message-box (string-constant warning) (format @@ -260,14 +260,14 @@ (show #f))))))))]))))] [define/public add-one - (lambda (name) + (λ (name) (unless (or (directory-exists? name) (send result-list find-string name)) (send result-list append (normal-case-path (normalize-path name)))))] [define/public do-add - (lambda () + (λ () (let ([name (send name-list get-string-selection)]) (if (string? name) (let ([name (build-path current-dir @@ -275,7 +275,7 @@ (add-one name)))))] [define/public do-add-all - (lambda () + (λ () (let loop ([n 0]) (when (< n (send name-list get-number)) (let ([name (send name-list get-string n)]) @@ -285,7 +285,7 @@ (loop (add1 n)))))))] [define/public do-remove - (lambda () + (λ () (let loop ([n 0]) (if (< n (send result-list get-number)) (if (send result-list is-selected? n) @@ -295,11 +295,11 @@ (loop (add1 n))))))] [define/public do-cancel - (lambda () + (λ () (set-box! result-box #f) (show #f))] - (define/augment on-close (lambda () #f)) + (define/augment on-close (λ () #f)) (super-new (label (if save-mode? (string-constant put-file) @@ -316,7 +316,7 @@ (make-object message% prompt top-panel) [define dir-choice (make-object choice% #f null top-panel - (lambda (choice event) (do-dir choice event)))] + (λ (choice event) (do-dir choice event)))] [define middle-panel (make-object horizontal-panel% main-panel)] [define left-middle-panel (make-object vertical-panel% middle-panel)] @@ -413,7 +413,7 @@ [else #f]))) [define/public set-selection-and-edit - (lambda (pos) + (λ (pos) (when (> (get-number) 0) (let* ([first-item (get-first-visible-item)] [last-item (sub1 (+ (number-of-visible-items) @@ -423,7 +423,7 @@ (set-selection pos))) (set-edit))] [define/public on-default-action - (lambda () + (λ () (when (> (get-number) 0) (let* ([which (get-string-selection)] [dir (build-path current-dir @@ -438,7 +438,7 @@ (super-new))] [define name-list (make-object name-list% - #f null left-middle-panel (lambda (x y) (do-name-list x y)) + #f null left-middle-panel (λ (x y) (do-name-list x y)) '(single))] [define save-panel (when save-mode? (make-object horizontal-panel% main-panel))] @@ -452,11 +452,11 @@ [define directory-field (keymap:call/text-keymap-initializer - (lambda () + (λ () (make-object text-field% (string-constant full-pathname) directory-panel - (lambda (txt evt) + (λ (txt evt) (when (eq? (send evt get-event-type) 'text-field-enter) (let ([dir (send directory-field get-value)]) (if (directory-exists? dir) @@ -472,7 +472,7 @@ #f null right-middle-panel - (lambda (x y) (do-result-list)) + (λ (x y) (do-result-list)) '(multiple)))] [define add-panel (when multi-mode? @@ -483,12 +483,12 @@ (make-object horizontal-panel% right-middle-panel))] [define/private do-updir - (lambda () + (λ () (set-listbox-directory (build-updir current-dir)) (set-focus-to-name-list))] [define/private set-focus-to-name-list - (lambda () + (λ () (send name-list focus))] @@ -497,7 +497,7 @@ (make-object check-box% (string-constant show-dot-files) dot-panel - (lambda (x y) (do-period-in/exclusion x y)))]) + (λ (x y) (do-period-in/exclusion x y)))]) (send dot-panel stretchable-height #f) (send dot-cb set-value (preferences:get 'framework:show-periods-in-dirlist)))) @@ -512,7 +512,7 @@ (make-object button% (string-constant up-directory-button-label) top-panel - (lambda (button evt) (do-updir))) + (λ (button evt) (do-updir))) (send dir-choice stretchable-width #t) (send name-list stretchable-width #t) @@ -527,13 +527,13 @@ (make-object button% (string-constant add-button-label) add-panel - (lambda (x y) (do-add))))] + (λ (x y) (do-add))))] [define add-all-button (when multi-mode? (begin0 (make-object button% (string-constant add-all-button-label) add-panel - (lambda (x y) (do-add-all))) + (λ (x y) (do-add-all))) (make-object horizontal-panel% add-panel)))] [define remove-button (when multi-mode? (make-object horizontal-panel% remove-panel) @@ -541,17 +541,17 @@ (make-object button% (string-constant remove-button-label) remove-panel - (lambda (x y) (do-remove))) + (λ (x y) (do-remove))) (make-object horizontal-panel% remove-panel)))] (make-object vertical-panel% bottom-panel) [define ok-button (make-object button% (string-constant ok) bottom-panel - (lambda (x y) (do-ok)) + (λ (x y) (do-ok)) (if multi-mode? '() '(border)))] [define cancel-button (make-object button% (string-constant cancel) bottom-panel - (lambda (x y) (do-cancel)))] + (λ (x y) (do-cancel)))] (make-object grow-box-spacer-pane% bottom-panel) (cond @@ -561,7 +561,7 @@ (normalize-path start-dir)))] [(get-last-directory) => - (lambda (dir) + (λ (dir) (set-listbox-directory dir))] [else (set-listbox-directory (current-directory))]) @@ -574,8 +574,8 @@ ; make-common takes a dialog-maker ; used to make one dialog object per session, now created each time (define make-common - (lambda (make-dialog) - (lambda args + (λ (make-dialog) + (λ args (let ([result-box (box #f)]) (apply make-dialog result-box args) (unbox result-box))))) @@ -734,7 +734,7 @@ ; external interfaces to file functions (define -put-file - (lambda args + (λ args (let ([actual-fun (case (preferences:get 'framework:file-dialogs) [(std) std-put-file] @@ -742,7 +742,7 @@ (apply actual-fun args)))) (define -get-file - (lambda args + (λ args (let ([actual-fun (case (preferences:get 'framework:file-dialogs) [(std) std-get-file] diff --git a/collects/framework/private/frame.ss b/collects/framework/private/frame.ss index 3794b762..198b4c13 100644 --- a/collects/framework/private/frame.ss +++ b/collects/framework/private/frame.ss @@ -42,7 +42,7 @@ (define (reorder-menus frame) (let* ([items (send (send frame get-menu-bar) get-items)] [move-to-back - (lambda (name items) + (λ (name items) (let loop ([items items] [back null]) (cond @@ -53,7 +53,7 @@ (cons item back)) (cons item (loop (cdr items) back))))])))] [move-to-front - (lambda (name items) + (λ (name items) (reverse (move-to-back name (reverse items))))] [re-ordered (move-to-front @@ -65,12 +65,12 @@ (move-to-back (string-constant windows-menu) items))))]) - (for-each (lambda (item) (send item delete)) items) - (for-each (lambda (item) (send item restore)) re-ordered))) + (for-each (λ (item) (send item delete)) items) + (for-each (λ (item) (send item restore)) re-ordered))) (define (add-snip-menu-items edit-menu c%) (let* ([get-edit-target-object - (lambda () + (λ () (let ([menu-bar (let loop ([p (send edit-menu get-parent)]) (cond @@ -83,19 +83,19 @@ (let ([frame (send menu-bar get-frame)]) (send frame get-edit-target-object)))))] [edit-menu:do - (lambda (const) - (lambda (menu evt) + (λ (const) + (λ (menu evt) (let ([edit (get-edit-target-object)]) (when (and edit (is-a? edit editor<%>)) (send edit do-edit-operation const))) #t))] [on-demand - (lambda (menu-item) + (λ (menu-item) (let ([edit (get-edit-target-object)]) (send menu-item enable (and edit (is-a? edit editor<%>)))))] [insert-comment-box - (lambda () + (λ () (let ([text (get-edit-target-object)]) (when text (let ([snip (make-object comment-box:snip%)]) @@ -104,7 +104,7 @@ (make-object c% (string-constant insert-comment-box-menu-item-label) edit-menu - (lambda (x y) (insert-comment-box)) + (λ (x y) (insert-comment-box)) #f #f on-demand) (make-object c% (string-constant insert-image-item) @@ -148,7 +148,7 @@ (define/override (on-exit) (exit:on-exit) (queue-callback - (lambda () + (λ () (exit) (exit:set-exiting #f)))) @@ -167,28 +167,28 @@ (define after-init? #f) (define/override on-drop-file - (lambda (filename) + (λ (filename) (handler:edit-file filename))) ;; added call to set label here to hopefully work around a problem in mac mred (inherit set-label change-children) (define/override after-new-child - (lambda (child) + (λ (child) (when after-init? - (change-children (lambda (l) (remq child l))) + (change-children (λ (l) (remq child l))) (error 'frame:basic-mixin "do not add children directly to a frame:basic (unless using make-root-area-container); use the get-area-container method instead" )))) - (define/public get-area-container% (lambda () vertical-panel%)) - (define/public get-menu-bar% (lambda () menu-bar%)) + (define/public get-area-container% (λ () vertical-panel%)) + (define/public get-menu-bar% (λ () menu-bar%)) (define/public make-root-area-container - (lambda (% parent) + (λ (% parent) (make-object % parent))) (inherit can-close? on-close) (define/public close - (lambda () + (λ () (when (can-close?) (on-close) (show #f)))) @@ -225,7 +225,7 @@ (define (setup-size-pref size-preferences-key w h) (preferences:set-default size-preferences-key (list w h) - (lambda (x) + (λ (x) (and (pair? x) (pair? (cdr x)) (null? (cddr x)) @@ -276,7 +276,7 @@ (define/override (on-paint) (let* ([dc (get-dc)] [draw - (lambda (str bg-color bg-style line-color line-style) + (λ (str bg-color bg-style line-color line-style) (send dc set-font (send (get-parent) get-label-font)) (let-values ([(w h) (get-client-size)] [(tw th ta td) (send dc get-text-extent str)]) @@ -333,7 +333,7 @@ r-root)) (define/public (open-status-line id) (do-main-thread - (lambda () + (λ () (when status-line-container-panel (set! status-lines (let loop ([status-lines status-lines]) @@ -348,7 +348,7 @@ (define/public (close-status-line id) (do-main-thread - (lambda () + (λ () (when status-line-container-panel ;; decrement counter in for status line, or remove it if @@ -372,7 +372,7 @@ (when status-line-msg (send (status-line-msg-message status-line-msg) set-label "") (set-status-line-msg-id! status-line-msg #f))) - (let* ([msgs-that-can-be-removed (filter (lambda (x) (not (status-line-msg-id x))) status-line-msgs)] + (let* ([msgs-that-can-be-removed (filter (λ (x) (not (status-line-msg-id x))) status-line-msgs)] [max-to-include (length status-lines)] [msgs-to-remove (let loop ([n max-to-include] @@ -383,8 +383,8 @@ [else (loop (- n 1) (cdr l))]))]) (send status-line-container-panel change-children - (lambda (old-children) - (foldl (lambda (status-line-msg l) + (λ (old-children) + (foldl (λ (status-line-msg l) (remq (status-line-msg-message status-line-msg) l)) old-children msgs-to-remove))) @@ -399,20 +399,20 @@ ;; update-status-line : symbol (union #f string) (define/public (update-status-line id msg-txt) (do-main-thread - (lambda () + (λ () (unless (open-status-line? id) (error 'update-status-line "unknown id ~e, other arg ~e" id msg-txt)) (if msg-txt (cond [(find-status-line-msg id) => - (lambda (existing-status-line-msg) + (λ (existing-status-line-msg) (let ([msg (status-line-msg-message existing-status-line-msg)]) (unless (equal? (send msg get-label) msg-txt) (send msg set-label msg-txt))))] [(find-available-status-line-msg) => - (lambda (available-status-line-msg) + (λ (available-status-line-msg) (send (status-line-msg-message available-status-line-msg) set-label msg-txt) (set-status-line-msg-id! available-status-line-msg id))] [else @@ -504,22 +504,22 @@ [define info-canvas #f] (public get-info-canvas set-info-canvas get-info-editor) [define get-info-canvas - (lambda () + (λ () info-canvas)] [define set-info-canvas - (lambda (c) + (λ (c) (set! info-canvas c))] [define get-info-editor - (lambda () + (λ () (and info-canvas (send info-canvas get-editor)))] (public determine-width) [define determine-width - (lambda (string canvas edit) + (λ (string canvas edit) (send edit set-autowrap-bitmap #f) (send canvas call-as-primary-owner - (lambda () + (λ () (let ([lb (box 0)] [rb (box 0)]) (send edit erase) @@ -551,14 +551,14 @@ (cond [(or info-hidden? (not pref-value)) (send super-root change-children - (lambda (l) + (λ (l) (if (memq outer-info-panel l) (begin (unregister-collecting-blit gc-canvas) (list rest-panel)) l)))] [else (send super-root change-children - (lambda (l) + (λ (l) (if (memq outer-info-panel l) l (begin @@ -568,7 +568,7 @@ [define close-panel-callback (preferences:add-callback 'framework:show-status-line - (lambda (p v) + (λ (p v) (update-info-visibility v)))] (define memory-cleanup void) ;; only for CVSers and nightly build users; used with memory-text @@ -598,7 +598,7 @@ (public update-info) [define update-info - (lambda () + (λ () (lock-status-changed))] (super-new) @@ -609,11 +609,11 @@ (make-object grow-box-spacer-pane% outer-info-panel) (public get-info-panel) [define get-info-panel - (lambda () + (λ () info-panel)] (public update-memory-text) [define update-memory-text - (lambda () + (λ () (when show-memory-text? (send memory-text begin-edit-sequence) (send memory-text lock #f) @@ -642,14 +642,14 @@ (when show-memory-text? (let* ([panel (make-object horizontal-panel% (get-info-panel) '(border))] [button (make-object button% (string-constant collect-button-label) panel - (lambda x + (λ x (collect-garbage) (update-memory-text)))] [ec (make-object editor-canvas% panel memory-text '(no-hscroll no-vscroll))]) (determine-width "0,000,000,000" ec memory-text) (update-memory-text) (set! memory-cleanup - (lambda () + (λ () (send ec set-editor #f))) (send panel stretchable-width #f))) @@ -668,7 +668,7 @@ (unless (preferences:get 'framework:show-status-line) (send super-root change-children - (lambda (l) + (λ (l) (list rest-panel)))) (register-gc-blit) @@ -701,7 +701,7 @@ [define remove-first (preferences:add-callback 'framework:col-offsets - (lambda (p v) + (λ (p v) (editor-position-changed-offset/numbers v (preferences:get 'framework:display-line-numbers)) @@ -709,23 +709,22 @@ [define remove-second (preferences:add-callback 'framework:display-line-numbers - (lambda (p v) + (λ (p v) (editor-position-changed-offset/numbers (preferences:get 'framework:col-offsets) v) #t))] - [define/augment on-close - (lambda () - (remove-first) - (remove-second) - (inner (void) on-close))] + (define/augment (on-close) + (remove-first) + (remove-second) + (inner (void) on-close)) [define last-start #f] [define last-end #f] [define last-params #f] (define/private (editor-position-changed-offset/numbers offset? line-numbers?) (let* ([edit (get-info-editor)] [make-one - (lambda (pos) + (λ (pos) (let* ([line (send edit position-paragraph pos)] [col (find-col edit line pos)]) (if line-numbers? @@ -809,7 +808,7 @@ (define/public (anchor-status-changed) (let ([info-edit (get-info-editor)] [failed - (lambda () + (λ () (unless (eq? anchor-last-state? #f) (set! anchor-last-state? #f) (send anchor-message show #f)))]) @@ -831,10 +830,10 @@ (preferences:get 'framework:col-offsets) (preferences:get 'framework:display-line-numbers))) [define/public overwrite-status-changed - (lambda () + (λ () (let ([info-edit (get-info-editor)] [failed - (lambda () + (λ () (set! overwrite-last-state? #f) (send overwrite-message show #f))]) (cond @@ -851,15 +850,14 @@ (failed)])))] [else (failed)])))] - [define/override update-info - (lambda () - (super update-info) - (update-macro-recording-icon) - (overwrite-status-changed) - (anchor-status-changed) - (editor-position-changed))] - (super-instantiate ()) - + (define/override (update-info) + (super update-info) + (update-macro-recording-icon) + (overwrite-status-changed) + (anchor-status-changed) + (editor-position-changed)) + (super-new) + (inherit get-info-panel) [define anchor-message @@ -884,10 +882,10 @@ (inherit determine-width) (let ([move-front - (lambda (x l) + (λ (x l) (cons x (remq x l)))]) (send (get-info-panel) change-children - (lambda (l) + (λ (l) (move-front macro-recording-message (move-front @@ -952,7 +950,7 @@ (define/override (editing-this-file? filename) (let ([path-equal? - (lambda (x y) + (λ (x y) (equal? (normal-case-path (normalize-path x)) (normal-case-path (normalize-path y))))]) (let ([this-fn (get-filename)]) @@ -975,7 +973,7 @@ (public get-entire-label get-label-prefix set-label-prefix) [define get-entire-label - (lambda () + (λ () (cond [(string=? "" label) label-prefix] @@ -983,25 +981,25 @@ label] [else (string-append label " - " label-prefix)]))] - [define get-label-prefix (lambda () label-prefix)] + [define get-label-prefix (λ () label-prefix)] [define set-label-prefix - (lambda (s) + (λ (s) (when (and (string? s) (not (string=? s label-prefix))) (set! label-prefix s) (do-label)))] - [define/override get-label (lambda () label)] + [define/override get-label (λ () label)] [define/override set-label - (lambda (t) + (λ (t) (when (and (string? t) (not (string=? t label))) (set! label t) (do-label)))] (public get-canvas% get-canvas<%> make-canvas get-editor% get-editor<%> make-editor) - [define get-canvas% (lambda () editor-canvas%)] - [define get-canvas<%> (lambda () (class->interface editor-canvas%))] - [define make-canvas (lambda () + [define get-canvas% (λ () editor-canvas%)] + [define get-canvas<%> (λ () (class->interface editor-canvas%))] + [define make-canvas (λ () (let ([% (get-canvas%)] [<%> (get-canvas<%>)]) (unless (implementation? % <%>) @@ -1054,7 +1052,7 @@ (send item enable (not (send (get-editor) is-locked?)))) (define/override file-menu:revert-callback - (lambda (item control) + (λ (item control) (let* ([edit (get-editor)] [b (box #f)] [filename (send edit get-filename b)]) @@ -1093,28 +1091,28 @@ (send edit end-edit-sequence)) (send edit end-edit-sequence))))))) - (define/override file-menu:create-revert? (lambda () #t)) + (define/override file-menu:create-revert? (λ () #t)) (define/override file-menu:save-callback - (lambda (item control) + (λ (item control) (save) #t)) - (define/override file-menu:create-save? (lambda () #t)) - (define/override file-menu:save-as-callback (lambda (item control) (save-as) #t)) - (define/override file-menu:create-save-as? (lambda () #t)) - (define/override file-menu:print-callback (lambda (item control) + (define/override file-menu:create-save? (λ () #t)) + (define/override file-menu:save-as-callback (λ (item control) (save-as) #t)) + (define/override file-menu:create-save-as? (λ () #t)) + (define/override file-menu:print-callback (λ (item control) (send (get-editor) print #t #t (preferences:get 'framework:print-output-mode)) #t)) - (define/override file-menu:create-print? (lambda () #t)) + (define/override file-menu:create-print? (λ () #t)) (define/override edit-menu:between-select-all-and-find - (lambda (edit-menu) + (λ (edit-menu) (let* ([c% (get-checkable-menu-item%)] [on-demand - (lambda (menu-item) + (λ (menu-item) (let ([edit (get-edit-target-object)]) (if (and edit (is-a? edit editor<%>)) (begin @@ -1124,7 +1122,7 @@ (send menu-item check #f) (send menu-item enable #f)))))] [callback - (lambda (item event) + (λ (item event) (let ([edit (get-edit-target-object)]) (when (and edit (is-a? edit editor<%>)) @@ -1137,14 +1135,14 @@ (make-object separator-menu-item% edit-menu))) (define/override help-menu:about-callback - (lambda (menu evt) + (λ (menu evt) (message-box (application:current-app-name) (format (string-constant welcome-to-something) (application:current-app-name)) #f '(ok app)))) - (define/override help-menu:about-string (lambda () (application:current-app-name))) - (define/override help-menu:create-about? (lambda () #t)) + (define/override help-menu:about-string (λ () (application:current-app-name))) + (define/override help-menu:create-about? (λ () #t)) (super-new (label (get-entire-label))) @@ -1152,13 +1150,13 @@ (define editor #f) (public get-canvas get-editor) (define get-canvas - (lambda () + (λ () (unless canvas (set! canvas (make-canvas)) (send canvas set-editor (get-editor))) canvas)) (define get-editor - (lambda () + (λ () (unless editor (set! editor (make-editor)) (send (get-canvas) set-editor editor)) @@ -1304,15 +1302,15 @@ (define text<%> (interface (-editor<%>))) (define text-mixin (mixin (-editor<%>) (text<%>) - [define/override get-editor<%> (lambda () (class->interface text%))] - [define/override get-editor% (lambda () text:keymap%)] + [define/override get-editor<%> (λ () (class->interface text%))] + [define/override get-editor% (λ () text:keymap%)] (super-new))) (define pasteboard<%> (interface (-editor<%>))) (define pasteboard-mixin (mixin (-editor<%>) (pasteboard<%>) - [define/override get-editor<%> (lambda () (class->interface pasteboard%))] - [define/override get-editor% (lambda () pasteboard:keymap%)] + [define/override get-editor<%> (λ () (class->interface pasteboard%))] + [define/override get-editor% (λ () pasteboard:keymap%)] (super-new))) (define delegate<%> @@ -1483,7 +1481,7 @@ [define rest-panel 'uninitialized-root] [define super-root 'uninitialized-super-root] [define/override make-root-area-container - (lambda (% parent) + (λ (% parent) (let* ([s-root (super make-root-area-container horizontal-panel% parent)] @@ -1508,13 +1506,13 @@ (set! shown? #f) (send (get-delegated-text) set-delegate #f) (send super-root change-children - (lambda (l) (list rest-panel)))) + (λ (l) (list rest-panel)))) (define/public (show-delegated-text) (open-status-line 'plt:delegate) (set! shown? #t) (send (get-delegated-text) set-delegate delegatee) (send super-root change-children - (lambda (l) (list rest-panel delegate-ec)))) + (λ (l) (list rest-panel delegate-ec)))) (define/public (click-in-overview pos) (when shown? @@ -1558,16 +1556,16 @@ (open-status-line 'plt:delegate) (send (get-delegated-text) set-delegate delegatee) (send super-root change-children - (lambda (l) (list rest-panel delegate-ec)))) + (λ (l) (list rest-panel delegate-ec)))) (begin (send (get-delegated-text) set-delegate #f) - (send super-root change-children (lambda (l) (list rest-panel))))))) + (send super-root change-children (λ (l) (list rest-panel))))))) (define (search-dialog frame) (init-find/replace-edits) (keymap:call/text-keymap-initializer - (lambda () + (λ () (let* ([to-be-searched-text (send frame get-text-to-search)] [to-be-searched-canvas (send to-be-searched-text get-canvas)] @@ -1580,7 +1578,7 @@ frame)] [copy-text - (lambda (from to) + (λ (from to) (send to erase) (let loop ([snip (send from find-first-snip)]) (when snip @@ -1615,60 +1613,60 @@ [button-panel (make-object horizontal-panel% dialog)] [update-texts - (lambda () + (λ () (send find-edit stop-searching) (copy-text f-text find-edit) (send find-edit start-searching) (copy-text r-text replace-edit))] [find-button (make-object button% (string-constant find) button-panel - (lambda x + (λ x (update-texts) (send frame search-again)) '(border))] [replace-button (make-object button% (string-constant replace) button-panel - (lambda x + (λ x (update-texts) (send frame replace)))] [replace-and-find-button (make-object button% (string-constant replace&find-again) button-panel - (lambda x + (λ x (update-texts) (send frame replace&search)))] [replace-to-end-button (make-object button% (string-constant replace-to-end) button-panel - (lambda x + (λ x (update-texts) (send frame replace-all)))] [dock-button (make-object button% (string-constant dock) button-panel - (lambda (btn evt) + (λ (btn evt) (update-texts) (preferences:set 'framework:search-using-dialog? #f) (send frame unhide-search)))] [close - (lambda () + (λ () (when to-be-searched-canvas (send to-be-searched-canvas force-display-focus #f)) (send dialog show #f))] [close-button (make-object button% (string-constant close) button-panel - (lambda (x y) + (λ (x y) (close)))] [remove-pref-callback (preferences:add-callback 'framework:search-using-dialog? - (lambda (p v) + (λ (p v) (unless v (close))))]) (unless allow-replace? (send button-panel change-children - (lambda (l) + (λ (l) (remq replace-button (remq @@ -1677,7 +1675,7 @@ replace-to-end-button l))))) (send dialog change-children - (lambda (l) + (λ (l) (remq replace-panel l)))) (copy-text find-edit f-text) @@ -1726,12 +1724,12 @@ (define old-search-highlight void) (define clear-search-highlight - (lambda () + (λ () (begin (old-search-highlight) (set! old-search-highlight void)))) (define reset-search-anchor (let ([color (make-object color% "BLUE")]) - (lambda (edit) + (λ (edit) (old-search-highlight) (let ([position (if (eq? 'forward searching-direction) @@ -1768,7 +1766,7 @@ start end get-start case-sensitive?)] [pop-out - (lambda () + (λ () (let ([admin (send edit get-admin)]) (if (is-a? admin editor-snip-editor-admin<%>) (let* ([snip (send admin get-snip)] @@ -1790,7 +1788,7 @@ 'after-or-none 'before-or-none))]) (let ([next-loop - (lambda () + (λ () (if (eq? direction 'forward) (loop (send current-snip next)) (loop (send current-snip previous))))]) @@ -1850,14 +1848,14 @@ top-searching-edit))] [not-found - (lambda (found-edit skip-beep?) + (λ (found-edit skip-beep?) (send found-edit set-position search-anchor) (when (and beep? (not skip-beep?)) (bell)) #f)] [found - (lambda (edit first-pos) + (λ (edit first-pos) (let ([last-pos ((if (eq? searching-direction 'forward) + -) first-pos (string-length string))]) (send* edit @@ -1944,7 +1942,7 @@ (unless find-edit (set! find-edit (make-object find-text%)) (set! replace-edit (make-object replace-text%)) - (for-each (lambda (keymap) + (for-each (λ (keymap) (send keymap chain-to-keymap (keymap:get-search) #t)) @@ -1955,16 +1953,16 @@ (mixin (standard-menus<%>) (searchable<%>) (init-find/replace-edits) (define super-root 'unitiaialized-super-root) - (define/override edit-menu:find-callback (lambda (menu evt) (move-to-search-or-search) #t)) - (define/override edit-menu:create-find? (lambda () #t)) - (define/override edit-menu:find-again-callback (lambda (menu evt) (search-again) #t)) - (define/override edit-menu:create-find-again? (lambda () #t)) - (define/override edit-menu:replace-and-find-again-callback (lambda (menu evt) (replace&search) #t)) + (define/override edit-menu:find-callback (λ (menu evt) (move-to-search-or-search) #t)) + (define/override edit-menu:create-find? (λ () #t)) + (define/override edit-menu:find-again-callback (λ (menu evt) (search-again) #t)) + (define/override edit-menu:create-find-again? (λ () #t)) + (define/override edit-menu:replace-and-find-again-callback (λ (menu evt) (replace&search) #t)) (define/override edit-menu:replace-and-find-again-on-demand - (lambda (item) (send item enable (can-replace?)))) - (define/override edit-menu:create-replace-and-find-again? (lambda () #t)) + (λ (item) (send item enable (can-replace?)))) + (define/override edit-menu:create-replace-and-find-again? (λ () #t)) (define/override make-root-area-container - (lambda (% parent) + (λ (% parent) (let* ([s-root (super make-root-area-container vertical-panel% parent)] @@ -1972,13 +1970,12 @@ (set! super-root s-root) root))) - (define/override on-activate - (lambda (on?) - (unless hidden? - (if on? - (reset-search-anchor (get-text-to-search)) - (clear-search-highlight))) - (super on-activate on?))) + (define/override (on-activate on?) + (unless hidden? + (if on? + (reset-search-anchor (get-text-to-search)) + (clear-search-highlight))) + (super on-activate on?)) (define/public (get-text-to-search) (error 'get-text-to-search "abstract method in searchable-mixin")) @@ -1986,7 +1983,7 @@ (opt-lambda ([startup? #f]) (when search-gui-built? (send super-root change-children - (lambda (l) + (λ (l) (remove search-panel l)))) (clear-search-highlight) (unless startup? @@ -2023,46 +2020,45 @@ (cond [hide? (send replace-canvas-panel change-children - (lambda (l) null)) - (send replace-button-panel change-children (lambda (l) null)) - (send middle-middle-panel change-children (lambda (l) null))] + (λ (l) null)) + (send replace-button-panel change-children (λ (l) null)) + (send middle-middle-panel change-children (λ (l) null))] [else (send replace-canvas-panel change-children - (lambda (l) (list replace-canvas))) + (λ (l) (list replace-canvas))) (send replace-button-panel change-children - (lambda (l) (list replace-button))) + (λ (l) (list replace-button))) (send middle-middle-panel change-children - (lambda (l) (list replace&search-button + (λ (l) (list replace&search-button replace-all-button)))])) (define remove-callback (preferences:add-callback 'framework:search-using-dialog? - (lambda (p v) + (λ (p v) (when p (hide-search))))) - (define/augment on-close - (lambda () - (remove-callback) - (let ([close-canvas - (lambda (canvas edit) - (send canvas set-editor #f))]) - (when search-gui-built? - (close-canvas find-canvas find-edit) - (close-canvas replace-canvas replace-edit))) - (when (eq? this searching-frame) - (set-searching-frame #f)) - (inner (void) on-close))) + (define/augment (on-close) + (remove-callback) + (let ([close-canvas + (λ (canvas edit) + (send canvas set-editor #f))]) + (when search-gui-built? + (close-canvas find-canvas find-edit) + (close-canvas replace-canvas replace-edit))) + (when (eq? this searching-frame) + (set-searching-frame #f)) + (inner (void) on-close)) (public set-search-direction can-replace? replace&search replace-all replace toggle-search-focus move-to-search-or-search move-to-search-or-reverse-search search-again) (define set-search-direction - (lambda (x) + (λ (x) (set-searching-direction x) (when dir-radio (send dir-radio set-selection (if (eq? x 'forward) 0 1))))) (define can-replace? - (lambda () + (λ () (let ([tx (get-text-to-search)]) (and tx @@ -2073,7 +2069,7 @@ (send tx get-end-position)) (send find-edit get-text 0 (send find-edit last-position))))))) (define replace&search - (lambda () + (λ () (let ([text (get-text-to-search)]) (send text begin-edit-sequence) (when (replace) @@ -2086,8 +2082,8 @@ (send embeded-replacee-edit get-start-position) (send embeded-replacee-edit get-end-position))] [done? (if (eq? 'forward searching-direction) - (lambda (x) (>= x (send replacee-edit last-position))) - (lambda (x) (<= x 0)))]) + (λ (x) (>= x (send replacee-edit last-position))) + (λ (x) (<= x 0)))]) (send replacee-edit begin-edit-sequence) (when (search-again) (send embeded-replacee-edit set-position pos) @@ -2136,7 +2132,7 @@ find-canvas]) focus))) (define move-to-search-or-search - (lambda () + (λ () (set-searching-frame this) (unhide-search) (cond @@ -2148,7 +2144,7 @@ (search-again 'forward) (send find-canvas focus))]))) (define move-to-search-or-reverse-search - (lambda () + (λ () (set-searching-frame this) (unhide-search) (if (or (send find-canvas has-focus?) @@ -2200,7 +2196,7 @@ (define search-button (make-object button% (string-constant find) middle-left-panel - (lambda args (search-again)))) + (λ args (search-again)))) (define _5 (set! replace-button-panel @@ -2212,26 +2208,26 @@ (define _6 (set! replace-button (make-object button% (string-constant replace) replace-button-panel - (lambda x (replace))))) + (λ x (replace))))) (define _7 (set! replace&search-button (make-object button% (string-constant replace&find-again) middle-middle-panel - (lambda x (replace&search))))) + (λ x (replace&search))))) (define _8 (set! replace-all-button (make-object button% (string-constant replace-to-end) middle-middle-panel - (lambda x (replace-all))))) + (λ x (replace-all))))) (define _9 (set! dir-radio (make-object radio-box% #f (list (string-constant forward) (string-constant backward)) middle-right-panel - (lambda (dir-radio evt) + (λ (dir-radio evt) (let ([forward (if (= (send dir-radio get-selection) 0) 'forward 'backward)]) @@ -2241,23 +2237,23 @@ (define hide/undock-pane (make-object horizontal-panel% middle-right-panel)) (define hide-button (make-object button% (string-constant hide) hide/undock-pane - (lambda args (hide-search)))) + (λ args (hide-search)))) (define undock-button (make-object button% (string-constant undock) hide/undock-pane - (lambda args (undock)))) + (λ args (undock)))) (let ([align - (lambda (x y) + (λ (x y) (let ([m (max (send x get-width) (send y get-width))]) (send x min-width m) (send y min-width m)))]) (align search-button replace-button) (align replace&search-button replace-all-button)) - (for-each (lambda (x) (send x set-alignment 'center 'center)) + (for-each (λ (x) (send x set-alignment 'center 'center)) (list middle-left-panel middle-middle-panel)) - (for-each (lambda (x) (send x stretchable-height #f)) + (for-each (λ (x) (send x stretchable-height #f)) (list search-panel middle-left-panel middle-middle-panel middle-right-panel)) - (for-each (lambda (x) (send x stretchable-width #f)) + (for-each (λ (x) (send x stretchable-width #f)) (list middle-left-panel middle-middle-panel middle-right-panel)) (send find-canvas set-editor find-edit) (send find-canvas stretchable-height #t) @@ -2284,10 +2280,10 @@ (send memory-text hide-caret #t) (define show-memory-text? (or (with-handlers ([exn:fail:filesystem? - (lambda (x) #f)]) + (λ (x) #f)]) (directory-exists? (collection-path "cvs-time-stamp"))) (with-handlers ([exn:fail:filesystem? - (lambda (x) #f)]) + (λ (x) #f)]) (directory-exists? (build-path (collection-path "framework") "CVS"))))) (define bday-click-canvas% diff --git a/collects/framework/private/gen-standard-menus.ss b/collects/framework/private/gen-standard-menus.ss index 0bf17869..dad38028 100644 --- a/collects/framework/private/gen-standard-menus.ss +++ b/collects/framework/private/gen-standard-menus.ss @@ -6,30 +6,29 @@ ;; build-before-super-item-clause : an-item -> (listof clause) (define build-before-super-item-clause - (lambda (item) + (λ (item) (list `[define/public ,(an-item->callback-name item) ,(an-item-proc item)] - `[define/public ,(an-item->get-item-name item) - (lambda () ,(an-item->item-name item))] - `[define/public ,(an-item->string-name item) - (lambda () ,(an-item-menu-string item))] - `[define/public ,(an-item->help-string-name item) - (lambda () ,(an-item-help-string item))] - `[define/public ,(an-item->on-demand-name item) - ,(an-item-on-demand item)] - `[define/public ,(an-item->create-menu-item-name item) - (lambda () ,(an-item-create item))]))) + `(define/public (,(an-item->get-item-name item)) + ,(an-item->item-name item)) + `(define/public (,(an-item->string-name item)) + ,(an-item-menu-string item)) + `(define/public (,(an-item->help-string-name item)) + ,(an-item-help-string item)) + `(define/public ,(an-item->on-demand-name item) ,(an-item-on-demand item)) + `(define/public (,(an-item->create-menu-item-name item)) + ,(an-item-create item))))) ;; build-before-super-clause : ((X -> sym) (X sexp) -> X -> (listof clause)) (define build-before-super-clause - (lambda (->name -procedure) - (lambda (obj) + (λ (->name -procedure) + (λ (obj) (list `(define/public ,(->name obj) ,(case (-procedure obj) - [(nothing) '(lambda (menu) (void))] - [(separator) '(lambda (menu) (make-object separator-menu-item% menu))] + [(nothing) '(λ (menu) (void))] + [(separator) '(λ (menu) (make-object separator-menu-item% menu))] [(nothing-with-standard-menus) - '(lambda (menu) + '(λ (menu) (unless (current-eventspace-has-standard-menus?) (make-object separator-menu-item% menu)))] [else (error 'gen-standard-menus "unknown between sym: ~e" (-procedure obj))])))))) @@ -60,20 +59,20 @@ (label (,(an-item->string-name item))) (parent ,(menu-item-menu-name item)) (help-string (,(an-item->help-string-name item))) - (demand-callback (lambda (menu-item) (,(an-item->on-demand-name item) menu-item)))) + (demand-callback (λ (menu-item) (,(an-item->on-demand-name item) menu-item)))) `(instantiate (get-menu-item%) () (label (,(an-item->string-name item))) (parent ,(menu-item-menu-name item)) - (callback (let ([,callback-name (lambda (item evt) (,callback-name item evt))]) + (callback (let ([,callback-name (λ (item evt) (,callback-name item evt))]) ,callback-name)) (shortcut ,key) (help-string (,(an-item->help-string-name item))) - (demand-callback (lambda (menu-item) (,(an-item->on-demand-name item) menu-item)))))))))) + (demand-callback (λ (menu-item) (,(an-item->on-demand-name item) menu-item)))))))))) ;; build-after-super-clause : ((X -> symbol) -> X -> (listof clause)) (define build-after-super-clause - (lambda (->name) - (lambda (between/after) + (λ (->name) + (λ (between/after) (list `(,(->name between/after) (,(menu-name->get-menu-name between/after))))))) @@ -117,12 +116,12 @@ (printf "writing to ~a~n" standard-menus.ss-filename) (call-with-output-file standard-menus.ss-filename - (lambda (port) + (λ (port) (pretty-print `(define standard-menus<%> (interface (basic<%>) ,@(apply append (map - (lambda (x) + (λ (x) (cond [(an-item? x) (list @@ -152,7 +151,7 @@ (define remove-prefs-callback (preferences:add-callback 'framework:menu-bindings - (lambda (p v) + (λ (p v) (let loop ([menu (get-menu-bar)]) (when (is-a? menu menu:can-restore<%>) (if v @@ -166,7 +165,7 @@ (for-each loop (send menu get-items))))))) (inherit get-menu-bar show can-close? get-edit-target-object) - ,@(apply append (map (lambda (x) + ,@(apply append (map (λ (x) (cond [(between? x) (build-before-super-between-clause x)] [(or (after? x) (before? x)) (build-before-super-before/after-clause x)] @@ -174,7 +173,7 @@ [(generic? x) (build-before-super-generic-clause x)])) items)) (super-instantiate ()) - ,@(apply append (map (lambda (x) + ,@(apply append (map (λ (x) (cond [(between? x) (build-after-super-between-clause x)] [(an-item? x) (build-after-super-item-clause x)] diff --git a/collects/framework/private/group.ss b/collects/framework/private/group.ss index 36549620..586440ca 100644 --- a/collects/framework/private/group.ss +++ b/collects/framework/private/group.ss @@ -41,7 +41,7 @@ (let ([menu-bar (send frame get-menu-bar)]) (and menu-bar (let ([menus (send menu-bar get-items)]) - (ormap (lambda (x) + (ormap (λ (x) (if (string=? (string-constant windows-menu) (send x get-plain-label)) x @@ -56,7 +56,7 @@ (when menu ;; to help the (conservative) gc. - (for-each (lambda (i) (send i delete)) (send menu get-items)) + (for-each (λ (i) (send i delete)) (send menu get-items)) (set! windows-menus (remove @@ -68,7 +68,7 @@ (let* ([windows (length windows-menus)] [default-name (string-constant untitled)] [get-name - (lambda (frame) + (λ (frame) (let ([label (send frame get-label)]) (if (string=? label "") (if (method-in-interface? 'get-entire-label (object-interface frame)) @@ -80,26 +80,26 @@ label)))] [sorted/visible-frames (quicksort - (filter (lambda (x) (send (frame-frame x) is-shown?)) frames) - (lambda (f1 f2) + (filter (λ (x) (send (frame-frame x) is-shown?)) frames) + (λ (f1 f2) (string-ci<=? (get-name (frame-frame f1)) (get-name (frame-frame f2)))))]) (for-each - (lambda (menu) - (for-each (lambda (item) (send item delete)) (send menu get-items)) + (λ (menu) + (for-each (λ (item) (send item delete)) (send menu get-items)) (instantiate menu:can-restore-menu-item% () (label (string-constant bring-frame-to-front...)) (parent menu) - (callback (lambda (x y) (choose-a-frame (send (send menu get-parent) get-frame)))) + (callback (λ (x y) (choose-a-frame (send (send menu get-parent) get-frame)))) (shortcut #\j)) (instantiate menu:can-restore-menu-item% () (label (string-constant most-recent-window)) (parent menu) - (callback (lambda (x y) (most-recent-window-to-front))) + (callback (λ (x y) (most-recent-window-to-front))) (shortcut #\')) (make-object separator-menu-item% menu) (for-each - (lambda (frame) + (λ (frame) (let ([frame (frame-frame frame)]) (make-object menu-item% (regexp-replace* @@ -107,7 +107,7 @@ (gui-utils:trim-string (get-name frame) 200) "&&") menu - (lambda (_1 _2) + (λ (_1 _2) (send frame show #t))))) sorted/visible-frames)) windows-menus))) @@ -121,14 +121,14 @@ (define/private (update-close-menu-item-state) (let* ([set-close-menu-item-state! - (lambda (frame state) + (λ (frame state) (when (is-a? frame frame:standard-menus<%>) (let ([close-menu-item (send frame file-menu:get-close-menu)]) (when close-menu-item (send close-menu-item enable state)))))]) (if (eq? (length frames) 1) (set-close-menu-item-state! (car frames) #f) - (for-each (lambda (a-frame) + (for-each (λ (a-frame) (set-close-menu-item-state! a-frame #t)) frames)))) @@ -139,7 +139,7 @@ [open-here-frame open-here-frame] [else (let ([candidates - (filter (lambda (x) (is-a? (frame-frame x) frame:open-here<%>)) + (filter (λ (x) (is-a? (frame-frame x) frame:open-here<%>)) frames)]) (if (null? candidates) #f @@ -150,7 +150,7 @@ remove-frame clear on-close-all can-close-all? locate-file get-frames frame-shown/hidden) [define get-mdi-parent - (lambda () + (λ () (when (and (eq? (system-type) 'windows) (preferences:get 'framework:windows-mdi) (not mdi-parent)) @@ -163,36 +163,36 @@ (define (get-frames) (map frame-frame frames)) [define frame-label-changed - (lambda (frame) + (λ (frame) (when (memq frame (map frame-frame frames)) (update-windows-menus)))] [define frame-shown/hidden - (lambda (frame) + (λ (frame) (when (memq frame (map frame-frame frames)) (update-windows-menus)))] [define for-each-frame - (lambda (f) - (for-each (lambda (x) (f (frame-frame x))) frames) + (λ (f) + (for-each (λ (x) (f (frame-frame x))) frames) (set! todo-to-new-frames (let ([old todo-to-new-frames]) - (lambda (frame) (old frame) (f frame)))))] + (λ (frame) (old frame) (f frame)))))] [define get-active-frame - (lambda () + (λ () (cond [active-frame active-frame] [(null? frames) #f] [else (frame-frame (car frames))]))] [define set-active-frame - (lambda (f) + (λ (f) (when (and active-frame (not (eq? active-frame f))) (set! most-recent-window-box (make-weak-box active-frame))) (set! active-frame f))] [define insert-frame - (lambda (new-frame) - (unless (memf (lambda (fr) (eq? (frame-frame fr) new-frame)) + (λ (new-frame) + (unless (memf (λ (fr) (eq? (frame-frame fr) new-frame)) frames) (set! frame-counter (add1 frame-counter)) (let ([new-frames (cons (make-frame new-frame frame-counter) @@ -204,44 +204,44 @@ (todo-to-new-frames new-frame)))] [define remove-frame - (lambda (f) + (λ (f) (when (eq? f active-frame) (set! active-frame #f)) (let ([new-frames (remove f frames - (lambda (f fr) (eq? f (frame-frame fr))))]) + (λ (f fr) (eq? f (frame-frame fr))))]) (set! frames new-frames) (update-close-menu-item-state) (remove-windows-menu f) (update-windows-menus)))] [define clear - (lambda () + (λ () (set! frames null) #t)] [define on-close-all - (lambda () - (for-each (lambda (f) + (λ () + (for-each (λ (f) (let ([frame (frame-frame f)]) (send frame on-close) (send frame show #f))) frames))] [define can-close-all? - (lambda () - (andmap (lambda (f) + (λ () + (andmap (λ (f) (let ([frame (frame-frame f)]) (send frame can-close?))) frames))] [define locate-file - (lambda (name) + (λ (name) (let* ([normalized ;; allow for the possiblity of filenames that are urls - (with-handlers ([(lambda (x) #t) - (lambda (x) name)]) + (with-handlers ([(λ (x) #t) + (λ (x) name)]) (normal-case-path (normalize-path name)))] [test-frame - (lambda (frame) + (λ (frame) (and (is-a? frame frame:basic<%>) (send frame editing-this-file? normalized)))]) (let loop ([frames frames]) @@ -259,12 +259,12 @@ (letrec-values ([(sorted-frames) (quicksort (send (get-the-frame-group) get-frames) - (lambda (x y) (string-ci<=? (send x get-label) (send y get-label))))] + (λ (x y) (string-ci<=? (send x get-label) (send y get-label))))] [(d) (make-object dialog% (string-constant bring-frame-to-front) parent 400 600)] [(lb) (instantiate list-box% () (label #f) - (choices (map (lambda (x) (gui-utils:trim-string (send x get-label) 200)) sorted-frames)) - (callback (lambda (x y) (listbox-callback y))) + (choices (map (λ (x) (gui-utils:trim-string (send x get-label) 200)) sorted-frames)) + (callback (λ (x y) (listbox-callback y))) (parent d))] [(t) (instantiate text:hide-caret/selection% ())] [(ec) (instantiate canvas:basic% () @@ -276,7 +276,7 @@ (alignment '(right center)))] [(cancelled?) #t] [(listbox-callback) - (lambda (evt) + (λ (evt) (case (send evt get-event-type) [(list-box) @@ -299,10 +299,10 @@ [(ok cancel) (gui-utils:ok/cancel-buttons bp - (lambda (x y) + (λ (x y) (set! cancelled? #f) (send d show #f)) - (lambda (x y) + (λ (x y) (send d show #f)))]) (send ec set-line-count 3) (send ec set-editor t) @@ -321,7 +321,7 @@ (define (internal-get-the-frame-group) (let ([the-frame-group (make-object %)]) - (set! internal-get-the-frame-group (lambda () the-frame-group)) + (set! internal-get-the-frame-group (λ () the-frame-group)) (internal-get-the-frame-group))) (define (get-the-frame-group) diff --git a/collects/framework/private/handler.ss b/collects/framework/private/handler.ss index fe44184a..d2c3e35e 100644 --- a/collects/framework/private/handler.ss +++ b/collects/framework/private/handler.ss @@ -27,14 +27,14 @@ (define make-insert-handler (letrec ([string-list? - (lambda (l) + (λ (l) (cond [(null? l) #t] [(not (pair? l)) #f] [else (and (string? (car l)) (string-list? (cdr l)))]))]) - (lambda (who name extension handler) + (λ (who name extension handler) (cond [(not (string? name)) (error who "name was not a string")] @@ -52,37 +52,37 @@ handler)])))) (define insert-format-handler - (lambda args + (λ args (set! format-handlers (cons (apply make-insert-handler 'insert-format-handler args) format-handlers)))) (define find-handler - (lambda (name handlers) + (λ (name handlers) (let/ec exit (let ([extension (if (string? name) (or (filename-extension name) "") "")]) (for-each - (lambda (handler) + (λ (handler) (let ([ext (handler-extension handler)]) (when (or (and (procedure? ext) (ext name)) (and (pair? ext) - (ormap (lambda (ext) (string=? ext extension)) + (ormap (λ (ext) (string=? ext extension)) ext))) (exit (handler-handler handler))))) handlers) #f)))) (define find-format-handler - (lambda (name) + (λ (name) (find-handler name format-handlers))) ; Finding format & mode handlers by name (define find-named-handler - (lambda (name handlers) + (λ (name handlers) (let loop ([l handlers]) (cond [(null? l) #f] @@ -91,13 +91,13 @@ [else (loop (cdr l))])))) (define find-named-format-handler - (lambda (name) + (λ (name) (find-named-handler name format-handlers))) ; Open a file for editing (define current-create-new-window (make-parameter - (lambda (filename) + (λ (filename) (let ([frame (make-object frame:text% filename)]) (send frame show #t) frame)))) @@ -106,11 +106,11 @@ (case-lambda [(filename) (edit-file filename - (lambda () + (λ () ((current-create-new-window) filename)))] [(filename make-default) - (with-handlers ([(lambda (x) #f) ;exn:fail? - (lambda (exn) + (with-handlers ([(λ (x) #f) ;exn:fail? + (λ (exn) (message-box (string-constant error-loading) (string-append @@ -123,7 +123,7 @@ (format "~s" exn)))) #f)]) (gui-utils:show-busy-cursor - (lambda () + (λ () (if filename (let ([already-open (send (group:get-the-frame-group) locate-file @@ -136,7 +136,7 @@ [(and (preferences:get 'framework:open-here?) (send (group:get-the-frame-group) get-open-here-frame)) => - (lambda (fr) + (λ (fr) (add-to-recent filename) (send fr open-here filename) (send fr show #t) @@ -157,7 +157,7 @@ ;; add-to-recent : path -> void (define (add-to-recent filename) (let* ([old-list (preferences:get 'framework:recently-opened-files/pos)] - [old-ents (filter (lambda (x) (string=? (path->string (car x)) + [old-ents (filter (λ (x) (string=? (path->string (car x)) (path->string filename))) old-list)] [old-ent (if (null? old-ents) @@ -203,7 +203,7 @@ ;; with the positions `start' and `end' (define (set-recent-position filename start end) (let ([recent-items - (filter (lambda (x) (string=? (path->string (car x)) + (filter (λ (x) (string=? (path->string (car x)) (path->string filename))) (preferences:get 'framework:recently-opened-files/pos))]) (unless (null? recent-items) @@ -216,18 +216,18 @@ (let ([recently-opened-files (preferences:get 'framework:recently-opened-files/pos)]) - (for-each (lambda (item) (send item delete)) + (for-each (λ (item) (send item delete)) (send menu get-items)) (instantiate menu-item% () (parent menu) (label (string-constant show-recent-items-window-menu-item)) - (callback (lambda (x y) (show-recent-items-window)))) + (callback (λ (x y) (show-recent-items-window)))) (instantiate separator-menu-item% () (parent menu)) - (for-each (lambda (recent-list-item) + (for-each (λ (recent-list-item) (let ([filename (car recent-list-item)]) (instantiate menu-item% () (parent menu) @@ -237,7 +237,7 @@ (path->string filename) "&&") 200)) - (callback (lambda (x y) (open-recent-list-item recent-list-item)))))) + (callback (λ (x y) (open-recent-list-item recent-list-item)))))) recently-opened-files))) ;; open-recent-list-item : recent-list-item -> void @@ -300,11 +300,11 @@ (define/private (refresh-hl recent-list-items) (let ([ed (send hl get-editor)]) (send ed begin-edit-sequence) - (for-each (lambda (item) (send hl delete-item item)) (send hl get-items)) - (for-each (lambda (item) (add-recent-item item)) + (for-each (λ (item) (send hl delete-item item)) (send hl get-items)) + (for-each (λ (item) (add-recent-item item)) (if (eq? (preferences:get 'framework:recently-opened-sort-by) 'name) (quicksort recent-list-items - (lambda (x y) (string<=? (path->string (car x)) + (λ (x y) (string<=? (path->string (car x)) (path->string (car y))))) recent-list-items)) (send ed end-edit-sequence))) @@ -316,7 +316,7 @@ (field [remove-prefs-callback (preferences:add-callback 'framework:recently-opened-files/pos - (lambda (p v) + (λ (p v) (refresh-hl v)))]) (define/augment (on-close) @@ -333,12 +333,12 @@ (make-object button% (string-constant recent-items-sort-by-name) bp - (lambda (x y) (set-sort-by 'name)))] + (λ (x y) (set-sort-by 'name)))] [sort-by-age-button (make-object button% (string-constant recent-items-sort-by-age) bp - (lambda (x y) (set-sort-by 'age)))]) + (λ (x y) (set-sort-by 'age)))]) (send bp stretchable-height #f) (send sort-by-name-button stretchable-width #t) @@ -359,7 +359,7 @@ ;; make-hierlist-item-mixin : recent-item -> mixin(arg to new-item method of hierlist) (define (make-hierlist-item-mixin recent-item) - (lambda (%) + (λ (%) (class % (define/public (open-item) (open-recent-list-item recent-item)) @@ -368,18 +368,18 @@ (define *open-directory* ; object to remember last directory (new (class object% (field [the-dir #f]) - [define/public get (lambda () the-dir)] + [define/public get (λ () the-dir)] [define/public set-from-file! - (lambda (file) + (λ (file) (set! the-dir (path-only file)))] [define/public set-to-default - (lambda () + (λ () (set! the-dir (current-directory)))] (set-to-default) (super-new)))) (define open-file - (lambda () + (λ () (let ([file (parameterize ([finder:dialog-parent-parameter (and (preferences:get 'framework:open-here?) diff --git a/collects/framework/private/icon.ss b/collects/framework/private/icon.ss index 74a8d77d..35343ea2 100644 --- a/collects/framework/private/icon.ss +++ b/collects/framework/private/icon.ss @@ -39,7 +39,7 @@ csr (make-object cursor% fallback))) (make-object cursor% fallback))))]) - (lambda () + (λ () (force ans))))])) (define get-up/down-cursor (make-get-cursor "up-down-cursor.xbm" "up-down-mask.xbm" 'size-n/s)) diff --git a/collects/framework/private/keymap.ss b/collects/framework/private/keymap.ss index d67efaa0..c95c3f58 100644 --- a/collects/framework/private/keymap.ss +++ b/collects/framework/private/keymap.ss @@ -28,7 +28,7 @@ (hash-table-get user-keybindings-files path - (lambda () + (λ () (let ([sexp (and (file-exists? path) (call-with-input-file path read))]) (match sexp @@ -42,7 +42,7 @@ (define (remove-user-keybindings-file path) (let/ec k - (let ([km (hash-table-get user-keybindings-files path (lambda () (k (void))))]) + (let ([km (hash-table-get user-keybindings-files path (λ () (k (void))))]) (send global remove-chained-keymap km) (hash-table-remove! user-keybindings-files path)))) @@ -69,9 +69,9 @@ (c-loop (cdr child-keymaps))]))]))))) (define (set-chained-keymaps parent-keymap children-keymaps) - (for-each (lambda (orig-sub) (send parent-keymap remove-chained-keymap)) + (for-each (λ (orig-sub) (send parent-keymap remove-chained-keymap)) (send parent-keymap get-chained-keymaps)) - (for-each (lambda (new-sub) (send parent-keymap chain-to-keymap new-sub #f)) + (for-each (λ (new-sub) (send parent-keymap chain-to-keymap new-sub #f)) children-keymaps)) (define aug-keymap<%> (interface ((class->interface keymap%)) @@ -107,11 +107,11 @@ (define/public (get-map-function-table/ht table) (hash-table-for-each function-table - (lambda (keyname fname) - (unless (hash-table-get table keyname (lambda () #f)) + (λ (keyname fname) + (unless (hash-table-get table keyname (λ () #f)) (hash-table-put! table keyname fname)))) (for-each - (lambda (chained-keymap) + (λ (chained-keymap) (when (is-a? chained-keymap aug-keymap<%>) (send chained-keymap get-map-function-table/ht table))) chained-keymaps) @@ -180,13 +180,13 @@ [command (if neg? #f 'd/c)] [do-key - (lambda (char val) + (λ (char val) (cond [(eq? val #t) (string char)] [(eq? val #f) (string #\~ char)] [(eq? val 'd/c) #f]))]) - (for-each (lambda (mod) + (for-each (λ (mod) (let ([val (not (char=? (car mod) #\~))]) (case (if (char=? (car mod) #\~) (cadr mod) @@ -200,7 +200,7 @@ (join-strings ":" (filter - (lambda (x) x) + (λ (x) x) (list (do-key #\a alt) (do-key #\c control) @@ -251,8 +251,8 @@ defaults))) (define send-map-function-meta - (lambda (keymap key func) - (for-each (lambda (key) (send keymap map-function key func)) + (λ (keymap key func) + (for-each (λ (key) (send keymap map-function key func)) (make-meta-prefix-list key)))) (define add-to-right-button-menu (make-parameter void)) @@ -261,11 +261,11 @@ (define setup-global ; Define some useful keyboard functions (let* ([ring-bell - (lambda (edit event) + (λ (edit event) (bell))] [mouse-popup-menu - (lambda (edit event) + (λ (edit event) (when (send event button-down?) (let ([a (send edit get-admin)]) (when a @@ -275,7 +275,7 @@ (append-editor-operation-menu-items m) (for-each - (lambda (i) + (λ (i) (when (is-a? i selectable-menu-item<%>) (send i set-shortcut #f))) (send m get-items)) @@ -289,11 +289,11 @@ (send a popup-menu m (+ x 1) (+ y 1))))))))] [toggle-anchor - (lambda (edit event) + (λ (edit event) (send edit set-anchor (not (send edit get-anchor))))] [center-view-on-line - (lambda (edit event) + (λ (edit event) (let ([new-mid-line (send edit position-line (send edit get-start-position))] [bt (box 0)] @@ -314,8 +314,8 @@ #t)] [make-insert-brace-pair - (lambda (open-brace close-brace) - (lambda (edit event) + (λ (open-brace close-brace) + (λ (edit event) (send edit begin-edit-sequence) (let ([selection-start (send edit get-start-position)]) (send edit set-position (send edit get-end-position)) @@ -325,7 +325,7 @@ (send edit end-edit-sequence)))] [insert-lambda-template - (lambda (edit event) + (λ (edit event) (send edit begin-edit-sequence) (let ([selection-start (send edit get-start-position)]) (send edit set-position (send edit get-end-position)) @@ -333,18 +333,18 @@ (send edit set-position selection-start) (send edit insert ") ") (send edit set-position selection-start) - (send edit insert "(lambda (")) + (send edit insert "(λ (")) (send edit end-edit-sequence))] [collapse-variable-space ;; As per emacs: collapse tabs & spaces around the point, ;; perhaps leaving a single space. ;; drscheme bonus: if at end-of-line, collapse into the next line. - (lambda (leave-one? edit event) + (λ (leave-one? edit event) (letrec ([last-pos (send edit last-position)] [sel-start (send edit get-start-position)] [sel-end (send edit get-end-position)] - [collapsible? (lambda (c) (and (char-whitespace? c) + [collapsible? (λ (c) (and (char-whitespace? c) (not (char=? #\newline c))))] [find-noncollapsible ; Return index of next non-collapsible char, @@ -352,7 +352,7 @@ ; NB returns -1 or last-pos, if examining ; initial/final whitespace ; (or, when initial pos is outside of [0,last-pos).) - (lambda (pos dir) + (λ (pos dir) (let loop ([pos pos]) (cond [(< pos 0) -1] [(>= pos last-pos) last-pos] @@ -389,17 +389,17 @@ (send edit end-edit-sequence))))))] [collapse-space - (lambda (edit event) + (λ (edit event) (collapse-variable-space #t edit event))] [remove-space - (lambda (edit event) + (λ (edit event) (collapse-variable-space #f edit event))] [collapse-newline - (lambda (edit event) + (λ (edit event) (letrec ([find-nonwhite - (lambda (pos d offset) + (λ (pos d offset) (let/ec escape (let ([max (if (> offset 0) (send edit last-position) @@ -459,7 +459,7 @@ end-line-start)]))))))] [open-line - (lambda (edit event) + (λ (edit event) (let ([sel-start (send edit get-start-position)] [sel-end (send edit get-end-position)]) (if (= sel-start sel-end) @@ -468,7 +468,7 @@ (set-position sel-start)))))] [transpose-chars - (lambda (edit event) + (λ (edit event) (let ([sel-start (send edit get-start-position)] [sel-end (send edit get-end-position)]) (when (and (= sel-start sel-end) @@ -490,7 +490,7 @@ (end-edit-sequence)))))))] [transpose-words - (lambda (edit event) + (λ (edit event) (let ([sel-start (send edit get-start-position)] [sel-end (send edit get-end-position)]) (when (= sel-start sel-end) @@ -520,7 +520,7 @@ (end-edit-sequence))))))))))] [capitalize-it - (lambda (edit char-case1 char-case2) + (λ (edit char-case1 char-case2) (let ([sel-start (send edit get-start-position)] [sel-end (send edit get-end-position)] [real-end (send edit last-position)]) @@ -547,17 +547,17 @@ (set-position word-end))))))] [capitalize-word - (lambda (edit event) + (λ (edit event) (capitalize-it edit char-upcase char-downcase))] [upcase-word - (lambda (edit event) + (λ (edit event) (capitalize-it edit char-upcase char-upcase))] [downcase-word - (lambda (edit event) + (λ (edit event) (capitalize-it edit char-downcase char-downcase))] [kill-word - (lambda (edit event) + (λ (edit event) (let ([sel-start (send edit get-start-position)] [sel-end (send edit get-end-position)]) (let ([end-box (box sel-end)]) @@ -565,7 +565,7 @@ (send edit kill 0 sel-start (unbox end-box)))))] [backward-kill-word - (lambda (edit event) + (λ (edit event) (let ([sel-start (send edit get-start-position)] [sel-end (send edit get-end-position)]) (let ([start-box (box sel-start)]) @@ -573,7 +573,7 @@ (send edit kill 0 (unbox start-box) sel-end))))] [region-click - (lambda (edit event f) + (λ (edit event f) (when (and (send event button-down?) (is-a? edit text%)) (let ([x-box (box (send event get-x))] @@ -591,39 +591,39 @@ (f click-pos eol start-pos click-pos) (f click-pos eol click-pos end-pos)))))))] [copy-click-region - (lambda (edit event) + (λ (edit event) (region-click edit event - (lambda (click eol start end) + (λ (click eol start end) (send edit flash-on start end) (send edit copy #f 0 start end))))] [cut-click-region - (lambda (edit event) + (λ (edit event) (region-click edit event - (lambda (click eol start end) + (λ (click eol start end) (send edit cut #f 0 start end))))] [paste-click-region - (lambda (edit event) + (λ (edit event) (region-click edit event - (lambda (click eol start end) + (λ (click eol start end) (send edit set-position click) (send edit paste-x-selection 0 click))))] [mouse-copy-clipboard - (lambda (edit event) + (λ (edit event) (send edit copy #f (send event get-time-stamp)))] [mouse-paste-clipboard - (lambda (edit event) + (λ (edit event) (send edit paste (send event get-time-stamp)))] [mouse-cut-clipboard - (lambda (edit event) + (λ (edit event) (send edit cut #f (send event get-time-stamp)))] [select-click-word - (lambda (edit event) + (λ (edit event) (region-click edit event - (lambda (click eol start end) + (λ (click eol start end) (let ([start-box (box click)] [end-box (box click)]) (send edit find-wordbreak @@ -634,9 +634,9 @@ (unbox start-box) (unbox end-box))))))] [select-click-line - (lambda (edit event) + (λ (edit event) (region-click edit event - (lambda (click eol start end) + (λ (click eol start end) (let* ([line (send edit position-line click eol)] [start (send edit line-start-position @@ -646,10 +646,10 @@ (send edit set-position start end)))))] [goto-line - (lambda (edit event) + (λ (edit event) (let ([num-str (call/text-keymap-initializer - (lambda () + (λ () (get-text-from-user (string-constant goto-line) (string-constant goto-line))))]) @@ -672,10 +672,10 @@ #t)] [goto-position - (lambda (edit event) + (λ (edit event) (let ([num-str (call/text-keymap-initializer - (lambda () + (λ () (get-text-from-user (string-constant goto-position) (string-constant goto-position))))]) @@ -685,26 +685,26 @@ (send edit set-position (sub1 pos)))))) #t)] [repeater - (lambda (n edit) + (λ (n edit) (let* ([km (send edit get-keymap)] [done - (lambda () + (λ () (send km set-break-sequence-callback void) (send km remove-grab-key-function))]) (send km set-grab-key-function - (lambda (name local-km edit event) + (λ (name local-km edit event) (if name (begin (done) (dynamic-wind - (lambda () + (λ () (send edit begin-edit-sequence)) - (lambda () + (λ () (let loop ([n n]) (unless (zero? n) (send local-km call-function name edit event) (loop (sub1 n))))) - (lambda () + (λ () (send edit end-edit-sequence)))) (let ([k (send event get-key-code)]) (if (and (char? k) (char<=? #\0 k #\9)) @@ -713,26 +713,26 @@ (begin (done) (dynamic-wind - (lambda () + (λ () (send edit begin-edit-sequence)) - (lambda () + (λ () (let loop ([n n]) (unless (zero? n) (send edit on-char event) (loop (sub1 n))))) - (lambda () + (λ () (send edit end-edit-sequence))))))) #t)) (send km set-break-sequence-callback done) #t))] [make-make-repeater - (lambda (n) - (lambda (edit event) + (λ (n) + (λ (edit event) (repeater n edit)))] [current-macro '()] [building-macro #f] [build-macro-km #f] [build-protect? #f] [show/hide-keyboard-macro-icon - (lambda (edit on?) + (λ (edit on?) (when (is-a? edit editor:basic<%>) (let ([frame (send edit get-top-level-window)]) (when (is-a? frame frame:text-info<%>) @@ -740,7 +740,7 @@ (send frame update-shown)))))] [do-macro - (lambda (edit event) + (λ (edit event) ; If c:x;e during record, copy the old macro (when building-macro (set! building-macro (append (reverse current-macro) @@ -748,13 +748,13 @@ (let ([bm building-macro] [km (send edit get-keymap)]) (dynamic-wind - (lambda () + (λ () (set! building-macro #f) (send edit begin-edit-sequence)) - (lambda () + (λ () (let/ec escape (for-each - (lambda (f) + (λ (f) (let ([name (car f)] [event (cdr f)]) (if name @@ -762,17 +762,17 @@ (escape #t)) (send edit on-char event)))) current-macro))) - (lambda () + (λ () (send edit end-edit-sequence) (set! building-macro bm)))) #t)] [start-macro - (lambda (edit event) + (λ (edit event) (if building-macro (send build-macro-km break-sequence) (letrec ([km (send edit get-keymap)] [done - (lambda () + (λ () (if build-protect? (send km set-break-sequence-callback done) (begin @@ -784,15 +784,15 @@ (show/hide-keyboard-macro-icon edit #t) (set! build-macro-km km) (send km set-grab-key-function - (lambda (name local-km edit event) + (λ (name local-km edit event) (dynamic-wind - (lambda () + (λ () (set! build-protect? #t)) - (lambda () + (λ () (if name (send local-km call-function name edit event) (send edit on-default-char event))) - (lambda () + (λ () (set! build-protect? #f))) (when building-macro (set! building-macro @@ -802,14 +802,14 @@ (send km set-break-sequence-callback done))) #t)] [end-macro - (lambda (edit event) + (λ (edit event) (when building-macro (set! current-macro (reverse building-macro)) (set! build-protect? #f) (send build-macro-km break-sequence)) #t)] [delete-key - (lambda (edit event) + (λ (edit event) (let ([kmap (send edit get-keymap)]) (send kmap call-function (if (preferences:get 'framework:delete-forward?) @@ -818,12 +818,12 @@ edit event #t)))] [toggle-overwrite - (lambda (edit event) + (λ (edit event) (send edit set-overwrite-mode (not (send edit get-overwrite-mode))))] [down-into-embedded-editor - (lambda (text event) + (λ (text event) (let ([start (send text get-start-position)] [end (send text get-end-position)]) (when (= start end) @@ -850,7 +850,7 @@ #t)] [forward-to-next-embedded-editor - (lambda (text event) + (λ (text event) (let ([start-pos (send text get-start-position)] [end-pos (send text get-end-position)]) (when (= start-pos end-pos) @@ -863,7 +863,7 @@ #t)] [back-to-prev-embedded-editor - (lambda (text event) + (λ (text event) (let ([start-pos (send text get-start-position)] [end-pos (send text get-end-position)]) (when (= start-pos end-pos) @@ -876,7 +876,7 @@ #t)] [up-out-of-embedded-editor - (lambda (text event) + (λ (text event) (let ([start (send text get-start-position)] [end (send text get-end-position)]) (when (= start end) @@ -893,18 +893,18 @@ #t)] [make-read-only - (lambda (text event) + (λ (text event) (send text lock #t) #t)]) - (lambda (kmap) - (let* ([map (lambda (key func) + (λ (kmap) + (let* ([map (λ (key func) (send kmap map-function key func))] - [map-meta (lambda (key func) + [map-meta (λ (key func) (send-map-function-meta kmap key func))] - [add (lambda (name func) + [add (λ (name func) (send kmap add-function name func))] - [add-m (lambda (name func) + [add-m (λ (name func) (send kmap add-function name func))]) ; Map names to keyboard functions @@ -916,7 +916,7 @@ (add "toggle-overwrite" toggle-overwrite) - (add "exit" (lambda (edit event) + (add "exit" (λ (edit event) (let ([frame (send edit get-frame)]) (if (and frame (is-a? frame frame:standard-menus<%>)) @@ -1156,8 +1156,8 @@ (define setup-search (let* ([send-frame - (lambda (invoke-method) - (lambda (edit event) + (λ (invoke-method) + (λ (edit event) (let ([frame (cond [(is-a? edit editor<%>) @@ -1171,26 +1171,26 @@ (invoke-method frame) (bell))) #t))]) - (lambda (kmap) - (let* ([map (lambda (key func) + (λ (kmap) + (let* ([map (λ (key func) (send kmap map-function key func))] - [map-meta (lambda (key func) + [map-meta (λ (key func) (send-map-function-meta kmap key func))] - [add (lambda (name func) + [add (λ (name func) (send kmap add-function name func))] - [add-m (lambda (name func) + [add-m (λ (name func) (send kmap add-function name func))]) (add "move-to-search-or-search" - (send-frame (lambda (f) (send f move-to-search-or-search)))) ;; key 1 + (send-frame (λ (f) (send f move-to-search-or-search)))) ;; key 1 (add "move-to-search-or-reverse-search" - (send-frame (lambda (f) (send f move-to-search-or-reverse-search)))) ;; key 1b, backwards + (send-frame (λ (f) (send f move-to-search-or-reverse-search)))) ;; key 1b, backwards (add "find-string-again" - (send-frame (lambda (f) (send f search-again)))) ;; key 2 + (send-frame (λ (f) (send f search-again)))) ;; key 2 (add "toggle-search-focus" - (send-frame (lambda (f) (send f toggle-search-focus)))) ;; key 3 + (send-frame (λ (f) (send f toggle-search-focus)))) ;; key 3 (add "hide-search" - (send-frame (lambda (f) (send f hide-search)))) ;; key 4 + (send-frame (λ (f) (send f hide-search)))) ;; key 4 (case (system-type) [(unix) @@ -1223,7 +1223,7 @@ (define setup-file (let* ([get-outer-editor ;; : text% -> text% ;; returns the outermost editor, if this editor is nested in an editor snip. - (lambda (edit) + (λ (edit) (let loop ([edit edit]) (let ([admin (send edit get-admin)]) (cond @@ -1231,7 +1231,7 @@ (loop (send (send (send admin get-snip) get-admin) get-editor))] [else edit]))))] [save-file-as - (lambda (this-edit event) + (λ (this-edit event) (let ([edit (get-outer-editor this-edit)]) (parameterize ([finder:dialog-parent-parameter (and (is-a? edit editor:basic<%>) @@ -1241,24 +1241,24 @@ (send edit save-file/gui-error file))))) #t)] [save-file - (lambda (this-edit event) + (λ (this-edit event) (let ([edit (get-outer-editor this-edit)]) (if (send edit get-filename) (send edit save-file/gui-error) (save-file-as edit event))) #t)] [load-file - (lambda (edit event) + (λ (edit event) (handler:open-file) #t)]) - (lambda (kmap) - (let* ([map (lambda (key func) + (λ (kmap) + (let* ([map (λ (key func) (send kmap map-function key func))] - [map-meta (lambda (key func) + [map-meta (λ (key func) (send-map-function-meta kmap key func))] - [add (lambda (name func) + [add (λ (name func) (send kmap add-function name func))] - [add-m (lambda (name func) + [add-m (λ (name func) (send kmap add-function name func))]) (add "save-file" save-file) @@ -1272,10 +1272,10 @@ (define (setup-editor kmap) (let ([add/map - (lambda (func op key) + (λ (func op key) (send kmap add-function func - (lambda (editor evt) + (λ (editor evt) (send editor do-edit-operation op))) (send kmap map-function (string-append @@ -1322,7 +1322,7 @@ (define (call/text-keymap-initializer thunk) (let ([ctki (current-text-keymap-initializer)]) (parameterize ([current-text-keymap-initializer - (lambda (keymap) + (λ (keymap) (send keymap chain-to-keymap global #t) (ctki keymap))]) (thunk))))))) diff --git a/collects/framework/private/main.ss b/collects/framework/private/main.ss index e475b7f1..8af05a4d 100644 --- a/collects/framework/private/main.ss +++ b/collects/framework/private/main.ss @@ -20,25 +20,25 @@ [color-prefs : framework:color-prefs^] [scheme : framework:scheme^]) - (application-preferences-handler (lambda () (preferences:show-dialog))) + (application-preferences-handler (λ () (preferences:show-dialog))) (preferences:set-default 'framework:basic-canvas-background (send the-color-database find-color "white") - (lambda (x) (is-a? x color%))) + (λ (x) (is-a? x color%))) (preferences:set-un/marshall 'framework:basic-canvas-background - (lambda (clr) (list (send clr red) (send clr green) (send clr blue))) - (lambda (lst) (and (pair? lst) + (λ (clr) (list (send clr red) (send clr green) (send clr blue))) + (λ (lst) (and (pair? lst) (pair? (cdr lst)) (pair? (cddr lst)) (null? (cdddr lst)) (make-object color% (car lst) (cadr lst) (caddr lst))))) (preferences:set-default 'framework:special-option-key #f boolean?) - (preferences:add-callback 'framework:special-option-key (lambda (p v) (special-option-key v))) + (preferences:add-callback 'framework:special-option-key (λ (p v) (special-option-key v))) (special-option-key (preferences:get 'framework:special-option-key)) - (preferences:set-default 'framework:fraction-snip-style 'mixed (lambda (x) (memq x '(mixed improper)))) + (preferences:set-default 'framework:fraction-snip-style 'mixed (λ (x) (memq x '(mixed improper)))) (preferences:set-default 'framework:standard-style-list:font-name (get-family-builtin-face 'modern) @@ -50,12 +50,12 @@ [stl (send txt get-style-list)] [bcs (send stl basic-style)]) (send bcs get-size)) - (lambda (x) (and (number? x) (exact? x) (integer? x) (positive? x)))) + (λ (x) (and (number? x) (exact? x) (integer? x) (positive? x)))) (preferences:set-default 'framework:standard-style-list:smoothing 'default - (lambda (x) + (λ (x) (memq x '(unsmoothed partly-smoothed smoothed default)))) (editor:set-standard-style-list-pref-callbacks) @@ -67,18 +67,18 @@ (* 3/4 256) (- (* 7/8 256) 1))]) (make-object color% gray-level gray-level gray-level)) - (lambda (x) (is-a? x color%))) + (λ (x) (is-a? x color%))) (preferences:set-un/marshall 'framework:paren-match-color - (lambda (c) (list (send c red) (send c green) (send c blue))) - (lambda (l) (make-object color% (car l) (cadr l) (caddr l)))) + (λ (c) (list (send c red) (send c green) (send c blue))) + (λ (l) (make-object color% (car l) (cadr l) (caddr l)))) (preferences:set-default 'framework:recently-opened-files/pos null - (lambda (x) (and (list? x) + (λ (x) (and (list? x) (andmap - (lambda (x) + (λ (x) (and (list? x) (= 3 (length x)) (path? (car x)) @@ -88,12 +88,12 @@ (preferences:set-un/marshall 'framework:recently-opened-files/pos - (lambda (l) (map (lambda (ele) (cons (path->bytes (car ele)) (cdr ele))) l)) - (lambda (l) + (λ (l) (map (λ (ele) (cons (path->bytes (car ele)) (cdr ele))) l)) + (λ (l) (let/ec k (unless (list? l) (k '())) - (map (lambda (x) + (map (λ (x) (unless (and (list? x) (= 3 (length x)) (bytes? (car x)) @@ -105,27 +105,27 @@ (preferences:set-default 'framework:last-directory (find-system-path 'doc-dir) - (lambda (x) (or (not x) path-string?))) + (λ (x) (or (not x) path-string?))) (preferences:set-un/marshall 'framework:last-directory - (lambda (x) (and (path? x) (path->bytes x))) - (lambda (x) + (λ (x) (and (path? x) (path->bytes x))) + (λ (x) (and (bytes? x) (bytes->path x)))) (preferences:set-default 'framework:recent-max-count 50 - (lambda (x) (and (number? x) + (λ (x) (and (number? x) (x . > . 0) (integer? x)))) (preferences:add-callback 'framework:recent-max-count - (lambda (p v) + (λ (p v) (handler:size-recently-opened-files v))) (preferences:set-default 'framework:last-url-string "" string?) (preferences:set-default 'framework:recently-opened-sort-by 'age - (lambda (x) (or (eq? x 'age) (eq? x 'name)))) + (λ (x) (or (eq? x 'age) (eq? x 'name)))) (preferences:set-default 'framework:recent-items-window-w 400 number?) (preferences:set-default 'framework:recent-items-window-h 600 number?) (preferences:set-default 'framework:open-here? #f boolean?) @@ -142,25 +142,25 @@ (preferences:set-default 'framework:print-output-mode 'standard - (lambda (x) (or (eq? x 'standard) (eq? x 'postscript)))) + (λ (x) (or (eq? x 'standard) (eq? x 'postscript)))) (preferences:set-default 'framework:highlight-parens #t boolean?) (preferences:set-default 'framework:fixup-parens #t boolean?) (preferences:set-default 'framework:paren-match #t boolean?) (let ([hash-table (make-hash-table)]) - (for-each (lambda (x) + (for-each (λ (x) (hash-table-put! hash-table x 'define)) '()) - (for-each (lambda (x) + (for-each (λ (x) (hash-table-put! hash-table x 'begin)) '(case-lambda - match-lambda match-lambda* + match-lambda match-lambda* λ cond delay unit compound-unit compound-unit/sig public private override inherit sequence)) - (for-each (lambda (x) + (for-each (λ (x) (hash-table-put! hash-table x 'lambda)) '( cases @@ -201,26 +201,26 @@ (preferences:set-default 'framework:tabify (list hash-table #rx"^begin" #rx"^def" #f) - (lambda (x) + (λ (x) (and (list? x) (= (length x) 4) (hash-table? (car x)) - (andmap (lambda (x) (or (regexp? x) (not x))) (cdr x))))) + (andmap (λ (x) (or (regexp? x) (not x))) (cdr x))))) (preferences:set-un/marshall 'framework:tabify - (lambda (t) (cons (hash-table-map (car t) list) + (λ (t) (cons (hash-table-map (car t) list) (cdr t))) - (lambda (l) + (λ (l) (and (list? l) (= (length l) 4) - (andmap (lambda (x) (or (regexp? x) (not x))) + (andmap (λ (x) (or (regexp? x) (not x))) (cdr l)) - (andmap (lambda (x) (and (list? x) + (andmap (λ (x) (and (list? x) (= 2 (length x)) (andmap symbol? x))) (car l)) (let ([h (make-hash-table)]) - (for-each (lambda (x) (apply hash-table-put! h x)) (car l)) + (for-each (λ (x) (apply hash-table-put! h x)) (car l)) (cons h (cdr l))))))) @@ -235,13 +235,13 @@ (preferences:set-default 'framework:file-dialogs 'std - (lambda (x) + (λ (x) (or (eq? x 'common) (eq? x 'std)))) ;; scheme prefs - (for-each (lambda (line) + (for-each (λ (line) (let ([sym (car line)] [color (cadr line)]) (color-prefs:register-color-pref (scheme:short-sym->pref-name sym) @@ -252,14 +252,14 @@ (preferences:set-default 'framework:default-text-color (send the-color-database find-color "Black") - (lambda (x) (is-a? x color%))) + (λ (x) (is-a? x color%))) (preferences:set-un/marshall 'framework:default-text-color - (lambda (c) (list (send c red) (send c green) (send c blue))) - (lambda (lst) + (λ (c) (list (send c red) (send c green) (send c blue))) + (λ (lst) (make-object color% (car lst) (cadr lst) (caddr lst)))) (preferences:add-callback 'framework:default-text-color - (lambda (p v) + (λ (p v) (editor:set-default-font-color v))) ;; groups @@ -267,17 +267,17 @@ (preferences:set-default 'framework:exit-when-no-frames #t boolean?) (exit:insert-can?-callback - (lambda () + (λ () (send (group:get-the-frame-group) can-close-all?))) (exit:insert-on-callback - (lambda () + (λ () (send (group:get-the-frame-group) on-close-all) (preferences:silent-save) ;; the prefs may have changed as a result of closing the windows... )) (exit:insert-can?-callback - (lambda () + (λ () (or (preferences:save) (exit-anyway?)))) diff --git a/collects/framework/private/number-snip.ss b/collects/framework/private/number-snip.ss index 607b019c..9f606e03 100644 --- a/collects/framework/private/number-snip.ss +++ b/collects/framework/private/number-snip.ss @@ -464,19 +464,19 @@ (make-object checkable-menu-item% (string-constant show-decimal-expansion) menu - (lambda (x y) (set-fraction-view 'decimal)))] + (λ (x y) (set-fraction-view 'decimal)))] [mixed-fraction-item (make-object checkable-menu-item% (string-constant show-mixed-fraction-view) menu - (lambda (x y) + (λ (x y) (set-fraction-view 'mixed) (preferences:set 'framework:fraction-snip-style 'mixed)))] [improper-fraction-item (make-object checkable-menu-item% (string-constant show-improper-fraction-view) menu - (lambda (x y) + (λ (x y) (set-fraction-view 'improper) (preferences:set 'framework:fraction-snip-style 'improper)))]) @@ -490,7 +490,7 @@ (make-object menu-item% (string-constant show-more-decimal-places) menu - (lambda (x y) + (λ (x y) (iterate/reflow)))) menu)) @@ -512,5 +512,5 @@ ;; hash-table-bound? : hash-table TST -> boolean (define (hash-table-bound? ht key) (let/ec k - (hash-table-get ht key (lambda () (k #f))) + (hash-table-get ht key (λ () (k #f))) #t))))) \ No newline at end of file diff --git a/collects/framework/private/panel.ss b/collects/framework/private/panel.ss index aeffdb19..5c3c112d 100644 --- a/collects/framework/private/panel.ss +++ b/collects/framework/private/panel.ss @@ -35,7 +35,7 @@ ;; would like to remove the child here, waiting on a PR submitted ;; about change-children during after-new-child (change-children - (lambda (l) + (λ (l) (remq c l))) (error 'single-mixin::after-new-child @@ -51,7 +51,7 @@ [define/override (place-children l width height) (let-values ([(h-align-spec v-align-spec) (get-alignment)]) (let ([align - (lambda (total-size spec item-size) + (λ (total-size spec item-size) (floor (case spec [(center) (- (/ total-size 2) (/ item-size 2))] @@ -59,7 +59,7 @@ [(right bottom) (- total-size item-size)] [else (error 'place-children "alignment spec is unknown ~a~n" spec)])))]) - (map (lambda (l) + (map (λ (l) (let*-values ([(min-width min-height v-stretch? h-stretch?) (apply values l)] [(x this-width) @@ -85,7 +85,7 @@ (error 'active-child "got a panel that is not a child: ~e" x)) (unless (eq? x current-active-child) (begin-container-sequence) - (for-each (lambda (x) (send x show #f)) + (for-each (λ (x) (send x show #f)) (get-children)) (set! current-active-child x) (send current-active-child show #t) @@ -97,12 +97,12 @@ (mixin (single<%> window<%>) (single-window<%>) (inherit get-client-size get-size) [define/override container-size - (lambda (l) + (λ (l) (let-values ([(super-width super-height) (super container-size l)] [(client-width client-height) (get-client-size)] [(window-width window-height) (get-size)] [(calc-size) - (lambda (super client window) + (λ (super client window) (+ super (max 0 (- window client))))]) (values @@ -121,13 +121,13 @@ (init-field parent editor) (public get-editor-canvas% get-vertical% get-horizontal%) [define get-editor-canvas% - (lambda () + (λ () editor-canvas%)] [define get-vertical% - (lambda () + (λ () vertical-panel%)] [define get-horizontal% - (lambda () + (λ () horizontal-panel%)] (define/private (split p%) @@ -137,20 +137,20 @@ (is-a? canvas ec%) (eq? (send canvas get-editor) editor)) (let ([p (send canvas get-parent)]) - (send p change-children (lambda (x) null)) + (send p change-children (λ (x) null)) (let ([pc (make-object p% p)]) (send (make-object ec% (make-object vertical-panel% pc) editor) focus) (make-object ec% (make-object vertical-panel% pc) editor)))))) [define/public split-vertically - (lambda () + (λ () (split (get-vertical%)))] [define/public split-horizontally - (lambda () + (λ () (split (get-horizontal%)))] (public collapse) (define collapse - (lambda () + (λ () (let ([canvas (send (send parent get-top-level-window) get-edit-target-window)] [ec% (get-editor-canvas%)]) (when (and canvas @@ -161,7 +161,7 @@ (bell) (let* ([sp (send p get-parent)] [p-to-remain (send sp get-parent)]) - (send p-to-remain change-children (lambda (x) null)) + (send p-to-remain change-children (λ (x) null)) (send (make-object ec% p-to-remain editor) focus)))))))) @@ -257,7 +257,7 @@ (let ([len-children (length (get-children))]) (unless (= len-children (length percentages)) (let ([rat (/ 1 len-children)]) - (set! percentages (build-list len-children (lambda (i) (make-percentage rat))))) + (set! percentages (build-list len-children (λ (i) (make-percentage rat))))) (after-percentage-change)))) (define/override (after-new-child child) @@ -270,7 +270,7 @@ (define/override (on-subwindow-event receiver evt) (if (eq? receiver this) (let ([gap - (ormap (lambda (gap) + (ormap (λ (gap) (and (<= (gap-before-dim gap) (event-get-dim evt) (gap-after-dim gap)) @@ -321,7 +321,7 @@ [else (let ([available-extent (get-available-extent)] [show-error - (lambda (n) + (λ (n) (error 'panel.ss::dragable-panel "internal error.~a" n))]) (let loop ([percentages percentages] [children (get-children)] diff --git a/collects/framework/private/path-utils.ss b/collects/framework/private/path-utils.ss index dd3da18f..aef07119 100644 --- a/collects/framework/private/path-utils.ss +++ b/collects/framework/private/path-utils.ss @@ -53,7 +53,7 @@ [(and (eq? (system-type) 'windows) (regexp-match #rx#"(.*)\\.[^.]*" name-bytes)) => - (lambda (m) + (λ (m) (build-path base (bytes->path (bytes-append (cadr m) #".bak"))))] [(eq? (system-type) 'windows) (build-path base (bytes->path (bytes-append name-bytes #".bak")))] diff --git a/collects/framework/private/preferences.ss b/collects/framework/private/preferences.ss index 9f66118c..19da01b0 100644 --- a/collects/framework/private/preferences.ss +++ b/collects/framework/private/preferences.ss @@ -70,7 +70,7 @@ p)) (hash-table-get preferences p - (lambda () + (λ () (let* ([def (hash-table-get defaults p)] [def-val (default-value def)]) (hash-table-put! preferences p def-val) @@ -82,7 +82,7 @@ (define (set p value) (let ([default (hash-table-get defaults p - (lambda () + (λ () (raise-unknown-preference-error "preferences:set: tried to set the preference ~e to ~e, but no default is set" p @@ -107,7 +107,7 @@ [unmarshall-fn (un/marshall-unmarshall (hash-table-get marshall-unmarshall p - (lambda () (k data))))] + (λ () (k data))))] [default (hash-table-get defaults p)]) (let ([result (unmarshall-fn data)]) (if ((default-checker default) result) @@ -123,13 +123,13 @@ (hash-table-put! callbacks p (append - (hash-table-get callbacks p (lambda () null)) + (hash-table-get callbacks p (λ () null)) (list new-cb))) - (lambda () + (λ () (hash-table-put! callbacks p - (let loop ([callbacks (hash-table-get callbacks p (lambda () null))]) + (let loop ([callbacks (hash-table-get callbacks p (λ () null))]) (cond [(null? callbacks) null] [else @@ -143,7 +143,7 @@ ;; check-callbacks : sym val -> void (define (check-callbacks p value) (let ([new-callbacks - (let loop ([callbacks (hash-table-get callbacks p (lambda () null))]) + (let loop ([callbacks (hash-table-get callbacks p (λ () null))]) (cond [(null? callbacks) null] [else @@ -165,7 +165,7 @@ (hash-table-put! callbacks p new-callbacks)))) (define set-un/marshall - (lambda (p marshall unmarshall) + (λ (p marshall unmarshall) (unless (hash-table-bound? defaults p) (error 'set-un/marshall "must call set-default for ~s before calling set-un/marshall for ~s" p p)) @@ -175,14 +175,14 @@ (define (hash-table-bound? ht s) (let/ec k - (hash-table-get ht s (lambda () (k #f))) + (hash-table-get ht s (λ () (k #f))) #t)) (define restore-defaults - (lambda () + (λ () (hash-table-for-each defaults - (lambda (p v) (set p v))))) + (λ (p v) (set p v))))) ;; set-default : (sym TST (TST -> boolean) -> void (define (set-default p default-value checker) @@ -200,7 +200,7 @@ ;; returns #t if the preference's value has been examined with set or get (define (pref-has-value? p) (let/ec k - (let ([b (hash-table-get preferences p (lambda () (k #f)))]) + (let ([b (hash-table-get preferences p (λ () (k #f)))]) (not (marshalled? b))))) @@ -212,7 +212,7 @@ ;; and result indicates if there was an error (define (raw-save silent?) (with-handlers ([exn:fail? - (lambda (exn) + (λ (exn) (unless silent? (message-box (string-constant preferences) @@ -224,18 +224,18 @@ [res #t]) (put-preferences syms vals - (lambda (filename) + (λ (filename) (unless silent? (let* ([d (make-object dialog% (string-constant preferences))] [m (make-object message% (string-constant waiting-for-pref-lock) d)]) (thread - (lambda () + (λ () (sleep 2) (send d show #f))) (send d show #t) (put-preferences syms vals - (lambda (filename) + (λ (filename) (set! res #f) (message-box (string-constant preferences) @@ -250,7 +250,7 @@ (let* ([marshaller (un/marshall-marshall (hash-table-get marshall-unmarshall p - (lambda () (k (list p value)))))] + (λ () (k (list p value)))))] [marshalled (marshaller value)]) (list p marshalled))))) @@ -281,7 +281,7 @@ ;; get-disk-prefs/install : (-> A) -> (union A sexp) (define (get-disk-prefs/install fail) (let/ec k - (let ([sexp (get-disk-prefs (lambda () (k (fail))))]) + (let ([sexp (get-disk-prefs (λ () (k (fail))))]) (install-stashed-preferences sexp '()) sexp))) @@ -290,7 +290,7 @@ (let/ec k (let* ([filename (find-system-path 'pref-file)] [mod (and (file-exists? filename) (file-or-directory-modify-seconds filename))] - [sexp (get-preference main-preferences-symbol (lambda () (k (fail))))]) + [sexp (get-preference main-preferences-symbol (λ () (k (fail))))]) sexp))) ;; install-stashed-preferences : sexp (listof symbol) -> void @@ -299,7 +299,7 @@ (define (install-stashed-preferences prefs skip) (for-each-pref-in-sexp prefs - (lambda (p marshalled) + (λ (p marshalled) (unless (memq p skip) (let ([unmarshalled (unmarshall p (make-marshalled marshalled))]) (hash-table-put! preferences p unmarshalled) @@ -308,8 +308,8 @@ (define (for-each-pref-in-file parse-pref preferences-filename) (let/ec k (let ([input (with-handlers - ([(lambda (x) #f) ;exn:fail? - (lambda (exn) + ([(λ (x) #f) ;exn:fail? + (λ (exn) (message-box (string-constant error-reading-preferences) (string-append @@ -373,7 +373,7 @@ (add-to-existing-children titles make-panel - (lambda (new-subtree) (set! ppanels (cons new-subtree ppanels)))))) + (λ (new-subtree) (set! ppanels (cons new-subtree ppanels)))))) ;; add-to-existing-children : (listof string) (panel -> panel) (ppanel -> void) ;; adds the child specified by the path in-titles to the tree. @@ -398,7 +398,7 @@ (ppanel-interior-children child) (car titles) (cdr titles) - (lambda (x) + (λ (x) (set-ppanel-interior-children! (cons x @@ -407,7 +407,7 @@ (cdr children) title titles - (lambda (x) + (λ (x) (set-cdr! children (cons x (cdr children)))))))]))) @@ -448,19 +448,19 @@ (define can-close-dialog-callbacks null) (define (make-preferences-dialog) - (letrec ([stashed-prefs (get-disk-prefs/install (lambda () null))] + (letrec ([stashed-prefs (get-disk-prefs/install (λ () null))] [frame-stashed-prefs% (class frame:basic% (define/override (show on?) (when on? - (set! stashed-prefs (get-disk-prefs/install (lambda () null)))) + (set! stashed-prefs (get-disk-prefs/install (λ () null)))) (super show on?)) (super-instantiate ()))] [frame (make-object frame-stashed-prefs% (string-constant preferences))] [build-ppanel-tree - (lambda (ppanel tab-panel single-panel) + (λ (ppanel tab-panel single-panel) (send tab-panel append (ppanel-name ppanel)) (cond [(ppanel-leaf? ppanel) @@ -468,10 +468,10 @@ [(ppanel-interior? ppanel) (let-values ([(tab-panel single-panel) (make-tab/single-panel single-panel #t)]) (for-each - (lambda (ppanel) (build-ppanel-tree ppanel tab-panel single-panel)) + (λ (ppanel) (build-ppanel-tree ppanel tab-panel single-panel)) (ppanel-interior-children ppanel)))]))] [make-tab/single-panel - (lambda (parent inset?) + (λ (parent inset?) (letrec ([spacer (and inset? (instantiate vertical-panel% () (parent parent) @@ -479,7 +479,7 @@ [tab-panel (instantiate tab-panel% () (choices null) (parent (if inset? spacer parent)) - (callback (lambda (_1 _2) + (callback (λ (_1 _2) (tab-panel-callback single-panel tab-panel))))] @@ -487,14 +487,14 @@ (parent tab-panel))]) (values tab-panel single-panel)))] [tab-panel-callback - (lambda (single-panel tab-panel) + (λ (single-panel tab-panel) (send single-panel active-child (list-ref (send single-panel get-children) (send tab-panel get-selection))))] [panel (make-object vertical-panel% (send frame get-area-container))] [_ (let-values ([(tab-panel single-panel) (make-tab/single-panel panel #f)]) (for-each - (lambda (ppanel) + (λ (ppanel) (build-ppanel-tree ppanel tab-panel single-panel)) ppanels) (let ([single-panel-children (send single-panel get-children)]) @@ -503,15 +503,15 @@ (send tab-panel set-selection 0))) (send tab-panel focus))] [bottom-panel (make-object horizontal-panel% panel)] - [ok-callback (lambda args - (when (andmap (lambda (f) (f)) + [ok-callback (λ args + (when (andmap (λ (f) (f)) can-close-dialog-callbacks) (for-each - (lambda (f) (f)) + (λ (f) (f)) on-close-dialog-callbacks) (save) (hide-dialog)))] - [cancel-callback (lambda (_1 _2) + [cancel-callback (λ (_1 _2) (hide-dialog) (install-stashed-preferences stashed-prefs '()))]) (gui-utils:ok/cancel-buttons @@ -528,17 +528,17 @@ (define (add-to-scheme-checkbox-panel f) (set! scheme-panel-procs (let ([old scheme-panel-procs]) - (lambda (parent) (old parent) (f parent))))) + (λ (parent) (old parent) (f parent))))) (define (add-to-editor-checkbox-panel f) (set! editor-panel-procs (let ([old editor-panel-procs]) - (lambda (parent) (old parent) (f parent))))) + (λ (parent) (old parent) (f parent))))) (define (add-to-warnings-checkbox-panel f) (set! warnings-panel-procs (let ([old warnings-panel-procs]) - (lambda (parent) (old parent) (f parent))))) + (λ (parent) (old parent) (f parent))))) (define scheme-panel-procs void) (define editor-panel-procs void) @@ -547,7 +547,7 @@ (define (add-checkbox-panel label proc) (add-panel label - (lambda (parent) + (λ (parent) (let* ([main (make-object vertical-panel% parent)]) (send main set-alignment 'left 'center) (proc main) @@ -557,14 +557,14 @@ ;; adds a check box preference to `main'. (define (make-check main pref title bool->pref pref->bool) (let* ([callback - (lambda (check-box _) + (λ (check-box _) (set pref (bool->pref (send check-box get-value))))] [pref-value (get pref)] [initial-value (pref->bool pref-value)] [c (make-object check-box% title main callback)]) (send c set-value initial-value) (add-callback pref - (lambda (p v) + (λ (p v) (send c set-value (pref->bool v)))))) (define (make-recent-items-slider parent) @@ -574,23 +574,23 @@ (min-value 1) (max-value 100) (init-value (get 'framework:recent-max-count)) - (callback (lambda (slider y) + (callback (λ (slider y) (set 'framework:recent-max-count (send slider get-value)))))]) (add-callback 'framework:recent-max-count - (lambda (p v) + (λ (p v) (send slider set-value v))))) (define (add-scheme-checkbox-panel) (letrec ([add-scheme-checkbox-panel - (lambda () + (λ () (set! add-scheme-checkbox-panel void) (add-checkbox-panel (list (string-constant editor-prefs-panel-label) (string-constant scheme-prefs-panel-label)) - (lambda (scheme-panel) + (λ (scheme-panel) (make-check scheme-panel 'framework:highlight-parens (string-constant highlight-parens) @@ -608,12 +608,12 @@ (define (add-editor-checkbox-panel) (letrec ([add-editor-checkbox-panel - (lambda () + (λ () (set! add-editor-checkbox-panel void) (add-checkbox-panel (list (string-constant editor-prefs-panel-label) (string-constant general-prefs-panel-label)) - (lambda (editor-panel) + (λ (editor-panel) (make-recent-items-slider editor-panel) (make-check editor-panel 'framework:autosaving-on? @@ -658,19 +658,19 @@ (make-check editor-panel 'framework:print-output-mode (string-constant automatically-to-ps) - (lambda (b) + (λ (b) (if b 'postscript 'standard)) - (lambda (n) (eq? 'postscript n)))) + (λ (n) (eq? 'postscript n)))) (editor-panel-procs editor-panel))))]) (add-editor-checkbox-panel))) (define (add-warnings-checkbox-panel) (letrec ([add-warnings-checkbox-panel - (lambda () + (λ () (set! add-warnings-checkbox-panel void) (add-checkbox-panel (string-constant warnings-prefs-panel-label) - (lambda (warnings-panel) + (λ (warnings-panel) (make-check warnings-panel 'framework:verify-change-format (string-constant ask-before-changing-format) @@ -701,15 +701,15 @@ [(macosx) 13] [else 12])] [font-section "mred"] - [build-font-entry (lambda (x) (string-append "Screen" x "__"))] + [build-font-entry (λ (x) (string-append "Screen" x "__"))] [font-file (find-graphical-system-path 'setup-file)] [build-font-preference-symbol - (lambda (family) + (λ (family) (string->symbol (string-append "framework:" family)))] [set-default - (lambda (build-font-entry default pred) - (lambda (family) + (λ (build-font-entry default pred) + (λ (family) (let ([name (build-font-preference-symbol family)] [font-entry (build-font-entry family)]) (set-default name @@ -720,7 +720,7 @@ [else (error 'internal-error.set-default "unrecognized default: ~a~n" default)])) (add-callback name - (lambda (p new-value) + (λ (p new-value) (write-resource font-section font-entry @@ -732,26 +732,26 @@ (for-each (set-default build-font-entry font-default-string string?) font-families) - ((set-default (lambda (x) x) + ((set-default (λ (x) x) font-default-size number?) font-size-entry) (add-panel (string-constant default-fonts) - (lambda (parent) + (λ (parent) (letrec ([font-size-pref-sym (build-font-preference-symbol font-size-entry)] [ex-string (string-constant font-example-string)] [main (make-object vertical-panel% parent)] [fonts (cons font-default-string (get-face-list))] [make-family-panel - (lambda (name) + (λ (name) (let* ([pref-sym (build-font-preference-symbol name)] [family-const-pair (assoc name font-families-name/const)] [edit (make-object text%)] [_ (send edit insert ex-string)] [set-edit-font - (lambda (size) + (λ (size) (let ([delta (make-object style-delta% 'change-size size)] [face (get pref-sym)]) (if (and (string=? face font-default-string) @@ -779,7 +779,7 @@ (make-object button% (string-constant change-font-button-label) horiz - (lambda (button evt) + (λ (button evt) (let ([new-value (get-choices-from-user (string-constant fonts) @@ -796,9 +796,9 @@ (set-edit-font (get font-size-pref-sym)) (add-callback pref-sym - (lambda (p new-value) + (λ (p new-value) (send horiz change-children - (lambda (l) + (λ (l) (let ([new-message (make-object message% new-value horiz)]) @@ -811,12 +811,12 @@ canvas)))))) (send canvas set-line-count 1) (vector set-edit-font - (lambda () (send message get-width)) - (lambda (width) (send message min-width width)) - (lambda () (send label get-width)) - (lambda (width) (send label min-width width)))))] + (λ () (send message get-width)) + (λ (width) (send message min-width width)) + (λ () (send label get-width)) + (λ (width) (send label min-width width)))))] [set-edit-fonts/messages (map make-family-panel font-families)] - [collect (lambda (n) (map (lambda (x) (vector-ref x n)) + [collect (λ (n) (map (λ (x) (vector-ref x n)) set-edit-fonts/messages))] [set-edit-fonts (collect 0)] [font-message-get-widths (collect 1)] @@ -824,9 +824,9 @@ [category-message-get-widths (collect 3)] [category-message-user-min-sizes (collect 4)] [update-message-sizes - (lambda (gets sets) - (let ([width (foldl (lambda (x l) (max l (x))) 0 gets)]) - (for-each (lambda (set) (set width)) sets)))] + (λ (gets sets) + (let ([width (foldl (λ (x l) (max l (x))) 0 gets)]) + (for-each (λ (set) (set width)) sets)))] [size-panel (make-object horizontal-panel% main '(border))] [initial-font-size (let ([b (box 0)]) @@ -840,19 +840,19 @@ (string-constant font-size-slider-label) 1 127 size-panel - (lambda (slider evt) + (λ (slider evt) (set font-size-pref-sym (send slider get-value))) initial-font-size)]) (update-message-sizes font-message-get-widths font-message-user-min-sizes) (update-message-sizes category-message-get-widths category-message-user-min-sizes) (add-callback font-size-pref-sym - (lambda (p value) - (for-each (lambda (f) (f value)) set-edit-fonts) + (λ (p value) + (for-each (λ (f) (f value)) set-edit-fonts) (unless (= value (send size-slider get-value)) (send size-slider set-value value)) #t)) - (for-each (lambda (f) (f initial-font-size)) set-edit-fonts) + (for-each (λ (f) (f initial-font-size)) set-edit-fonts) (make-object message% (string-constant restart-to-see-font-changes) main) main)))) (set! local-add-font-panel void)) diff --git a/collects/framework/private/scheme.ss b/collects/framework/private/scheme.ss index 950e605d..9dfd7cc7 100644 --- a/collects/framework/private/scheme.ss +++ b/collects/framework/private/scheme.ss @@ -46,8 +46,8 @@ (opt-lambda (text [start 0] [in-end #f]) (let* ([end (or in-end (send text last-position))] [port (open-input-text-editor text start end)]) - (with-handlers ([exn:fail:read:eof? (lambda (x) #f)] - [exn:fail:read? (lambda (x) #t)]) + (with-handlers ([exn:fail:read:eof? (λ (x) #f)] + [exn:fail:read? (λ (x) #t)]) (let loop () (let ([s (read port)]) (or (eof-object? s) @@ -74,7 +74,7 @@ (define/public (read-special file line col pos) (let ([text (make-object text:basic%)]) (for-each - (lambda (s) (send text insert (send s copy) + (λ (s) (send text insert (send s copy) (send text last-position) (send text last-position))) saved-snips) @@ -87,7 +87,7 @@ (opt-lambda (offset num [flattened? #f]) (if flattened? (apply string-append - (map (lambda (snip) + (map (λ (snip) (send snip get-text 0 (send snip get-count) flattened?)) saved-snips)) (super get-text offset num flattened?)))) @@ -156,7 +156,7 @@ (keymap:add-to-right-button-menu (let ([old (keymap:add-to-right-button-menu)]) - (lambda (menu text event) + (λ (menu text event) (old menu text event) (split/collapse-text menu text event) (void)))) @@ -167,11 +167,11 @@ (let* ([on-it-box (box #f)] [click-pos (call-with-values - (lambda () + (λ () (send text dc-location-to-editor-location (send event get-x) (send event get-y))) - (lambda (x y) + (λ (x y) (send text find-position x y #f on-it-box)))] [snip (send text find-snip click-pos 'after)] [char (send text get-character click-pos)] @@ -209,7 +209,7 @@ (instantiate menu-item% () (parent menu) (label (string-constant expand-sexp)) - (callback (lambda (item evt) (expand-from text snip))))) + (callback (λ (item evt) (expand-from text snip))))) ;; expand-from : (instanceof text%) (instanceof sexp-snip<%>) -> void (define (expand-from text snip) @@ -232,7 +232,7 @@ (instantiate menu-item% () (parent menu) (label (string-constant collapse-sexp)) - (callback (lambda (item evt) + (callback (λ (item evt) (collapse-from text left-pos right-pos))))) (define (collapse-from text left-pos right-pos) @@ -285,7 +285,7 @@ (define sn-hash (make-hash-table)) (define (short-sym->style-name sym) (hash-table-get sn-hash sym - (lambda () + (λ () (let ([s (format "framework:syntax-coloring:scheme:~a" sym)]) (hash-table-put! sn-hash sym s) s)))) @@ -293,9 +293,9 @@ (define (add-coloring-preferences-panel) (color-prefs:add-to-preferences-panel "Scheme" - (lambda (parent) + (λ (parent) (for-each - (lambda (line) + (λ (line) (let ([sym (car line)]) (color-prefs:build-color-selection-panel parent @@ -341,7 +341,7 @@ set-tab-size)) (define init-wordbreak-map - (lambda (map) + (λ (map) (let ([v (send map get-map #\-)]) (send map set-map #\- @@ -442,7 +442,7 @@ (position-paragraph last))]) (letrec ([find-offset - (lambda (pos) + (λ (pos) (let loop ([p pos][o 0]) (let ([c (get-character p)]) (cond @@ -455,7 +455,7 @@ [else (cons o p)]))))] [visual-offset - (lambda (pos) + (λ (pos) (let loop ([p (sub1 pos)]) (if (= p -1) 0 @@ -468,7 +468,7 @@ [(char=? c #\newline) 0] [else (add1 (loop (sub1 p)))])))))] [do-indent - (lambda (amt) + (λ (amt) (let* ([pos-start end] [curr-offset (find-offset pos-start)]) (unless (= amt (car curr-offset)) @@ -477,26 +477,26 @@ (make-string amt #\space) pos-start))))] [get-proc - (lambda () + (λ () (let ([id-end (forward-match contains (last-position))]) (if (and id-end (> id-end contains)) (let* ([text (get-text contains id-end)]) (or (get-keyword-type text) 'other)))))] [procedure-indent - (lambda () + (λ () (case (get-proc) [(define) 1] [(begin) 1] [(lambda) 3] [else 0]))] [special-check - (lambda () + (λ () (let* ([proc-name (get-proc)]) (or (eq? proc-name 'define) (eq? proc-name 'lambda))))] [indent-first-arg - (lambda (start) + (λ (start) (car (find-offset start)))]) (when (and okay (not (char=? (get-character (sub1 end)) @@ -561,13 +561,13 @@ (let ([first-para (position-paragraph start-pos)] [end-para (position-paragraph end-pos)]) (with-handlers ([exn:break? - (lambda (x) #t)]) + (λ (x) #t)]) (dynamic-wind - (lambda () + (λ () (when (< first-para end-para) (begin-busy-cursor)) (begin-edit-sequence)) - (lambda () + (λ () (let loop ([para first-para]) (when (<= para end-para) (tabify (paragraph-start-position para)) @@ -583,7 +583,7 @@ (not (char=? next #\newline)))) (loop (add1 new-pos)) new-pos))))) - (lambda () + (λ () (end-edit-sequence) (when (< first-para end-para) (end-busy-cursor)))))))) @@ -739,31 +739,31 @@ (set-position pos pos))) [define get-forward-sexp - (lambda (start-pos) + (λ (start-pos) (forward-match start-pos (last-position)))] [define remove-sexp - (lambda (start-pos) + (λ (start-pos) (let ([end-pos (get-forward-sexp start-pos)]) (if end-pos (kill 0 start-pos end-pos) (bell))) #t)] [define forward-sexp - (lambda (start-pos) + (λ (start-pos) (let ([end-pos (get-forward-sexp start-pos)]) (if end-pos (set-position end-pos) (bell)) #t))] [define flash-forward-sexp - (lambda (start-pos) + (λ (start-pos) (let ([end-pos (get-forward-sexp start-pos)]) (if end-pos (flash-on end-pos (add1 end-pos)) (bell)) #t))] [define get-backward-sexp - (lambda (start-pos) + (λ (start-pos) (let* ([limit (get-limit start-pos)] [end-pos (backward-match start-pos limit)] @@ -777,21 +777,21 @@ #f)]) ans))] [define flash-backward-sexp - (lambda (start-pos) + (λ (start-pos) (let ([end-pos (get-backward-sexp start-pos)]) (if end-pos (flash-on end-pos (add1 end-pos)) (bell)) #t))] [define backward-sexp - (lambda (start-pos) + (λ (start-pos) (let ([end-pos (get-backward-sexp start-pos)]) (if end-pos (set-position end-pos) (bell)) #t))] [define find-up-sexp - (lambda (start-pos) + (λ (start-pos) (let* ([limit-pos (get-limit start-pos)] [exp-pos (backward-containing-sexp start-pos limit-pos)]) @@ -799,7 +799,7 @@ (if (and exp-pos (> exp-pos limit-pos)) (let* ([in-start-pos (skip-whitespace exp-pos 'backward #t)] [paren-pos - (lambda (paren-pair) + (λ (paren-pair) (find-string (car paren-pair) 'backward @@ -818,14 +818,14 @@ (- (apply max poss) 1)))) ;; subtract one to move outside the paren #f)))] [define up-sexp - (lambda (start-pos) + (λ (start-pos) (let ([exp-pos (find-up-sexp start-pos)]) (if exp-pos (set-position exp-pos) (bell)) #t))] [define find-down-sexp - (lambda (start-pos) + (λ (start-pos) (let ([last (last-position)]) (let loop ([pos start-pos]) (let ([next-pos (forward-match pos last)]) @@ -838,14 +838,14 @@ (loop next-pos))) #f)))))] [define down-sexp - (lambda (start-pos) + (λ (start-pos) (let ([pos (find-down-sexp start-pos)]) (if pos (set-position pos) (bell)) #t))] [define remove-parens-forward - (lambda (start-pos) + (λ (start-pos) (let* ([pos (skip-whitespace start-pos 'forward #f)] [first-char (get-character pos)] [paren? (or (char=? first-char #\( ) @@ -874,10 +874,10 @@ (public select-forward-sexp select-backward-sexp select-up-sexp select-down-sexp transpose-sexp mark-matching-parenthesis) - [define select-forward-sexp (lambda () (select-text (lambda (x) (get-forward-sexp x)) #t))] - [define select-backward-sexp (lambda () (select-text (lambda (x) (get-backward-sexp x)) #f))] - [define select-up-sexp (lambda () (select-text (lambda (x) (find-up-sexp x)) #f))] - [define select-down-sexp (lambda () (select-text (lambda (x) (find-down-sexp x)) #t))] + [define select-forward-sexp (λ () (select-text (λ (x) (get-forward-sexp x)) #t))] + [define select-backward-sexp (λ () (select-text (λ (x) (get-backward-sexp x)) #f))] + [define select-up-sexp (λ () (select-text (λ (x) (find-up-sexp x)) #f))] + [define select-down-sexp (λ () (select-text (λ (x) (find-down-sexp x)) #t))] (inherit get-fixed-style) (define (mark-matching-parenthesis pos) @@ -900,7 +900,7 @@ (change-style matching-parenthesis-style (- end 1) end)]))))))) [define transpose-sexp - (lambda (pos) + (λ (pos) (let ([start-1 (get-backward-sexp pos)]) (if (not start-1) (bell) @@ -925,8 +925,8 @@ (end-edit-sequence)))))))))))] [define tab-size 8] (public get-tab-size set-tab-size) - [define get-tab-size (lambda () tab-size)] - [define set-tab-size (lambda (s) (set! tab-size s))] + [define get-tab-size (λ () tab-size)] + [define set-tab-size (λ (s) (set! tab-size s))] (super-instantiate ()))) @@ -985,7 +985,7 @@ (hash-table-get ht (string->symbol text) - (lambda () + (λ () (cond [(and beg-reg (regexp-match beg-reg text)) 'begin] [(and def-reg (regexp-match def-reg text)) 'define] @@ -1019,54 +1019,54 @@ ; ; ;; ;;; (define setup-keymap - (lambda (keymap) + (λ (keymap) (let ([add-pos-function - (lambda (name call-method) + (λ (name call-method) (send keymap add-function name - (lambda (edit event) + (λ (edit event) (call-method edit (send edit get-start-position)))))]) - (add-pos-function "remove-sexp" (lambda (e p) (send e remove-sexp p))) - (add-pos-function "forward-sexp" (lambda (e p) (send e forward-sexp p))) - (add-pos-function "backward-sexp" (lambda (e p) (send e backward-sexp p))) - (add-pos-function "up-sexp" (lambda (e p) (send e up-sexp p))) - (add-pos-function "down-sexp" (lambda (e p) (send e down-sexp p))) - (add-pos-function "flash-backward-sexp" (lambda (e p) (send e flash-backward-sexp p))) - (add-pos-function "flash-forward-sexp" (lambda (e p) (send e flash-forward-sexp p))) - (add-pos-function "remove-parens-forward" (lambda (e p) (send e remove-parens-forward p))) - (add-pos-function "transpose-sexp" (lambda (e p) (send e transpose-sexp p))) + (add-pos-function "remove-sexp" (λ (e p) (send e remove-sexp p))) + (add-pos-function "forward-sexp" (λ (e p) (send e forward-sexp p))) + (add-pos-function "backward-sexp" (λ (e p) (send e backward-sexp p))) + (add-pos-function "up-sexp" (λ (e p) (send e up-sexp p))) + (add-pos-function "down-sexp" (λ (e p) (send e down-sexp p))) + (add-pos-function "flash-backward-sexp" (λ (e p) (send e flash-backward-sexp p))) + (add-pos-function "flash-forward-sexp" (λ (e p) (send e flash-forward-sexp p))) + (add-pos-function "remove-parens-forward" (λ (e p) (send e remove-parens-forward p))) + (add-pos-function "transpose-sexp" (λ (e p) (send e transpose-sexp p))) (add-pos-function "mark-matching-parenthesis" - (lambda (e p) (send e mark-matching-parenthesis p)))) + (λ (e p) (send e mark-matching-parenthesis p)))) (let ([add-edit-function - (lambda (name call-method) + (λ (name call-method) (send keymap add-function name - (lambda (edit event) + (λ (edit event) (call-method edit))))]) (add-edit-function "select-forward-sexp" - (lambda (x) (send x select-forward-sexp))) + (λ (x) (send x select-forward-sexp))) (add-edit-function "select-backward-sexp" - (lambda (x) (send x select-backward-sexp))) + (λ (x) (send x select-backward-sexp))) (add-edit-function "select-down-sexp" - (lambda (x) (send x select-down-sexp))) + (λ (x) (send x select-down-sexp))) (add-edit-function "select-up-sexp" - (lambda (x) (send x select-up-sexp))) + (λ (x) (send x select-up-sexp))) (add-edit-function "tabify-at-caret" - (lambda (x) (send x tabify-selection))) + (λ (x) (send x tabify-selection))) (add-edit-function "do-return" - (lambda (x) + (λ (x) (send x insert-return))) (add-edit-function "comment-out" - (lambda (x) (send x comment-out-selection))) + (λ (x) (send x comment-out-selection))) (add-edit-function "box-comment-out" - (lambda (x) (send x box-comment-out-selection))) + (λ (x) (send x box-comment-out-selection))) (add-edit-function "uncomment" - (lambda (x) (send x uncomment-selection)))) + (λ (x) (send x uncomment-selection)))) (send keymap add-function "balance-parens" - (lambda (edit event) + (λ (edit event) (send edit balance-parens event))) (send keymap map-function "TAB" "tabify-at-caret") @@ -1086,10 +1086,10 @@ (send keymap map-function "}" "balance-parens") (let ([map-meta - (lambda (key func) + (λ (key func) (keymap:send-map-function-meta keymap key func))] [map - (lambda (key func) + (λ (key func) (send keymap map-function key func))]) (map-meta "up" "up-sexp") @@ -1168,11 +1168,11 @@ (preferences:add-panel (list (string-constant editor-prefs-panel-label) (string-constant indenting-prefs-panel-label)) - (lambda (p) + (λ (p) (define get-keywords - (lambda (hash-table) + (λ (hash-table) (letrec ([all-keywords (hash-table-map hash-table list)] - [pick-out (lambda (wanted in out) + [pick-out (λ (wanted in out) (cond [(null? in) (quicksort out string<=?)] [else (if (eq? wanted (cadr (car in))) @@ -1184,22 +1184,22 @@ (define-values (begin-keywords define-keywords lambda-keywords) (get-keywords (car (preferences:get 'framework:tabify)))) (define add-button-callback - (lambda (keyword-type keyword-symbol list-box) - (lambda (button command) + (λ (keyword-type keyword-symbol list-box) + (λ (button command) (let ([new-one (keymap:call/text-keymap-initializer - (lambda () + (λ () (get-text-from-user (format (string-constant enter-new-keyword) keyword-type) (format (string-constant x-keyword) keyword-type))))]) (when new-one - (let ([parsed (with-handlers ((exn:fail:read? (lambda (x) #f))) + (let ([parsed (with-handlers ((exn:fail:read? (λ (x) #f))) (read (open-input-string new-one)))]) (cond [(and (symbol? parsed) (hash-table-get (car (preferences:get 'framework:tabify)) parsed - (lambda () #f))) + (λ () #f))) (message-box (string-constant error) (format (string-constant already-used-keyword) parsed))] [(symbol? parsed) @@ -1210,30 +1210,30 @@ (string-constant error) (format (string-constant expected-a-symbol) new-one))]))))))) (define delete-callback - (lambda (list-box) - (lambda (button command) + (λ (list-box) + (λ (button command) (let* ([selections (send list-box get-selections)] - [symbols (map (lambda (x) (string->symbol (send list-box get-string x))) selections)]) - (for-each (lambda (x) (send list-box delete x)) (reverse selections)) + [symbols (map (λ (x) (string->symbol (send list-box get-string x))) selections)]) + (for-each (λ (x) (send list-box delete x)) (reverse selections)) (let ([ht (car (preferences:get 'framework:tabify))]) - (for-each (lambda (x) (hash-table-remove! ht x)) symbols)))))) + (for-each (λ (x) (hash-table-remove! ht x)) symbols)))))) (define main-panel (make-object horizontal-panel% p)) (define make-column - (lambda (string symbol keywords bang-regexp) + (λ (string symbol keywords bang-regexp) (let* ([vert (make-object vertical-panel% main-panel)] [_ (make-object message% (format (string-constant x-like-keywords) string) vert)] [box (make-object list-box% #f keywords vert void '(multiple))] [button-panel (make-object horizontal-panel% vert)] [text (new text-field% (label (string-constant indenting-prefs-extra-regexp)) - (callback (lambda (tf evt) + (callback (λ (tf evt) (let ([str (send tf get-value)]) (cond [(equal? str "") (bang-regexp #f)] [else (with-handlers ([exn:fail? - (lambda (x) + (λ (x) (color-yellow (send tf get-editor)))]) (bang-regexp (regexp str)) (clear-color (send tf get-editor)))])))) @@ -1259,32 +1259,32 @@ (make-column "Begin" 'begin begin-keywords - (lambda (x) (set-car! (cdr (preferences:get 'framework:tabify)) x)))) + (λ (x) (set-car! (cdr (preferences:get 'framework:tabify)) x)))) (define-values (define-list-box define-regexp-text) (make-column "Define" 'define define-keywords - (lambda (x) (set-car! (cddr (preferences:get 'framework:tabify)) x)))) + (λ (x) (set-car! (cddr (preferences:get 'framework:tabify)) x)))) (define-values (lambda-list-box lambda-regexp-text) (make-column "Lambda" 'lambda lambda-keywords - (lambda (x) (set-car! (cdddr (preferences:get 'framework:tabify)) x)))) + (λ (x) (set-car! (cdddr (preferences:get 'framework:tabify)) x)))) (define update-list-boxes - (lambda (hash-table) + (λ (hash-table) (let-values ([(begin-keywords define-keywords lambda-keywords) (get-keywords hash-table)] - [(reset) (lambda (list-box keywords) + [(reset) (λ (list-box keywords) (send list-box clear) - (for-each (lambda (x) (send list-box append x)) keywords))]) + (for-each (λ (x) (send list-box append x)) keywords))]) (reset begin-list-box begin-keywords) (reset define-list-box define-keywords) (reset lambda-list-box lambda-keywords) #t))) (define update-gui - (lambda (pref) + (λ (pref) (update-list-boxes (car pref)) (send begin-regexp-text set-value (or (object-name (cadr pref)) "")) (send define-regexp-text set-value (or (object-name (caddr pref)) "")) (send lambda-regexp-text set-value (or (object-name (cadddr pref)) "")))) - (preferences:add-callback 'framework:tabify (lambda (p v) (update-gui v))) + (preferences:add-callback 'framework:tabify (λ (p v) (update-gui v))) main-panel)))))) diff --git a/collects/framework/private/standard-menus-items.ss b/collects/framework/private/standard-menus-items.ss index c09899f1..bcf2c641 100644 --- a/collects/framework/private/standard-menus-items.ss +++ b/collects/framework/private/standard-menus-items.ss @@ -100,7 +100,7 @@ (format "~a:~a-help-string" (menu-item-menu-name item) (an-item-item-name item)))) (define (edit-menu:do const) - `(lambda (menu evt) + `(λ (menu evt) (let ([edit (get-edit-target-object)]) (when (and edit (is-a? edit editor<%>)) @@ -108,7 +108,7 @@ #t)) (define (edit-menu:can-do-on-demand const) - `(lambda (item) + `(λ (item) (let* ([editor (get-edit-target-object)] [enable? (and editor @@ -117,12 +117,12 @@ (send item enable enable?)))) (define edit-menu:edit-target-on-demand - `(lambda (item) + `(λ (item) (send item enable (let ([target (get-edit-target-object)]) (and target (is-a? target editor<%>)))))) - (define on-demand-do-nothing '(lambda (menu-item) (void))) + (define on-demand-do-nothing '(λ (menu-item) (void))) (define items (list (make-generic-augment @@ -133,7 +133,7 @@ '("@return : void" "Removes the preferences callbacks for the menu items")) (make-generic-method - 'get-menu% '(lambda () menu:can-restore-underscore-menu%) + 'get-menu% '(λ () menu:can-restore-underscore-menu%) '("The result of this method is used as the class" "for creating the result of these methods:" "@ilink frame:standard-menus get-file-menu %" @@ -148,7 +148,7 @@ "defaultly returns" "@link menu")) (make-generic-method - 'get-menu-item% '(lambda () menu:can-restore-menu-item%) + 'get-menu-item% '(λ () menu:can-restore-menu-item%) '("The result of this method is used as the class for creating" "the menu items in this frame (see " "@link frame:standard-menus" @@ -160,7 +160,7 @@ "@link menu:can-restore-menu-item %" ".")) (make-generic-method - 'get-checkable-menu-item% '(lambda () menu:can-restore-checkable-menu-item%) + 'get-checkable-menu-item% '(λ () menu:can-restore-checkable-menu-item%) '("The result of this method is used as the class for creating" "checkable menu items in this class (see " "@link frame:standard-menus" @@ -174,7 +174,7 @@ (make-generic-method 'get-file-menu - '(lambda () file-menu) + '(λ () file-menu) '("Returns the file menu" "See also" "@ilink frame:standard-menus get-menu\\%" @@ -189,7 +189,7 @@ (get-menu-bar))) (make-generic-method 'get-edit-menu - '(lambda () edit-menu) + '(λ () edit-menu) '("Returns the edit menu" "See also" @@ -201,7 +201,7 @@ '(make-object (get-menu%) (string-constant edit-menu-label) (get-menu-bar))) (make-generic-method 'get-help-menu - '(lambda () help-menu) + '(λ () help-menu) '("Returns the help menu" "See also" @@ -214,30 +214,30 @@ (make-an-item 'file-menu 'new '(string-constant new-info) - '(lambda (item control) (handler:edit-file #f) #t) + '(λ (item control) (handler:edit-file #f) #t) #\n '(string-constant new-menu-item) on-demand-do-nothing #t) (make-between 'file-menu 'new 'open 'nothing) (make-an-item 'file-menu 'open '(string-constant open-info) - '(lambda (item control) (handler:open-file) #t) + '(λ (item control) (handler:open-file) #t) #\o '(string-constant open-menu-item) on-demand-do-nothing #t) (make-a-submenu-item 'file-menu 'open-recent '(string-constant open-recent-info) - '(lambda (x y) (void)) + '(λ (x y) (void)) #f '(string-constant open-recent-menu-item) - '(lambda (menu) + '(λ (menu) (handler:install-recent-items menu)) #t) (make-between 'file-menu 'open 'revert 'nothing) (make-an-item 'file-menu 'revert '(string-constant revert-info) - '(lambda (item control) (void)) + '(λ (item control) (void)) #f '(string-constant revert-menu-item) on-demand-do-nothing @@ -245,14 +245,14 @@ (make-between 'file-menu 'revert 'save 'nothing) (make-an-item 'file-menu 'save '(string-constant save-info) - '(lambda (item control) (void)) + '(λ (item control) (void)) #\s '(string-constant save-menu-item) on-demand-do-nothing #f) (make-an-item 'file-menu 'save-as '(string-constant save-as-info) - '(lambda (item control) (void)) + '(λ (item control) (void)) #f '(string-constant save-as-menu-item) on-demand-do-nothing @@ -260,7 +260,7 @@ (make-between 'file-menu 'save-as 'print 'nothing) (make-an-item 'file-menu 'print '(string-constant print-info) - '(lambda (item control) (void)) + '(λ (item control) (void)) #\p '(string-constant print-menu-item) on-demand-do-nothing @@ -268,7 +268,7 @@ (make-between 'file-menu 'print 'close 'separator) (make-an-item 'file-menu 'close '(string-constant close-info) - '(lambda (item control) (when (can-close?) (on-close) (show #f)) #t) + '(λ (item control) (when (can-close?) (on-close) (show #f)) #t) #\w '(string-constant close-menu-item) on-demand-do-nothing @@ -276,7 +276,7 @@ (make-between 'file-menu 'close 'quit 'nothing) (make-an-item 'file-menu 'quit '(string-constant quit-info) - '(lambda (item control) + '(λ (item control) (when (exit:user-oks-exit) (exit:exit))) #\q @@ -346,21 +346,21 @@ (make-an-item 'edit-menu 'find '(string-constant find-info) - '(lambda (item control) (void)) + '(λ (item control) (void)) #\f '(string-constant find-menu-item) edit-menu:edit-target-on-demand #f) (make-an-item 'edit-menu 'find-again '(string-constant find-again-info) - '(lambda (item control) (void)) + '(λ (item control) (void)) #\g '(string-constant find-again-menu-item) edit-menu:edit-target-on-demand #f) (make-an-item 'edit-menu 'replace-and-find-again '(string-constant replace-and-find-again-info) - '(lambda (item control) (void)) + '(λ (item control) (void)) '(if (eq? (system-type) 'macosx) #f #\h) '(string-constant replace-and-find-again-menu-item) edit-menu:edit-target-on-demand @@ -369,7 +369,7 @@ (make-between 'edit-menu 'find 'preferences 'nothing-with-standard-menus) (make-an-item 'edit-menu 'preferences '(string-constant preferences-info) - '(lambda (item control) (preferences:show-dialog) #t) + '(λ (item control) (preferences:show-dialog) #t) #\; '(string-constant preferences-menu-item) on-demand-do-nothing @@ -379,7 +379,7 @@ (make-before 'help-menu 'about 'nothing) (make-an-item 'help-menu 'about '(string-constant about-info) - '(lambda (item control) (void)) + '(λ (item control) (void)) #f '(string-constant about-menu-item) on-demand-do-nothing diff --git a/collects/framework/private/text.ss b/collects/framework/private/text.ss index 73945af0..6074722b 100644 --- a/collects/framework/private/text.ss +++ b/collects/framework/private/text.ss @@ -108,7 +108,7 @@ WARNING: printf is rebound in the body of the unit to always (let-values ([(this-left this-right) (send (car canvases) call-as-primary-owner - (lambda () + (λ () (send (get-admin) get-view b1 b2 b3 b4) (let* ([this-left (unbox b1)] [this-width (unbox b3)] @@ -167,7 +167,7 @@ WARNING: printf is rebound in the body of the unit to always (let* ([b1 (box 0)] [b2 (box 0)] [new-rectangles - (lambda (range) + (λ (range) (let* ([start (range-start range)] [end (range-end range)] [b/w-bitmap (range-b/w-bitmap range)] @@ -227,13 +227,13 @@ WARNING: printf is rebound in the body of the unit to always [old-rectangles range-rectangles]) (set! range-rectangles - (foldl (lambda (x l) (append (new-rectangles x) l)) + (foldl (λ (x l) (append (new-rectangles x) l)) null ranges)))) (define/public highlight-range (opt-lambda (start end color [bitmap #f] [caret-space? #f] [priority 'low]) (unless (let ([exact-pos-int? - (lambda (x) (and (integer? x) (exact? x) (x . >= . 0)))]) + (λ (x) (and (integer? x) (exact? x) (x . >= . 0)))]) (and (exact-pos-int? start) (exact-pos-int? end))) (error 'highlight-range "expected first two arguments to be non-negative exact integers, got: ~e ~e" @@ -246,7 +246,7 @@ WARNING: printf is rebound in the body of the unit to always (set! ranges (if (eq? priority 'high) (cons l ranges) (append ranges (list l)))) (recompute-range-rectangles) (invalidate-rectangles range-rectangles) - (lambda () + (λ () (let ([old-rectangles range-rectangles]) (set! ranges (let loop ([r ranges]) @@ -265,7 +265,7 @@ WARNING: printf is rebound in the body of the unit to always [b3 (box 0)] [b4 (box 0)]) (for-each - (lambda (rectangle) + (λ (rectangle) (let-values ([(view-x view-y view-width view-height) (begin (send (get-admin) get-view b1 b2 b3 b4) @@ -291,7 +291,7 @@ WARNING: printf is rebound in the body of the unit to always rc #f)) rc))] - [first-number (lambda (x y) (if (number? x) x y))] + [first-number (λ (x y) (if (number? x) x y))] [left (max left-margin (first-number (rectangle-left rectangle) view-x))] [top (max top-margin (rectangle-top rectangle))] [right (min right-margin @@ -519,8 +519,8 @@ WARNING: printf is rebound in the body of the unit to always (cond [(zero? n) (if blank? - (lambda (dc x y) (void)) - (lambda (dc x y) + (λ (dc x y) (void)) + (λ (dc x y) (send dc draw-line (+ x n) y (+ x n (- len 1)) y)))] [else (let ([white? (char-whitespace? (string-ref str (- n 1)))]) @@ -531,7 +531,7 @@ WARNING: printf is rebound in the body of the unit to always (let ([res (loop (- n 1) 1 (not blank?))]) (if blank? res - (lambda (dc x y) + (λ (dc x y) (send dc draw-line (+ x n) y (+ x n (- len 1)) y) (res dc x y))))]))]))) @@ -644,7 +644,7 @@ WARNING: printf is rebound in the body of the unit to always (send delegate last-position)) (loop (send snip next))))) (for-each - (lambda (range) + (λ (range) (send delegate highlight-range (range-start range) (range-end range) @@ -662,7 +662,7 @@ WARNING: printf is rebound in the body of the unit to always (if delegate (let ([delegate-res (send delegate highlight-range start end color bitmap caret-space? priority)]) - (lambda () + (λ () (res) (delegate-res))) res)))) @@ -690,7 +690,7 @@ WARNING: printf is rebound in the body of the unit to always (when (and delegate linked-snips (not (is-a? snip string-snip%))) - (let ([delegate-copy (hash-table-get linked-snips snip (lambda () #f))]) + (let ([delegate-copy (hash-table-get linked-snips snip (λ () #f))]) (when delegate-copy (send delegate resized delegate-copy redraw-now?))))) @@ -754,7 +754,7 @@ WARNING: printf is rebound in the body of the unit to always (define/private (enqueue-for-frame call-method tag) (run-after-edit-sequence (rec from-enqueue-for-frame - (lambda () + (λ () (call-with-frame call-method))) tag)) @@ -770,12 +770,12 @@ WARNING: printf is rebound in the body of the unit to always (define/override (set-anchor x) (super set-anchor x) (enqueue-for-frame - (lambda (x) (send x anchor-status-changed)) + (λ (x) (send x anchor-status-changed)) 'framework:anchor-status-changed)) (define/override (set-overwrite-mode x) (super set-overwrite-mode x) (enqueue-for-frame - (lambda (x) (send x overwrite-status-changed)) + (λ (x) (send x overwrite-status-changed)) 'framework:overwrite-status-changed)) (define/augment (after-set-position) (maybe-queue-editor-position-update) @@ -787,11 +787,11 @@ WARNING: printf is rebound in the body of the unit to always (define callback-running? #f) (define/private (maybe-queue-editor-position-update) (enqueue-for-frame - (lambda (frame) + (λ (frame) (unless callback-running? (set! callback-running? #t) (queue-callback - (lambda () + (λ () (send frame editor-position-changed) (set! callback-running? #f)) #f))) @@ -1061,12 +1061,12 @@ WARNING: printf is rebound in the body of the unit to always (for-each/snips-chars unread-start-point (last-position) - (lambda (s/c line-col-pos) + (λ (s/c line-col-pos) (cond [(is-a? s/c snip%) (channel-put read-chan (cons s/c line-col-pos))] [(char? s/c) - (for-each (lambda (b) (channel-put read-chan (cons b line-col-pos))) + (for-each (λ (b) (channel-put read-chan (cons b line-col-pos))) (bytes->list (string->bytes/utf-8 (string s/c))))]))) (set! allow-tabify? #f) (set! allow-tabify? #t) @@ -1110,7 +1110,7 @@ WARNING: printf is rebound in the body of the unit to always (define/private (queue-insertion txts signal) (parameterize ([current-eventspace eventspace]) (queue-callback - (lambda () + (λ () (do-insertion txts) (sync signal))))) @@ -1161,7 +1161,7 @@ WARNING: printf is rebound in the body of the unit to always (define output-buffer-thread (let ([converter (bytes-open-converter "UTF-8-permissive" "UTF-8")]) (thread - (lambda () + (λ () (let loop (;; text-to-insert : (queue (cons (union snip bytes) style)) [text-to-insert (empty-queue)] [last-flush (current-inexact-milliseconds)]) @@ -1171,7 +1171,7 @@ WARNING: printf is rebound in the body of the unit to always never-evt (handle-evt (alarm-evt (+ last-flush msec-timeout)) - (lambda (_) + (λ (_) (dprintf show-dprintf? "o: alarm.1 ~s\n" (queue->list text-to-insert)) (let-values ([(viable-bytes remaining-queue) (split-queue converter text-to-insert)]) (dprintf show-dprintf? "o: alarm.2 ~s\n" viable-bytes) @@ -1179,7 +1179,7 @@ WARNING: printf is rebound in the body of the unit to always (loop remaining-queue (current-inexact-milliseconds)))))) (handle-evt flush-chan - (lambda (return-evt) + (λ (return-evt) (dprintf show-dprintf? "o: flush.1 ~s\n" (queue->list text-to-insert)) (let-values ([(viable-bytes remaining-queue) (split-queue converter text-to-insert)]) (dprintf show-dprintf? "o: flush.2 ~s\n" viable-bytes) @@ -1187,12 +1187,12 @@ WARNING: printf is rebound in the body of the unit to always (loop remaining-queue (current-inexact-milliseconds))))) (handle-evt clear-output-chan - (lambda (_) + (λ (_) (dprintf show-dprintf? "o: clear-output\n") (loop (empty-queue) (current-inexact-milliseconds)))) (handle-evt write-chan - (lambda (pr) + (λ (pr) (dprintf show-dprintf? "o: write ~s\n" pr) (let ([new-text-to-insert (enqueue pr text-to-insert)]) (cond @@ -1220,7 +1220,7 @@ WARNING: printf is rebound in the body of the unit to always ;; in any thread (even concurrently) ;; (define (make-write-bytes-proc style) - (lambda (to-write start end block/buffer? enable-breaks?) + (λ (to-write start end block/buffer? enable-breaks?) (cond [(= start end) (flush-proc)] [(eq? (current-thread) (eventspace-handler-thread eventspace)) @@ -1236,7 +1236,7 @@ WARNING: printf is rebound in the body of the unit to always [else (sync (nack-guard-evt - (lambda (fail-channel) + (λ (fail-channel) (let* ([return-channel (make-channel)] [return-evt (choice-evt @@ -1249,7 +1249,7 @@ WARNING: printf is rebound in the body of the unit to always (void)) (define (make-write-special-proc style) - (lambda (special can-buffer? enable-breaks?) + (λ (special can-buffer? enable-breaks?) (cond [(eq? (current-thread) (eventspace-handler-thread eventspace)) (error 'write-bytes-proc "cannot write to port on eventspace main thread")] @@ -1258,7 +1258,7 @@ WARNING: printf is rebound in the body of the unit to always #t)) (let* ([add-standard - (lambda (sd) + (λ (sd) (let* ([style-list (get-style-list)] [std (send style-list find-named-style "Standard")]) (if std @@ -1312,7 +1312,7 @@ WARNING: printf is rebound in the body of the unit to always (define input-buffer-thread (thread - (lambda () + (λ () ;; these vars are like arguments to the loop function ;; they are only set right before loop is called. @@ -1346,7 +1346,7 @@ WARNING: printf is rebound in the body of the unit to always (sync (handle-evt position-chan - (lambda (pr) + (λ (pr) (dprintf show-dprintf? "i: position-chan\n") (let ([nack-chan (car pr)] [resp-chan (cdr pr)]) @@ -1357,7 +1357,7 @@ WARNING: printf is rebound in the body of the unit to always never-evt) (handle-evt read-chan - (lambda (ent) + (λ (ent) (dprintf show-dprintf? "i: read-chan\n") (set! data (enqueue ent data)) (unless position @@ -1365,7 +1365,7 @@ WARNING: printf is rebound in the body of the unit to always (loop))) (handle-evt clear-input-chan - (lambda (_) + (λ (_) (dprintf show-dprintf? "i: clear-input-chan\n") (semaphore-post peeker-sema) (set! peeker-sema (make-semaphore 0)) @@ -1375,7 +1375,7 @@ WARNING: printf is rebound in the body of the unit to always (loop))) (handle-evt progress-event-chan - (lambda (return-pr) + (λ (return-pr) (dprintf show-dprintf? "i: progress-event-chan\n") (let ([return-chan (car return-pr)] [return-nack (cdr return-pr)]) @@ -1387,20 +1387,20 @@ WARNING: printf is rebound in the body of the unit to always (loop)))) (handle-evt peek-chan - (lambda (peeker) + (λ (peeker) (dprintf show-dprintf? "i: peek-chan\n") (set! peekers (cons peeker peekers)) (loop))) (handle-evt commit-chan - (lambda (committer) + (λ (committer) (dprintf show-dprintf? "i:commit-chan\n") (set! committers (cons committer committers)) (loop))) (apply choice-evt (map - (lambda (a-committer) + (λ (a-committer) (match a-committer [($ committer kr @@ -1411,13 +1411,13 @@ WARNING: printf is rebound in the body of the unit to always (choice-evt (handle-evt commit-peeker-evt - (lambda (_) + (λ (_) (dprintf show-dprintf? "i: commit-peeker-evt\n") ;; this committer will be thrown out in next iteration (loop))) (handle-evt done-evt - (lambda (v) + (λ (v) (dprintf show-dprintf? "i: done-evt\n") (let ([nth-pos (cdr (peek-n data (- kr 1)))]) (set! position @@ -1438,10 +1438,10 @@ WARNING: printf is rebound in the body of the unit to always (loop))))])) committers)) (apply choice-evt - (map (lambda (resp-evt) + (map (λ (resp-evt) (handle-evt resp-evt - (lambda (_) + (λ (_) (dprintf show-dprintf? "i: resp-evt\n") (set! response-evts (remq resp-evt response-evts)) (loop)))) @@ -1455,7 +1455,7 @@ WARNING: printf is rebound in the body of the unit to always (choice-evt nack-evt (channel-put-evt resp-evt position)) (let ([sent-position position]) - (lambda (_) + (λ (_) (set! positioners (remq pr positioners)) (loop)))))) @@ -1503,7 +1503,7 @@ WARNING: printf is rebound in the body of the unit to always [else (channel-put-evt resp-chan - (lambda (src line col pos) + (λ (src line col pos) (if (is-a? nth readable-snip<%>) (send nth read-special src line col pos) nth)))])))] @@ -1546,7 +1546,7 @@ WARNING: printf is rebound in the body of the unit to always [(sync/timeout 0 progress-evt) 0] [else (wrap-evt v - (lambda (v) + (λ (v) (if (and (number? v) (zero? v)) 0 (if (commit-proc (if (number? v) v 1) @@ -1557,7 +1557,7 @@ WARNING: printf is rebound in the body of the unit to always (define (peek-proc bstr skip-count progress-evt) (nack-guard-evt - (lambda (nack) + (λ (nack) (let ([chan (make-channel)]) (channel-put peek-chan (make-peeker bstr skip-count progress-evt chan nack)) chan)))) @@ -1565,7 +1565,7 @@ WARNING: printf is rebound in the body of the unit to always (define (progress-evt-proc) (sync (nack-guard-evt - (lambda (nack) + (λ (nack) (let ([chan (make-channel)]) (channel-put progress-event-chan (cons chan nack)) chan))))) @@ -1573,7 +1573,7 @@ WARNING: printf is rebound in the body of the unit to always (define (commit-proc kr progress-evt done-evt) (sync (nack-guard-evt - (lambda (nack) + (λ (nack) (let ([chan (make-channel)]) (channel-put commit-chan (make-committer kr progress-evt done-evt chan nack)) chan))))) @@ -1586,7 +1586,7 @@ WARNING: printf is rebound in the body of the unit to always values (sync (nack-guard-evt - (lambda (fail) + (λ (fail) (channel-put position-chan (cons fail chan)) chan)))))) diff --git a/collects/framework/private/version.ss b/collects/framework/private/version.ss index c177bb41..f0bdcb2d 100644 --- a/collects/framework/private/version.ss +++ b/collects/framework/private/version.ss @@ -15,9 +15,9 @@ (define specs null) (define -version - (lambda () + (λ () (foldr - (lambda (entry sofar) + (λ (entry sofar) (let ([sep (first entry)] [num (second entry)]) (string-append sofar sep num))) @@ -25,6 +25,6 @@ specs))) (define add-spec - (lambda (sep num) + (λ (sep num) (set! specs (cons (list (expr->string sep) (format "~a" num)) specs))))))) diff --git a/collects/framework/splash.ss b/collects/framework/splash.ss index 2e655c28..98459536 100644 --- a/collects/framework/splash.ss +++ b/collects/framework/splash.ss @@ -82,11 +82,11 @@ (send splash-frame show #f))) (define (shutdown-splash) - (set! splash-load-handler (lambda (old-load f expected) (old-load f expected)))) + (set! splash-load-handler (λ (old-load f expected) (old-load f expected)))) (define funny? (let ([date (seconds->date (current-seconds))]) - (and (with-handlers ([exn:fail:filesystem? (lambda (x) #f)]) + (and (with-handlers ([exn:fail:filesystem? (λ (x) #f)]) (collection-path "icons") #t) (= (date-day date) 25) @@ -111,7 +111,7 @@ (current-load (let ([old-load (current-load)]) - (lambda (f expected) + (λ (f expected) (splash-load-handler old-load f expected)))) (when (and make-compilation-manager-load/use-compiled-handler @@ -122,7 +122,7 @@ (equal? (getenv "PLTDRDEBUG") "trace")) (printf "PLTDRCM/PLTDRDEBUG: reinstalling CM trace handler after setting splash load handler\n") (manager-trace-handler - (lambda (x) (display "2: ") (display x) (newline)))))) + (λ (x) (display "2: ") (display x) (newline)))))) (define funny-gauge% (class canvas% @@ -133,9 +133,9 @@ (make-object bitmap% (build-path (collection-path "icons") "touch.bmp"))] [max-value 1]) - [define/public set-range (lambda (r) (set! max-value r))] + [define/public set-range (λ (r) (set! max-value r))] [define/public set-value - (lambda (new-value) + (λ (new-value) (let* ([before-x (floor (* (send funny-bitmap get-width) (/ funny-value max-value)))] [after-x @@ -173,7 +173,7 @@ (define (splash-get-preference name default) (get-preference name - (lambda () + (λ () default))) (define (splash-set-preference name value) (put-preferences (list name) (list value))) @@ -210,7 +210,7 @@ (if splash-bitmap (send dc draw-bitmap splash-bitmap 0 0) (send dc clear)) - (for-each (lambda (icon) + (for-each (λ (icon) (send dc draw-bitmap (icon-bm icon) (icon-x icon) diff --git a/collects/framework/test.ss b/collects/framework/test.ss index 4e485514..8c564e35 100644 --- a/collects/framework/test.ss +++ b/collects/framework/test.ss @@ -80,22 +80,22 @@ ;; ((frame-has? p) f) = ;; f is a frame and it has a child (in it or a subpanel) that responds #t to p (test:button-push - ((union (lambda (str) + ((union (λ (str) (and (string? str) (test:top-level-focus-window-has? - (lambda (c) + (λ (c) (and (is-a? c button%) (string=? (send c get-label) str) (send c is-enabled?) (send c is-shown?)))))) (and/c (is-a?/c button%) - (lambda (btn) + (λ (btn) (and (send btn is-enabled?) (send btn is-shown?))) - (lambda (btn) + (λ (btn) (test:top-level-focus-window-has? - (lambda (c) (eq? c btn)))))) + (λ (c) (eq? c btn)))))) . -> . void?) (button) @@ -245,9 +245,9 @@ ;; (define install-timer - (lambda (msec thunk) + (λ (msec thunk) (let ([timer (instantiate timer% () - [notify-callback (lambda () (thunk))])]) + [notify-callback (λ () (thunk))])]) (send timer start msec #t)))) ;; @@ -274,19 +274,19 @@ [the-error #f]) ;; boxed exn struct, or else #f. (letrec ([begin-action - (lambda () + (λ () (semaphore-wait sem) (set! count (add1 count)) (semaphore-post sem))] [end-action - (lambda () + (λ () (semaphore-wait sem) (set! count (sub1 count)) (semaphore-post sem))] [end-action-with-error - (lambda (exn) + (λ (exn) (semaphore-wait sem) (set! count (sub1 count)) (unless the-error @@ -294,7 +294,7 @@ (semaphore-post sem))] [get-exn-box - (lambda () + (λ () (semaphore-wait sem) (let ([ans the-error]) (set! the-error #f) @@ -302,14 +302,14 @@ ans))] [is-exn? - (lambda () + (λ () (semaphore-wait sem) (let ([ans (if the-error #t #f)]) (semaphore-post sem) ans))] [num-actions - (lambda () + (λ () (semaphore-wait sem) (let ([ans (+ count (if the-error 1 0))]) (semaphore-post sem) @@ -323,7 +323,7 @@ (define number-pending-actions num-actions) (define reraise-error - (lambda () + (λ () (let ([exn-box (get-exn-box)]) (if exn-box (raise (unbox exn-box)) (void))))) @@ -340,15 +340,15 @@ [thread-semaphore (make-semaphore 0)]) (thread (rec loop - (lambda () + (λ () (semaphore-wait thread-semaphore) (sleep) (semaphore-post yield-semaphore) (loop)))) - (lambda (thunk) + (λ (thunk) (let ([sem (make-semaphore 0)]) (letrec ([start - (lambda () ;; eventspace main thread + (λ () ;; eventspace main thread ;; guarantee (probably) that some events are handled (semaphore-post thread-semaphore) @@ -358,13 +358,13 @@ (unless (is-exn?) (begin-action) (parameterize ([current-exception-handler - (lambda (exn) + (λ (exn) (end-action-with-error exn) ((error-escape-handler)))]) (thunk)) (end-action)))] - [return (lambda () (semaphore-post sem))]) + [return (λ () (semaphore-post sem))]) (install-timer 0 start) (semaphore-wait sem) @@ -376,25 +376,25 @@ [thread-semaphore (make-semaphore 0)]) (thread (rec loop - (lambda () + (λ () (semaphore-wait thread-semaphore) (sleep) (semaphore-post yield-semaphore) (loop)))) - (lambda (thunk) + (λ (thunk) (let ([done (make-semaphore 0)]) (queue-callback - (lambda () + (λ () ;; guarantee (probably) that some events are handled (semaphore-post thread-semaphore) (yield yield-semaphore) - (queue-callback (lambda () (semaphore-post done))) + (queue-callback (λ () (semaphore-post done))) (unless (is-exn?) (begin-action) (parameterize ([current-exception-handler - (lambda (exn) + (λ (exn) (end-action-with-error exn) ((error-escape-handler)))]) (thunk)) @@ -402,10 +402,10 @@ (semaphore-wait done))))) (define current-get-eventspaces - (make-parameter (lambda () (list (current-eventspace))))) + (make-parameter (λ () (list (current-eventspace))))) (define (get-active-frame) - (ormap (lambda (eventspace) + (ormap (λ (eventspace) (parameterize ([current-eventspace eventspace]) (get-top-level-focus-window))) ((current-get-eventspaces)))) @@ -426,7 +426,7 @@ ;; (define ancestor-list - (lambda (window stop-at-top-level-window?) + (λ (window stop-at-top-level-window?) (let loop ([w window] [l null]) (if (or (not w) (and stop-at-top-level-window? @@ -440,7 +440,7 @@ ;; (define in-active-frame? - (lambda (window) + (λ (window) (let ([frame (get-active-frame)]) (let loop ([window window]) (cond [(null? window) #f] @@ -454,13 +454,13 @@ ;; (define verify-list - (lambda (l valid) + (λ (l valid) (cond [(null? l) #f] [(member (car l) valid) (verify-list (cdr l) valid)] [else (car l)]))) (define verify-item - (lambda (item valid) + (λ (item valid) (verify-list (list item) valid))) ;;; @@ -473,7 +473,7 @@ ;; find-object : class (union string (object -> boolean)) -> object (define (find-object obj-class b-desc) - (lambda () + (λ () (cond [(or (string? b-desc) (procedure? b-desc)) @@ -483,7 +483,7 @@ "could not find object: ~a, no active frame" b-desc))] [child-matches? - (lambda (child) + (λ (child) (cond [(string? b-desc) (equal? (send child get-label) b-desc)] @@ -491,7 +491,7 @@ (b-desc child)]))] [found (let loop ([panel active-frame]) - (ormap (lambda (child) + (ormap (λ (child) (cond [(and (is-a? child obj-class) (child-matches? child)) @@ -520,9 +520,9 @@ ;;; CONTROL functions, to be specialized for individual controls (define control-action - (lambda (error-tag event-sym find-ctrl update-control) + (λ (error-tag event-sym find-ctrl update-control) (run-one - (lambda () + (λ () (let ([event (make-object control-event% event-sym)] [ctrl (find-ctrl)]) (cond @@ -557,7 +557,7 @@ 'test:set-check-box! 'check-box (find-object check-box% in-cb) - (lambda (cb) (send cb set-value state)))) + (λ (cb) (send cb set-value state)))) ;; ;; RADIO-BOX @@ -581,7 +581,7 @@ 'test:set-radio-box! 'radio-box (find-object radio-box% in-cb) - (lambda (rb) + (λ (rb) (cond [(string? state) (let ([total (send rb get-number)]) @@ -614,7 +614,7 @@ 'test:set-check-box-state! 'radio-box (find-object radio-box% (entry-matches state)) - (lambda (rb) + (λ (rb) (let ([total (send rb get-number)]) (let loop ([n total]) (cond @@ -631,7 +631,7 @@ ;; entry-matches : string -> radio-box -> boolean (define (entry-matches name) - (lambda (rb) + (λ (rb) (let loop ([n (send rb get-number)]) (and (not (zero? n)) (or (equal? name (send rb get-item-label (- n 1))) @@ -646,7 +646,7 @@ 'test:set-choice! 'choice (find-object choice% in-choice) - (lambda (choice) + (λ (choice) (cond [(number? str) (send choice set-selection str)] [(string? str) (send choice set-string-selection str)] @@ -692,10 +692,10 @@ [(not (list? modifier-list)) (error key-tag "expected a list as second argument, got: ~e" modifier-list)] [(verify-list modifier-list legal-keystroke-modifiers) - => (lambda (mod) (error key-tag "unknown key modifier: ~e" mod))] + => (λ (mod) (error key-tag "unknown key modifier: ~e" mod))] [else (run-one - (lambda () + (λ () (let ([window (get-focused-window)]) (cond [(not window) @@ -734,7 +734,7 @@ ;; WILL WANT TO ADD SET-POSITION WHEN THAT GETS IMPLEMENTED. (define make-key-event - (lambda (key window modifier-list) + (λ (key window modifier-list) (let ([event (make-object key-event%)]) (send event set-key-code key) (send event set-time-stamp (time-stamp)) @@ -742,7 +742,7 @@ event))) (define set-key-modifiers - (lambda (event key modifier-list) + (λ (event key modifier-list) (when (shifted? key) (send event set-shift-down #t)) (let loop ([l modifier-list]) (unless (null? l) @@ -765,7 +765,7 @@ #\! #\@ #\# #\$ #\% #\^ #\& #\* #\_ #\+ #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z)]) - (lambda (key) + (λ (key) (memq shifted-keys shifted-keys)))) ;; @@ -781,7 +781,7 @@ (define menu-tag 'test:menu-select) (define menu-select - (lambda (menu-name . item-names) + (λ (menu-name . item-names) (cond [(not (string? menu-name)) (error menu-tag "expects string, given: ~e" menu-name)] @@ -789,7 +789,7 @@ (error menu-tag "expects strings, given: ~e" item-names)] [else (run-one - (lambda () + (λ () (let* ([frame (get-active-frame)] [item (get-menu-item frame (cons menu-name item-names))] [evt (make-object control-event% 'menu)]) @@ -797,7 +797,7 @@ (send item command evt))))]))) (define get-menu-item - (lambda (frame item-names) + (λ (frame item-names) (cond [(not frame) (error menu-tag "no active frame")] @@ -863,18 +863,18 @@ [(button x y modifier-list) (cond [(verify-item button legal-mouse-buttons) - => (lambda (button) + => (λ (button) (error mouse-tag "unknown mouse button: ~e" button))] [(not (real? x)) (error mouse-tag "expected real, given: ~e" x)] [(not (real? y)) (error mouse-tag "expected real, given: ~e" y)] [(verify-list modifier-list legal-mouse-modifiers) - => (lambda (mod) + => (λ (mod) (error mouse-tag "unknown mouse modifier: ~e" mod))] [else (run-one - (lambda () + (λ () (let ([window (get-focused-window)]) (cond [(not window) @@ -898,7 +898,7 @@ ;; NEED TO MOVE THE CHECK FOR 'ON-EVENT TO HERE. (define send-mouse-event - (lambda (window event) + (λ (window event) (let loop ([l (ancestor-list window #t)]) (cond [(null? l) @@ -913,7 +913,7 @@ ;; (define make-mouse-event - (lambda (type x y modifier-list) + (λ (type x y modifier-list) (let ([event (make-object mouse-event% (mouse-type-const type))]) (when (and (pair? type) (not (eq? (cadr type) 'up))) (set-mouse-modifiers event (list (car type)))) @@ -924,7 +924,7 @@ event))) (define set-mouse-modifiers - (lambda (event modifier-list) + (λ (event modifier-list) (unless (null? modifier-list) (let ([mod (car modifier-list)]) (cond @@ -943,7 +943,7 @@ (set-mouse-modifiers event (cdr modifier-list))))) (define mouse-type-const - (lambda (type) + (λ (type) (cond [(symbol? type) (cond @@ -976,7 +976,7 @@ [else (bad-mouse-type type)]))) (define bad-mouse-type - (lambda (type) + (λ (type) (error mouse-tag "unknown mouse event type: ~e" type))) ;; @@ -989,13 +989,13 @@ (define new-window (let ([tag 'test:new-window]) - (lambda (new-window) + (λ (new-window) (cond [(not (is-a? new-window window<%>)) (error tag "new-window is not a window<%>")] [else (run-one - (lambda () + (λ () (let ([old-window (get-focused-window)] [leave (make-object mouse-event% 'leave)] diff --git a/collects/mrlib/graph.ss b/collects/mrlib/graph.ss index bcd7c531..9665a387 100644 --- a/collects/mrlib/graph.ss +++ b/collects/mrlib/graph.ss @@ -257,9 +257,9 @@ (inherit invalidate-bitmap-cache) (define/private (invalidate-to-children/parents snip) (when (is-a? snip graph-snip<%>) - (let* ([children (get-all-children snip)] - [parents (get-all-parents snip)] - [rects (eliminate-redundancies (get-rectangles snip (append children parents)))] + (let* ([parents-and-children (append (get-all-parents snip) + (get-all-children snip))] + [rects (eliminate-redundancies (get-rectangles snip parents-and-children))] [union (union-rects rects)] [invalidate-rect (lambda (rect) @@ -300,7 +300,7 @@ ((rect-top r1) . >= . (rect-top r2)) ((rect-right r1) . <= . (rect-right r2)) ((rect-bottom r1) . <= . (rect-bottom r2)))) - + ;; get-rectangles : snip (listof snip) -> rect ;; computes the rectangles that need to be invalidated for connecting (define/private (get-rectangles main-snip c/p-snips)