diff options
| author | Nick Roberts | 2006-07-11 09:37:28 +0000 |
|---|---|---|
| committer | Nick Roberts | 2006-07-11 09:37:28 +0000 |
| commit | c4e153bb821f7ced375441974b0eb765e1e16ffe (patch) | |
| tree | 977cf9aff93a7bb43cb9078dca9a78c226af840a | |
| parent | b05b996fe25e1aa24e18e34203c6dac5260a497d (diff) | |
| download | emacs-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.el | 65 |
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 |