Merge branch 'embed-tags'

README.md

@@ -9,9 +9,10 @@ tracked solely by the application.
 ### Dependencies
 
 - [Racket](http://racket-lang.org/) version 6.6 and up
+- [gif-image](https://github.com/lehitoskin/gif-image)
+- [png-image](https://github.com/lehitoskin/png-image)
 - [racquel](https://github.com/brown131/racquel)
 - [rsvg](https://github.com/takikawa/rsvg) (which uses librsvg)
-- [gif-image](https://github.com/lehitoskin/gif-image)
 
 ### Compilation
 
@@ -106,3 +107,11 @@ an image path and selecting "Edit Tags" from the menu.
 Animated GIF support is currently marked as experimental. To animate a GIF,
 select View -> GIF Animation. Due to the unstable natue of the related code,
 know that some GIF's may not load properly or at all.
+
+### Embedding Tags as XMP metadata
+
+Ivy embeds the taglist as XMP metadata in the file itself (if that file supports
+XMP metadata). That way if you move your images around, the tags will stay the
+same. However, the information in the database will then be out of date, so it
+is recommended that if you move files around, utilize Ivy's command-line
+interface with the switch `-M` to ensure the changes are tracked.

base.rkt

@@ -16,7 +16,10 @@
          (only-in srfi/13
                   string-contains-ci
                   string-null?)
+         txexpr
+         xml
          "db.rkt"
+         "embed.rkt"
          "files.rkt")
 (provide (all-defined-out)
          string-null?
@@ -42,13 +45,15 @@
 (define image-bmp-master (make-bitmap 50 50))
 ; pict of the currently displayed image
 (define image-pict #f)
+; the cached XMP metadata of the image
+(define image-xmp (make-parameter ""))
 ; bitmap to actually display
 ; eliminate image "jaggies"
 ; reduce amount of times we use pict->bitmap, as this takes a very long time
 (define image-bmp (make-bitmap 50 50))
 ; directory containing the currently displayed image
 (define image-dir (make-parameter (find-system-path 'home-dir)))
-(define supported-extensions '(".bmp" ".gif" ".jpe" ".jpeg" ".jpg" ".png" ".svg"))
+(define supported-extensions '(".bmp" ".gif" ".jpe" ".jpeg" ".JPEG" ".jpg" ".JPG" ".png" ".svg"))
 (define exact-search? (make-parameter #f))
 (define color-white (make-object color% "white"))
 (define color-black (make-object color% "black"))
@@ -65,7 +70,24 @@
 
 ; contract for image scaling
 (define image-scale/c
-  (or/c 'default 'cmd 'larger 'wheel-larger 'smaller 'wheel-smaller 'same 'none))
+  (or/c 'default
+        'cmd
+        'larger
+        'wheel-larger
+        'smaller
+        'wheel-smaller
+        'same
+        'none
+        10
+        20
+        30
+        40
+        50
+        60
+        70
+        80
+        90
+        100))
 
 ; all image files contained within image-dir
 (define (path-files)
@@ -329,6 +351,9 @@
     [(smaller wheel-smaller)
      (scale-to-fit img (* img-width 0.9) (* img-height 0.9))]
     [(same) img]
+    [(10 20 30 40 50 60 70 80 90 100)
+     (define num (/ type 100))
+     (scale-to-fit img (* img-width num) (* img-height num))]
     [(none) (bitmap img)]))
 
 ; janky!
@@ -398,7 +423,8 @@
 ; the position message
 (define/contract (load-image img [scale 'default])
   (->* ([or/c path? pict? (is-a?/c bitmap%) (listof pict?)])
-       (image-scale/c) void?)
+       (image-scale/c)
+       void?)
   (define canvas (ivy-canvas))
   (define tag-tfield (ivy-tag-tfield))
   (define sbd (status-bar-dimensions))
@@ -455,10 +481,9 @@
        [else
         ; make sure the bitmap loaded correctly
         (define load-success
-          (cond [(bytes=? (path-get-extension img) #".svg")
-                 (set! image-bmp-master (load-svg-from-file img))]
-                [else
-                 (send image-bmp-master load-file img 'unknown/alpha)]))
+          (if (bytes=? (path-get-extension img) #".svg")
+              (and (set! image-bmp-master (load-svg-from-file img)) #t)
+              (send image-bmp-master load-file img 'unknown/alpha)))
         (cond [load-success
                (send (send canvas get-parent) set-label (path->string name))
                (set! image-pict (scale-image image-bmp-master scale))
@@ -485,6 +510,17 @@
             (define tags (send img-obj get-tags))
             (incoming-tags (string-join tags ", "))]
            [else (incoming-tags "")])
+     ; check to see if the image has embedded tags
+     ; and use them instead of what's in the DB
+     ; because it may be out of date
+     (cond [(embed-support? img-str)
+            (image-xmp (get-embed-xmp img-str))
+            (define embed-lst (get-embed-tags img-str))
+            (unless (empty? embed-lst)
+              ; the embedded tags may come back unsorted
+              (incoming-tags (string-join (sort embed-lst string<?) ", ")))]
+           [else (image-xmp "")])
+
      ; ...put them in the tfield
      (send tag-tfield set-value (incoming-tags))
      ; ensure the text-field displays the changes we just made

db.rkt

@@ -187,6 +187,7 @@
     ; add the image to each tag% object
     (send tag-obj add-img img)
     (save-data-object db-conn tag-obj))
+  (define img-path (get-column path img-obj))
   (save-data-object db-conn img-obj))
 
 ; remove the tags from the img entry
@@ -204,6 +205,7 @@
   (when img-obj
     ; remove the tags from the image
     (send img-obj del-tag tag-lst)
+    (define img-path (get-column path img-obj))
     ; if the image has no tags, remove from database
     (if (empty? (send img-obj get-tags))
         (delete-data-object db-conn img-obj)
@@ -256,15 +258,14 @@
         #:threaded? boolean?)
        (or/c void? thread?))
   (db-purge! #:db-conn db-conn img)
-  (add-tags! #:db-conn db-conn img tag-lst)
   (if threaded?
       (thread (λ ()
                 (add-tags! #:db-conn db-conn img tag-lst)))
       (add-tags! #:db-conn db-conn img tag-lst)))
 
-; reconcile between the old tags and new tags
-; instead of a scorched earth approach like db-set!, only delete and add
-; the tags as necessary
+; reconcile between the old tags and new tags.
+; instead of a scorched earth approach like db-set!,
+; only delete and add the tags as necessary
 (define/contract (reconcile-tags! #:db-conn [db-conn sqlc] img tag-lst)
   (->* ([or/c string? data-object?]
         [listof string?])
@@ -311,25 +312,14 @@
 ; counted more than once, so a final sort and remove-duplicates
 ; (how ironic) is possibly necessary.
 (define (keep-duplicates lst [dups empty])
-  (define sorted (sort lst equal?))
-  (define len (length sorted))
+  (define len (length lst))
   (cond [(< len 2) (remove-duplicates dups)]
         [(>= len 2)
+         (define sorted (sort lst (if (string? (first lst)) string<? path<?)))
          (if (equal? (first sorted) (second sorted))
              (keep-duplicates (rest sorted) (cons (first sorted) dups))
              (keep-duplicates (rest sorted) dups))]))
 
-(define (keep-duplicates-refined lst-lst)
-  (for/fold ([accum empty])
-            ([lst (in-list lst-lst)])
-    ; search-db-exact has a list of strings (from the db)
-    ; search-db-inexact has a list of paths (auto-converted by in-table-pairs)
-    (define cmp? (if (path? (first lst)) path<? string<?))
-    (define sorted (sort (append accum lst) cmp?))
-    (if (empty? accum)
-        sorted
-        (keep-duplicates sorted))))
-
 ; list the tags associated with the image
 (define/contract (image-taglist #:db-conn [db-conn sqlc] img)
   (->* ([or/c string? data-object?])
@@ -357,59 +347,49 @@
                           (string-replace str "'" "''"))) tag-lst))
          (define results
            ; loop over the tags we're searching through
-           (map (λ (tag-obj)
-                  (send tag-obj get-images))
-                (select-data-objects db-conn tag% (where (in label lst-quotes)))))
+           (flatten
+            (map (λ (tag-obj)
+                   (send tag-obj get-images))
+                 (select-data-objects db-conn tag% (where (in label lst-quotes))))))
          (case type
            ; turn all the strings into paths, remove duplicate items
            [(or)
-            (define sorted (sort (flatten results) string<?))
+            (define sorted (sort results string<?))
             (map string->path (remove-duplicates sorted))]
            ; turn all the strings in paths, keep only duplicate items
            [(and)
             (cond [(= (length lst-quotes) 1)
-                   (define sorted (sort (flatten results) string<?))
+                   (define sorted (sort results string<?))
                    (map string->path (remove-duplicates sorted))]
                   [else
-                   (map string->path (keep-duplicates-refined results))])])]))
+                   (map string->path (keep-duplicates results))])])]))
 
-; returns a list of paths or empty
+; return a list of paths or empty
 (define/contract (search-db-inexact #:db-conn [db-conn sqlc] type tag-lst)
   (->* ([or/c 'or 'and]
         [listof string?])
        (#:db-conn connection?)
        (or/c (listof path?) empty?))
-  (cond [(zero? (length tag-lst)) empty]
+  (cond [(= (length tag-lst) 0) empty]
         [else
+         ; search the database
          (define results
-           ; populate accum for each of the tags we're looking for
-           ; will become a list of lists
-           ;
-           ; allow in-table-pairs to be calculated only once,
-           ; to save on querying the db so many times
-           (let ([itp-sequence (in-table-pairs #:db-conn db-conn 'images)])
-             (for/fold ([accum empty])
-                       ([tag (in-list tag-lst)])
-               (define imgs-in-tag
-                 ; loop for each item in the database
-                 (for/list ([img-pair itp-sequence])
-                   (define img-tags (second img-pair))
-                   (define hit-or-miss
-                     (for/list ([img-tag (in-list img-tags)])
-                       (if (string-contains-ci img-tag tag)
-                           (first img-pair)
-                           #f)))
-                   ; remove any #f that we've found
-                   (filter path? hit-or-miss)))
-               ; flatten the list of length-1 lists,
-               ; then add it to the accumulator
-               (cons (flatten imgs-in-tag) accum))))
-         (cond [(or (= (length tag-lst) 1) (eq? type 'or))
-                ; remove any duplicates
-                (remove-duplicates (flatten results))]
-               [else
-                ; keep any duplicates
-                (keep-duplicates-refined results)])]))
+           ; iterate over the tags and see if any of them
+           ; match our tag-lst
+           (for/fold ([db-accum empty])
+                     ([db-pair (in-table-pairs #:db-conn db-conn 'tags)])
+             (define search
+               (for/fold ([tag-accum empty])
+                         ([tag (in-list tag-lst)])
+                 (if (string-contains-ci (first db-pair) tag)
+                     (append tag-accum (second db-pair))
+                     tag-accum)))
+             (if (empty? search)
+                 db-accum
+                 (append db-accum search))))
+         (if (or (= (length tag-lst) 1) (eq? type 'or))
+             (remove-duplicates results)
+             (keep-duplicates results))]))
 
 ; returns a list of paths or empty
 (define/contract (exclude-search-exact #:db-conn [db-conn sqlc] searched-imgs exclusion-tags)

doc/ivy.html

@@ -21,6 +21,8 @@ <h2 id="tag-browser">Tag Browser</h2>
 <p>From the tag browser it is also possible to delete entire tag categories or rename them. Also, it is possible to edit the taglist of an image by clicking on an image path and selecting &quot;Edit Tags&quot; from the menu.</p>
 <h2 id="animated-gif-support">Animated GIF Support</h2>
 <p>Animated GIF support is currently marked as experimental. To animate a GIF, select View -&gt; GIF Animation. Due to the unstable natue of the related code, know that some GIF's may not load properly or at all.</p>
+<h2 id="embedding-tags-as-xmp-metadata">Embedding Tags as XMP metadata</h2>
+<p>Ivy embeds the taglist as XMP metadata in the file itself (if that file supports XMP metadata). That way if you move your images around, the tags will stay the same. However, the information in the database will then be out of date, so it is recommended that if you move files around, utilize Ivy's command-line interface with the switch <code>-M</code> to ensure the changes are tracked.</p>
 <h1 id="options">OPTIONS</h1>
 <h2 id="mutually-exclusive-options">Mutually exclusive options</h2>
 <h3 id="v---version">-V, --version</h3>
@@ -41,6 +43,10 @@ <h3 id="t---set-tags-taglist">-T, --set-tags <em>[taglist]</em></h3>
 <p>Sets the taglist of the image. ex: ivy -T &quot;tag0, tag1, ...&quot; /path/to/image ...</p>
 <h3 id="m---move-image-images-...-destination">-M, --move-image <em>[image(s) ... destination]</em></h3>
 <p>Moves the source file(s) to the destination, updating the database.</p>
+<h3 id="show-xmp-imagelist">---show-xmp <em>[imagelist]</em></h3>
+<p>Shows the XMP metadata for supported files.</p>
+<h3 id="set-xmp-xmp-string-imagelist">---set-xmp <em>[xmp string]</em> <em>[imagelist]</em></h3>
+<p>Sets the XMP metadata for supported files in imagelist.</p>
 <h2 id="may-be-specified-once-each">May be specified once each</h2>
 <h3 id="e---exact-search">-e, --exact-search</h3>
 <p>Search the tags database for exact matches.</p>

doc/ivy.md

@@ -74,6 +74,14 @@ Animated GIF support is currently marked as experimental. To animate a GIF,
 select View -> GIF Animation. Due to the unstable natue of the related code,
 know that some GIF's may not load properly or at all.
 
+## Embedding Tags as XMP metadata
+
+Ivy embeds the taglist as XMP metadata in the file itself (if that file supports
+XMP metadata). That way if you move your images around, the tags will stay the
+same. However, the information in the database will then be out of date, so it
+is recommended that if you move files around, utilize Ivy's command-line
+interface with the switch `-M` to ensure the changes are tracked.
+
 # OPTIONS
 
 ## Mutually exclusive options
@@ -105,6 +113,12 @@ Sets the taglist of the image. ex: ivy -T "tag0, tag1, ..." /path/to/image ...
 ### -M, --move-image *[image(s) ... destination]*
 Moves the source file(s) to the destination, updating the database.
 
+### ---show-xmp *[imagelist]*
+Shows the XMP metadata for supported files.
+
+### ---set-xmp *[xmp string]* *[imagelist]*
+Sets the XMP metadata for supported files in imagelist.
+
 ## May be specified once each
 
 ### -e, --exact-search