fix modbeg again, change resolved module path so that it is not case-normalized
svn: r7917
This commit is contained in:
Matthew Flatt
parent
3b0081a865
commit
a7dad576bd
|
|
@ -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)))])
|
||||
|
|
|
|||
|
|
@ -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'
|
||||
|
|
|
|||
|
|
@ -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<?)
|
||||
(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)
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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)"
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user