Upstream pdf roll

image-roll-mode.el

@@ -0,0 +1,92 @@
+;;; image-roll-mode.el --- Demo for image roll. -*- lexical-binding: t; -*-
+
+;;; Commentary:
+;; Demo for image roll. Contains a major mode for displaying images.
+
+;;; Code:
+
+(require 'svg)
+(require 'image-roll)
+
+(defun image-roll-demo-display-page (page)
+  "Return demo image of PAGE.
+This function is used for the `image-roll-demo'."
+  (let* ((o (image-roll-page-overlay page))
+         (s (cdr (overlay-get o 'display)))
+         (w (car (plist-get s :width)))
+         (h (car (plist-get s :height)))
+         (svg (svg-create w h)))
+    (unless w (print "NO W" #'external-debugging-output))
+    (svg-rectangle svg 0 0 w h :fill-color "white")
+    (svg-text svg
+              (number-to-string page)
+              :font-size "40"
+              :fill "black"
+              :x 20
+              :y 50)
+    (when image-roll-center
+      (overlay-put o 'before-string
+                   (when (> (window-pixel-width) w)
+                     (propertize " " 'display
+                                 `(space :align-to
+                                         (,(floor (/ (- (window-pixel-width) w) 2))))))))
+    (overlay-put o 'display (svg-image svg :margin `(0 . ,image-roll-vertical-margin)))))
+
+(define-derived-mode image-roll-mode special-mode "Image Roll"
+  ;; we don't use `(image-mode-setup-winprops)' because it would additionally
+  ;; add `image-mode-reapply-winprops' to the
+  ;; `window-configuration-change-hook', but `image-roll-redisplay' already
+  ;; reapplies the vscroll, so we simply initialize the
+  ;; `image-mode-winprops-alist' here, and add lines from
+  ;; `image-mode-reapply-winprops' at the start of `image-roll-redisplay'.
+  (add-hook 'window-size-change-functions 'image-roll-window-size-change-function nil t)
+  (add-hook 'image-mode-new-window-functions 'image-roll-new-window-function nil t)
+  (unless (listp image-mode-winprops-alist)
+    (setq image-mode-winprops-alist nil)))
+;; (add-hook 'window-configuration-change-hook
+;;           #'image-mode-reapply-winprops nil t))
+;; (image-mode-setup-winprops))
+
+(setq image-roll-mode-map
+      (let ((map (make-sparse-keymap)))
+        (define-key map (kbd "C-n") 'image-roll-scroll-forward)
+        (define-key map (kbd "<down>") 'image-roll-scroll-forward)
+        (define-key map (kbd "C-p") 'image-roll-scroll-backward)
+        (define-key map (kbd "<up>") 'image-roll-scroll-backward)
+        (define-key map (kbd "<wheel-up>") 'image-roll-scroll-mouse-wheel)
+        (define-key map (kbd "<wheel-down>") 'image-roll-scroll-mouse-wheel)
+        (define-key map (kbd "<mouse-5>") 'image-roll-scroll-forward)
+        (define-key map (kbd "<mouse-4>") 'image-roll-scroll-backward)
+        (define-key map "n" 'image-roll-next-page)
+        (define-key map (kbd "<next>") 'image-roll-next-page)
+        (define-key map "p" 'image-roll-previous-page)
+        (define-key map (kbd "<prior>") 'image-roll-previous-page)
+        (define-key map (kbd "S-<next>") 'image-roll-scroll-screen-forward)
+        (define-key map (kbd "S-<prior>") 'image-roll-scroll-screen-backward)
+        (define-key map [remap goto-line] 'image-roll-goto-page)
+        map))
+
+(defun image-roll-demo (&optional page-size pages)
+  "Display a demo buffer displaying some images.
+PAGE-SIZE is the size of each image and PAGES is the number of images."
+  (interactive)
+  (let ((buf-name "*image-roll-demo*"))
+    ;;   (if (get-buffer buf-name)
+    ;;       (switch-to-buffer (current-buffer))
+    (with-current-buffer (get-buffer-create buf-name)
+      (erase-buffer)
+      (image-roll-mode)
+      (setq cursor-type nil)
+      (setq image-roll-step-size 50)
+      (setq-local image-roll-last-page             (or pages 3)
+                  image-roll-display-page-function 'image-roll-demo-display-page
+                  image-roll-demo-page-size        (or page-size
+                                                       (lambda ()
+                                                         (let ((w (window-pixel-width)))
+                                                           (cons w (* 1.4 w))))))
+
+      (setq image-roll-center t)
+      (switch-to-buffer (current-buffer)))))
+(provide 'image-roll-mode)
+
+;;; image-roll-mode.el ends here

lisp/pdf-annot.el

@@ -999,7 +999,8 @@ other annotations."
                 `("white" "steel blue" 0.35 ,@edges))
              :map (pdf-view-apply-hotspot-functions
                    window page size)
-             :width (car size))))
+             :width (car size))
+           (when pdf-view-roll-minor-mode page)))
         (pdf-util-scroll-to-edges
          (pdf-util-scale-relative-to-pixel (car edges)))))))
 
@@ -1086,8 +1087,8 @@ Return the new annotation."
       (pdf-annot-activate-annotation a))
     a))
 
-(defun pdf-annot-add-text-annotation (pos &optional icon property-alist)
-  "Add a new text annotation at POS in the selected window.
+(defun pdf-annot-add-text-annotation (pos &optional icon property-alist page)
+  "Add a new text annotation at POS on PAGE in the selected window.
 
 POS should be a image position object or a cons \(X . Y\), both
 being image coordinates.
@@ -1115,6 +1116,9 @@ Return the new annotation."
      (list posn)))
   (pdf-util-assert-pdf-window)
   (when (posnp pos)
+    (setq page (or page
+                   (when pdf-view-roll-minor-mode
+                     (1+ (/ (posn-point pos) 4)))))
     (setq pos (posn-object-x-y pos)))
   (let ((isize (pdf-view-image-size))
         (x (car pos))
@@ -1139,7 +1143,8 @@ Return the new annotation."
         property-alist
         (cdr (assq 'text pdf-annot-default-annotation-properties))
         (cdr (assq t pdf-annot-default-annotation-properties))
-        `((color . ,(car pdf-annot-color-history))))))))
+        `((color . ,(car pdf-annot-color-history))))
+       page))))
 
 (defun pdf-annot-mouse-add-text-annotation (ev)
   "Add a text annotation using the mouse.
@@ -1155,11 +1160,12 @@ EV describes the captured mouse event."
           "Click where a new text annotation should be added ..."))
      (event-start ev))))
 
-(defun pdf-annot-add-markup-annotation (list-of-edges type &optional color
+(defun pdf-annot-add-markup-annotation (region type &optional color
                                                       property-alist)
   "Add a new markup annotation in the selected window.
 
-LIST-OF-EDGES determines the marked up area and should be a list
+REGION determines the marked up area and should be a cons cell
+\(PAGE . LIST-OF-EDGES\) where LIST-OF-EDGES should be list
 of \(LEFT TOP RIGHT BOT\), each value a relative coordinate.
 
 TYPE should be one of `squiggly', `underline', `strike-out' or
@@ -1182,7 +1188,7 @@ Return the new annotation."
   (pdf-util-assert-pdf-window)
   (pdf-annot-add-annotation
    type
-   list-of-edges
+   (cdr region)
    (pdf-annot-merge-alists
     (and color `((color . ,color)))
     property-alist
@@ -1191,7 +1197,7 @@ Return the new annotation."
     (when pdf-annot-color-history
       `((color . ,(car pdf-annot-color-history))))
     '((color . "#ffff00")))
-   (pdf-view-current-page)))
+   (car region)))
 
 (defun pdf-annot-add-squiggly-markup-annotation (list-of-edges
                                                  &optional color property-alist)
@@ -1540,6 +1546,66 @@ At any given point of time, only one annotation can be in edit mode."
       (error "No annotation at this position"))
     (pdf-annot-edit-contents a)))
 
+(defun pdf-annot-edit (annot)
+  "Activate ANNOT, for editing.
+
+Interactively, annot is read via `pdf-annot-read-annot'.
+This function displays characters around the annots in the current
+page and starts reading characters (ignoring case).  After a
+sufficient number of characters have been read, the corresponding
+annot's annot is invoked.  Additionally, SPC may be used to
+scroll the current page."
+  (interactive
+   (list (or (pdf-annot-read-annot "Activate annot (SPC scrolls): ")
+             (error "No annot selected"))))
+  (pdf-annot-activate-annotation annot))
+
+;; TODO 'merge' this function with `pdf-links-read-link-action' into a single
+;; universal 'read-action' function (in `pdf-util'?)
+(defun pdf-annot-read-annot (prompt)
+  "Using PROMPT, interactively read an annot-action.
+
+See `pdf-annot-edit' for the interface."
+  (pdf-util-assert-pdf-window)
+  (let* ((annots (pdf-annot-getannots (pdf-view-current-page) nil nil))
+         (keys (pdf-links-read-link-action--create-keys
+                (length annots)))
+         (key-strings (mapcar (apply-partially 'apply 'string)
+                              keys))
+         (alist (cl-mapcar 'cons keys annots))
+         (size (pdf-view-image-size))
+         (colors (pdf-util-face-colors
+                  'pdf-links-read-link pdf-view-dark-minor-mode))
+         (args (list
+                :foreground (car colors)
+                :background (cdr colors)
+                :formats
+                `((?c . ,(lambda (_edges) (pop key-strings)))
+                  (?P . ,(number-to-string
+                          (max 1 (* (cdr size)
+                                    pdf-links-convert-pointsize-scale)))))
+                :commands pdf-links-read-link-convert-commands
+                :apply (pdf-util-scale-relative-to-pixel
+                        (mapcar (lambda (l) (cdr (assq 'edges l)))
+                                annots)))))
+    ;; (print (plist-get args :apply))
+    (unless annots
+      (error "No annots on this page"))
+    (unwind-protect
+        (let ((image-data
+               (pdf-cache-get-image
+                (pdf-view-current-page)
+                (car size) (car size) 'pdf-annot-read-annot)))
+          (unless image-data
+            (setq image-data (apply 'pdf-util-convert-page args ))
+            (pdf-cache-put-image
+             (pdf-view-current-page)
+             (car size) image-data 'pdf-annot-read-annot))
+          (pdf-view-display-image
+           (create-image image-data (pdf-view-image-type) t)
+           (when pdf-view-roll-minor-mode (pdf-view-current-page)))
+          (pdf-links-read-link-action--read-chars prompt alist))
+      (pdf-view-redisplay))))
 
 
 ;; * ================================================================== *
@@ -1582,6 +1648,7 @@ Currently supported properties are page, type, label, date and contents."
 
 (defvar pdf-annot-list-mode-map
   (let ((km (make-sparse-keymap)))
+    (define-key km (kbd "e") 'pdf-annot-edit)
     (define-key km (kbd "C-c C-f") #'pdf-annot-list-follow-minor-mode)
     (define-key km (kbd "SPC") #'pdf-annot-list-display-annotation-from-id)
     km))

lisp/pdf-cache.el

@@ -451,10 +451,7 @@ WINDOW and IMAGE-WIDTH decide the page and scale of the final image."
                         (image-size (pdf-view-create-page page))
                         (pdf-util-debug
                           (message "Prefetched page %s." page))
-                        ;; Avoid max-lisp-eval-depth
-                        (run-with-timer
-                         0.001 nil
-                         #'pdf-cache--prefetch-pages window image-width)))))))
+                        (pdf-cache--prefetch-pages window image-width)))))))
           (condition-case err
               (pdf-info-renderpage page image-width)
             (error