aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorNick Roberts2006-07-11 09:37:28 +0000
committerNick Roberts2006-07-11 09:37:28 +0000
commitc4e153bb821f7ced375441974b0eb765e1e16ffe (patch)
tree977cf9aff93a7bb43cb9078dca9a78c226af840a
parentb05b996fe25e1aa24e18e34203c6dac5260a497d (diff)
downloademacs-c4e153bb821f7ced375441974b0eb765e1e16ffe.tar.gz
emacs-c4e153bb821f7ced375441974b0eb765e1e16ffe.zip
(tumme-create-thumb)
(tumme-thumbnail-display-external, tumme-display-image) (tumme-rotate-thumbnail, tumme-rotate-original) (tumme-set-exif-data, tumme-get-exif-data): Use call-process instead of shell-command. (tumme-create-thumbnail-buffer) (tumme-create-display-image-buffer, tumme-display-thumbs) (tumme-modify-mark-on-thumb-original-file, tumme-display-image) (tumme-get-exif-data): Use with-current-buffer. (tumme-display-properties-format) (tumme-dired-insert-marked-thumbs, tumme-rotate-original) (tumme-get-exif-file-name) (tumme-thumbnail-set-image-description, tumme-gallery-generate): Fit to 80 columns.
-rw-r--r--lisp/tumme.el65
1 files changed, 32 insertions, 33 deletions
diff --git a/lisp/tumme.el b/lisp/tumme.el
index d6420bf33d7..d97a5d0108f 100644
--- a/lisp/tumme.el
+++ b/lisp/tumme.el
@@ -491,7 +491,8 @@ with the comment."
491 :group 'tumme) 491 :group 'tumme)
492 492
493(defcustom tumme-external-viewer 493(defcustom tumme-external-viewer
494 ;; TODO: use mailcap, dired-guess-shell-alist-default, dired-view-command-alist 494 ;; TODO: Use mailcap, dired-guess-shell-alist-default,
495 ;; dired-view-command-alist.
495 (cond ((executable-find "display")) 496 (cond ((executable-find "display"))
496 ((executable-find "xli")) 497 ((executable-find "xli"))
497 ((executable-find "qiv") "qiv -t")) 498 ((executable-find "qiv") "qiv -t"))
@@ -627,7 +628,7 @@ according to the Thumbnail Managing Standard."
627 (setq thumbnail-dir (file-name-directory thumbnail-file)))) 628 (setq thumbnail-dir (file-name-directory thumbnail-file))))
628 (message "Creating thumbnail directory.") 629 (message "Creating thumbnail directory.")
629 (make-directory thumbnail-dir)) 630 (make-directory thumbnail-dir))
630 (shell-command command nil))) 631 (call-process shell-file-name nil nil nil "-c" command)))
631 632
632;;;###autoload 633;;;###autoload
633(defun tumme-dired-insert-marked-thumbs () 634(defun tumme-dired-insert-marked-thumbs ()
@@ -643,8 +644,10 @@ according to the Thumbnail Managing Standard."
643 ;; Can't use (overlays-at (point)), BUG? 644 ;; Can't use (overlays-at (point)), BUG?
644 (overlays-in (point) (1+ (point))))) 645 (overlays-in (point) (1+ (point)))))
645 (put-image thumb-file image-pos) 646 (put-image thumb-file image-pos)
646 (setq overlay (car (delq nil (mapcar (lambda (o) (and (overlay-get o 'put-image) o)) 647 (setq
647 (overlays-in (point) (1+ (point))))))) 648 overlay
649 (car (delq nil (mapcar (lambda (o) (and (overlay-get o 'put-image) o))
650 (overlays-in (point) (1+ (point)))))))
648 (overlay-put overlay 'image-file image-file) 651 (overlay-put overlay 'image-file image-file)
649 (overlay-put overlay 'thumb-file thumb-file))) 652 (overlay-put overlay 'thumb-file thumb-file)))
650 nil) 653 nil)
@@ -716,8 +719,7 @@ Otherwise, delete overlays."
716(defun tumme-create-thumbnail-buffer () 719(defun tumme-create-thumbnail-buffer ()
717 "Create thumb buffer and set `tumme-thumbnail-mode'." 720 "Create thumb buffer and set `tumme-thumbnail-mode'."
718 (let ((buf (get-buffer-create tumme-thumbnail-buffer))) 721 (let ((buf (get-buffer-create tumme-thumbnail-buffer)))
719 (save-excursion 722 (with-current-buffer buf
720 (set-buffer buf)
721 (setq buffer-read-only t) 723 (setq buffer-read-only t)
722 (if (not (eq major-mode 'tumme-thumbnail-mode)) 724 (if (not (eq major-mode 'tumme-thumbnail-mode))
723 (tumme-thumbnail-mode))) 725 (tumme-thumbnail-mode)))
@@ -729,8 +731,7 @@ Otherwise, delete overlays."
729(defun tumme-create-display-image-buffer () 731(defun tumme-create-display-image-buffer ()
730 "Create image display buffer and set `tumme-display-image-mode'." 732 "Create image display buffer and set `tumme-display-image-mode'."
731 (let ((buf (get-buffer-create tumme-display-image-buffer))) 733 (let ((buf (get-buffer-create tumme-display-image-buffer)))
732 (save-excursion 734 (with-current-buffer buf
733 (set-buffer buf)
734 (setq buffer-read-only t) 735 (setq buffer-read-only t)
735 (if (not (eq major-mode 'tumme-display-image-mode)) 736 (if (not (eq major-mode 'tumme-display-image-mode))
736 (tumme-display-image-mode))) 737 (tumme-display-image-mode)))
@@ -812,8 +813,7 @@ thumbnail buffer to be selected."
812 (setq files (list (dired-get-filename))) 813 (setq files (list (dired-get-filename)))
813 (setq files (dired-get-marked-files))) 814 (setq files (dired-get-marked-files)))
814 (setq dired-buf (current-buffer)) 815 (setq dired-buf (current-buffer))
815 (save-excursion 816 (with-current-buffer buf
816 (set-buffer buf)
817 (let ((inhibit-read-only t)) 817 (let ((inhibit-read-only t))
818 (if (not append) 818 (if (not append)
819 (erase-buffer) 819 (erase-buffer)
@@ -1170,10 +1170,9 @@ dired."
1170 (dired-buf (tumme-associated-dired-buffer))) 1170 (dired-buf (tumme-associated-dired-buffer)))
1171 (if (not (and dired-buf file-name)) 1171 (if (not (and dired-buf file-name))
1172 (message "No image, or image with correct properties, at point.") 1172 (message "No image, or image with correct properties, at point.")
1173 (save-excursion 1173 (with-current-buffer dired-buf
1174 (message file-name) 1174 (message file-name)
1175 (setq file-name (file-name-nondirectory file-name)) 1175 (setq file-name (file-name-nondirectory file-name))
1176 (set-buffer dired-buf)
1177 (goto-char (point-min)) 1176 (goto-char (point-min))
1178 (if (search-forward file-name nil t) 1177 (if (search-forward file-name nil t)
1179 (cond ((eq command 'mark) (dired-mark 1)) 1178 (cond ((eq command 'mark) (dired-mark 1))
@@ -1294,7 +1293,8 @@ You probably want to use this together with
1294 (define-key tumme-thumbnail-mode-map "L" 'tumme-rotate-original-left) 1293 (define-key tumme-thumbnail-mode-map "L" 'tumme-rotate-original-left)
1295 (define-key tumme-thumbnail-mode-map "R" 'tumme-rotate-original-right) 1294 (define-key tumme-thumbnail-mode-map "R" 'tumme-rotate-original-right)
1296 1295
1297 (define-key tumme-thumbnail-mode-map "D" 'tumme-thumbnail-set-image-description) 1296 (define-key tumme-thumbnail-mode-map "D"
1297 'tumme-thumbnail-set-image-description)
1298 1298
1299 (define-key tumme-thumbnail-mode-map "\C-d" 'tumme-delete-char) 1299 (define-key tumme-thumbnail-mode-map "\C-d" 'tumme-delete-char)
1300 (define-key tumme-thumbnail-mode-map " " 1300 (define-key tumme-thumbnail-mode-map " "
@@ -1686,25 +1686,22 @@ Ask user how many thumbnails should be displayed per row."
1686 1686
1687(defun tumme-thumbnail-display-external () 1687(defun tumme-thumbnail-display-external ()
1688 "Display original image for thumbnail at point using external viewer." 1688 "Display original image for thumbnail at point using external viewer."
1689
1690 (interactive) 1689 (interactive)
1691 (let ((file (tumme-original-file-name))) 1690 (let ((file (tumme-original-file-name)))
1692 (if (not (tumme-image-at-point-p)) 1691 (if (not (tumme-image-at-point-p))
1693 (message "No thumbnail at point") 1692 (message "No thumbnail at point")
1694 (if (not file) 1693 (if (not file)
1695 (message "No original file name found") 1694 (message "No original file name found")
1696 (shell-command (format "%s \"%s\"" 1695 (call-process shell-file-name nil nil nil "-c"
1697 tumme-external-viewer 1696 (format "%s \"%s\"" tumme-external-viewer file))))))
1698 file))))))
1699 1697
1700;;;###autoload 1698;;;###autoload
1701(defun tumme-dired-display-external () 1699(defun tumme-dired-display-external ()
1702 "Display file at point using an external viewer." 1700 "Display file at point using an external viewer."
1703 (interactive) 1701 (interactive)
1704 (let ((file (dired-get-filename))) 1702 (let ((file (dired-get-filename)))
1705 (shell-command (format "%s \"%s\"" 1703 (call-process shell-file-name nil nil nil "-c"
1706 tumme-external-viewer 1704 (format "%s \"%s\"" tumme-external-viewer file))))
1707 file))))
1708 1705
1709(defun tumme-window-width-pixels (window) 1706(defun tumme-window-width-pixels (window)
1710 "Calculate WINDOW width in pixels." 1707 "Calculate WINDOW width in pixels."
@@ -1776,12 +1773,11 @@ original size."
1776 (cons ?h height) 1773 (cons ?h height)
1777 (cons ?f file) 1774 (cons ?f file)
1778 (cons ?t new-file)))) 1775 (cons ?t new-file))))
1779 (setq ret (shell-command command nil)) 1776 (setq ret (call-process shell-file-name nil nil nil "-c" command))
1780 (if (not (= 0 ret)) 1777 (if (not (= 0 ret))
1781 (error "Could not resize image"))) 1778 (error "Could not resize image")))
1782 (copy-file file new-file t)) 1779 (copy-file file new-file t))
1783 (save-excursion 1780 (with-current-buffer (tumme-create-display-image-buffer)
1784 (set-buffer (tumme-create-display-image-buffer))
1785 (let ((inhibit-read-only t)) 1781 (let ((inhibit-read-only t))
1786 (erase-buffer) 1782 (erase-buffer)
1787 (clear-image-cache) 1783 (clear-image-cache)
@@ -1829,7 +1825,7 @@ With prefix argument ARG, display image in its original size."
1829 (cons ?p tumme-cmd-rotate-thumbnail-program) 1825 (cons ?p tumme-cmd-rotate-thumbnail-program)
1830 (cons ?d degrees) 1826 (cons ?d degrees)
1831 (cons ?t (expand-file-name file))))) 1827 (cons ?t (expand-file-name file)))))
1832 (shell-command command nil) 1828 (call-process shell-file-name nil nil nil "-c" command)
1833 ;; Clear the cache to refresh image. I wish I could just refresh 1829 ;; Clear the cache to refresh image. I wish I could just refresh
1834 ;; the current file but I do not know how to do that. Yet... 1830 ;; the current file but I do not know how to do that. Yet...
1835 (clear-image-cache)))) 1831 (clear-image-cache))))
@@ -1874,11 +1870,12 @@ overwritten. This confirmation can be turned off using
1874 (cons ?d degrees) 1870 (cons ?d degrees)
1875 (cons ?o (expand-file-name file)) 1871 (cons ?o (expand-file-name file))
1876 (cons ?t tumme-temp-rotate-image-file)))) 1872 (cons ?t tumme-temp-rotate-image-file))))
1877 (if (not (= 0 (shell-command command nil))) 1873 (if (not (= 0 (call-process shell-file-name nil nil nil "-c" command)))
1878 (error "Could not rotate image") 1874 (error "Could not rotate image")
1879 (tumme-display-image tumme-temp-rotate-image-file) 1875 (tumme-display-image tumme-temp-rotate-image-file)
1880 (if (or (and tumme-rotate-original-ask-before-overwrite 1876 (if (or (and tumme-rotate-original-ask-before-overwrite
1881 (y-or-n-p "Rotate to temp file OK. Overwrite original image? ")) 1877 (y-or-n-p
1878 "Rotate to temp file OK. Overwrite original image? "))
1882 (not tumme-rotate-original-ask-before-overwrite)) 1879 (not tumme-rotate-original-ask-before-overwrite))
1883 (progn 1880 (progn
1884 (copy-file tumme-temp-rotate-image-file file t) 1881 (copy-file tumme-temp-rotate-image-file file t)
@@ -1910,7 +1907,8 @@ YYYY_MM_DD_HH_MM_DD_ORIG_FILE_NAME.jpg. Used from
1910 (format-time-string 1907 (format-time-string
1911 "%Y:%m:%d %H:%M:%S" 1908 "%Y:%m:%d %H:%M:%S"
1912 (nth 5 (file-attributes (expand-file-name file)))))) 1909 (nth 5 (file-attributes (expand-file-name file))))))
1913 (setq data (tumme-get-exif-data (expand-file-name file) "DateTimeOriginal"))) 1910 (setq data (tumme-get-exif-data (expand-file-name file)
1911 "DateTimeOriginal")))
1914 (while (string-match "[ :]" data) 1912 (while (string-match "[ :]" data)
1915 (setq data (replace-match "_" nil nil data))) 1913 (setq data (replace-match "_" nil nil data)))
1916 (format "%s%s%s" data 1914 (format "%s%s%s" data
@@ -1930,7 +1928,8 @@ default value at the prompt."
1930 (old-value (tumme-get-exif-data file "ImageDescription"))) 1928 (old-value (tumme-get-exif-data file "ImageDescription")))
1931 (if (eq 0 1929 (if (eq 0
1932 (tumme-set-exif-data file "ImageDescription" 1930 (tumme-set-exif-data file "ImageDescription"
1933 (read-string "Value of ImageDescription: " old-value))) 1931 (read-string "Value of ImageDescription: "
1932 old-value)))
1934 (message "Successfully wrote ImageDescription tag.") 1933 (message "Successfully wrote ImageDescription tag.")
1935 (error "Could not write ImageDescription tag"))))) 1934 (error "Could not write ImageDescription tag")))))
1936 1935
@@ -1944,7 +1943,7 @@ default value at the prompt."
1944 (cons ?f (expand-file-name file)) 1943 (cons ?f (expand-file-name file))
1945 (cons ?t tag-name) 1944 (cons ?t tag-name)
1946 (cons ?v tag-value)))) 1945 (cons ?v tag-value))))
1947 (shell-command command nil))) 1946 (call-process shell-file-name nil nil nil "-c" command)))
1948 1947
1949(defun tumme-get-exif-data (file tag-name) 1948(defun tumme-get-exif-data (file tag-name)
1950 "From FILE, return EXIF tag TAG-NAME." 1949 "From FILE, return EXIF tag TAG-NAME."
@@ -1956,10 +1955,9 @@ default value at the prompt."
1956 (cons ?p tumme-cmd-read-exif-data-program) 1955 (cons ?p tumme-cmd-read-exif-data-program)
1957 (cons ?f file) 1956 (cons ?f file)
1958 (cons ?t tag-name)))) 1957 (cons ?t tag-name))))
1959 (save-excursion 1958 (with-current-buffer buf
1960 (set-buffer buf)
1961 (delete-region (point-min) (point-max)) 1959 (delete-region (point-min) (point-max))
1962 (if (not (eq (shell-command command buf) 0)) 1960 (if (not (eq (call-process shell-file-name nil t nil "-c" command) 0))
1963 (error "Could not get EXIF tag") 1961 (error "Could not get EXIF tag")
1964 (goto-char (point-min)) 1962 (goto-char (point-min))
1965 ;; Clean buffer from newlines and carriage returns before 1963 ;; Clean buffer from newlines and carriage returns before
@@ -2377,7 +2375,8 @@ when using per-directory thumbnail file storage"))
2377 ;; Insert thumbnail with link to full image 2375 ;; Insert thumbnail with link to full image
2378 (insert 2376 (insert
2379 (format "<a href=\"%s/%s\"><img src=\"%s/%s\"%s></a>\n" 2377 (format "<a href=\"%s/%s\"><img src=\"%s/%s\"%s></a>\n"
2380 tumme-gallery-image-root-url (file-name-nondirectory file) 2378 tumme-gallery-image-root-url
2379 (file-name-nondirectory file)
2381 tumme-gallery-thumb-image-root-url 2380 tumme-gallery-thumb-image-root-url
2382 (file-name-nondirectory (tumme-thumb-name file)) file)) 2381 (file-name-nondirectory (tumme-thumb-name file)) file))
2383 ;; Insert comment, if any 2382 ;; Insert comment, if any