Anonymous avatar Anonymous committed e986e90

2002-10-18 Glynn Clements <glynn.clements@virgin.net>;

* image-mode.el: Substantially re-written to avoid use of
format-alist.

xemacs-patches <15791.21139.768333.174888@cerise.nosuchdomain.co.uk>;

Comments (0)

Files changed (2)

+2002-10-18  Glynn Clements  <glynn.clements@virgin.net>
+
+	* image-mode.el: Substantially re-written to avoid use of
+	format-alist.
+
 2002-10-15  Ville Skyttä  <scop@xemacs.org>
 
 	* Makefile (srckit): Remove.
 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 ;; 02111-1307, USA.
 
+;;; Commentary:
+
+;; Modified: 2001-07-10, Glynn Clements <glynn.clements@virgin.net>
+;; 	Substantially re-written to avoid use of format-alist
+;; Modified: 2002-10-18, Glynn Clements <glynn.clements@virgin.net>
+;; 	Autoload image-mode-install
+;; Modified: 2002-10-22, Glynn Clements <glynn.clements@virgin.net>
+;; 	Remove format-alist entries
+
 ;;; Code:
 
-(defvar buffer-image-format nil)
-(make-variable-buffer-local 'buffer-image-format)
+(require 'cl)
 
-(defsubst image-decode (start end type)
+(defvar image-format nil)
+(make-variable-buffer-local 'image-format)
+
+(defvar image-decoded nil)
+(make-variable-buffer-local 'image-decoded)
+
+;;;###autoload
+(defvar image-formats-alist
+  '(("png"   . png )
+    ("gif"   . gif )
+    ("jpe?g" . jpeg)
+    ("tiff?" . tiff)
+    ("xbm"   . xbm )
+    ("xpm"   . xpm )
+    ("bmp"   . bmp )))
+
+(defun image-guess-type ()
+  (let (ext item)
+    (and buffer-file-name
+	 (setq ext (downcase (file-name-extension buffer-file-name)))
+	 (setq item (assoc* ext image-formats-alist
+			    :test (lambda (str re)
+				    (string-match (concat "^" re "\\'")
+						  str))))
+	 (setq image-format (cdr item)))))
+
+(defun image-decode-buffer ()
+  (image-decode (point-min) (point-max) image-format)
+  (setq image-decoded t)
+  (set-buffer-modified-p nil))
+
+(defun image-undecode-buffer ()
+  (setq buffer-read-only nil)
+  (map-extents (function
+		(lambda (extent maparg)
+		  (delete-extent extent)))
+	       nil (point-min) (point-max) nil 'end-closed)
+  (setq image-decoded nil))
+
+(defun image-decode (start end type)
   "Decode the image between START and END which is encoded in TYPE."
   (save-excursion
-    (let ((image (make-image-instance
-		  (vector type :data (buffer-string start end)) nil nil 'no-error)))
-      (delete-region start end)
-      (if image
-	  (let ((glyph (make-glyph image)))
-	    (set-extent-begin-glyph (make-extent start start) glyph)
-	    (setq buffer-read-only t)
-	    )
-	(insert (format "%s is not supported!\n" type))
-	(let ((overriding-local-map image-mode-map))
-	  (insert
-	   (substitute-command-keys
-	    "
-Please type `\\[image-toggle-decoding]' if you would like to display
-raw data.
-Please type `\\[image-enter-hexl-mode]' if you would like to edit hex
-data.
-Please type `\\[image-enter-xpm-mode]' if you would like to edit xpm
-data.
-Please type `\\[image-start-external-viewer]' if you would like to
-display contents of this buffer by external viewer.\n")))
-	(call-interactively 'fill-paragraph)
-	)
-      start)))
+    (let ((image (and type
+		      (make-image-instance
+		       (vector type :data (buffer-string start end))
+		       nil nil 'no-error))))
+      (unless image
+	(setq image (make-image-instance
+		     (vector 'string :data "format is not supported!\n")
+		     nil nil 'no-error)))
+      (set-extent-property (make-extent start end) 'invisible t)
+      (let ((glyph (make-glyph image)))
+	(set-extent-end-glyph (make-extent end end) glyph))
+      (setq buffer-read-only t))))
 
 (defvar image-mode-map (make-keymap))
 (suppress-keymap image-mode-map)
 
 ;; ### There must be a general way of doing this, using mimecap....
 (defvar image-external-viewer-list
-  '("display"				; ImageMagic
+  '(
     "xv"				; xv
+    "display"				; ImageMagic
     )
   "*List of external viewers for image-mode.
 
 (defun image-toggle-decoding ()
   "Toggle image display mode in current buffer."
   (interactive)
-  (if buffer-file-format
-      (progn
-	(setq buffer-read-only nil)
-	(erase-buffer)
-	(map-extents (function
-		      (lambda (extent maparg)
-			(delete-extent extent)
-			)) nil (point-min)(point-min))
-	(setq buffer-file-format nil)
-	(insert-file-contents-literally buffer-file-name)
-	(set-buffer-modified-p nil)
-	)
-    (format-decode-buffer buffer-image-format)
-    ))
+  (if image-decoded
+      (image-undecode-buffer)
+    (image-decode-buffer)))
 
 (defun image-exit-hexl-mode-function ()
-  (format-decode-buffer)
-  (remove-hook 'hexl-mode-exit-hook 'image-exit-hexl-mode-function)
-  )
+  (image-decode-buffer)
+  (remove-hook 'hexl-mode-exit-hook 'image-exit-hexl-mode-function))
 
 (defun image-enter-hexl-mode ()
-  "Enter to hexl-mode."
+  "Enter hexl-mode."
   (interactive)
-  (when buffer-file-format
-    (setq buffer-read-only nil)
-    (erase-buffer)
-    (map-extents (function
-		  (lambda (extent maparg)
-		    (delete-extent extent)
-		    )) nil (point-min)(point-min))
-    (setq buffer-file-format nil)
-    (insert-file-contents-literally buffer-file-name)
-    (set-buffer-modified-p nil)
-    (add-hook 'hexl-mode-exit-hook 'image-exit-hexl-mode-function)
-    )
-  (hexl-mode)
-  )
+  (when image-decoded
+    (image-undecode-buffer)
+    (add-hook 'hexl-mode-exit-hook 'image-exit-hexl-mode-function))
+  (hexl-mode))
 
 (defun image-enter-xpm-mode ()
-  "Enter to xpm-mode."
+  "Enter xpm-mode."
   (interactive)
-  (if (not (eq buffer-image-format 'image/x-xpm))
-      (error "Not a xpm-picture."))
-  (when buffer-file-format
-    (setq buffer-read-only nil)
-    (erase-buffer)
-    (map-extents (function
-		  (lambda (extent maparg)
-		    (delete-extent extent)
-		    )) nil (point-min)(point-min))
-    (setq buffer-file-format nil)
-    (insert-file-contents-literally buffer-file-name)
-    (set-buffer-modified-p nil)
-    )
-  (xpm-mode 1)
-  )
+  (if (not (eq image-format 'xpm))
+      (error "Not an XPM image."))
+  (when image-decoded
+    (image-undecode-buffer))
+  (xpm-mode 1))
 
 (defun image-mode-quit ()
   "Exit image-mode."
   (interactive)
-  (kill-buffer (current-buffer))
-  )
+  (kill-buffer (current-buffer)))
 
 (defun image-maybe-restore ()
-  "Restore buffer from file if it is decoded as `buffer-file-format'."
-  (when (and buffer-file-format
-	     buffer-file-name)
-    (setq buffer-read-only nil)
-    (erase-buffer)
-    (map-extents (function
-		  (lambda (extent maparg)
-		    (delete-extent extent)
-		    )) nil (point-min)(point-min))
-    (setq buffer-file-format nil)
-    (insert-file-contents-literally buffer-file-name)
-    (set-buffer-modified-p nil)
-    ))
+  "Restore buffer if it is decoded."
+  (when image-decoded
+    (image-undecode-buffer)))
 
 (add-hook 'change-major-mode-hook 'image-maybe-restore)
 
-
 ;;;###autoload
 (defun image-mode (&optional arg)
   "\\{image-mode-map}"
   (setq major-mode 'image-mode)
   (setq mode-name "Image")
   (use-local-map image-mode-map)
-  )
+  (image-guess-type)
+  (image-decode-buffer))
 
 ;;;###autoload
-(defun image-decode-jpeg (start end)
-  "Decode JPEG image between START and END."
-  (setq buffer-image-format 'image/jpeg)
-  (image-decode start end 'jpeg)
-  )
-
-;;;###autoload
-(defun image-decode-gif (start end)
-  "Decode GIF image between START and END."
-  (setq buffer-image-format 'image/gif)
-  (image-decode start end 'gif)
-  )
-
- ;;;###autoload
-(defun image-decode-tiff (start end)
-  "Decode TIFF image between START and END."
-  (setq buffer-image-format 'image/tiff)
-  (image-decode start end 'tiff))
-
-;;;###autoload
-(defun image-decode-png (start end)
-  "Decode PNG image between START and END."
-  (setq buffer-image-format 'image/png)
-  (image-decode start end 'png)
-  )
-
-;;;###autoload
-(defun image-decode-xpm (start end)
-  "Decode XPM image between START and END."
-  (setq buffer-image-format 'image/x-xpm)
-  (image-decode start end 'xpm)
-  )
-
-;; XEmacs addition
-;;;###autoload
-(add-to-list 'auto-mode-alist '("\\.\\(?:jpe?g\\|JPE?G\\|png\\|PNG\\|gif\\|GIF\\|tiff?\\|TIFF?\\)\\'" . image-mode))
+(progn
+  (setq format-alist
+	(remove-if (lambda (x)
+		     (eq (nth 6 x) 'image-mode))
+		   format-alist))
+  (dolist (format image-formats-alist)
+    (let* ((re (car format))
+	   (type (cdr format))
+	   (regexp (concat "\\.\\(" re "\\|" (upcase re) "\\)\\'"))
+	   (item (cons regexp 'image-mode)))
+      (and (featurep type)
+	   (add-to-list 'auto-mode-alist item)))))
 
 (provide 'image-mode)
 
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.