diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/pdf-roll.el | 421 |
1 files changed, 421 insertions, 0 deletions
diff --git a/lisp/pdf-roll.el b/lisp/pdf-roll.el new file mode 100644 index 0000000..e47063b --- /dev/null +++ b/lisp/pdf-roll.el @@ -0,0 +1,421 @@ +;;; pdf-roll.el --- Add continuous scroll. -*- lexical-binding: t -*- + +;; Copyright (C) 2013, 2014 Andreas Politz + +;; Author: Daniel Nicolai <dalanicolai@gmail.com> +;; Keywords: files, multimedia + +;; This program 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 3 of the License, or +;; (at your option) any later version. + +;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; + +;;; Code: +(require 'pdf-view) + +(put 'pdf-roll 'display '(space :width 25 :height 1000)) +(put 'pdf-roll 'evaporate t) +(put 'pdf-roll-margin 'evaporate t) + +;;; Custom Variables +(defgroup pdf-roll nil + "Image roll configurations." + :group 'pdf-view) + +(defface pdf-roll-default `((t :font ,(font-spec :family "monospace" :size 1))) + "Default face for image roll documents.") + +(defcustom pdf-roll-vertical-margin 2 + "Vertical margin between images in pixels, i.e. page separation height." + :type 'integer) + +(defcustom pdf-roll-margin-color "gray" + "Background color of overlay, i.e. page separation color." + :type 'color + :set (lambda (_ color) (put 'pdf-roll-margin 'face `(:background ,color)))) + +;;; Variables +(defvar pdf-roll--state nil + "Local variable that tracks window, point and vscroll to handle changes.") + +;;; Utility Macros and functions +(defsubst pdf-roll-page-to-pos (page) + "Get the buffer position displaing PAGE." + (- (* 4 page) 3)) + +(defun pdf-roll--pos-overlay (pos window) + "Return an overlay for WINDOW at POS." + (cl-find window (overlays-at pos) :key (lambda (ov) (overlay-get ov 'window)))) + +(defun pdf-roll-page-overlay (&optional page window) + "Return overlay displaying PAGE in WINDOW." + (pdf-roll--pos-overlay + (pdf-roll-page-to-pos (or page (pdf-roll-page-at-current-pos))) + (or window (selected-window)))) + +(defun pdf-roll-page-at-current-pos () + "Page at point." + (if (cl-oddp (point)) + (/ (+ (point) 3) 4) + (error "No page is displayed at current position (%s)" (point)))) + +(defun pdf-roll-set-vscroll (vscroll win) + "Set vscroll to VSCROLL in window WIN." + (image-mode-winprops win t) + (image-mode-window-put 'vscroll vscroll win) + (set-window-vscroll win vscroll t)) + +;;; Displaying/Undisplaying pages +(defun pdf-roll-maybe-slice-image (image &optional window inhibit-slice-p) + "Return a sliced IMAGE if `pdf-view-current-slice' in WINDOW is non-nil. +If INHIBIT-SLICE-P is non-nil, disregard `pdf-view-current-slice'." + (if-let ((slice (pdf-view-current-slice window)) + ((not inhibit-slice-p))) + (list (cons 'slice + (pdf-util-scale slice (image-size image t) 'round)) + image) + image)) + +(defun pdf-roll-display-image (image page &optional window inhibit-slice-p) + "Display IMAGE for PAGE in WINDOW. +If INHIBIT-SLICE-P is non-nil, disregard `pdf-view-current-slice'." + (let* ((image (pdf-roll-maybe-slice-image image window inhibit-slice-p)) + (size (image-display-size image t)) + (overlay (pdf-roll-page-overlay page window)) + (margin-pos (+ (pdf-roll-page-to-pos page) 2)) + (margin-overlay (pdf-roll--pos-overlay margin-pos window)) + (offset (when (> (window-width window t) (car size)) + `(space :width (,(/ (- (window-width window t) (car size)) 2)))))) + (overlay-put overlay 'display image) + (overlay-put overlay 'line-prefix offset) + (overlay-put margin-overlay 'display `(space :width (,(car size)) :height (,pdf-roll-vertical-margin))) + (overlay-put margin-overlay 'line-prefix offset) + (cdr size))) + +(defun pdf-roll-display-page (page window &optional force) + "Display PAGE in WINDOW. +With FORCE non-nil display fetch page again even if it is already displayed." + (let ((display (overlay-get (pdf-roll-page-overlay page window) 'display))) + (if (or force (not display) (eq (car display) 'space)) + (pdf-roll-display-image (pdf-view-create-page page window) page window) + (cdr (image-display-size display t))))) + +(defun pdf-roll-display-pages (page &optional window force pscrolling) + "Display pages to fill the WINDOW starting from PAGE. +If FORCE is non-nill redisplay a page even if it is already displayed." + (let (displayed + (available-height (window-pixel-height window))) + (when (and pscrolling (> page 1)) + (pdf-roll-display-page (1- page) window force) + (push (1- page) displayed)) + (let ((vscroll (image-mode-window-get 'vscroll window)) + (im-height (pdf-roll-display-page page window force))) + (pdf-roll-set-vscroll (min vscroll (1- im-height)) window) + (cl-callf - available-height (- im-height (window-vscroll window t)))) + (push page displayed) + (while (and (> available-height 0) (< page (pdf-cache-number-of-pages))) + (cl-callf - available-height (pdf-roll-display-page (cl-incf page) window force)) + (push page displayed)) + (when (and pscrolling (< page (pdf-cache-number-of-pages))) + (pdf-roll-display-page (cl-incf page) window force) + (push page displayed)) + ;; store displayed images for determining which images to update when update + ;; is triggered + (cl-callf cl-union (image-mode-window-get 'displayed-pages window) displayed) + displayed)) + +(defun pdf-roll-undisplay-pages (pages &optional window) + "Undisplay PAGES from WINDOW. +Replaces the display property of the overlay holding a page with a space." + (dolist (page pages) + (overlay-put (pdf-roll-page-overlay page window) + 'display (get 'pdf-roll 'display)))) + +;;; State Management +(defun pdf-roll-new-window-function (&optional win) + "Setup image roll in a new window WIN. +If the buffer is newly created, then it does not contain any +overlay and this function erases the buffer contents, after which +it inserts empty spaces that each hold a overlay. If the buffer +already has overlays (i.e. a second or subsequent window is +created), the function simply copies the overlays and adds the +new window as window overlay-property to each overlay. + +This function should be added to pdf-roll (continuous scroll) +minor mode commands, after erasing the buffer to create the +overlays." + (setq win (or (and (windowp win) win) (selected-window))) + (if (not (overlays-at 1)) + (let ((pages (pdf-cache-number-of-pages)) + (inhibit-read-only t)) + (erase-buffer) + (setq pdf-roll--state (list t)) + (dotimes (i (* 2 pages)) + (insert " ") + (let ((o (make-overlay (1- (point)) (point)))) + (overlay-put o 'category (if (eq 0 (mod i 2)) 'pdf-roll 'pdf-roll-margin)) + (overlay-put o 'window win)) + (insert "\n")) + (delete-char -1) + (set-buffer-modified-p nil)) + (unless (pdf-roll-page-overlay 1 win) + (dotimes (i (/ (point-max) 2)) + (overlay-put (copy-overlay (car (overlays-at (1+ (* 2 i))))) + 'window win)) + (dolist (win-st pdf-roll--state) + (when-let ((win-old (car-safe win-st)) + ((not (window-live-p win-old)))) + (remove-overlays (point-min) (point-max) 'window win-old))) + (cl-callf2 cl-delete-if-not #'window-live-p pdf-roll--state :key #'car-safe))) + ;; initial `pdf-roll-redisplay' needs to know which page(s) to display + (cl-callf or (pdf-view-current-page win) 1) + (cl-callf or (image-mode-window-get 'vscroll win) 0)) + +(defun pdf-roll-redisplay (&optional window) + "Analogue of `pdf-view-redisplay' for WINDOW." + (setq window (if (windowp window) window (selected-window))) + (when (pdf-roll-page-overlay 1 window) + (setf (alist-get window pdf-roll--state) nil) + (force-window-update window))) + +(defun pdf-roll-pre-redisplay (win) + "Handle modifications to the state in window WIN. +It should be added to `pre-redisplay-functions' buffer locally." + (with-demoted-errors "Error in image roll pre-redisplay: %S" + (unless (pdf-roll-page-overlay 1 win) + (pdf-roll-new-window-function win)) + (let* ((state (alist-get win pdf-roll--state)) + (pscrolling (memq last-command + '(pixel-scroll-precision pixel-scroll-start-momentum + pixel-scroll-interpolate-up pixel-scroll-interpolate-down))) + (page (progn (when pscrolling + (setf (pdf-view-current-page win) + (/ (min (+ (window-start win) 5) (point-max)) 4))) + (pdf-view-current-page win))) + (height (window-pixel-height win)) + (vscroll (image-mode-window-get 'vscroll win)) + (size-changed (not (and (eq height (nth 1 state)) + (eq (window-pixel-width win) (nth 2 state))))) + (page-changed (not (eq page (nth 0 state)))) + (vscroll-changed (not (eq vscroll (nth 3 state)))) + (start (pdf-roll-page-to-pos page))) + (if (and pscrolling + (or (not (eq start (- (point-max) 3))) + (let ((visible-pixels (nth 4 (pos-visible-in-window-p start win t)))) + (and visible-pixels (> visible-pixels (/ (window-text-height win t) 2)))) + (prog1 nil (message "End of buffer")))) + (progn (image-mode-window-put 'vscroll (window-vscroll win t) win) + (image-mode-window-put 'hscroll (window-hscroll win)) win) + (set-window-vscroll win vscroll t) + (set-window-hscroll win (or (image-mode-window-get 'hscroll win) 0)) + (set-window-start win start t)) + (setq disable-point-adjustment t) + (when (or size-changed page-changed vscroll-changed) + (let ((old (image-mode-window-get 'displayed-pages win)) + (new (pdf-roll-display-pages page win size-changed pscrolling))) + ;; If images/pages are small enough (or after jumps), there + ;; might be multiple image that need to get updated + (pdf-roll-undisplay-pages (cl-set-difference old new) win) + (image-mode-window-put 'displayed-pages new win) + (set-window-point win (+ start + (if (pos-visible-in-window-p (+ 2 start) win) 2 0)))) + (setf (alist-get win pdf-roll--state) + `(,page ,height ,(window-pixel-width win) ,vscroll nil)) + (when page-changed (run-hooks 'pdf-view-after-change-page-hook)))))) + +;;; Page navigation commands +(defun pdf-roll-goto-page-start () + "Go to the start of the first displayed page." + (interactive) + (pdf-roll-set-vscroll 0 nil)) + +(defun pdf-roll-goto-page (page &optional window) + "Go to PAGE in WINDOW." + (interactive + (list (if current-prefix-arg + (prefix-numeric-value current-prefix-arg) + (read-number "Page: ")))) + (unless (and (>= page 1) + (<= page (pdf-cache-number-of-pages))) + (error "No such page: %d" page)) + (setf (pdf-view-current-page window) page) + (pdf-roll-set-vscroll 0 window)) + +(defun pdf-roll-next-page (&optional n) + "Go to next page or next Nth page." + (interactive "p") + (pdf-roll-goto-page (+ (pdf-roll-page-at-current-pos) n))) + +(defun pdf-roll-previous-page (&optional n) + "Go to previous page or previous Nth page." + (interactive "p") + (pdf-roll-next-page (- n))) + +;;; Scrolling Commands +(defun pdf-roll-scroll-forward (&optional n window pixels) + "Scroll image N lines forward in WINDOW. +Line height is determined by `frame-char-height'. When N is negative +scroll backward instead. With a prefix arg N is its numeric value. + +If PIXELS is non-nil N is number of pixels instead of lines." + (interactive (list (prefix-numeric-value current-prefix-arg))) + (setq n (* (or n 1) (if pixels 1 (frame-char-height)))) + (setq window (or window (selected-window))) + (when (> 0 n) (pdf-roll-scroll-backward (- n) window)) + (let ((pos (goto-char (window-start window)))) + (while (let* ((data (pos-visible-in-window-p (point) window t)) + (occupied-pixels (cond ((nth 2 data) (nth 4 data)) + (data (line-pixel-height)) + (t (pdf-roll-display-page + (pdf-roll-page-at-current-pos) window))))) + (if (eq (point) (- (point-max) 3)) + (prog1 nil + (setq n (min n (max 0 (- occupied-pixels (/ (window-text-height window t) 2))))) + (message "End of buffer")) + (when (>= n occupied-pixels) + (cl-decf n occupied-pixels)))) + (forward-char 4)) + (setf (pdf-view-current-page window) (pdf-roll-page-at-current-pos)) + (pdf-roll-set-vscroll (+ (if (eq pos (point)) (window-vscroll window t) 0) n) + window))) + +(defun pdf-roll-scroll-backward (&optional n window pixels) + "Scroll image N lines backwards in WINDOW. +Line height is determined by `frame-char-height'. When N is negative +scroll forward instead. With a prefix arg N is its numeric value. + +If PIXELS is non-nil N is number of pixels instead of lines." + (interactive (list (prefix-numeric-value current-prefix-arg))) + (setq n (* (or n 1) (if pixels 1 (frame-char-height)))) + (setq window (or window (selected-window))) + (when (> 0 n) (pdf-roll-scroll-backward (- n) window)) + (goto-char (window-start window)) + (let* ((data (pos-visible-in-window-p (point) window t)) + (pixels-top (if (nth 2 data) (nth 2 data) 0))) + (if (< n pixels-top) + (pdf-roll-set-vscroll (- (window-vscroll window t) n) + window) + (cl-decf n pixels-top) + (while (and (if (bobp) + (prog1 nil (message "Beginning of buffer.")) + t) + (progn (forward-char -4) + (pdf-roll-display-page + (pdf-roll-page-at-current-pos) window) + (cl-decf n (line-pixel-height))) + (> n 0))) + (pdf-roll-set-vscroll (- n) window))) + (setf (pdf-view-current-page window) (pdf-roll-page-at-current-pos))) + +(defun pdf-roll-scroll-screen-forward (&optional arg) + "Scroll forward by (almost) ARG many full screens." + (interactive "p") + (pdf-roll-scroll-forward + (- (* (window-text-height nil t) arg) (* next-screen-context-lines (frame-char-height))) + nil t)) + +(defun pdf-roll-scroll-screen-backward (&optional arg) + "Scroll backward by (almost) ARG many full screens." + (interactive "p") + (pdf-roll-scroll-backward + (- (* (window-text-height nil t) arg) (* next-screen-context-lines (frame-char-height))) + nil t)) + +;;; Minor mode +(defun pdf-roll-initialize (&rest _args) + "Fun to initialize `pdf-view-roll-minor-mode'. +It is also added to `revert-buffer-function'." + (let ((inhibit-read-only t)) + (erase-buffer) + (remove-overlays)) + (image-mode-window-put 'displayed-pages nil) + (pdf-roll-new-window-function)) + +;;;###autoload +(define-minor-mode pdf-view-roll-minor-mode + "If enabled display document on a virtual scroll providing continuous scrolling." + :lighter " Continuous" + :keymap (let ((map (make-sparse-keymap))) + (define-key map [remap pdf-view-previous-line-or-previous-page] 'pdf-roll-scroll-backward) + (define-key map [remap pdf-view-next-line-or-next-page] 'pdf-roll-scroll-forward) + (define-key map [remap pdf-view-scroll-down-or-previous-page] 'pdf-roll-scroll-backward) + (define-key map [remap pdf-view-scroll-up-or-next-page] 'pdf-roll-scroll-forward) + (define-key map [remap mouse-set-point] 'ignore) + (define-key map (kbd "S-<next>") 'pdf-roll-scroll-screen-forward) + (define-key map (kbd "S-<prior>") 'pdf-roll-scroll-screen-backward) + map) + :version 28.1 + + (cond (pdf-view-roll-minor-mode + (setq-local face-remapping-alist '((default . pdf-roll-default)) + mwheel-scroll-up-function #'pdf-roll-scroll-forward + mwheel-scroll-down-function #'pdf-roll-scroll-backward) + + (remove-hook 'window-configuration-change-hook 'image-mode-reapply-winprops t) + (remove-hook 'window-configuration-change-hook 'pdf-view-redisplay-some-windows t) + (remove-hook 'image-mode-new-window-functions#'pdf-view-new-window-function t) + + (add-hook 'pre-redisplay-functions 'pdf-roll-pre-redisplay nil t) + (add-hook 'pdf-roll-after-change-page-hook 'pdf-history-before-change-page-hook nil t) + + (add-function :after (local 'revert-buffer-function) #'pdf-roll-initialize) + + (make-local-variable 'pdf-roll--state) + + (when (local-variable-p 'pixel-scroll-precision-mode) + (kill-local-variable 'pixel-scroll-precision-mode) + (kill-local-variable 'mwheel-coalesce-scroll-events)) + + (pdf-roll-initialize)) + (t + (setq-local mwheel-scroll-up-function #'pdf-view-scroll-up-or-next-page + mwheel-scroll-down-function #'pdf-view-scroll-down-or-previous-page) + + (add-hook 'window-configuration-change-hook 'image-mode-reapply-winprops nil t) + (add-hook 'window-configuration-change-hook 'pdf-view-redisplay-some-windows nil t) + (add-hook 'image-mode-new-window-functions #'pdf-view-new-window-function nil t) + + (remove-function (local 'revert-buffer-function) #'pdf-roll-initialize) + + (remove-hook 'pre-redisplay-functions 'pdf-roll-pre-redisplay t) + (remove-hook 'pdf-roll-after-change-page-hook 'pdf-history-before-change-page-hook t) + + (kill-local-variable 'pdf-roll--state) + + (when (bound-and-true-p pixel-scroll-precision-mode) + (setq-local pixel-scroll-precision-mode nil) + (setq-local mwheel-coalesce-scroll-events t)) + + (let ((inhibit-read-only t)) + (remove-overlays) + (image-mode-window-put 'displayed-pages nil) + (pdf-view-new-window-function (list (selected-window))) + (set-buffer-modified-p nil))))) + +(defun pdf-roll--get-display-property () + "`:before-until' advice for `image-get-display-property'. +`image-get-display-property' looks at the `point-min'. This function instead +returns the display property for the current page if `pdf-view-roll-minor-mode' +is non-nil." + (when pdf-view-roll-minor-mode + (get-char-property (pdf-roll-page-to-pos (pdf-view-current-page)) + 'display + (if (eq (window-buffer) (current-buffer)) + (selected-window))))) + +(advice-add 'image-get-display-property :before-until #'pdf-roll--get-display-property) + +(provide 'pdf-roll) + +;;; pdf-roll.el ends here |