fix modbeg again, change resolved module path so that it is not case-normalized

svn: r7917

collects/mzlib/process.ss

@@ -62,7 +62,7 @@
 			       (lambda ()
 				 (with-handlers ([exn:break? void])
 				   (ready-for-break #t)
-				   (copy-port cin in)
+                                   (copy-port cin in)
 				   (ready-for-break #f)))
 			       (lambda () (close-output-port in)))
 			   (ready-for-break #t)))])

collects/scheme/private/modbeg.ss

@@ -58,8 +58,10 @@
                 ;; `begin' is special...
                 (if (let-values ([(p) (syntax-e e)])
                       (if (pair? p)
-                          (if (free-identifier=? (car p) (quote-syntax begin))
+                          (if (symbol? (syntax-e (car p)))
-                              (syntax->list e)
+                              (if (free-identifier=? (car p) (quote-syntax begin))
+                                  (syntax->list e)
+                                  #f)
                               #f)
                           #f))
                     ;; splice `begin'

collects/sirmail/readr.ss

@@ -975,9 +975,9 @@
       (send global-keymap add-function "next-msg"
 	    (lambda (w e) (send header-list select-next)))
       (send global-keymap add-function "mark-msg"
-	    (lambda (w e) (send header-list mark-message)))
+	    (lambda (w e) (send header-list mark-message #t)))
       (send global-keymap add-function "unmark-msg"
-	    (lambda (w e) (send header-list unmark-message)))
+	    (lambda (w e) (send header-list unmark-message #t)))
       (send global-keymap add-function "hit-msg"
 	    (lambda (w e) (send header-list hit)))
       (send global-keymap add-function "scroll-down"
@@ -1186,13 +1186,13 @@
       (make-object separator-menu-item% msg-menu)
       (make-object menu-item% "&Mark Selected" msg-menu
 		   (lambda (i e)
-		     (send header-list mark-message))
+		     (send header-list mark-message #t))
 		   #\D)
       (make-object menu-item% "&Unmark Selected" msg-menu
         (lambda (i e)
-          (send header-list unmark-message))
+          (send header-list unmark-message #t))
         #\U)
-      (define (mark-all mark?)
+      (define (mark-all mark? between?)
 	(let* ([marked-uids (map message-uid (filter (if mark?
 							 (lambda (x) (not (message-marked? x)))
 							 message-marked?)
@@ -1204,17 +1204,31 @@
 	     (when (member (send i user-data) marked-uids)
 	       (send i select #t)
 	       (if mark?
-		   (send header-list mark-message)
+		   (send header-list mark-message #f)
-		   (send header-list unmark-message))))
+		   (send header-list unmark-message #f))))
-	   items)
+           (if between?
+               (let ([drop-some
+                      (lambda (items)
+                        (let loop ([items items])
+                          (if (null? items)
+                              null
+                              (if (message-marked? (find-message (send (car items) user-data)))
+                                  items
+                                  (loop (cdr items))))))])
+                 (reverse (drop-some (reverse (drop-some items)))))
+               items))
+          (write-mailbox)
+          (status "~aarked all" (if mark? "M" "Unm"))
 	  (if selected
 	      (send selected select #t)
 	      (send (send header-list get-selected) select #f))))
       
       (make-object menu-item% "Mark All" msg-menu
-        (lambda (i e) (mark-all #t)))
+        (lambda (i e) (mark-all #t #f)))
       (make-object menu-item% "Unmark All" msg-menu
-        (lambda (i e) (mark-all #f)))
+        (lambda (i e) (mark-all #f #f)))
+      (make-object menu-item% "Mark All Between Marked" msg-menu
+        (lambda (i e) (mark-all #t #t)))
       
       (make-object separator-menu-item% msg-menu)
       (make-object menu-item% "&Delete Marked" msg-menu
@@ -1300,6 +1314,7 @@
       (make-object menu-item% "by Subject" sort-menu (lambda (i e) (sort-by-subject)))
       (make-object menu-item% "by Date" sort-menu (lambda (i e) (sort-by-date)))
       (make-object menu-item% "by Order Received" sort-menu (lambda (i e) (sort-by-order-received)))
+      (make-object menu-item% "by Size" sort-menu (lambda (i e) (sort-by-size)))
       (make-object menu-item% "by Header Field..." sort-menu (lambda (i e) (sort-by-header-field)))
       
       ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1316,7 +1331,7 @@
           (inherit get-items show-focus set-cursor select)
           (field [selected #f])
           
-          (define/public (mark marked?)
+          (define/public (mark marked? update?)
             (when selected
               (let* ([uid (send selected user-data)]
                      [m (find-message uid)]
@@ -1326,13 +1341,15 @@
                   (set-message-flags! m (if marked?
                                             (cons 'marked flags)
                                             (remq 'marked flags)))
-                  (write-mailbox)
+                  (when update?
+                    (write-mailbox))
                   (apply-style selected 
                                (if marked? 
                                    marked-delta
                                    unmarked-delta))
-                  (status "~aarked" 
+                  (when update?
-                          (if marked? "M" "Unm"))))))
+                    (status "~aarked" 
+                            (if marked? "M" "Unm")))))))
           
           (define/public (archive-current-message)
             (when selected
@@ -1355,10 +1372,10 @@
             (when selected
               (on-double-select selected)))
           
-          (define/public (mark-message)
+          (define/public (mark-message update?)
-            (mark #t))
+            (mark #t update?))
-          (define/public (unmark-message)
+          (define/public (unmark-message update?)
-            (mark #f))
+            (mark #f update?))
           (define/public (selected-hit?) (eq? selected current-selected))
           (define/override (on-select i)
             (set! selected i))
@@ -2038,6 +2055,10 @@
         (sort-by subject<?)
         (reset-sorting-text-styles)
         (identify-sorted sorting-text-subject))
+      (define (sort-by-size) 
+        (sort-by size<?)
+        (reset-sorting-text-styles)
+        (identify-sorted sorting-text-subject))
       (define (sort-by-order-received) 
         (sort-by-uid)
         (reset-sorting-text-styles)
@@ -2261,6 +2282,13 @@
                                       s))
                                 "")))])
           (string-cmp/default-uid (simplify a) (simplify b) a b)))
+
+      (define (size<? a b)
+        (let ([sa (or (message-size a) 0)]
+              [sb (or (message-size b) 0)])
+          (if (= sa sb)
+              (< (message-uid a) (message-uid b))
+              (< sa sb))))
       
       ;; string-cmp : string string message message -> boolean
       (define (string-cmp/default-uid str-a str-b a b)

src/mzscheme/src/cstartup.inc

@@ -26,14 +26,14 @@
 3,196,28,248,22,71,193,20,15,159,35,34,35,28,248,22,71,248,22,65,194,
 248,22,64,193,249,22,167,3,80,158,37,34,251,22,73,2,17,248,22,64,199,
 249,22,63,2,7,248,22,65,201,11,18,100,10,8,31,8,30,8,29,8,28,
-8,27,16,4,11,11,2,18,3,1,7,101,110,118,54,55,55,53,16,4,11,
+8,27,16,4,11,11,2,18,3,1,7,101,110,118,54,55,55,54,16,4,11,
-11,2,19,3,1,7,101,110,118,54,55,55,54,27,248,22,65,248,22,174,3,
+11,2,19,3,1,7,101,110,118,54,55,55,55,27,248,22,65,248,22,174,3,
 196,28,248,22,71,193,20,15,159,35,34,35,28,248,22,71,248,22,65,194,248,
 22,64,193,249,22,167,3,80,158,37,34,250,22,73,2,20,248,22,73,249,22,
 73,248,22,73,2,21,248,22,64,201,251,22,73,2,17,2,21,2,21,249,22,
 63,2,10,248,22,65,204,18,100,11,8,31,8,30,8,29,8,28,8,27,16,
-4,11,11,2,18,3,1,7,101,110,118,54,55,55,56,16,4,11,11,2,19,
+4,11,11,2,18,3,1,7,101,110,118,54,55,55,57,16,4,11,11,2,19,
-3,1,7,101,110,118,54,55,55,57,248,22,174,3,193,27,248,22,174,3,194,
+3,1,7,101,110,118,54,55,56,48,248,22,174,3,193,27,248,22,174,3,194,
 249,22,63,248,22,73,248,22,64,196,248,22,65,195,27,248,22,65,248,22,174,
 3,196,249,22,167,3,80,158,37,34,28,248,22,51,248,22,168,3,248,22,64,
 197,27,249,22,2,32,0,89,162,8,36,35,41,9,222,33,39,248,22,174,3,
@@ -61,8 +61,8 @@
 97,203,2,25,248,22,65,202,251,22,73,2,17,28,249,22,137,8,248,22,168,
 3,248,22,64,200,64,101,108,115,101,10,248,22,64,197,250,22,74,2,20,9,
 248,22,65,200,249,22,63,2,6,248,22,65,202,99,8,31,8,30,8,29,8,
-28,8,27,16,4,11,11,2,18,3,1,7,101,110,118,54,56,48,49,16,4,
+28,8,27,16,4,11,11,2,18,3,1,7,101,110,118,54,56,48,50,16,4,
-11,11,2,19,3,1,7,101,110,118,54,56,48,50,18,158,94,10,64,118,111,
+11,11,2,19,3,1,7,101,110,118,54,56,48,51,18,158,94,10,64,118,111,
 105,100,8,47,27,248,22,65,248,22,174,3,196,249,22,167,3,80,158,37,34,
 28,248,22,51,248,22,168,3,248,22,64,197,250,22,73,2,26,248,22,73,248,
 22,64,199,248,22,88,198,27,248,22,168,3,248,22,64,197,250,22,73,2,26,
@@ -435,7 +435,7 @@
 196,35,248,80,158,41,50,194,91,159,37,11,90,161,37,34,11,28,248,22,155,
 7,198,250,22,7,2,22,249,22,160,7,202,36,2,22,248,22,178,12,197,27,
 28,248,22,155,7,199,249,22,160,7,200,37,249,80,158,46,51,196,5,0,27,
-28,248,22,155,7,200,249,22,160,7,201,38,248,22,146,4,198,27,27,250,22,
+28,248,22,155,7,200,249,22,160,7,201,38,248,22,146,4,199,27,27,250,22,
 126,80,158,50,41,248,22,161,13,247,22,145,11,11,28,192,192,27,247,22,120,
 87,94,250,22,125,80,158,51,41,248,22,161,13,247,22,145,11,195,192,87,95,
 28,23,16,27,250,22,126,196,197,11,28,192,12,87,95,27,27,28,248,22,17,

src/mzscheme/src/startup.inc

@@ -632,7 +632,7 @@
 " (path-replace-suffix name #\"\"))))"
 "(let((modname(if(vector? s-parsed)"
 "(vector-ref s-parsed 4)"
-"(make-resolved-module-path normal-filename)))"
+"(make-resolved-module-path filename)))"
 "(ht(or(hash-table-get -module-hash-table-table"
 "(namespace-module-registry(current-namespace))"
 " #f)"

src/mzscheme/src/startup.ss

@@ -720,7 +720,7 @@
                                        (path-replace-suffix name #""))])
                       (let ([modname (if (vector? s-parsed)
                                          (vector-ref s-parsed 4)
-                                         (make-resolved-module-path normal-filename))]
+                                         (make-resolved-module-path filename))]
                             [ht (or (hash-table-get -module-hash-table-table
                                                     (namespace-module-registry (current-namespace))
                                                     #f)