1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
|
;;; image-mode.el --- Major mode for navigating images
;; Copyright (C) 1997 MORIOKA Tomohiko
;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Created: 1997/6/27
;; Version: image-mode.el,v 20.3.1.2 1997/07/01 17:29:44 morioka Exp
;; Keywords: image, graphics
;; This file is part of XEmacs.
;; XEmacs is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; XEmacs is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with XEmacs; see the file COPYING. If not, write to the Free
;; 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:
(require 'cl)
(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 (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)
(define-key image-mode-map "v" 'image-start-external-viewer)
(define-key image-mode-map "t" 'image-toggle-decoding)
(define-key image-mode-map "h" 'image-enter-hexl-mode)
(define-key image-mode-map "e" 'image-enter-xpm-mode)
(define-key image-mode-map "q" 'image-mode-quit)
;; ### There must be a general way of doing this, using mimecap....
(defvar image-external-viewer-list
'(
"xv" ; xv
"display" ; ImageMagic
)
"*List of external viewers for image-mode.
Each viewer is a string, to be called via `start-process'. If null,
no external viewer will be used.")
(defun image-start-external-viewer ()
"Start external image viewer for current-buffer.
It tries each program name in `image-external-viewer-list' in order.
If `image-external-viewer-list' is empty, or none of the viewers can
be found, signals an error."
(interactive)
(let ((vl image-external-viewer-list))
(if vl
(catch 'done
(while vl
(condition-case nil
(progn
(start-process "external image viewer" nil
(car vl) buffer-file-name)
(throw 'done nil)) ; exit loop
(file-error (setq vl (cdr vl)))))
(error "image-start-external-viewer: couldn't start any viewer in `image-external-viewer-list'"))
(error "image-start-external-viewer: `image-external-viewer-list' is empty."))))
(defun image-toggle-decoding ()
"Toggle image display mode in current buffer."
(interactive)
(if image-decoded
(image-undecode-buffer)
(image-decode-buffer)))
(defun 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 hexl-mode."
(interactive)
(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 xpm-mode."
(interactive)
(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)))
(defun image-maybe-restore ()
"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}"
(interactive)
(setq major-mode 'image-mode)
(setq mode-name "Image")
(use-local-map image-mode-map)
(image-guess-type)
(image-decode-buffer))
;;;###autoload
(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)
;;; image-mode.el ends here
|
