From 106dcba4fa781596914e87177bf01d275f5b99c8 Mon Sep 17 00:00:00 2001 From: Brigham Toskin Date: Sat, 21 Apr 2018 19:18:01 -0700 Subject: [PATCH 1/7] Ignore mac disk images. --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 691eb4c..8e5e0e3 100644 --- a/.gitignore +++ b/.gitignore @@ -13,3 +13,4 @@ compiled ivy.app mac.iconset .DS_Store +*.dmg From ea2b49c850abe3574bec3bae85340f3d1133f8eb Mon Sep 17 00:00:00 2001 From: Brigham Toskin Date: Sat, 21 Apr 2018 19:23:35 -0700 Subject: [PATCH 2/7] Fixes #68: Long image paths in tag browser. Truncate image paths > 200 chars long; they will cause lbox to throw. When doing so, set the full path as attached data item. Then, when loading selected item, check first for attached data, then label. --- tag-browser.rkt | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/tag-browser.rkt b/tag-browser.rkt index 4888bd0..b18bc07 100644 --- a/tag-browser.rkt +++ b/tag-browser.rkt @@ -153,7 +153,8 @@ (λ (button evt) (define sel (send img-lbox get-selection)) (cond [(number? sel) - (define img-label (send img-lbox get-string sel)) + (define img-label (or (send img-lbox get-data sel) + (send img-lbox get-string sel))) ; 15 the tallest any column can be (define tag-grid (grid-list (image-taglist img-label) 15)) ; remove any children vpanel might have @@ -247,11 +248,14 @@ [callback (λ (lbox evt) (define sel (send lbox get-selection)) (define tag-label (if sel (send lbox get-string sel) "")) - ; clear old data + (define img-list (search-db-exact 'or (list tag-label))) (send img-lbox clear) - (for ([img (in-list (search-db-exact 'or (list tag-label)))]) - (define img-str (path->string img)) - (send img-lbox append img-str)))])) + (for ([img (in-list img-list)]) + (define img-path-str (path->string img)) + (define img-label-str (if (> (string-length img-path-str) 200) + (format "~a..." (substring img-path-str 0 197)) + img-path-str)) + (send img-lbox append img-label-str img-path-str)))])) (define img-vpanel (new vertical-panel% From e09a44e56903c7be786f31633d19457b10caefa5 Mon Sep 17 00:00:00 2001 From: Brigham Toskin Date: Sat, 21 Apr 2018 19:24:12 -0700 Subject: [PATCH 3/7] Hide thumb panel when switching tags in browser. --- tag-browser.rkt | 1 + 1 file changed, 1 insertion(+) diff --git a/tag-browser.rkt b/tag-browser.rkt index b18bc07..b34bcd7 100644 --- a/tag-browser.rkt +++ b/tag-browser.rkt @@ -250,6 +250,7 @@ (define tag-label (if sel (send lbox get-string sel) "")) (define img-list (search-db-exact 'or (list tag-label))) (send img-lbox clear) + (remove-children thumb-vpanel (send thumb-vpanel get-children)) (for ([img (in-list img-list)]) (define img-path-str (path->string img)) (define img-label-str (if (> (string-length img-path-str) 200) From 8efba882052bfe1afb12480d2d466fe98fb5ffea Mon Sep 17 00:00:00 2001 From: Brigham Toskin Date: Sat, 21 Apr 2018 19:52:23 -0700 Subject: [PATCH 4/7] Sets image count for selected tag in browser. --- tag-browser.rkt | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/tag-browser.rkt b/tag-browser.rkt index b34bcd7..b4f309e 100644 --- a/tag-browser.rkt +++ b/tag-browser.rkt @@ -249,6 +249,7 @@ (define sel (send lbox get-selection)) (define tag-label (if sel (send lbox get-string sel) "")) (define img-list (search-db-exact 'or (list tag-label))) + (send img-lbox set-label (format "Image List (~a)" (length img-list))) (send img-lbox clear) (remove-children thumb-vpanel (send thumb-vpanel get-children)) (for ([img (in-list img-list)]) @@ -264,7 +265,7 @@ (define img-lbox (new list-box% - [label "Image List"] + [label "Image List "] [parent img-vpanel] [style '(single vertical-label)] [choices (list "")] From d0097f586669bd77198891175df65aef527ce23a Mon Sep 17 00:00:00 2001 From: Brigham Toskin Date: Mon, 23 Apr 2018 23:35:45 -0700 Subject: [PATCH 5/7] Tag filtering in browser. New filter text-field%. On event, calls (update-tag-browser). When loading tags, filter results to match input field. --- tag-browser.rkt | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/tag-browser.rkt b/tag-browser.rkt index b4f309e..86a5711 100644 --- a/tag-browser.rkt +++ b/tag-browser.rkt @@ -231,6 +231,14 @@ ; end menu bar definitions +(define tag-filter-tfield + (new text-field% + [parent browser-frame] + [label "Filter Tags"] + [callback (λ (tfield evt) + (define filter-str (or (send (send tfield get-editor) get-text) ".*")) + (update-tag-browser filter-str))])) + (define browser-hpanel (new horizontal-panel% [parent browser-frame])) @@ -319,7 +327,7 @@ [parent updating-frame] [label "Updating Tag Browser..."])) -(define (update-tag-browser) +(define (update-tag-browser [filter-str (or (send (send tag-filter-tfield get-editor) get-text) ".*")]) (send updating-frame center 'both) (send updating-frame show #t) ; remove the "" we put as a placeholder @@ -328,7 +336,11 @@ ; remove old thumb-button (remove-children thumb-vpanel (send thumb-vpanel get-children)) ; get every tag in the database - (define tag-labels (sort (table-column 'tags 'Tag_Label) string Date: Sat, 28 Apr 2018 01:01:12 -0700 Subject: [PATCH 6/7] Adds a checkbox to control tag filtering substr vs regex. --- tag-browser.rkt | 46 ++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 38 insertions(+), 8 deletions(-) diff --git a/tag-browser.rkt b/tag-browser.rkt index 86a5711..df4d5a6 100644 --- a/tag-browser.rkt +++ b/tag-browser.rkt @@ -3,7 +3,7 @@ ; browse taglist and images, modify tags if necessary (require racket/class racket/gui/base - racket/string + srfi/13 ; instead of racket/string, for string-contains-ci "base.rkt" "db.rkt" "embed.rkt" @@ -231,13 +231,44 @@ ; end menu bar definitions +; begin tag filtering/search definitions + +(define should-use-regex (make-parameter #f)) + +(define (filter-query tfield) + (or (send (send tfield get-editor) get-text) + (if (should-use-regex) + ".*" + ""))) + +(define tag-filter-layout + (new horizontal-panel% + [parent browser-frame] + [stretchable-height #f])) + +(define (filter-tags filter-str regex) + (λ (tag) + (if (should-use-regex) + (regexp-match filter-str tag) + (string-contains-ci tag filter-str)))) + (define tag-filter-tfield (new text-field% - [parent browser-frame] + [parent tag-filter-layout] [label "Filter Tags"] [callback (λ (tfield evt) - (define filter-str (or (send (send tfield get-editor) get-text) ".*")) - (update-tag-browser filter-str))])) + (update-tag-browser (filter-query tfield)))])) + +(define tag-filter-regex-checkbox + (new check-box% + [parent tag-filter-layout] + [label "Regex"] + [value #f] + [callback (λ (chk evt) + (should-use-regex (not (should-use-regex))) + (update-tag-browser))])) + +; end tag filtering/search definitions (define browser-hpanel (new horizontal-panel% @@ -327,7 +358,7 @@ [parent updating-frame] [label "Updating Tag Browser..."])) -(define (update-tag-browser [filter-str (or (send (send tag-filter-tfield get-editor) get-text) ".*")]) +(define (update-tag-browser [filter-str (filter-query tag-filter-tfield)]) (send updating-frame center 'both) (send updating-frame show #t) ; remove the "" we put as a placeholder @@ -337,9 +368,8 @@ (remove-children thumb-vpanel (send thumb-vpanel get-children)) ; get every tag in the database (define tag-labels (sort - (filter (lambda (tag) (regexp-match filter-str tag)) - (table-column 'tags 'Tag_Label) - ) + (filter (filter-tags filter-str should-use-regex) + (table-column 'tags 'Tag_Label)) string Date: Sat, 28 Apr 2018 10:42:47 -0700 Subject: [PATCH 7/7] PR #71 feedback: module imports. Restore racket/string import for its version of string-replace. Specifically import string-contains-ci from srfi/13. --- tag-browser.rkt | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/tag-browser.rkt b/tag-browser.rkt index df4d5a6..47047e3 100644 --- a/tag-browser.rkt +++ b/tag-browser.rkt @@ -3,7 +3,8 @@ ; browse taglist and images, modify tags if necessary (require racket/class racket/gui/base - srfi/13 ; instead of racket/string, for string-contains-ci + racket/string + (only-in srfi/13 string-contains-ci) "base.rkt" "db.rkt" "embed.rkt"