comparison lisp/thumbs.el @ 83463:38c49afb29d9

Merged from Patches applied: * [e-mail]/emacs--devo--0--patch-31 Update from CVS git-archimport-id: [e-mail]--2004/emacs--multi-tty--0--patch-503

83462:75949877b3ed

(defvar thumbs-current-dir nil
  "Current directory.")

(defvar thumbs-marked-list nil
  "List of marked files.")

(defalias 'thumbs-gensym
    (if (fboundp 'gensym)
        'gensym
      ;; Copied from cl-macs.el

	((string-match ".*\\.bmp\\'" img) 'bmp)
	((string-match ".*\\.png\\'" img) 'png)
	((string-match ".*\\.tiff?\\'" img) 'tiff)))

(defun thumbs-file-size (img)
  (let ((i (image-size (find-image `((:type ,(thumbs-image-type img) :file ,img))) t)))
    (concat (number-to-string (round (car i)))
	    "x"
	    (number-to-string (round (cdr i))))))

;;;###autoload
(defun thumbs-find-thumb (img)
  "Display the thumbnail for IMG."

If MARKED is non-nil, the image is marked."
  (thumbs-insert-image
   (thumbs-make-thumb img) 'jpeg thumbs-relief marked)
  (add-text-properties (1- (point)) (point)
		     `(thumb-image-file ,img
		       help-echo ,(file-name-nondirectory img))))

(defun thumbs-do-thumbs-insertion (list)
  "Insert all thumbnails into thumbs buffer."
  (let* ((i 0)
	(length (length list))

  (with-current-buffer thumbs-buffer
    (save-excursion
      (let (list)
	(goto-char (point-min))
	(while (not (eobp))
	  (unless (= 0 (mod (point) (1+ thumbs-per-line)))
	    (if (thumbs-current-image)
		(push (cons (point-marker)
			    (thumbs-current-image))
		    list)))
	  (forward-char 1))

(put 'thumbs-mode 'mode-class 'special)
(define-derived-mode thumbs-mode
  fundamental-mode "thumbs"
  "Preview images in a thumbnails buffer"
  (setq buffer-read-only t)
  (set (make-local-variable 'thumbs-marked-list) nil))

(defvar thumbs-view-image-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map [prior] 'thumbs-previous-image)
    (define-key map [next] 'thumbs-next-image)

83463:38c49afb29d9

(defvar thumbs-current-dir nil
  "Current directory.")

(defvar thumbs-marked-list nil
  "List of marked files.")
(make-variable-buffer-local 'thumbs-marked-list)
(put 'thumbs-marked-list 'permanent-local t)

(defalias 'thumbs-gensym
    (if (fboundp 'gensym)
        'gensym
      ;; Copied from cl-macs.el

	((string-match ".*\\.bmp\\'" img) 'bmp)
	((string-match ".*\\.png\\'" img) 'png)
	((string-match ".*\\.tiff?\\'" img) 'tiff)))

(defun thumbs-file-size (img)
  (let ((i (image-size
	    (find-image `((:type ,(thumbs-image-type img) :file ,img))) t)))
    (concat (number-to-string (round (car i))) "x"
	    (number-to-string (round (cdr i))))))

;;;###autoload
(defun thumbs-find-thumb (img)
  "Display the thumbnail for IMG."

If MARKED is non-nil, the image is marked."
  (thumbs-insert-image
   (thumbs-make-thumb img) 'jpeg thumbs-relief marked)
  (add-text-properties (1- (point)) (point)
		     `(thumb-image-file ,img
		       help-echo ,(file-name-nondirectory img)
		       rear-nonsticky help-echo)))

(defun thumbs-do-thumbs-insertion (list)
  "Insert all thumbnails into thumbs buffer."
  (let* ((i 0)
	(length (length list))

  (with-current-buffer thumbs-buffer
    (save-excursion
      (let (list)
	(goto-char (point-min))
	(while (not (eobp))
	  (unless (eolp)
	    (if (thumbs-current-image)
		(push (cons (point-marker)
			    (thumbs-current-image))
		    list)))
	  (forward-char 1))

(put 'thumbs-mode 'mode-class 'special)
(define-derived-mode thumbs-mode
  fundamental-mode "thumbs"
  "Preview images in a thumbnails buffer"
  (setq buffer-read-only t))

(defvar thumbs-view-image-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map [prior] 'thumbs-previous-image)
    (define-key map [next] 'thumbs-next-image)