From c43ef272befcf5f956cb9c5edc6de32504db943b Mon Sep 17 00:00:00 2001 From: Lehi Toskin Date: Mon, 28 May 2018 16:00:44 -0700 Subject: [PATCH 1/3] Fix #79 --- embed.rkt | 6 +++++- meta-editor.rkt | 49 +++++++++++++++++++++++++++---------------------- 2 files changed, 32 insertions(+), 23 deletions(-) diff --git a/embed.rkt b/embed.rkt index 5707fdb..36ba854 100644 --- a/embed.rkt +++ b/embed.rkt @@ -718,7 +718,11 @@ GIF XMP keyword: #"XMP Data" with auth #"XMP" (is-dc:subject? . -> . list?) (define found (findf*-txexpr dc:sub is-rdf:li?)) (if found - (flatten (map (λ (item) (get-elements item)) found)) + (for/fold ([lst empty]) + ([element (map get-elements found)]) + (if (> (length element) 1) + (append lst (list (apply string-append element))) + (append lst element))) empty)) ; set the tag inside xexpr with the contents of tx. diff --git a/meta-editor.rkt b/meta-editor.rkt index d38a840..b5bc68b 100644 --- a/meta-editor.rkt +++ b/meta-editor.rkt @@ -168,28 +168,32 @@ (send attr-tfield set-value "") (send attr-choice set-string-selection "")) +(define (tab-panel-defaults) + (define num (send tab-panel get-number)) + (when (> num 1) + (for ([tab (in-range (- num 1))]) + (send tab-panel delete 1))) + (send tab-panel set-item-label 0 "default")) + (define (meta-editor-defaults) ; set tabs to default - (let ([num (send tab-panel get-number)]) - (cond [(= num 1) - (send tab-panel set-item-label 0 "default")] - [else - ; delete all but one tab - (for ([tab (in-range (- num 1))]) - (send tab-panel delete 1)) - (send tab-panel set-item-label 0 "default")])) + (tab-panel-defaults) (fields-defaults) (send xmp-lbox set-string-selection "dc:subject")) (define (langs-hash found) - (define elem+attrs (map (λ (tx) (findf-txexpr tx is-rdf:li?)) found)) - (for/hash ([tx (in-list elem+attrs)]) - (define elem (first (get-elements tx))) + (define elem+attrs (map (λ (tx) (findf*-txexpr tx is-rdf:li?)) found)) + (for/hash ([tx (in-list (first elem+attrs))]) + (define elem + (let ([li (get-elements tx)]) + (if (> (length li) 1) + (apply string-append li) + (first li)))) (define lang (first (filter (λ (pair) - (equal? (first pair) 'xml:lang)) + (eq? (first pair) 'xml:lang)) (get-attrs tx)))) (values (second lang) elem))) @@ -246,14 +250,7 @@ ; set some fields to defaults (fields-defaults) ; set tabs to default - (let ([num (send tab-panel get-number)]) - (cond [(= num 1) - (send tab-panel set-item-label 0 "default")] - [else - ; delete all but one tab - (for ([tab (in-range (- num 1))]) - (send tab-panel delete 1)) - (send tab-panel set-item-label 0 "default")])) + (tab-panel-defaults) (case sel ; just in case get-string-selection returns #f [(||) (void)] @@ -286,7 +283,11 @@ dc:type) (when found (define rdf:li (findf*-txexpr (first found) is-rdf:li?)) - (define lst (flatten (map get-elements rdf:li))) + (define lst + (for/list ([elem (in-list (map get-elements rdf:li))]) + (if (> (length elem) 1) + (apply string-append elem) + (first elem)))) (send dc-tfield set-value (string-join lst ", ")))] ; grab the attrs from rdf:Description [(xmp:BaseURL xmp:Label xmp:Rating) @@ -306,7 +307,11 @@ ; everything else is just a single value [else (when found - (define lst (flatten (map get-elements found))) + (define lst + (for/list ([elem (in-list (map get-elements found))]) + (if (> (length elem) 1) + (apply string-append elem) + (first elem)))) (send dc-tfield set-value (string-join lst ", ")))])))])) (define dc-vpanel From 6b6b588f5d7a3cb16a911fe723518ed2b1fa8d30 Mon Sep 17 00:00:00 2001 From: Lehi Toskin Date: Tue, 29 May 2018 15:16:38 -0700 Subject: [PATCH 2/3] Refactor some rdf:li copypasta --- embed.rkt | 16 +++++++++++----- meta-editor.rkt | 18 +++--------------- 2 files changed, 14 insertions(+), 20 deletions(-) diff --git a/embed.rkt b/embed.rkt index 36ba854..06a5c23 100644 --- a/embed.rkt +++ b/embed.rkt @@ -28,6 +28,7 @@ is-rdf:li? is-tag? make-xmp-xexpr + rdf:li-fixer set-embed-tags! set-embed-xmp! set-xmp-tag @@ -713,16 +714,21 @@ GIF XMP keyword: #"XMP Data" with auth #"XMP" ([tag (in-list lst)]) (append bag `((rdf:li () ,tag))))))) +; fixes issues when we have multiple elements inside a single rdf:li +(define/contract (rdf:li-fixer rdf:li) + ((listof is-rdf:li?) . -> . list?) + (for/fold ([lst empty]) + ([elem (map get-elements rdf:li)]) + (if (> (length elem) 1) + (append lst (list (apply string-append elem))) + (append lst elem)))) + ; take a dc:subject entry and return a list of tags (define/contract (dc:subject->list dc:sub) (is-dc:subject? . -> . list?) (define found (findf*-txexpr dc:sub is-rdf:li?)) (if found - (for/fold ([lst empty]) - ([element (map get-elements found)]) - (if (> (length element) 1) - (append lst (list (apply string-append element))) - (append lst element))) + (rdf:li-fixer found) empty)) ; set the tag inside xexpr with the contents of tx. diff --git a/meta-editor.rkt b/meta-editor.rkt index b5bc68b..58edc71 100644 --- a/meta-editor.rkt +++ b/meta-editor.rkt @@ -184,11 +184,7 @@ (define (langs-hash found) (define elem+attrs (map (λ (tx) (findf*-txexpr tx is-rdf:li?)) found)) (for/hash ([tx (in-list (first elem+attrs))]) - (define elem - (let ([li (get-elements tx)]) - (if (> (length li) 1) - (apply string-append li) - (first li)))) + (define elem (first (rdf:li-fixer (list tx)))) (define lang (first (filter @@ -283,11 +279,7 @@ dc:type) (when found (define rdf:li (findf*-txexpr (first found) is-rdf:li?)) - (define lst - (for/list ([elem (in-list (map get-elements rdf:li))]) - (if (> (length elem) 1) - (apply string-append elem) - (first elem)))) + (define lst (rdf:li-fixer rdf:li)) (send dc-tfield set-value (string-join lst ", ")))] ; grab the attrs from rdf:Description [(xmp:BaseURL xmp:Label xmp:Rating) @@ -307,11 +299,7 @@ ; everything else is just a single value [else (when found - (define lst - (for/list ([elem (in-list (map get-elements found))]) - (if (> (length elem) 1) - (apply string-append elem) - (first elem)))) + (define lst (rdf:li-fixer found)) (send dc-tfield set-value (string-join lst ", ")))])))])) (define dc-vpanel From 55fe431cca9fdeb0cdd15739ec5ce5cd0c6c3f41 Mon Sep 17 00:00:00 2001 From: Lehi Toskin Date: Tue, 29 May 2018 21:08:34 -0700 Subject: [PATCH 3/3] Simplify rdf:li-fixer --- embed.rkt | 14 +++++++------- meta-editor.rkt | 6 +++--- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/embed.rkt b/embed.rkt index 06a5c23..e43d3ee 100644 --- a/embed.rkt +++ b/embed.rkt @@ -715,20 +715,20 @@ GIF XMP keyword: #"XMP Data" with auth #"XMP" (append bag `((rdf:li () ,tag))))))) ; fixes issues when we have multiple elements inside a single rdf:li +; enter a single rdf:li, return a single string (define/contract (rdf:li-fixer rdf:li) - ((listof is-rdf:li?) . -> . list?) - (for/fold ([lst empty]) - ([elem (map get-elements rdf:li)]) - (if (> (length elem) 1) - (append lst (list (apply string-append elem))) - (append lst elem)))) + (is-rdf:li? . -> . string?) + (define elem (get-elements rdf:li)) + (if (> (length elem) 1) + (apply string-append elem) + (first elem))) ; take a dc:subject entry and return a list of tags (define/contract (dc:subject->list dc:sub) (is-dc:subject? . -> . list?) (define found (findf*-txexpr dc:sub is-rdf:li?)) (if found - (rdf:li-fixer found) + (map rdf:li-fixer found) empty)) ; set the tag inside xexpr with the contents of tx. diff --git a/meta-editor.rkt b/meta-editor.rkt index 58edc71..98b644c 100644 --- a/meta-editor.rkt +++ b/meta-editor.rkt @@ -184,7 +184,7 @@ (define (langs-hash found) (define elem+attrs (map (λ (tx) (findf*-txexpr tx is-rdf:li?)) found)) (for/hash ([tx (in-list (first elem+attrs))]) - (define elem (first (rdf:li-fixer (list tx)))) + (define elem (rdf:li-fixer tx)) (define lang (first (filter @@ -279,7 +279,7 @@ dc:type) (when found (define rdf:li (findf*-txexpr (first found) is-rdf:li?)) - (define lst (rdf:li-fixer rdf:li)) + (define lst (map rdf:li-fixer rdf:li)) (send dc-tfield set-value (string-join lst ", ")))] ; grab the attrs from rdf:Description [(xmp:BaseURL xmp:Label xmp:Rating) @@ -299,7 +299,7 @@ ; everything else is just a single value [else (when found - (define lst (rdf:li-fixer found)) + (define lst (map rdf:li-fixer found)) (send dc-tfield set-value (string-join lst ", ")))])))])) (define dc-vpanel