Misc reformatting, mostly using new stuff that make things easier.

svn: r10286

collects/framework/private/handler.ss

@@ -23,74 +23,50 @@
 
 (define format-handlers '())
 
-(define make-insert-handler
-  (letrec ([string-list?
-            (λ (l)
-              (cond
-                [(null? l) #t]
-                [(not (pair? l)) #f]
-                [else
-                 (and (string? (car l))
-                      (string-list? (cdr l)))]))])
-    (λ (who name extension handler)
-      (cond
-        [(not (string? name))
+(define (make-insert-handler who name extension handler)
+  (cond [(not (string? name))
          (error who "name was not a string")]
-        [(and (not (procedure? extension))
-              (not (string? extension))
-              (not (string-list? extension)))
+        [(not (or (procedure? extension)
+                  (string? extension)
+                  (and (list? extension) (andmap string? extension))))
          (error who
                 "extension was not a string, list of strings, or a predicate")]
         [(not (procedure? handler))
          (error who "handler was not a function")]
         [else (make-handler name
-                            (if (string? extension)
-                                (list extension)
-                                extension)
-                            handler)]))))
+                            (if (string? extension) (list extension) extension)
+                            handler)]))
 
-(define insert-format-handler
-  (λ args
+(define (insert-format-handler . args)
   (set! format-handlers
         (cons (apply make-insert-handler 'insert-format-handler args)
-                format-handlers))))
+              format-handlers)))
 
-(define find-handler
-  (λ (name handlers)
+(define (find-handler name handlers)
   (let/ec exit
-      (let ([extension (if (string? name)
-                           (or (filename-extension name)
-                               "")
-                           "")])
-        (for-each
-         (λ (handler)
+    (let ([extension (if (string? name) (or (filename-extension name) "") "")])
+      (for ([handler handlers])
         (let ([ext (handler-extension handler)])
-             (when (or (and (procedure? ext)
-                            (ext name))
+          (when (or (and (procedure? ext) (ext name))
                     (and (pair? ext)
                          (ormap (λ (ext) (string=? ext extension))
                                 ext)))
             (exit (handler-handler handler)))))
-         handlers)
-        #f))))
+      #f)))
 
-(define find-format-handler
-  (λ (name)
-    (find-handler name format-handlers)))
+(define (find-format-handler name)
+  (find-handler name format-handlers))
 
 ; Finding format & mode handlers by name
-(define find-named-handler
-  (λ (name handlers)
+(define (find-named-handler name handlers)
   (let loop ([l handlers])
-      (cond
-        [(null? l) #f]
+    (cond [(null? l) #f]
           [(string-ci=? (handler-name (car l)) name)
            (handler-handler (car l))]
-        [else (loop (cdr l))]))))
+          [else (loop (cdr l))])))
 
-(define find-named-format-handler
-  (λ (name)
-    (find-named-handler name format-handlers)))
+(define (find-named-format-handler name)
+  (find-named-handler name format-handlers))
 
 ; Open a file for editing
 (define current-create-new-window
@@ -100,13 +76,8 @@
        (send frame show #t)
        frame))))
 
-(define edit-file
-  (case-lambda
-    [(filename) (edit-file
-                 filename
-                 (λ ()
-                   ((current-create-new-window) filename)))]
-    [(filename make-default)
+(define (edit-file filename [make-default
+                             (λ () ((current-create-new-window) filename))])
   (with-handlers ([(λ (x) #f) ;exn:fail?
                    (λ (exn)
                      (message-box
@@ -140,15 +111,11 @@
                 (send fr show #t)
                 fr)]
              [else
-                   (let ([handler
-                          (if (path? filename)
-                              (find-format-handler filename)
-                              #f)])
+              (let ([handler (and (path? filename)
+                                  (find-format-handler filename))])
                 (add-to-recent filename)
-                     (if handler
-                         (handler filename)
-                         (make-default)))]))
-              (make-default)))))]))
+                (if handler (handler filename) (make-default)))]))
+         (make-default))))))
 
 ;; type recent-list-item = (list/p string? number? number?)
 
@@ -164,28 +131,25 @@
          [new-ent (list filename
                         (if old-ent (cadr old-ent) 0)
                         (if old-ent (caddr old-ent) 0))]
-         [added-in (cons new-ent (remove new-ent old-list compare-recent-list-items))]
-         [new-recent (size-down added-in (preferences:get 'framework:recent-max-count))])
+         [added-in (cons new-ent
+                         (remove new-ent old-list compare-recent-list-items))]
+         [new-recent (size-down added-in
+                                (preferences:get 'framework:recent-max-count))])
     (preferences:set 'framework:recently-opened-files/pos new-recent)))
 
 ;; compare-recent-list-items : recent-list-item recent-list-item -> boolean
 (define (compare-recent-list-items l1 l2)
-  (string=? (path->string (car l1))
-            (path->string (car l2))))
+  (equal? (car l1) (car l2)))
 
 ;; size-down : (listof X) -> (listof X)[< recent-max-count]
 ;; takes a list of stuff and returns the
 ;; front of the list, up to `recent-max-count' items
 (define (size-down new-recent n)
-  (let loop ([n n]
-             [new-recent new-recent])
-    (cond
-      [(zero? n) null]
+  (let loop ([n n] [new-recent new-recent])
+    (cond [(zero? n) null]
           [(null? new-recent) null]
-      [else
-       (cons (car new-recent)
-             (loop (- n 1)
-                   (cdr new-recent)))])))
+          [else (cons (car new-recent)
+                      (loop (- n 1) (cdr new-recent)))])))
 
 ;; size-recently-opened-files : number -> void
 ;; sets the recently-opened-files/pos preference
@@ -295,24 +259,24 @@
     (define/private (refresh-hl recent-list-items)
       (let ([ed (send hl get-editor)])
         (send ed begin-edit-sequence)
-        (for-each (λ (item) (send hl delete-item item)) (send hl get-items))
+        (for ([item (send hl get-items)]) (send hl delete-item item))
         (for-each (λ (item) (add-recent-item item))
-                  (if (eq? (preferences:get 'framework:recently-opened-sort-by) 'name)
-                      (sort recent-list-items
-                            (λ (x y) (string<=? (path->string (car x))
-                                                (path->string (car y)))))
+                  (if (eq? (preferences:get 'framework:recently-opened-sort-by)
+                           'name)
+                    (sort recent-list-items string<?
+                          #:key (compose path->string car) #:cache-keys? #t)
                     recent-list-items))
         (send ed end-edit-sequence)))
 
     (define/private (add-recent-item recent-list-item)
-      (let ([item (send hl new-item (make-hierlist-item-mixin recent-list-item))])
-        (send (send item get-editor) insert (path->string (car recent-list-item)))))
+      (let ([item (send hl
+                        new-item (make-hierlist-item-mixin recent-list-item))])
+        (send (send item get-editor)
+              insert (path->string (car recent-list-item)))))
 
     (field [remove-prefs-callback
-            (preferences:add-callback
-             'framework:recently-opened-files/pos
-             (λ (p v)
-               (refresh-hl v)))])
+            (preferences:add-callback 'framework:recently-opened-files/pos
+                                      (λ (p v) (refresh-hl v)))])
 
     (define/augment (on-close)
       (inner (void) on-close)
@@ -323,7 +287,8 @@
 
     (inherit get-area-container)
     (field [bp (make-object horizontal-panel% (get-area-container))]
-           [hl (make-object recent-items-hierarchical-list% (get-area-container) '())]
+           [hl (make-object recent-items-hierarchical-list%
+                            (get-area-container) '())]
            [sort-by-name-button
             (make-object button%
               (string-constant recent-items-sort-by-name)