changeset 92004:db743b98a24b

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.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Thu, 21 Feb 2008 03:45:04 +0000
parents 0cba8a715dc9
children f60998626e8a
files lisp/ChangeLog lisp/doc-view.el
diffstat 2 files changed, 84 insertions(+), 88 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Thu Feb 21 03:36:56 2008 +0000
+++ b/lisp/ChangeLog	Thu Feb 21 03:45:04 2008 +0000
@@ -1,5 +1,15 @@
 2008-02-21  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+	* doc-view.el: 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.
+
 	* image-mode.el: Extend [hv]scroll support to per-window properties.
 	(image-mode-current-vscroll, image-mode-current-hscroll): Remove.
 	(image-mode-winprops-alist): New var to replace them.
--- a/lisp/doc-view.el	Thu Feb 21 03:36:56 2008 +0000
+++ b/lisp/doc-view.el	Thu Feb 21 03:45:04 2008 +0000
@@ -214,39 +214,33 @@
 
 ;;;; Internal Variables
 
+(defun doc-view-new-window-function (winprops)
+  (let ((ol (image-mode-window-get 'overlay winprops)))
+    (if ol
+        (setq ol (copy-overlay ol))
+      (setq ol (make-overlay (point-min) (point-max) nil t))
+      (overlay-put ol 'doc-view t))
+    (overlay-put ol 'window (car winprops))
+    (image-mode-window-put 'overlay ol winprops)))
+
 (defvar doc-view-current-files nil
   "Only used internally.")
 
-(defvar doc-view-current-page nil
-  "Only used internally.")
-
 (defvar doc-view-current-converter-process nil
   "Only used internally.")
 
 (defvar doc-view-current-timer nil
   "Only used internally.")
 
-(defvar doc-view-current-slice nil
-  "Only used internally.")
-
 (defvar doc-view-current-cache-dir nil
   "Only used internally.")
 
 (defvar doc-view-current-search-matches nil
   "Only used internally.")
 
-(defvar doc-view-current-image nil
-  "Only used internally.")
-
-(defvar doc-view-current-overlay nil
-  "Only used internally.")
-
 (defvar doc-view-pending-cache-flush nil
   "Only used internally.")
 
-(defvar doc-view-current-info nil
-  "Only used internally.")
-
 (defvar doc-view-previous-major-mode nil
   "Only used internally.")
 
@@ -328,6 +322,12 @@
 
 ;;;; Navigation Commands
 
+(defmacro doc-view-current-page () `(image-mode-window-get 'page))
+(defmacro doc-view-current-info () `(image-mode-window-get 'info))
+(defmacro doc-view-current-overlay () `(image-mode-window-get 'overlay))
+(defmacro doc-view-current-image () `(image-mode-window-get 'image))
+(defmacro doc-view-current-slice () `(image-mode-window-get 'slice))
+
 (defun doc-view-goto-page (page)
   "View the page given by PAGE."
   (interactive "nPage: ")
@@ -336,41 +336,39 @@
 	(setq page 1)
       (when (> page len)
 	(setq page len)))
-    (setq doc-view-current-page page
-	  doc-view-current-info
+    (setf (doc-view-current-page) page
+	  (doc-view-current-info)
 	  (concat
 	   (propertize
-	    (format "Page %d of %d."
-		    doc-view-current-page
-		    len) 'face 'bold)
+	    (format "Page %d of %d." page len) 'face 'bold)
 	   ;; Tell user if converting isn't finished yet
 	   (if doc-view-current-converter-process
 	       " (still converting...)\n"
 	     "\n")
 	   ;; Display context infos if this page matches the last search
 	   (when (and doc-view-current-search-matches
-		      (assq doc-view-current-page
-			    doc-view-current-search-matches))
+		      (assq page doc-view-current-search-matches))
 	     (concat (propertize "Search matches:\n" 'face 'bold)
 		     (let ((contexts ""))
-		       (dolist (m (cdr (assq doc-view-current-page
+		       (dolist (m (cdr (assq page
 					     doc-view-current-search-matches)))
 			 (setq contexts (concat contexts "  - \"" m "\"\n")))
 		       contexts)))))
     ;; Update the buffer
     (doc-view-insert-image (nth (1- page) doc-view-current-files)
                            :pointer 'arrow)
-    (overlay-put doc-view-current-overlay 'help-echo doc-view-current-info)))
+    (overlay-put (doc-view-current-overlay)
+                 'help-echo (doc-view-current-info))))
 
 (defun doc-view-next-page (&optional arg)
   "Browse ARG pages forward."
   (interactive "p")
-  (doc-view-goto-page (+ doc-view-current-page (or arg 1))))
+  (doc-view-goto-page (+ (doc-view-current-page) (or arg 1))))
 
 (defun doc-view-previous-page (&optional arg)
   "Browse ARG pages backward."
   (interactive "p")
-  (doc-view-goto-page (- doc-view-current-page (or arg 1))))
+  (doc-view-goto-page (- (doc-view-current-page) (or arg 1))))
 
 (defun doc-view-first-page ()
   "View the first page."
@@ -386,18 +384,18 @@
   "Scroll page up if possible, else goto next page."
   (interactive)
   (when (= (window-vscroll) (image-scroll-up nil))
-    (let ((cur-page doc-view-current-page))
+    (let ((cur-page (doc-view-current-page)))
       (doc-view-next-page)
-      (when (/= cur-page doc-view-current-page)
+      (when (/= cur-page (doc-view-current-page))
 	(set-window-vscroll nil 0)))))
 
 (defun doc-view-scroll-down-or-previous-page ()
   "Scroll page down if possible, else goto previous page."
   (interactive)
   (when (= (window-vscroll) (image-scroll-down nil))
-    (let ((cur-page doc-view-current-page))
+    (let ((cur-page (doc-view-current-page)))
       (doc-view-previous-page)
-      (when (/= cur-page doc-view-current-page)
+      (when (/= cur-page (doc-view-current-page))
 	(image-scroll-up nil)))))
 
 ;;;; Utility Functions
@@ -661,15 +659,15 @@
 See `doc-view-set-slice-using-mouse' for a more convenient way to
 do that.  To reset the slice use `doc-view-reset-slice'."
   (interactive
-   (let* ((size (image-size doc-view-current-image t))
+   (let* ((size (image-size (doc-view-current-image) t))
 	  (a (read-number (format "Top-left X (0..%d): " (car size))))
 	  (b (read-number (format "Top-left Y (0..%d): " (cdr size))))
 	  (c (read-number (format "Width (0..%d): " (- (car size) a))))
 	  (d (read-number (format "Height (0..%d): " (- (cdr size) b)))))
      (list a b c d)))
-  (setq doc-view-current-slice (list x y width height))
+  (setf (doc-view-current-slice) (list x y width height))
   ;; Redisplay
-  (doc-view-goto-page doc-view-current-page))
+  (doc-view-goto-page (doc-view-current-page)))
 
 (defun doc-view-set-slice-using-mouse ()
   "Set the slice of the images that should be displayed.
@@ -694,9 +692,9 @@
   "Reset the current slice.
 After calling this function whole pages will be visible again."
   (interactive)
-  (setq doc-view-current-slice nil)
+  (setf (doc-view-current-slice) nil)
   ;; Redisplay
-  (doc-view-goto-page doc-view-current-page))
+  (doc-view-goto-page (doc-view-current-page)))
 
 ;;;; Display
 
@@ -706,22 +704,21 @@
   (when doc-view-pending-cache-flush
     (clear-image-cache)
     (setq doc-view-pending-cache-flush nil))
-  (if (null file)
-      ;; We're trying to display a page that doesn't exist.  Typically happens
-      ;; if the conversion process somehow failed.  Better not signal an
-      ;; error here because it could prevent a subsequent reconversion from
-      ;; fixing the problem.
-      (progn
-        (setq doc-view-current-image nil)
-        (move-overlay doc-view-current-overlay (point-min) (point-max))
-        (overlay-put doc-view-current-overlay 'display
-                     "Cannot display this page!  Probably a conversion failure!"))
-    (let ((image (apply 'create-image file 'png nil args)))
-      (setq doc-view-current-image image)
-      (move-overlay doc-view-current-overlay (point-min) (point-max))
-      (overlay-put doc-view-current-overlay 'display
-                   (if doc-view-current-slice
-                       (list (cons 'slice doc-view-current-slice) image)
+  (let ((ol (doc-view-current-overlay))
+        (image (if file (apply 'create-image file 'png nil args)))
+        (slice (doc-view-current-slice)))
+    (setf (doc-view-current-image) image)
+    (move-overlay ol (point-min) (point-max)) ;Probably redundant.
+    (overlay-put ol 'display
+                 (if (null image)
+                     ;; We're trying to display a page that doesn't exist.
+                     ;; Typically happens if the conversion process somehow
+                     ;; failed.  Better not signal an error here because it
+                     ;; could prevent a subsequent reconversion from fixing
+                     ;; the problem.
+                     "Cannot display this page!  Probably a conversion failure!"
+                   (if slice
+                       (list (cons 'slice slice) image)
                      image)))))
 
 (defun doc-view-sort (a b)
@@ -740,17 +737,17 @@
           (sort (directory-files (doc-view-current-cache-dir) t
                                  "page-[0-9]+\\.png" t)
                 'doc-view-sort))
-    (when (or force
-              (>= (length doc-view-current-files)
-                  (or doc-view-current-page 1)))
-      (doc-view-goto-page doc-view-current-page))))
+    (let ((page (doc-view-current-page)))
+      (when (or force
+                (>= (length doc-view-current-files) (or page 1)))
+        (doc-view-goto-page page)))))
 
 (defun doc-view-buffer-message ()
   ;; Only show this message initially, not when refreshing the buffer (in which
   ;; case it's better to keep displaying the "stale" page while computing
   ;; the fresh new ones).
-  (unless (overlay-get doc-view-current-overlay 'display)
-    (overlay-put doc-view-current-overlay 'display
+  (unless (overlay-get (doc-view-current-overlay) 'display)
+    (overlay-put (doc-view-current-overlay) 'display
                  (concat (propertize "Welcome to DocView!" 'face 'bold)
                          "\n"
                          "
@@ -766,7 +763,7 @@
 
 (defun doc-view-show-tooltip ()
   (interactive)
-  (tooltip-show doc-view-current-info))
+  (tooltip-show (doc-view-current-info)))
 
 ;;;;; Toggle between editing and viewing
 
@@ -778,7 +775,8 @@
       (progn
 	(doc-view-kill-proc)
 	(setq buffer-read-only nil)
-        (remove-overlays (point-min) (point-max) 'doc-view)
+        (remove-overlays (point-min) (point-max) 'doc-view t)
+        (set (make-local-variable 'image-mode-winprops-alist) t)
 	;; Switch to the previously used major mode or fall back to fundamental
 	;; mode.
 	(if doc-view-previous-major-mode
@@ -889,7 +887,7 @@
   "Go to the ARGth next matching page."
   (interactive "p")
   (let* ((next-pages (doc-view-remove-if
-		      (lambda (i) (<= (car i) doc-view-current-page))
+		      (lambda (i) (<= (car i) (doc-view-current-page)))
 		      doc-view-current-search-matches))
 	 (page (car (nth (1- arg) next-pages))))
     (if page
@@ -903,7 +901,7 @@
   "Go to the ARGth previous matching page."
   (interactive "p")
   (let* ((prev-pages (doc-view-remove-if
-		      (lambda (i) (>= (car i) doc-view-current-page))
+		      (lambda (i) (>= (car i) (doc-view-current-page)))
 		      doc-view-current-search-matches))
 	 (page (car (nth (1- arg) (nreverse prev-pages)))))
     (if page
@@ -922,7 +920,7 @@
   (if (doc-view-mode-p (intern (file-name-extension doc-view-buffer-file-name)))
       (progn
 	(doc-view-buffer-message)
-	(setq doc-view-current-page (or doc-view-current-page 1))
+	(setf (doc-view-current-page) (or (doc-view-current-page) 1))
 	(if (file-exists-p (doc-view-current-cache-dir))
 	    (progn
 	      (message "DocView: using cached files!")
@@ -949,16 +947,12 @@
   ;; for each clone), but that means that clones need to collaborate a bit.
   ;; I guess it mostly means: detect when a reconversion process is already
   ;; running, and run the sentinel in all clones.
-  ;; Not sure how important it is to fix it: a better target would be to
-  ;; allow a single buffer (without cloning) to display different pages in
-  ;; different windows.
-  ;; Maybe then the clones should really have a separate /tmp directory
+  ;; 
+  ;; Maybe the clones should really have a separate /tmp directory
   ;; so they could have a different resolution and you could use clones
   ;; for zooming.
-  (dolist (ol (overlays-in (point-min) (point-max)))
-    ;; The overlay was copied by the cloning, so we just need to find it
-    ;; and put it in doc-view-current-overlay.
-    (if (overlay-get ol 'doc-view) (setq doc-view-current-overlay ol))))
+  (remove-overlays (point-min) (point-max) 'doc-view t)
+  (if (consp image-mode-winprops-alist) (setq image-mode-winprops-alist nil)))
 
 ;;;###autoload
 (defun doc-view-mode ()
@@ -996,32 +990,24 @@
     (write-region nil nil doc-view-buffer-file-name))
 
   (make-local-variable 'doc-view-current-files)
-  (make-local-variable 'doc-view-current-image)
-  (make-local-variable 'doc-view-current-page)
   (make-local-variable 'doc-view-current-converter-process)
   (make-local-variable 'doc-view-current-timer)
-  (make-local-variable 'doc-view-current-slice)
   (make-local-variable 'doc-view-current-cache-dir)
-  (make-local-variable 'doc-view-current-info)
   (make-local-variable 'doc-view-current-search-matches)
-  (set (make-local-variable 'doc-view-current-overlay)
-       (make-overlay (point-min) (point-max) nil t))
-  (overlay-put doc-view-current-overlay 'doc-view t)
   (add-hook 'change-major-mode-hook
-	    (lambda () (remove-overlays (point-min) (point-max) 'doc-view))
+	    (lambda () (remove-overlays (point-min) (point-max) 'doc-view t))
 	    nil t)
   (add-hook 'clone-indirect-buffer-hook 'doc-view-clone-buffer-hook nil t)
 
-  ;; Keep track of [vh]scroll when switching buffers
-  (make-local-variable 'image-mode-current-hscroll)
-  (make-local-variable 'image-mode-current-vscroll)
-  (image-set-window-hscroll (selected-window) (window-hscroll))
-  (image-set-window-vscroll (selected-window) (window-vscroll))
-  (add-hook 'window-configuration-change-hook
-	    'image-reset-current-vhscroll nil t)
-
+  (remove-overlays (point-min) (point-max) 'doc-view t) ;Just in case.
+  ;; Keep track of display info ([vh]scroll, page number, overlay, ...)
+  ;; for each window in which this document is shown.
+  (add-hook 'image-mode-new-window-functions
+            'doc-view-new-window-function nil t)
+  (image-mode-setup-winprops)
+  
   (set (make-local-variable 'mode-line-position)
-       '(" P" (:eval (number-to-string doc-view-current-page))
+       '(" P" (:eval (number-to-string (doc-view-current-page)))
 	 "/" (:eval (number-to-string (length doc-view-current-files)))))
   ;; Don't scroll unless the user specifically asked for it.
   (set (make-local-variable 'auto-hscroll-mode) nil)
@@ -1067,7 +1053,7 @@
 (defun doc-view-bookmark-make-cell (annotation &rest args)
   (let ((the-record
          `((filename . ,buffer-file-name)
-           (page     . ,doc-view-current-page)
+           (page     . ,(doc-view-current-page))
            (handler  . doc-view-bookmark-jump))))
 
     ;; Take no chances with text properties