Changeset 4131 for trunk/lisp/tumme.el

Timestamp:

07/29/06 07:48:34 (2 years ago)

Author:

miyoshi

Message:

Sync up with Emacs CVS HEAD.

Files:

• trunk/lisp/tumme.el (modified) (24 diffs)

trunk/lisp/tumme.el

@@ -85 +85 @@
-;; =====
-;;
-
+ 
-;; the Emacs manual and go to the node Thumbnails by typing `g
-;; Thumbnails RET'.
@@ -162 +162 @@
-(require 'dired)
-(require 'format-spec)
+(require 'widget)
+
+(eval-when-compile
+  (require 'wid-edit))
-
-(defgroup tumme nil
@@ -645 +649 @@
-                               (overlays-in (point) (1+ (point)))))
-       (put-image thumb-file image-pos)
- 
+
-        overlay
-        (car (delq nil (mapcar (lambda (o) (and (overlay-get o 'put-image) o))
@@ -865 +869 @@
-(defalias 'tumme 'tumme-show-all-from-dir)
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-(defun tumme-remove-tag (files tag)
@@ -952 +951 @@
-        curr-file files)
-    (if arg
-dired-get-filename
+list (dired-get-filename)
-      (setq files (dired-get-marked-files)))
-
+
+
+
+
+
-
-(defun tumme-tag-thumbnail ()
@@ -960 +963 @@
-  (interactive)
-  (let ((tag (read-string "Tags to add (separate tags with a semicolon): ")))
- (tumme-original-file-name) tag
+s (list (cons (tumme-original-file-name) tag))
-  (tumme-update-property
-   'tags (tumme-list-tags (tumme-original-file-name))))
@@ -1007 +1010 @@
-        (dired-buf (tumme-associated-dired-buffer))
-        (file-name (tumme-original-file-name)))
-dired-buf
+(buffer-live-p dired-buf)
-      (setq file-name (file-name-nondirectory file-name))
-      (set-buffer dired-buf)
@@ -1070 +1073 @@
-      (tumme-track-thumbnail)))
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-  (tumme-display-thumb-properties))
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-  (tumme-display-thumb-properties))
-
@@ -1104 +1121 @@
-  ;; If we end up in an empty spot, back up to the next thumbnail.
-  (if (not (tumme-image-at-point-p))
-char
+image
-  (if tumme-track-movement
-      (tumme-track-original-file))
@@ -1119 +1136 @@
-  ;; can handle it in a good manner, so why not?
-  (if (not (tumme-image-at-point-p))
-char
+image
-  (if tumme-track-movement
-      (tumme-track-original-file))
@@ -1132 +1149 @@
-   tumme-display-properties-format
-   (list
-buf
+(or buf "")
-    (cons ?f file)
-    (cons ?t (or (princ props) ""))
@@ -1188 +1205 @@
-  (interactive)
-  (tumme-modify-mark-on-thumb-original-file 'mark)
-char
+image
-
-(defun tumme-unmark-thumb-original-file ()
@@ -1194 +1211 @@
-  (interactive)
-  (tumme-modify-mark-on-thumb-original-file 'unmark)
-char
+image
-
-(defun tumme-flag-thumb-original-file ()
@@ -1200 +1217 @@
-  (interactive)
-  (tumme-modify-mark-on-thumb-original-file 'flag)
-char
+image
-
-(defun tumme-toggle-mark-thumb-original-file ()
@@ -1248 +1265 @@
-
-  ;; Keys
-char
-char
+image
+image
-  (define-key tumme-thumbnail-mode-map [up] 'tumme-previous-line)
-  (define-key tumme-thumbnail-mode-map [down] 'tumme-next-line)
-char
-char
+image
+image
-  (define-key tumme-thumbnail-mode-map "\C-p" 'tumme-previous-line)
-  (define-key tumme-thumbnail-mode-map "\C-n" 'tumme-next-line)
@@ -1656 +1673 @@
-          (insert " ")
-          (setq count (1+ count))
-
+
+
-            (forward-char)
-            (insert "\n")
@@ -1799 +1817 @@
-        (if (not file)
-            (message "No original file name found")
-
-
+
+
+
+
-
-;;;###autoload
@@ -1808 +1828 @@
-With prefix argument ARG, display image in its original size."
-  (interactive "P")
-
-
+
+
+
-
-(defun tumme-image-at-point-p ()
@@ -2001 +2022 @@
-  "In thubnail buffer, move to next thumbnail and display the image."
-  (interactive)
-char
+image
-  (tumme-display-thumbnail-original-image))
-
-(defun tumme-display-previous-thumbnail-original ()
-  "Move to previous thumbnail and display image."
-
-
-
+
+
-  (tumme-display-thumbnail-original-image))
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-(defun tumme-update-property (prop value)
@@ -2057 +2078 @@
-  "Add comment to current or marked files in dired."
-  (interactive)
-files (dired-get-marked-files
-     (comment (tumme-read-comment)))
-
-
-(tumme-write-comment
-files
+comment (tumme-read-comment)
+(tumme-write-comments
+ 
+ 
+ (cons
+ (dired-get-marked-files))
-
-(defun tumme-comment-thumbnail ()
@@ -2069 +2090 @@
-  (let* ((file (tumme-original-file-name))
-         (comment (tumme-read-comment file)))
- file comment
+s (list (cons file comment))
-    (tumme-update-property 'comment comment))
-  (tumme-display-thumb-properties))
@@ -2086 +2107 @@
-  "Get comment for file FILE."
-  (save-excursion
- comment (base-name (file-name-nondirectory file))
+-pos comment-end-pos comment
-      (setq buf (find-file tumme-db-file))
-      (goto-char (point-min))
-      (when (search-forward-regexp
-base-nam
+fil
-        (end-of-line)
-        (setq end (point))
-        (beginning-of-line)
-        (cond ((search-forward ";comment:" end t)
-
+-pos
-               (if (search-forward ";" end t)
-
-
+-pos
+-pos
-               (setq comment (buffer-substring
- comment-end
+-pos comment-end-pos
-      (kill-buffer buf)
-      comment)))
@@ -2154 +2175 @@
-    (if tumme-track-movement
-        (tumme-track-original-file))
+    (tumme-create-display-image-buffer)
+    (display-buffer tumme-display-image-buffer)
-    (tumme-display-image file)))
-
@@ -2422 +2445 @@
-    (kill-buffer buffer)))
-
+(defvar tumme-widget-list nil
+  "List to keep track of meta data in edit buffer.")
+
+;;;###autoload
+(defun tumme-dired-edit-comment-and-tags ()
+  "Edit comment and tags of current or marked image files.
+Edit comment and tags for all marked image files in an
+easy-to-use form."
+  (interactive)
+  (setq tumme-widget-list nil)
+  ;; Setup buffer.
+  (let ((files (dired-get-marked-files)))
+    (switch-to-buffer "*Tumme Edit Meta Data*")
+    (kill-all-local-variables)
+    (make-local-variable 'widget-example-repeat)
+    (let ((inhibit-read-only t))
+      (erase-buffer))
+    (remove-overlays)
+    ;; Some help for the user.
+    (widget-insert
+"\nEdit comments and tags for each image.  Separate multiple tags
+with a comma.  Move forward between fields using TAB or RET.
+Move to the previous field using backtab (S-TAB).  Save by
+activating the Save button at the bottom of the form or cancel
+the operation by activating the Cancel button.\n\n")
+    ;; Here comes all images and a comment and tag field for each
+    ;; image.
+    (let (thumb-file img comment-widget tag-widget)
+
+      (dolist (file files)
+
+       (setq thumb-file (tumme-thumb-name file)
+             img (create-image thumb-file))
+
+       (insert-image img)
+       (widget-insert "\n\nComment: ")
+       (setq comment-widget
+             (widget-create 'editable-field
+                            :size 60
+                            :format "%v "
+                            :value (or (tumme-get-comment file) "")))
+       (widget-insert "\nTags:    ")
+       (setq tag-widget
+             (widget-create 'editable-field
+                            :size 60
+                            :format "%v "
+                            :value (or (mapconcat
+                                        (lambda (tag)
+                                          tag)
+                                        (tumme-list-tags file)
+                                        ",") "")))
+       ;; Save information in all widgets so that we can use it when
+       ;; the user saves the form.
+       (setq tumme-widget-list
+             (append tumme-widget-list
+                     (list (list file comment-widget tag-widget))))
+       (widget-insert "\n\n")))
+
+    ;; Footer with Save and Cancel button.
+    (widget-insert "\n")
+    (widget-create 'push-button
+                 :notify
+                 (lambda (&rest ignore)
+                   (tumme-save-information-from-widgets)
+                   (bury-buffer)
+                   (message "Done."))
+                 "Save")
+    (widget-insert " ")
+    (widget-create 'push-button
+                   :notify
+                   (lambda (&rest ignore)
+                     (bury-buffer)
+                     (message "Operation canceled."))
+                   "Cancel")
+    (widget-insert "\n")
+    (use-local-map widget-keymap)
+    (widget-setup)
+    ;; Jump to the first widget.
+    (widget-forward 1)))
+
+(defun tumme-save-information-from-widgets ()
+  "Save information found in `tumme-widget-list'.
+Use the information in `tumme-widget-list' to save comments and
+tags to their respective image file.  Internal function used by
+`tumme-dired-edit-comment-and-tags'."
+  (let (file comment tag-string tag-list lst)
+    (tumme-write-comments
+          (mapcar
+           (lambda (widget)
+             (setq file (car widget)
+                   comment (widget-value (cadr widget)))
+             (cons file comment))
+           tumme-widget-list))
+    (tumme-write-tags
+     (dolist (widget tumme-widget-list lst)
+       (setq file (car widget)
+             tag-string (widget-value (car (cddr widget)))
+             tag-list (split-string tag-string ","))
+       (dolist (tag tag-list)
+         (push (cons file tag) lst))))))
+
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;; TEST-SECTION ;;;;;;;;;;;