aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2008-02-21 03:45:04 +0000
committerStefan Monnier2008-02-21 03:45:04 +0000
commitde1714654196ecc734675a200d933aee2dc49638 (patch)
tree570cfdc45d7dd83f8568a47e3c3ae778d8e10728
parent027cd64481d5c80328d3da22795776ed3060fa0c (diff)
downloademacs-de1714654196ecc734675a200d933aee2dc49638.tar.gz
emacs-de1714654196ecc734675a200d933aee2dc49638.zip
Allow different windows to show different pages.
(doc-view-current-page, doc-view-current-slice, doc-view-current-info) (doc-view-current-image, doc-view-current-overlay): Remove variables, add them back as macros instead, using image-mode-winprops instead. Update all users of those variables. (doc-view-new-window-function): New function to create a new overlay for each new window. (doc-view-mode): Use it and image-mode-setup-winprops. (doc-view-clone-buffer-hook): Rewrite accordingly.
-rw-r--r--lisp/ChangeLog10
-rw-r--r--lisp/doc-view.el162
2 files changed, 84 insertions, 88 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 72d97f777ac..ef9279b6ccd 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,15 @@
12008-02-21 Stefan Monnier <monnier@iro.umontreal.ca> 12008-02-21 Stefan Monnier <monnier@iro.umontreal.ca>
2 2
3 * doc-view.el: Allow different windows to show different pages.
4 (doc-view-current-page, doc-view-current-slice, doc-view-current-info)
5 (doc-view-current-image, doc-view-current-overlay): Remove variables,
6 add them back as macros instead, using image-mode-winprops instead.
7 Update all users of those variables.
8 (doc-view-new-window-function): New function to create a new overlay
9 for each new window.
10 (doc-view-mode): Use it and image-mode-setup-winprops.
11 (doc-view-clone-buffer-hook): Rewrite accordingly.
12
3 * image-mode.el: Extend [hv]scroll support to per-window properties. 13 * image-mode.el: Extend [hv]scroll support to per-window properties.
4 (image-mode-current-vscroll, image-mode-current-hscroll): Remove. 14 (image-mode-current-vscroll, image-mode-current-hscroll): Remove.
5 (image-mode-winprops-alist): New var to replace them. 15 (image-mode-winprops-alist): New var to replace them.
diff --git a/lisp/doc-view.el b/lisp/doc-view.el
index 2bf8b28ff8b..c3ec4372920 100644
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -214,10 +214,16 @@ has finished."
214 214
215;;;; Internal Variables 215;;;; Internal Variables
216 216
217(defvar doc-view-current-files nil 217(defun doc-view-new-window-function (winprops)
218 "Only used internally.") 218 (let ((ol (image-mode-window-get 'overlay winprops)))
219 (if ol
220 (setq ol (copy-overlay ol))
221 (setq ol (make-overlay (point-min) (point-max) nil t))
222 (overlay-put ol 'doc-view t))
223 (overlay-put ol 'window (car winprops))
224 (image-mode-window-put 'overlay ol winprops)))
219 225
220(defvar doc-view-current-page nil 226(defvar doc-view-current-files nil
221 "Only used internally.") 227 "Only used internally.")
222 228
223(defvar doc-view-current-converter-process nil 229(defvar doc-view-current-converter-process nil
@@ -226,27 +232,15 @@ has finished."
226(defvar doc-view-current-timer nil 232(defvar doc-view-current-timer nil
227 "Only used internally.") 233 "Only used internally.")
228 234
229(defvar doc-view-current-slice nil
230 "Only used internally.")
231
232(defvar doc-view-current-cache-dir nil 235(defvar doc-view-current-cache-dir nil
233 "Only used internally.") 236 "Only used internally.")
234 237
235(defvar doc-view-current-search-matches nil 238(defvar doc-view-current-search-matches nil
236 "Only used internally.") 239 "Only used internally.")
237 240
238(defvar doc-view-current-image nil
239 "Only used internally.")
240
241(defvar doc-view-current-overlay nil
242 "Only used internally.")
243
244(defvar doc-view-pending-cache-flush nil 241(defvar doc-view-pending-cache-flush nil
245 "Only used internally.") 242 "Only used internally.")
246 243
247(defvar doc-view-current-info nil
248 "Only used internally.")
249
250(defvar doc-view-previous-major-mode nil 244(defvar doc-view-previous-major-mode nil
251 "Only used internally.") 245 "Only used internally.")
252 246
@@ -328,6 +322,12 @@ the (uncompressed, extracted) file residing in
328 322
329;;;; Navigation Commands 323;;;; Navigation Commands
330 324
325(defmacro doc-view-current-page () `(image-mode-window-get 'page))
326(defmacro doc-view-current-info () `(image-mode-window-get 'info))
327(defmacro doc-view-current-overlay () `(image-mode-window-get 'overlay))
328(defmacro doc-view-current-image () `(image-mode-window-get 'image))
329(defmacro doc-view-current-slice () `(image-mode-window-get 'slice))
330
331(defun doc-view-goto-page (page) 331(defun doc-view-goto-page (page)
332 "View the page given by PAGE." 332 "View the page given by PAGE."
333 (interactive "nPage: ") 333 (interactive "nPage: ")
@@ -336,41 +336,39 @@ the (uncompressed, extracted) file residing in
336 (setq page 1) 336 (setq page 1)
337 (when (> page len) 337 (when (> page len)
338 (setq page len))) 338 (setq page len)))
339 (setq doc-view-current-page page 339 (setf (doc-view-current-page) page
340 doc-view-current-info 340 (doc-view-current-info)
341 (concat 341 (concat
342 (propertize 342 (propertize
343 (format "Page %d of %d." 343 (format "Page %d of %d." page len) 'face 'bold)
344 doc-view-current-page
345 len) 'face 'bold)
346 ;; Tell user if converting isn't finished yet 344 ;; Tell user if converting isn't finished yet
347 (if doc-view-current-converter-process 345 (if doc-view-current-converter-process
348 " (still converting...)\n" 346 " (still converting...)\n"
349 "\n") 347 "\n")
350 ;; Display context infos if this page matches the last search 348 ;; Display context infos if this page matches the last search
351 (when (and doc-view-current-search-matches 349 (when (and doc-view-current-search-matches
352 (assq doc-view-current-page 350 (assq page doc-view-current-search-matches))
353 doc-view-current-search-matches))
354 (concat (propertize "Search matches:\n" 'face 'bold) 351 (concat (propertize "Search matches:\n" 'face 'bold)
355 (let ((contexts "")) 352 (let ((contexts ""))
356 (dolist (m (cdr (assq doc-view-current-page 353 (dolist (m (cdr (assq page
357 doc-view-current-search-matches))) 354 doc-view-current-search-matches)))
358 (setq contexts (concat contexts " - \"" m "\"\n"))) 355 (setq contexts (concat contexts " - \"" m "\"\n")))
359 contexts))))) 356 contexts)))))
360 ;; Update the buffer 357 ;; Update the buffer
361 (doc-view-insert-image (nth (1- page) doc-view-current-files) 358 (doc-view-insert-image (nth (1- page) doc-view-current-files)
362 :pointer 'arrow) 359 :pointer 'arrow)
363 (overlay-put doc-view-current-overlay 'help-echo doc-view-current-info))) 360 (overlay-put (doc-view-current-overlay)
361 'help-echo (doc-view-current-info))))
364 362
365(defun doc-view-next-page (&optional arg) 363(defun doc-view-next-page (&optional arg)
366 "Browse ARG pages forward." 364 "Browse ARG pages forward."
367 (interactive "p") 365 (interactive "p")
368 (doc-view-goto-page (+ doc-view-current-page (or arg 1)))) 366 (doc-view-goto-page (+ (doc-view-current-page) (or arg 1))))
369 367
370(defun doc-view-previous-page (&optional arg) 368(defun doc-view-previous-page (&optional arg)
371 "Browse ARG pages backward." 369 "Browse ARG pages backward."
372 (interactive "p") 370 (interactive "p")
373 (doc-view-goto-page (- doc-view-current-page (or arg 1)))) 371 (doc-view-goto-page (- (doc-view-current-page) (or arg 1))))
374 372
375(defun doc-view-first-page () 373(defun doc-view-first-page ()
376 "View the first page." 374 "View the first page."
@@ -386,18 +384,18 @@ the (uncompressed, extracted) file residing in
386 "Scroll page up if possible, else goto next page." 384 "Scroll page up if possible, else goto next page."
387 (interactive) 385 (interactive)
388 (when (= (window-vscroll) (image-scroll-up nil)) 386 (when (= (window-vscroll) (image-scroll-up nil))
389 (let ((cur-page doc-view-current-page)) 387 (let ((cur-page (doc-view-current-page)))
390 (doc-view-next-page) 388 (doc-view-next-page)
391 (when (/= cur-page doc-view-current-page) 389 (when (/= cur-page (doc-view-current-page))
392 (set-window-vscroll nil 0))))) 390 (set-window-vscroll nil 0)))))
393 391
394(defun doc-view-scroll-down-or-previous-page () 392(defun doc-view-scroll-down-or-previous-page ()
395 "Scroll page down if possible, else goto previous page." 393 "Scroll page down if possible, else goto previous page."
396 (interactive) 394 (interactive)
397 (when (= (window-vscroll) (image-scroll-down nil)) 395 (when (= (window-vscroll) (image-scroll-down nil))
398 (let ((cur-page doc-view-current-page)) 396 (let ((cur-page (doc-view-current-page)))
399 (doc-view-previous-page) 397 (doc-view-previous-page)
400 (when (/= cur-page doc-view-current-page) 398 (when (/= cur-page (doc-view-current-page))
401 (image-scroll-up nil))))) 399 (image-scroll-up nil)))))
402 400
403;;;; Utility Functions 401;;;; Utility Functions
@@ -661,15 +659,15 @@ and Y) of the slice to display and its WIDTH and HEIGHT.
661See `doc-view-set-slice-using-mouse' for a more convenient way to 659See `doc-view-set-slice-using-mouse' for a more convenient way to
662do that. To reset the slice use `doc-view-reset-slice'." 660do that. To reset the slice use `doc-view-reset-slice'."
663 (interactive 661 (interactive
664 (let* ((size (image-size doc-view-current-image t)) 662 (let* ((size (image-size (doc-view-current-image) t))
665 (a (read-number (format "Top-left X (0..%d): " (car size)))) 663 (a (read-number (format "Top-left X (0..%d): " (car size))))
666 (b (read-number (format "Top-left Y (0..%d): " (cdr size)))) 664 (b (read-number (format "Top-left Y (0..%d): " (cdr size))))
667 (c (read-number (format "Width (0..%d): " (- (car size) a)))) 665 (c (read-number (format "Width (0..%d): " (- (car size) a))))
668 (d (read-number (format "Height (0..%d): " (- (cdr size) b))))) 666 (d (read-number (format "Height (0..%d): " (- (cdr size) b)))))
669 (list a b c d))) 667 (list a b c d)))
670 (setq doc-view-current-slice (list x y width height)) 668 (setf (doc-view-current-slice) (list x y width height))
671 ;; Redisplay 669 ;; Redisplay
672 (doc-view-goto-page doc-view-current-page)) 670 (doc-view-goto-page (doc-view-current-page)))
673 671
674(defun doc-view-set-slice-using-mouse () 672(defun doc-view-set-slice-using-mouse ()
675 "Set the slice of the images that should be displayed. 673 "Set the slice of the images that should be displayed.
@@ -694,9 +692,9 @@ dragging it to its bottom-right corner. See also
694 "Reset the current slice. 692 "Reset the current slice.
695After calling this function whole pages will be visible again." 693After calling this function whole pages will be visible again."
696 (interactive) 694 (interactive)
697 (setq doc-view-current-slice nil) 695 (setf (doc-view-current-slice) nil)
698 ;; Redisplay 696 ;; Redisplay
699 (doc-view-goto-page doc-view-current-page)) 697 (doc-view-goto-page (doc-view-current-page)))
700 698
701;;;; Display 699;;;; Display
702 700
@@ -706,22 +704,21 @@ ARGS is a list of image descriptors."
706 (when doc-view-pending-cache-flush 704 (when doc-view-pending-cache-flush
707 (clear-image-cache) 705 (clear-image-cache)
708 (setq doc-view-pending-cache-flush nil)) 706 (setq doc-view-pending-cache-flush nil))
709 (if (null file) 707 (let ((ol (doc-view-current-overlay))
710 ;; We're trying to display a page that doesn't exist. Typically happens 708 (image (if file (apply 'create-image file 'png nil args)))
711 ;; if the conversion process somehow failed. Better not signal an 709 (slice (doc-view-current-slice)))
712 ;; error here because it could prevent a subsequent reconversion from 710 (setf (doc-view-current-image) image)
713 ;; fixing the problem. 711 (move-overlay ol (point-min) (point-max)) ;Probably redundant.
714 (progn 712 (overlay-put ol 'display
715 (setq doc-view-current-image nil) 713 (if (null image)
716 (move-overlay doc-view-current-overlay (point-min) (point-max)) 714 ;; We're trying to display a page that doesn't exist.
717 (overlay-put doc-view-current-overlay 'display 715 ;; Typically happens if the conversion process somehow
718 "Cannot display this page! Probably a conversion failure!")) 716 ;; failed. Better not signal an error here because it
719 (let ((image (apply 'create-image file 'png nil args))) 717 ;; could prevent a subsequent reconversion from fixing
720 (setq doc-view-current-image image) 718 ;; the problem.
721 (move-overlay doc-view-current-overlay (point-min) (point-max)) 719 "Cannot display this page! Probably a conversion failure!"
722 (overlay-put doc-view-current-overlay 'display 720 (if slice
723 (if doc-view-current-slice 721 (list (cons 'slice slice) image)
724 (list (cons 'slice doc-view-current-slice) image)
725 image))))) 722 image)))))
726 723
727(defun doc-view-sort (a b) 724(defun doc-view-sort (a b)
@@ -740,17 +737,17 @@ have the page we want to view."
740 (sort (directory-files (doc-view-current-cache-dir) t 737 (sort (directory-files (doc-view-current-cache-dir) t
741 "page-[0-9]+\\.png" t) 738 "page-[0-9]+\\.png" t)
742 'doc-view-sort)) 739 'doc-view-sort))
743 (when (or force 740 (let ((page (doc-view-current-page)))
744 (>= (length doc-view-current-files) 741 (when (or force
745 (or doc-view-current-page 1))) 742 (>= (length doc-view-current-files) (or page 1)))
746 (doc-view-goto-page doc-view-current-page)))) 743 (doc-view-goto-page page)))))
747 744
748(defun doc-view-buffer-message () 745(defun doc-view-buffer-message ()
749 ;; Only show this message initially, not when refreshing the buffer (in which 746 ;; Only show this message initially, not when refreshing the buffer (in which
750 ;; case it's better to keep displaying the "stale" page while computing 747 ;; case it's better to keep displaying the "stale" page while computing
751 ;; the fresh new ones). 748 ;; the fresh new ones).
752 (unless (overlay-get doc-view-current-overlay 'display) 749 (unless (overlay-get (doc-view-current-overlay) 'display)
753 (overlay-put doc-view-current-overlay 'display 750 (overlay-put (doc-view-current-overlay) 'display
754 (concat (propertize "Welcome to DocView!" 'face 'bold) 751 (concat (propertize "Welcome to DocView!" 'face 'bold)
755 "\n" 752 "\n"
756 " 753 "
@@ -766,7 +763,7 @@ For now these keys are useful:
766 763
767(defun doc-view-show-tooltip () 764(defun doc-view-show-tooltip ()
768 (interactive) 765 (interactive)
769 (tooltip-show doc-view-current-info)) 766 (tooltip-show (doc-view-current-info)))
770 767
771;;;;; Toggle between editing and viewing 768;;;;; Toggle between editing and viewing
772 769
@@ -778,7 +775,8 @@ For now these keys are useful:
778 (progn 775 (progn
779 (doc-view-kill-proc) 776 (doc-view-kill-proc)
780 (setq buffer-read-only nil) 777 (setq buffer-read-only nil)
781 (remove-overlays (point-min) (point-max) 'doc-view) 778 (remove-overlays (point-min) (point-max) 'doc-view t)
779 (set (make-local-variable 'image-mode-winprops-alist) t)
782 ;; Switch to the previously used major mode or fall back to fundamental 780 ;; Switch to the previously used major mode or fall back to fundamental
783 ;; mode. 781 ;; mode.
784 (if doc-view-previous-major-mode 782 (if doc-view-previous-major-mode
@@ -889,7 +887,7 @@ If BACKWARD is non-nil, jump to the previous match."
889 "Go to the ARGth next matching page." 887 "Go to the ARGth next matching page."
890 (interactive "p") 888 (interactive "p")
891 (let* ((next-pages (doc-view-remove-if 889 (let* ((next-pages (doc-view-remove-if
892 (lambda (i) (<= (car i) doc-view-current-page)) 890 (lambda (i) (<= (car i) (doc-view-current-page)))
893 doc-view-current-search-matches)) 891 doc-view-current-search-matches))
894 (page (car (nth (1- arg) next-pages)))) 892 (page (car (nth (1- arg) next-pages))))
895 (if page 893 (if page
@@ -903,7 +901,7 @@ If BACKWARD is non-nil, jump to the previous match."
903 "Go to the ARGth previous matching page." 901 "Go to the ARGth previous matching page."
904 (interactive "p") 902 (interactive "p")
905 (let* ((prev-pages (doc-view-remove-if 903 (let* ((prev-pages (doc-view-remove-if
906 (lambda (i) (>= (car i) doc-view-current-page)) 904 (lambda (i) (>= (car i) (doc-view-current-page)))
907 doc-view-current-search-matches)) 905 doc-view-current-search-matches))
908 (page (car (nth (1- arg) (nreverse prev-pages))))) 906 (page (car (nth (1- arg) (nreverse prev-pages)))))
909 (if page 907 (if page
@@ -922,7 +920,7 @@ If BACKWARD is non-nil, jump to the previous match."
922 (if (doc-view-mode-p (intern (file-name-extension doc-view-buffer-file-name))) 920 (if (doc-view-mode-p (intern (file-name-extension doc-view-buffer-file-name)))
923 (progn 921 (progn
924 (doc-view-buffer-message) 922 (doc-view-buffer-message)
925 (setq doc-view-current-page (or doc-view-current-page 1)) 923 (setf (doc-view-current-page) (or (doc-view-current-page) 1))
926 (if (file-exists-p (doc-view-current-cache-dir)) 924 (if (file-exists-p (doc-view-current-cache-dir))
927 (progn 925 (progn
928 (message "DocView: using cached files!") 926 (message "DocView: using cached files!")
@@ -949,16 +947,12 @@ If BACKWARD is non-nil, jump to the previous match."
949 ;; for each clone), but that means that clones need to collaborate a bit. 947 ;; for each clone), but that means that clones need to collaborate a bit.
950 ;; I guess it mostly means: detect when a reconversion process is already 948 ;; I guess it mostly means: detect when a reconversion process is already
951 ;; running, and run the sentinel in all clones. 949 ;; running, and run the sentinel in all clones.
952 ;; Not sure how important it is to fix it: a better target would be to 950 ;;
953 ;; allow a single buffer (without cloning) to display different pages in 951 ;; Maybe the clones should really have a separate /tmp directory
954 ;; different windows.
955 ;; Maybe then the clones should really have a separate /tmp directory
956 ;; so they could have a different resolution and you could use clones 952 ;; so they could have a different resolution and you could use clones
957 ;; for zooming. 953 ;; for zooming.
958 (dolist (ol (overlays-in (point-min) (point-max))) 954 (remove-overlays (point-min) (point-max) 'doc-view t)
959 ;; The overlay was copied by the cloning, so we just need to find it 955 (if (consp image-mode-winprops-alist) (setq image-mode-winprops-alist nil)))
960 ;; and put it in doc-view-current-overlay.
961 (if (overlay-get ol 'doc-view) (setq doc-view-current-overlay ol))))
962 956
963;;;###autoload 957;;;###autoload
964(defun doc-view-mode () 958(defun doc-view-mode ()
@@ -996,32 +990,24 @@ toggle between displaying the document or editing it as text.
996 (write-region nil nil doc-view-buffer-file-name)) 990 (write-region nil nil doc-view-buffer-file-name))
997 991
998 (make-local-variable 'doc-view-current-files) 992 (make-local-variable 'doc-view-current-files)
999 (make-local-variable 'doc-view-current-image)
1000 (make-local-variable 'doc-view-current-page)
1001 (make-local-variable 'doc-view-current-converter-process) 993 (make-local-variable 'doc-view-current-converter-process)
1002 (make-local-variable 'doc-view-current-timer) 994 (make-local-variable 'doc-view-current-timer)
1003 (make-local-variable 'doc-view-current-slice)
1004 (make-local-variable 'doc-view-current-cache-dir) 995 (make-local-variable 'doc-view-current-cache-dir)
1005 (make-local-variable 'doc-view-current-info)
1006 (make-local-variable 'doc-view-current-search-matches) 996 (make-local-variable 'doc-view-current-search-matches)
1007 (set (make-local-variable 'doc-view-current-overlay)
1008 (make-overlay (point-min) (point-max) nil t))
1009 (overlay-put doc-view-current-overlay 'doc-view t)
1010 (add-hook 'change-major-mode-hook 997 (add-hook 'change-major-mode-hook
1011 (lambda () (remove-overlays (point-min) (point-max) 'doc-view)) 998 (lambda () (remove-overlays (point-min) (point-max) 'doc-view t))
1012 nil t) 999 nil t)
1013 (add-hook 'clone-indirect-buffer-hook 'doc-view-clone-buffer-hook nil t) 1000 (add-hook 'clone-indirect-buffer-hook 'doc-view-clone-buffer-hook nil t)
1014 1001
1015 ;; Keep track of [vh]scroll when switching buffers 1002 (remove-overlays (point-min) (point-max) 'doc-view t) ;Just in case.
1016 (make-local-variable 'image-mode-current-hscroll) 1003 ;; Keep track of display info ([vh]scroll, page number, overlay, ...)
1017 (make-local-variable 'image-mode-current-vscroll) 1004 ;; for each window in which this document is shown.
1018 (image-set-window-hscroll (selected-window) (window-hscroll)) 1005 (add-hook 'image-mode-new-window-functions
1019 (image-set-window-vscroll (selected-window) (window-vscroll)) 1006 'doc-view-new-window-function nil t)
1020 (add-hook 'window-configuration-change-hook 1007 (image-mode-setup-winprops)
1021 'image-reset-current-vhscroll nil t) 1008
1022
1023 (set (make-local-variable 'mode-line-position) 1009 (set (make-local-variable 'mode-line-position)
1024 '(" P" (:eval (number-to-string doc-view-current-page)) 1010 '(" P" (:eval (number-to-string (doc-view-current-page)))
1025 "/" (:eval (number-to-string (length doc-view-current-files))))) 1011 "/" (:eval (number-to-string (length doc-view-current-files)))))
1026 ;; Don't scroll unless the user specifically asked for it. 1012 ;; Don't scroll unless the user specifically asked for it.
1027 (set (make-local-variable 'auto-hscroll-mode) nil) 1013 (set (make-local-variable 'auto-hscroll-mode) nil)
@@ -1067,7 +1053,7 @@ See the command `doc-view-mode' for more information on this mode."
1067(defun doc-view-bookmark-make-cell (annotation &rest args) 1053(defun doc-view-bookmark-make-cell (annotation &rest args)
1068 (let ((the-record 1054 (let ((the-record
1069 `((filename . ,buffer-file-name) 1055 `((filename . ,buffer-file-name)
1070 (page . ,doc-view-current-page) 1056 (page . ,(doc-view-current-page))
1071 (handler . doc-view-bookmark-jump)))) 1057 (handler . doc-view-bookmark-jump))))
1072 1058
1073 ;; Take no chances with text properties 1059 ;; Take no chances with text properties