suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

adjust the 'recently opened files' menu item so its contents are contain fewer redundant entries

Browse Source 
amusingly I was reminded to do this by Matthew's recent commit message
saying that normal-case-path is usually a bad idea
This commit is contained in:
Robby Findler 2011-08-30 16:09:36 -05:00
parent c11b7b3c9a
commit ce0da835ce
1 changed files with 32 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
collects/framework/private/handler.rkt
View File

@ -120,25 +120,29 @@
;; add-to-recent : path -> void
(define (add-to-recent filename)
(let* ([old-list (preferences:get 'framework:recently-opened-files/pos)]
[old-ents (filter (λ (x) (string=? (path->string (car x))
(path->string filename)))
old-list)]
[old-ent (if (null? old-ents)
#f
(car old-ents))]
[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))])
(preferences:set 'framework:recently-opened-files/pos new-recent)))
(define old-list (preferences:get 'framework:recently-opened-files/pos))
(define old-ents (filter (λ (x) (recently-opened-files-same-enough-path? (car x) filename))
old-list))
(define new-ent (if (null? old-ents)
(list filename 0 0)
(cons filename (cdr (car old-ents)))))
(define added-in (cons new-ent
(remove* (list new-ent)
old-list
(λ (l1 l2)
(recently-opened-files-same-enough-path? (car l1) (car l2))))))
(define new-recent (size-down added-in
(preferences:get 'framework:recent-max-count)))
(preferences:set 'framework:recently-opened-files/pos new-recent))
;; same-enough-path? : path path -> boolean
;; used to determine if the open-recent-files menu item considers two paths to be the same
(define (recently-opened-files-same-enough-path? p1 p2)
(equal? (simplify-path (normal-case-path p1) #f)
(simplify-path (normal-case-path p2) #f)))
;; compare-recent-list-items : recent-list-item recent-list-item -> boolean
(define (compare-recent-list-items l1 l2)
(equal? (car l1) (car l2)))
;; size-down : (listof X) -> (listof X)[< recent-max-count]
;; takes a list of stuff and returns the
@ -167,8 +171,8 @@
(preferences:get 'framework:recently-opened-files/pos)]
[new-recent-items
(map (λ (x)
(if (string=? (path->string (car x))
(path->string filename))
(if (recently-opened-files-same-enough-path? (path->string (car x))
(path->string filename))
(list* (car x) start end (cdddr x))
x))
(preferences:get 'framework:recently-opened-files/pos))])
@ -198,9 +202,8 @@
(define (recent-list-item->menu-label recent-list-item)
(let ([filename (car recent-list-item)])
(gui-utils:trim-string
(regexp-replace* #rx"&" (path->string filename) "\\&\\&")
200)))
(gui-utils:quote-literal-label
(path->string filename))))
;; this function must mimic what happens in install-recent-items
;; it returns #t if all of the labels of menus are the same, or approximation to
@ -232,8 +235,12 @@
(send ed set-position start end)))))]
[else
(preferences:set 'framework:recently-opened-files/pos
(remove recent-list-item
(preferences:get 'framework:recently-opened-files/pos)))
(remove* (list recent-list-item)
(preferences:get 'framework:recently-opened-files/pos)
(λ (l1 l2)
(recently-opened-files-same-enough-path?
(car l1)
(car l2)))))
(message-box (string-constant error)
(format (string-constant cannot-open-because-dne)
filename))])))