Mercurial > emacs
comparison lisp/image-mode.el @ 77989:6393038dae4d
(image-forward-hscroll, image-backward-hscroll)
(image-next-line, image-previous-line, image-scroll-up)
(image-scroll-down, image-bol, image-eol, image-bob, image-eob):
New functions.
(image-mode-map): Remap motion commands.
(image-mode-text-map): New keymap for viewing images as text.
(image-mode): Use image-mode-map.
(image-toggle-display): Toggle auto-hscroll-mode and mode keymaps.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Fri, 08 Jun 2007 03:01:25 +0000 |
parents | 19d4ee6e5621 |
children | 9355f9b7bbff |
comparison
equal
deleted
inserted
replaced
77988:5666db0f6385 | 77989:6393038dae4d |
---|---|
41 ;;;###autoload (push '("\\.gif\\'" . image-mode) auto-mode-alist) | 41 ;;;###autoload (push '("\\.gif\\'" . image-mode) auto-mode-alist) |
42 ;;;###autoload (push '("\\.tiff?\\'" . image-mode) auto-mode-alist) | 42 ;;;###autoload (push '("\\.tiff?\\'" . image-mode) auto-mode-alist) |
43 ;;;###autoload (push '("\\.p[bpgn]m\\'" . image-mode) auto-mode-alist) | 43 ;;;###autoload (push '("\\.p[bpgn]m\\'" . image-mode) auto-mode-alist) |
44 ;;;###autoload (push '("\\.x[bp]m\\'" . image-mode-maybe) auto-mode-alist) | 44 ;;;###autoload (push '("\\.x[bp]m\\'" . image-mode-maybe) auto-mode-alist) |
45 | 45 |
46 ;;; Image scrolling functions | |
47 | |
48 (defun image-forward-hscroll (&optional n) | |
49 "Scroll image in current window to the left by N character widths. | |
50 Stop if the right edge of the image is reached." | |
51 (interactive "p") | |
52 (cond ((= n 0) nil) | |
53 ((< n 0) | |
54 (set-window-hscroll nil (max 0 (+ (window-hscroll) n)))) | |
55 (t | |
56 (let* ((image (get-text-property 1 'display)) | |
57 (img-width (ceiling (car (image-size image)))) | |
58 (edges (window-inside-edges)) | |
59 (win-width (- (nth 2 edges) (nth 0 edges)))) | |
60 (set-window-hscroll nil | |
61 (min (max 0 (- img-width win-width)) | |
62 (+ n (window-hscroll)))))))) | |
63 | |
64 (defun image-backward-hscroll (&optional n) | |
65 "Scroll image in current window to the right by N character widths. | |
66 Stop if the left edge of the image is reached." | |
67 (interactive "p") | |
68 (image-forward-hscroll (- n))) | |
69 | |
70 (defun image-next-line (&optional n) | |
71 "Scroll image in current window upward by N lines. | |
72 Stop if the bottom edge of the image is reached." | |
73 (interactive "p") | |
74 (cond ((= n 0) nil) | |
75 ((< n 0) | |
76 (set-window-vscroll nil (max 0 (+ (window-vscroll) n)))) | |
77 (t | |
78 (let* ((image (get-text-property 1 'display)) | |
79 (img-height (ceiling (cdr (image-size image)))) | |
80 (edges (window-inside-edges)) | |
81 (win-height (- (nth 3 edges) (nth 1 edges)))) | |
82 (set-window-vscroll nil | |
83 (min (max 0 (- img-height win-height)) | |
84 (+ n (window-vscroll)))))))) | |
85 | |
86 (defun image-previous-line (&optional n) | |
87 "Scroll image in current window downward by N lines. | |
88 Stop if the top edge of the image is reached." | |
89 (interactive "p") | |
90 (image-next-line (- n))) | |
91 | |
92 (defun image-scroll-up (&optional n) | |
93 "Scroll image in current window upward by N lines. | |
94 Stop if the bottom edge of the image is reached. | |
95 If ARG is omitted or nil, scroll upward by a near full screen. | |
96 A near full screen is `next-screen-context-lines' less than a full screen. | |
97 Negative ARG means scroll downward. | |
98 If ARG is the atom `-', scroll downward by nearly full screen. | |
99 When calling from a program, supply as argument a number, nil, or `-'." | |
100 (interactive "P") | |
101 (cond ((null n) | |
102 (let* ((edges (window-inside-edges)) | |
103 (win-height (- (nth 3 edges) (nth 1 edges)))) | |
104 (image-next-line | |
105 (max 0 (- win-height next-screen-context-lines))))) | |
106 ((eq n '-) | |
107 (let* ((edges (window-inside-edges)) | |
108 (win-height (- (nth 3 edges) (nth 1 edges)))) | |
109 (image-next-line | |
110 (min 0 (- next-screen-context-lines win-height))))) | |
111 (t (image-next-line (prefix-numeric-value n))))) | |
112 | |
113 (defun image-scroll-down (&optional n) | |
114 "Scroll image in current window downward by N lines | |
115 Stop if the top edge of the image is reached. | |
116 If ARG is omitted or nil, scroll downward by a near full screen. | |
117 A near full screen is `next-screen-context-lines' less than a full screen. | |
118 Negative ARG means scroll upward. | |
119 If ARG is the atom `-', scroll upward by nearly full screen. | |
120 When calling from a program, supply as argument a number, nil, or `-'." | |
121 (interactive "P") | |
122 (cond ((null n) | |
123 (let* ((edges (window-inside-edges)) | |
124 (win-height (- (nth 3 edges) (nth 1 edges)))) | |
125 (image-next-line | |
126 (min 0 (- next-screen-context-lines win-height))))) | |
127 ((eq n '-) | |
128 (let* ((edges (window-inside-edges)) | |
129 (win-height (- (nth 3 edges) (nth 1 edges)))) | |
130 (image-next-line | |
131 (max 0 (- win-height next-screen-context-lines))))) | |
132 (t (image-next-line (- (prefix-numeric-value n)))))) | |
133 | |
134 (defun image-bol (arg) | |
135 "Scroll horizontally to the left edge of the image in the current window. | |
136 With argument ARG not nil or 1, move forward ARG - 1 lines first, | |
137 stopping if the top or bottom edge of the image is reached." | |
138 (interactive "p") | |
139 (and arg | |
140 (/= (setq arg (prefix-numeric-value arg)) 1) | |
141 (image-next-line (- arg 1))) | |
142 (set-window-hscroll (selected-window) 0)) | |
143 | |
144 (defun image-eol (arg) | |
145 "Scroll horizontally to the right edge of the image in the current window. | |
146 With argument ARG not nil or 1, move forward ARG - 1 lines first, | |
147 stopping if the top or bottom edge of the image is reached." | |
148 (interactive "p") | |
149 (and arg | |
150 (/= (setq arg (prefix-numeric-value arg)) 1) | |
151 (image-next-line (- arg 1))) | |
152 (let* ((image (get-text-property 1 'display)) | |
153 (edges (window-inside-edges)) | |
154 (win-width (- (nth 2 edges) (nth 0 edges))) | |
155 (img-width (ceiling (car (image-size image))))) | |
156 (set-window-hscroll (selected-window) | |
157 (max 0 (- img-width win-width))))) | |
158 | |
159 (defun image-bob () | |
160 "Scroll to the top-left corner of the image in the current window." | |
161 (interactive) | |
162 (set-window-hscroll (selected-window) 0) | |
163 (set-window-vscroll (selected-window) 0)) | |
164 | |
165 (defun image-eob () | |
166 "Scroll to the bottom-right corner of the image in the current window." | |
167 (interactive) | |
168 (let* ((image (get-text-property 1 'display)) | |
169 (edges (window-inside-edges)) | |
170 (win-width (- (nth 2 edges) (nth 0 edges))) | |
171 (img-width (ceiling (car (image-size image)))) | |
172 (win-height (- (nth 3 edges) (nth 1 edges))) | |
173 (img-height (ceiling (cdr (image-size image))))) | |
174 (set-window-hscroll (selected-window) (max 0 (- img-width win-width))) | |
175 (set-window-vscroll (selected-window) (max 0 (- img-height win-height))))) | |
176 | |
177 ;;; Image Mode setup | |
178 | |
46 (defvar image-mode-map | 179 (defvar image-mode-map |
47 (let ((map (make-sparse-keymap))) | 180 (let ((map (make-sparse-keymap))) |
48 (define-key map "\C-c\C-c" 'image-toggle-display) | 181 (define-key map "\C-c\C-c" 'image-toggle-display) |
182 (define-key map [remap forward-char] 'image-forward-hscroll) | |
183 (define-key map [remap backward-char] 'image-backward-hscroll) | |
184 (define-key map [remap previous-line] 'image-previous-line) | |
185 (define-key map [remap next-line] 'image-next-line) | |
186 (define-key map [remap scroll-up] 'image-scroll-up) | |
187 (define-key map [remap scroll-down] 'image-scroll-down) | |
188 (define-key map [remap move-beginning-of-line] 'image-bol) | |
189 (define-key map [remap move-end-of-line] 'image-eol) | |
190 (define-key map [remap beginning-of-buffer] 'image-bob) | |
191 (define-key map [remap end-of-buffer] 'image-eob) | |
49 map) | 192 map) |
50 "Major mode keymap for Image mode.") | 193 "Major mode keymap for viewing images in Image mode.") |
194 | |
195 (defvar image-mode-text-map | |
196 (let ((map (make-sparse-keymap))) | |
197 (define-key map "\C-c\C-c" 'image-toggle-display) | |
198 map) | |
199 "Major mode keymap for viewing images as text in Image mode.") | |
51 | 200 |
52 ;;;###autoload | 201 ;;;###autoload |
53 (defun image-mode () | 202 (defun image-mode () |
54 "Major mode for image files. | 203 "Major mode for image files. |
55 You can use \\<image-mode-map>\\[image-toggle-display] | 204 You can use \\<image-mode-map>\\[image-toggle-display] |
56 to toggle between display as an image and display as text." | 205 to toggle between display as an image and display as text." |
57 (interactive) | 206 (interactive) |
58 (kill-all-local-variables) | 207 (kill-all-local-variables) |
59 (setq mode-name "Image") | 208 (setq mode-name "Image") |
60 (setq major-mode 'image-mode) | 209 (setq major-mode 'image-mode) |
61 (use-local-map image-mode-map) | |
62 (add-hook 'change-major-mode-hook 'image-toggle-display-text nil t) | 210 (add-hook 'change-major-mode-hook 'image-toggle-display-text nil t) |
63 (if (and (display-images-p) | 211 (if (and (display-images-p) |
64 (not (get-text-property (point-min) 'display))) | 212 (not (get-text-property (point-min) 'display))) |
65 (image-toggle-display) | 213 (image-toggle-display) |
66 ;; Set next vars when image is already displayed but local | 214 ;; Set next vars when image is already displayed but local |
67 ;; variables were cleared by kill-all-local-variables | 215 ;; variables were cleared by kill-all-local-variables |
216 (use-local-map image-mode-map) | |
68 (setq cursor-type nil truncate-lines t)) | 217 (setq cursor-type nil truncate-lines t)) |
69 (run-mode-hooks 'image-mode-hook) | 218 (run-mode-hooks 'image-mode-hook) |
70 (if (display-images-p) | 219 (if (display-images-p) |
71 (message "%s" (concat | 220 (message "%s" (concat |
72 (substitute-command-keys | 221 (substitute-command-keys |
138 '(display intangible read-nonsticky | 287 '(display intangible read-nonsticky |
139 read-only front-sticky)) | 288 read-only front-sticky)) |
140 (set-buffer-modified-p modified) | 289 (set-buffer-modified-p modified) |
141 (kill-local-variable 'cursor-type) | 290 (kill-local-variable 'cursor-type) |
142 (kill-local-variable 'truncate-lines) | 291 (kill-local-variable 'truncate-lines) |
292 (kill-local-variable 'auto-hscroll-mode) | |
293 (use-local-map image-mode-text-map) | |
143 (if (called-interactively-p) | 294 (if (called-interactively-p) |
144 (message "Repeat this command to go back to displaying the image"))) | 295 (message "Repeat this command to go back to displaying the image"))) |
145 ;; Turn the image data into a real image, but only if the whole file | 296 ;; Turn the image data into a real image, but only if the whole file |
146 ;; was inserted | 297 ;; was inserted |
147 (let* ((image | 298 (let* ((image |
175 ;; because cursors look very strange on top of images. | 326 ;; because cursors look very strange on top of images. |
176 (setq cursor-type nil) | 327 (setq cursor-type nil) |
177 ;; This just makes the arrow displayed in the right fringe | 328 ;; This just makes the arrow displayed in the right fringe |
178 ;; area look correct when the image is wider than the window. | 329 ;; area look correct when the image is wider than the window. |
179 (setq truncate-lines t) | 330 (setq truncate-lines t) |
331 ;; Allow navigation of large images | |
332 (set (make-local-variable 'auto-hscroll-mode) nil) | |
333 (use-local-map image-mode-map) | |
180 (if (called-interactively-p) | 334 (if (called-interactively-p) |
181 (message "Repeat this command to go back to displaying the file as text"))))) | 335 (message "Repeat this command to go back to displaying the file as text"))))) |
182 | 336 |
183 (provide 'image-mode) | 337 (provide 'image-mode) |
184 | 338 |