Mercurial > emacs
comparison lisp/image-dired.el @ 82013:28a05f6b7f8f
(image-dired-sane-db-file): New func.
(image-dired-write-tags, image-dired-remove-tag)
(image-dired-list-tags, image-dired-write-comments)
(image-dired-get-comment, image-dired-mark-tagged-files)
(image-dired-create-gallery-lists): Call new func.
| author | Thien-Thi Nguyen <ttn@gnuvola.org> |
|---|---|
| date | Sat, 21 Jul 2007 23:41:50 +0000 |
| parents | 2a989ff22a03 |
| children | b98604865ea0 |
comparison
equal
deleted
inserted
replaced
| 82012:878cfe0c0c5a | 82013:28a05f6b7f8f |
|---|---|
| 867 (defalias 'image-dired 'image-dired-show-all-from-dir) | 867 (defalias 'image-dired 'image-dired-show-all-from-dir) |
| 868 | 868 |
| 869 ;;;###autoload | 869 ;;;###autoload |
| 870 (defalias 'tumme 'image-dired-show-all-from-dir) | 870 (defalias 'tumme 'image-dired-show-all-from-dir) |
| 871 | 871 |
| 872 (defun image-dired-sane-db-file () | |
| 873 "Check if `image-dired-db-file' exists. | |
| 874 If not, try to create it (including any parent directories). | |
| 875 Signal error if there are problems creating it." | |
| 876 (or (file-exists-p image-dired-db-file) | |
| 877 (let (dir buf) | |
| 878 (unless (file-directory-p (setq dir (file-name-directory | |
| 879 image-dired-db-file))) | |
| 880 (make-directory dir t)) | |
| 881 (with-current-buffer (setq buf (create-file-buffer | |
| 882 image-dired-db-file)) | |
| 883 (write-file image-dired-db-file)) | |
| 884 (kill-buffer buf) | |
| 885 (file-exists-p image-dired-db-file)) | |
| 886 (error "Could not create %s" image-dired-db-file))) | |
| 887 | |
| 872 (defun image-dired-write-tags (file-tags) | 888 (defun image-dired-write-tags (file-tags) |
| 873 "Write file tags to database. | 889 "Write file tags to database. |
| 874 Write each file and tag in FILE-TAGS to the database. FILE-TAGS | 890 Write each file and tag in FILE-TAGS to the database. FILE-TAGS |
| 875 is an alist in the following form: | 891 is an alist in the following form: |
| 876 ((FILE . TAG) ... )" | 892 ((FILE . TAG) ... )" |
| 893 (image-dired-sane-db-file) | |
| 877 (let (end file tag) | 894 (let (end file tag) |
| 878 (with-temp-file image-dired-db-file | 895 (with-temp-file image-dired-db-file |
| 879 (insert-file-contents image-dired-db-file) | 896 (insert-file-contents image-dired-db-file) |
| 880 (dolist (elt file-tags) | 897 (dolist (elt file-tags) |
| 881 (setq file (car elt) | 898 (setq file (car elt) |
| 891 (goto-char (point-max)) | 908 (goto-char (point-max)) |
| 892 (insert (format "\n%s;%s" file tag))))))) | 909 (insert (format "\n%s;%s" file tag))))))) |
| 893 | 910 |
| 894 (defun image-dired-remove-tag (files tag) | 911 (defun image-dired-remove-tag (files tag) |
| 895 "For all FILES, remove TAG from the image database." | 912 "For all FILES, remove TAG from the image database." |
| 913 (image-dired-sane-db-file) | |
| 896 (save-excursion | 914 (save-excursion |
| 897 (let (end buf start) | 915 (let (end buf start) |
| 898 (setq buf (find-file image-dired-db-file)) | 916 (setq buf (find-file image-dired-db-file)) |
| 899 (if (not (listp files)) | 917 (if (not (listp files)) |
| 900 (if (stringp files) | 918 (if (stringp files) |
| 925 (save-buffer) | 943 (save-buffer) |
| 926 (kill-buffer buf)))) | 944 (kill-buffer buf)))) |
| 927 | 945 |
| 928 (defun image-dired-list-tags (file) | 946 (defun image-dired-list-tags (file) |
| 929 "Read all tags for image FILE from the image database." | 947 "Read all tags for image FILE from the image database." |
| 948 (image-dired-sane-db-file) | |
| 930 (save-excursion | 949 (save-excursion |
| 931 (let (end buf (tags "")) | 950 (let (end buf (tags "")) |
| 932 (setq buf (find-file image-dired-db-file)) | 951 (setq buf (find-file image-dired-db-file)) |
| 933 (goto-char (point-min)) | 952 (goto-char (point-min)) |
| 934 (when (search-forward-regexp | 953 (when (search-forward-regexp |
| 2036 (defun image-dired-write-comments (file-comments) | 2055 (defun image-dired-write-comments (file-comments) |
| 2037 "Write file comments to database. | 2056 "Write file comments to database. |
| 2038 Write file comments to one or more files. FILE-COMMENTS is an alist on | 2057 Write file comments to one or more files. FILE-COMMENTS is an alist on |
| 2039 the following form: | 2058 the following form: |
| 2040 ((FILE . COMMENT) ... )" | 2059 ((FILE . COMMENT) ... )" |
| 2060 (image-dired-sane-db-file) | |
| 2041 (let (end comment-beg-pos comment-end-pos file comment) | 2061 (let (end comment-beg-pos comment-end-pos file comment) |
| 2042 (with-temp-file image-dired-db-file | 2062 (with-temp-file image-dired-db-file |
| 2043 (insert-file-contents image-dired-db-file) | 2063 (insert-file-contents image-dired-db-file) |
| 2044 (dolist (elt file-comments) | 2064 (dolist (elt file-comments) |
| 2045 (setq file (car elt) | 2065 (setq file (car elt) |
| 2106 (if file (image-dired-get-comment file))))) | 2126 (if file (image-dired-get-comment file))))) |
| 2107 comment)) | 2127 comment)) |
| 2108 | 2128 |
| 2109 (defun image-dired-get-comment (file) | 2129 (defun image-dired-get-comment (file) |
| 2110 "Get comment for file FILE." | 2130 "Get comment for file FILE." |
| 2131 (image-dired-sane-db-file) | |
| 2111 (save-excursion | 2132 (save-excursion |
| 2112 (let (end buf comment-beg-pos comment-end-pos comment) | 2133 (let (end buf comment-beg-pos comment-end-pos comment) |
| 2113 (setq buf (find-file image-dired-db-file)) | 2134 (setq buf (find-file image-dired-db-file)) |
| 2114 (goto-char (point-min)) | 2135 (goto-char (point-min)) |
| 2115 (when (search-forward-regexp | 2136 (when (search-forward-regexp |
| 2134 image file and stored in image-dired's database file. This command | 2155 image file and stored in image-dired's database file. This command |
| 2135 lets you input a regexp and this will be matched against all tags | 2156 lets you input a regexp and this will be matched against all tags |
| 2136 on all image files in the database file. The files that have a | 2157 on all image files in the database file. The files that have a |
| 2137 matching tags will be marked in the dired buffer." | 2158 matching tags will be marked in the dired buffer." |
| 2138 (interactive) | 2159 (interactive) |
| 2160 (image-dired-sane-db-file) | |
| 2139 (let ((tag (read-string "Mark tagged files (regexp): ")) | 2161 (let ((tag (read-string "Mark tagged files (regexp): ")) |
| 2140 (hits 0) | 2162 (hits 0) |
| 2141 files buf) | 2163 files buf) |
| 2142 (save-excursion | 2164 (save-excursion |
| 2143 (setq buf (find-file image-dired-db-file)) | 2165 (setq buf (find-file image-dired-db-file)) |
| 2298 (cdr image-dired-file-comment-list)))) | 2320 (cdr image-dired-file-comment-list)))) |
| 2299 (setq image-dired-file-comment-list (list (cons file comment))))) | 2321 (setq image-dired-file-comment-list (list (cons file comment))))) |
| 2300 | 2322 |
| 2301 (defun image-dired-create-gallery-lists () | 2323 (defun image-dired-create-gallery-lists () |
| 2302 "Create temporary lists used by `image-dired-gallery-generate'." | 2324 "Create temporary lists used by `image-dired-gallery-generate'." |
| 2325 (image-dired-sane-db-file) | |
| 2303 (let ((buf (find-file image-dired-db-file)) | 2326 (let ((buf (find-file image-dired-db-file)) |
| 2304 end beg file row-tags) | 2327 end beg file row-tags) |
| 2305 (setq image-dired-tag-file-list nil) | 2328 (setq image-dired-tag-file-list nil) |
| 2306 (setq image-dired-file-tag-list nil) | 2329 (setq image-dired-file-tag-list nil) |
| 2307 (setq image-dired-file-comment-list nil) | 2330 (setq image-dired-file-comment-list nil) |