diff --git a/collects/mzlib/process.ss b/collects/mzlib/process.ss index d04f384654..7a12c88c1f 100644 --- a/collects/mzlib/process.ss +++ b/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)))]) diff --git a/collects/scheme/private/modbeg.ss b/collects/scheme/private/modbeg.ss index 854c15bbb3..ab8e2c209c 100644 --- a/collects/scheme/private/modbeg.ss +++ b/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)) - (syntax->list e) + (if (symbol? (syntax-e (car p))) + (if (free-identifier=? (car p) (quote-syntax begin)) + (syntax->list e) + #f) #f) #f)) ;; splice `begin' diff --git a/collects/sirmail/readr.ss b/collects/sirmail/readr.ss index 171e3da196..4e919326f3 100644 --- a/collects/sirmail/readr.ss +++ b/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 unmark-message)))) - items) + (send header-list mark-message #f) + (send header-list unmark-message #f)))) + (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" - (if marked? "M" "Unm")))))) + (when update? + (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) - (mark #t)) - (define/public (unmark-message) - (mark #f)) + (define/public (mark-message update?) + (mark #t update?)) + (define/public (unmark-message update?) + (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 boolean (define (string-cmp/default-uid str-a str-b a b) diff --git a/src/mzscheme/src/cstartup.inc b/src/mzscheme/src/cstartup.inc index 0dde983b51..5bbfef93d6 100644 --- a/src/mzscheme/src/cstartup.inc +++ 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, -11,2,19,3,1,7,101,110,118,54,55,55,54,27,248,22,65,248,22,174,3, +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,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, -3,1,7,101,110,118,54,55,55,57,248,22,174,3,193,27,248,22,174,3,194, +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,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, -11,11,2,19,3,1,7,101,110,118,54,56,48,50,18,158,94,10,64,118,111, +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,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, diff --git a/src/mzscheme/src/startup.inc b/src/mzscheme/src/startup.inc index 9eddb972b8..34e6aa9bf8 100644 --- a/src/mzscheme/src/startup.inc +++ b/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)" diff --git a/src/mzscheme/src/startup.ss b/src/mzscheme/src/startup.ss index 48bc1b6cd8..39d1bdde1e 100644 --- a/src/mzscheme/src/startup.ss +++ b/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)