Merge pull request #80 from lehitoskin/xml-control

Fix #79
lehitoskin · May 30, 2018 · 364b4fd · 364b4fd
2 parents e3c58aa + 55fe431
commit 364b4fd
Show file tree

Hide file tree

Showing 2 changed files with 26 additions and 23 deletions.
diff --git 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,12 +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
+; enter a single rdf:li, return a single string
+(define/contract (rdf:li-fixer rdf:li)
+  (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
-      (flatten (map (λ (item) (get-elements item)) 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
@@ -168,28 +168,28 @@
   (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 (rdf:li-fixer tx))
     (define lang
       (first
        (filter
         (λ (pair)
-          (equal? (first pair) 'xml:lang))
+          (eq? (first pair) 'xml:lang))
         (get-attrs tx))))
     (values (second lang) elem)))
 
@@ -246,14 +246,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 +279,7 @@
                          dc:type)
                         (when found
                           (define rdf:li (findf*-txexpr (first found) is-rdf:li?))
-                          (define lst (flatten (map get-elements 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)
@@ -306,7 +299,7 @@
                        ; everything else is just a single value
                        [else
                         (when found
-                          (define lst (flatten (map get-elements found)))
+                          (define lst (map rdf:li-fixer found))
                           (send dc-tfield set-value (string-join lst ", ")))])))]))
 
 (define dc-vpanel