unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
From: dalanicolai <dalanicolai@gmail.com>
To: Po Lu <luangruo@yahoo.com>
Cc: Emacs Devel <emacs-devel@gnu.org>
Subject: Re: Question about (excessive?) ram usage when many overlays (with large vscroll)
Date: Thu, 28 Apr 2022 18:28:10 +0200	[thread overview]
Message-ID: <CACJP=3n6AnVSQyejmi8Ki9U_m9HXKOBTEsjA4sMJQ3krbxp6ig@mail.gmail.com> (raw)
In-Reply-To: <87zgk5za1w.fsf@yahoo.com>


[-- Attachment #1.1: Type: text/plain, Size: 3879 bytes --]

Thank you Po, for your explanations. Indeed this clears things
up a little, but unfortunately my question was not 'precise enough',
for the answer to 'solve' the issue that motivated this question.
(I wanted to keep my `image-mode.el` out of the question, but I
guess it is necessary to add it to explain the issue I am experiencing).

So I have rewritten `image-mode.el` to scroll by `line + vscroll` instead
of using vscroll only. This solves the issue with the RAM usage for
'large documents'.
Additionally, it made the code a little 'simpler', which is a welcome 'side
effect'
(I got rid of the 'gap' (page separation) overlays, and instead added
margins
 to the images. So now the buffer contents is just single spaces  on
separate
lines, where the number of lines is equal to the number of `images/pages`.
The 'gap' color can be configured by adding the overlay's face background).
It seems to work mostly correct (the 'scrolling' look a tiny bit less
smooth than
with the pure vscroll version, but I would say it is very acceptable).

Anyway, I hope someone can quickly have a look at the issue explained below
(this should take less than a minute). So let me quickly provide some
context
for the issue.

Currently, each overlay is overlaid on a single space on separate lines. So
the
contents of the buffer is a single space (holding a page overlay) on every
line.
So to jump to the next page, I can simply use 'forward-line'. Now this
works fine
when the page is 'off-window` but when the next page is already within view
('on-window'), then going to the next line does not position that line at
the top of
the window, nor makes it the current `window-start. To get it at the top of
the
 window, I could subsequently call `(set-window-start nil (point))`,
but then subsequently, `set-window-vscroll` does not work. To make
`set-window-vscroll` have effect, I can add a `redisplay` just before I
call it.
This works, but the 'jump' gets very/unacceptably ugly (you see the
'recentering'
steps taking place).

However, when the next page is 'off-window' than using the 'forward-line'
works
directly, and the page jump looks smooth.

So to reproduce it from `emacs -Q` you can just load the `image-roll.el`
file that I
will attach here, then do `M-x image-roll-demo` and scroll down using the
arrow
keys until you see the page transition between page one and two. Now press
the
`page down` (PgDn) button to jump to the next page.

Because page two is already 'on-window' this only moves the cursor one page
down.

If you now press a second time `PgDn` then, because page 3 is still
`off-window`,
the jump takes place how it should.

I would be happy, if someone could tell me how I could 'solve' this issue.
Otherwise,
all scrolling functions work fine, although I did not yet take care of the
'edge cases'
(i.e. first and last page). Also, I did not update the docstrings yet, so I
am not asking
for feedback on those. My only question is if someone could have a look at
what I am
describing above.

On Thu, 28 Apr 2022 at 14:07, Po Lu <luangruo@yahoo.com> wrote:

> dalanicolai <dalanicolai@gmail.com> writes:
>
> > I have a question about this, namely: how to make a line the 'window
> > start'?  Using 'set-window-start` does not work.
> >
> > From 'emacs -Q' (which starts within the scratch buffer), immediately
> > evaluate
> >
> > (set-window-start nil (point))
> >
> > to set the 'new' window start. Subsequently do
> >
> > (set-window-vscroll nil 1)
> >
> > it will scroll from the start of the buffer, and not from the 'new'
> > window start as I would expect
>
> That's because the point is obscured after the vscroll is applied, so
> the display is recentered.  You have to move point to some location that
> is at least partially visible after the vscroll if you set
> `make-cursor-line-fully-visible' to t, or a location that is fully
> visible otherwise.
>

[-- Attachment #1.2: Type: text/html, Size: 5086 bytes --]

[-- Attachment #2: image-roll.el --]
[-- Type: text/x-emacs-lisp, Size: 18228 bytes --]

(require 'image-mode)
(require 'svg)

(defgroup image-roll nil
  "Image roll configurations.")

(defcustom image-roll-vertical-margin 2
  "Page gap height."
  :type 'integer)

(defcustom image-roll-step-size
  (lambda ()
    (let* ((o (image-roll-page-overlay))
           (s (overlay-get o 'display))
           (w (image-property s :width)))
      (if w
          (* 50
             (/  (float (if (consp w) (car w) w))
                 (window-pixel-height)))
        50)))
  "Scroll step size.
The value can be either a number or a function that takes no
arguments and returns a positive number. If the number is equal
to or larger than 1, it represents pixel units. Otherwise, if the
value is between 0 and 1, it represents a fraction of the current
page height."
  :type '(choice function interger float))

(defcustom image-roll-center nil
  "When non-nil, center the roll horizontally in the window."
  :type 'boolean)


(defvar-local image-roll-number-of-pages-function nil
  "Function that should return the total number of pages.
The function should return an integer with the total number of
pages in the document.")

(defvar-local image-roll-page-sizes-function nil
  "Function that should return page-sizes of document.
The function should return a list of conses of the form (WIDTH .
HEIGHT), both numbers.")

(defvar-local image-roll-set-redisplay-flag-function nil)

(defvar-local image-roll-display-page 'image-roll-demo-display-page
  "Function that sets the overlay's display property.
The function receives the page number as a single
argument (PAGE). The function should use `(image-roll-page-overlay
PAGE)' to add the image of the page as the overlay's
display-property.")

(defmacro image-roll-debug (object)
  `(progn (print (format "%s = %s" ,object (eval ,object))
                 #'external-debugging-output)
          (eval ,object)))

;; define as macro's for setf-ability

;; TODO update docstring
(defmacro image-roll-overlays (&optional window)
  "List of overlays that make up a scroll.
Overlays with an even index hold the page-overlays, where the
overlay at index 0 holds page number 1. For each page, except for
the last page, the subsequent element holds the gap-overlay."
  `(image-mode-window-get 'overlays ,window))

(defmacro image-roll-page-overlay (&optional page)
  "Return the overlay that hold page number PAGE.
Implemented as macro to make it setf'able."
  `(nth (1- ,page) (image-roll-overlays)))

(defmacro image-roll-page-overlay-get (page prop)
  "Get overlay-property PROP of overlay holding page number PAGE.
Implemented as macro to make it setf'able."
  `(overlay-get (nth (1- ,page) (image-roll-overlays))
                ,prop))

(defmacro image-roll-current-page (&optional window)
  "Return the page number of the currently displayed page.
The current page is the page that overlaps with the window
start (this choice was made in order to simplify the scrolling
logic)"
  `(image-mode-window-get 'page ,window))

(defun image-roll-overlay-height (page)
  (+ (cdr (image-roll-page-overlay-get page 'page-size))
     (* 2 image-roll-vertical-margin)))

(defun image-roll-visible-overlays ()
  "Page numbers corresponding of currently visible overlays.
The numbers are returned in a list. Overlays that are only
partially visible are included."
  (let* (visible
         (page (image-roll-current-page))
         (available-height (window-pixel-height)))

    (push page visible)
    (cl-decf available-height (- (image-roll-overlay-height page)
                                 (window-vscroll nil t)))
    (cl-incf page)

    (while (> available-height 0)
      (push page visible)
      (cl-decf available-height (image-roll-overlay-height page))
      (cl-incf page))
    visible))

(defun image-roll-undisplay-page (page)
  "Undisplay PAGE.
The function replaces the image display property of the overlay
holding PAGE with a space. It size is determined from the image
its `image-size'."
  (display-warning '(image-roll) (format "undisplay %s" page)
                   :debug "*image-roll-debug-log*")
  (let* ((o (image-roll-page-overlay page))
         (im (overlay-get o 'display))
         (s (image-size im t))
         (w (car s))
         (h (cdr s)))
    (overlay-put o 'display `(space . (:width (,w) :height (,h))))
    (overlay-put o 'face `(:background "gray"))))

(defun image-roll--new-window-function (winprops)
  "Function called first after displaying buffer in a new window.
If the buffer is newly created, then it does not contain any
overlay and this function creates erases the buffer contents
after which it inserts empty spaces that each holds a page or gap
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."
  ;; (if (= (buffer-size) 0)
  (if (not (overlays-at 1))
      (let (overlays
            (pages (if image-roll-number-of-pages-function
                       (funcall image-roll-number-of-pages-function)
                     image-roll-demo-number-of-pages))
            (win (car winprops))
            (inhibit-read-only t))

        (erase-buffer)

        ;; here we only add the 'page' and 'window' overlay-properties, we add
        ;; more properties/information as soon as it becomes available in the
        ;; 'image-roll-display' function
        (dotimes (i pages)
          (let ((i (1+ i)))
            (insert " ")
            (let ((po (make-overlay (1- (point)) (point))))
              (overlay-put po 'page  i)
              (overlay-put po 'window win)
              (push po overlays))
            (insert "\n")))
        (delete-char -1)
        (image-mode-window-put 'overlays (nreverse overlays))
        (set-buffer-modified-p nil)

        ;; we must put the cursor at the `point-min' for the vscroll
        ;; functionality to work. It is only required here because we will never
        ;; move the cursor (we will merely update overlay properties and vscroll)
        ;; (goto-char (point-min))

        ;; required to make `pdf-view-redisplay-some-windows' call `pdf-view-redisplay'
        (when-let (fun image-roll-set-redisplay-flag-function)
          (funcall fun)))
    (let ((ols (mapcar (lambda (o)
                         (let ((oc (copy-overlay o)))
                           (overlay-put oc 'window (car winprops))
                           oc))
                       (image-roll-overlays))))
      (image-mode-window-put 'overlays ols winprops)))
  (image-roll-goto-page 1))

(defun image-roll--redisplay (&optional window no-relative-vscroll)
  "Redisplay the scroll.
Besides that this function can be called directly, it should also
be added to the `window-configuration-change-hook'.

The argument WINDOW is not use in the body, but it exists to make
the function compatible with `pdf-tools' (in which case is a
substitute for `pdf-view-redisplay').

When NO-RELATIVE-SCROLL is non-nil, then the relative-scroll is
not included when setting teh vscroll position. For example this
is used in `pdf-view-goto-page' (in the `pdf-scroll.el'
extension) to make it scroll to the start of the page."
  (display-warning '(image-roll) (format "redisplay %s" (car (image-mode-winprops))) :debug "*image-roll-debug-log*")

  ;; NOTE the `(when (listp image-mode-winprops-alist)' from
  ;; `image-mode-reapply-winprops' was removed here (but in the end might turn
  ;; out to be required)

  ;; Beware: this call to image-mode-winprops can't be optimized away, because
  ;; it not only gets the winprops data but sets it up if needed (e.g. it's used
  ;; by doc-view to display the image in a new window).
  (image-mode-winprops nil t)
  (let* ((pages image-roll-demo-number-of-pages)
         ;; (page-sizes (make-list pages (cons (- (window-text-width nil t) 200)
         ;;                                    (* 1.4 (window-text-width nil t)))))
         (page-sizes (if image-roll-page-sizes-function
                         (funcall image-roll-page-sizes-function)
                       (make-list pages (if (functionp image-roll-demo-page-size)
                                            (funcall image-roll-demo-page-size)
                                          image-roll-demo-page-size))))
         ;; (let ((w (window-pixel-width)))
         ;;   (make-list pages (cons w (* 1.4 w))))))

         (n 0))
         ;; (vpos 0))

    (dolist (page-size page-sizes)
      (let* ((page-width (car page-size))
             (overley-heigth (+ (cdr page-size) (* 2 image-roll-vertical-margin)))
             (o (nth n (image-roll-overlays))))
        (when image-roll-center
          (overlay-put o 'before-string
                       (when (> (window-pixel-width) page-width)
                         (propertize " " 'display
                                     `(space :align-to
                                             (,(floor (/ (- (window-pixel-width) page-width) 2))))))))
        (overlay-put o 'display `(space . (:width (,page-width) :height (,overley-heigth))))
        (overlay-put o 'face `(:background "gray"))
        (overlay-put o 'page-size page-size)
        (setq n (+ n 1)))))
  ;; (let ((current-page (car (image-mode-window-get 'displayed-pages))))
  (let (displayed)
    (dolist (p (image-roll-visible-overlays))
      (funcall image-roll-display-page p)
      (push p displayed))
  ;; (image-mode-window-put 'page (car (last displayed))) ; TODO check if possible to use 'displayed-pages
  (image-mode-window-put 'displayed-pages (reverse displayed))
  (image-mode-window-put 'visible-pages-vscroll-limit
                         (- (apply #'+ (mapcar #'image-roll-overlay-height displayed))
                            (window-text-height nil t))))
  (when-let (p (image-roll-current-page))
    (goto-line p)
    ;; (redisplay)
    (image-set-window-vscroll (or (image-mode-window-get 'vscroll) 10))))

(defun image-roll-goto-page (page &optional window)
  "Go to PAGE in PDF.

If optional parameter WINDOW, go to PAGE in all `pdf-view'
windows."
  (interactive
   (list (if current-prefix-arg
             (prefix-numeric-value current-prefix-arg)
           (read-number "Page: "))))
  (unless (and (>= page 1)
               (<= page (count-lines (point-min) (point-max))))
    (error "No such page: %d" page))
  ;; (unless window
  ;;   (setq window
  ;;         (if (pdf-util-pdf-window-p)
  ;;             (selected-window)
  ;;           t)))
  (save-selected-window
    ;; Select the window for the hooks below.
    (when (window-live-p window)
      (select-window window 'norecord))
    (let ((changing-p
           (not (eq page (image-roll-current-page window)))))
      (when changing-p
        ;; (run-hooks 'pdf-view-before-change-page-hook)
        (setf (image-roll-current-page window) page)
        ;; (run-hooks 'pdf-view-change-page-hook))
      (when (window-live-p window)
        (image-roll--redisplay window))
      ;; (when changing-p
      ;;   (pdf-view-deactivate-region)
      ;;   (force-mode-line-update)
      ;;   (run-hooks 'pdf-view-after-change-page-hook))))
  nil))))

(defun image-roll-update-displayed-pages ()
  (let ((old (print (image-mode-window-get 'displayed-pages) #'external-debugging-output))
        (new (print (image-roll-visible-overlays) #'external-debugging-output)))
    ;; dolist because if images/pages are small enough, there might be
    ;; multiple image that need to get updated
    (dolist (p (cl-set-difference old new))
      (image-roll-undisplay-page p)
      (image-mode-window-put 'displayed-pages
                             (setq old (delete p old)))) ; important to update/setq old before
    ;; setting/appending new below
    (dolist (p (cl-set-difference new old))
      (funcall image-roll-display-page p)
      (image-mode-window-put 'displayed-pages (setq old (append old (list p)))))
    ;; update also visible-range
    (image-mode-window-put 'visible-pages-vscroll-limit
                           (- (apply #'+ (mapcar #'image-roll-overlay-height new))
                              (window-text-height nil t)))))

(defun image-roll-next-page (&optional n)
  (interactive)
  (cl-incf (image-roll-current-page) (or n 1))
  ;; (set-window-start nil (+ (point) 2))
  (image-roll--redisplay))

(defun image-roll-previous-page ()
  (interactive)
  (image-roll-next-page -1))

(defun image-roll-scroll-forward (&optional backward screen)
  (interactive)
  (let* ((current-page (image-roll-current-page))
         (current-overlay-height (image-roll-overlay-height current-page))
         (visible-pages-vscroll-limit (image-mode-window-get 'visible-pages-vscroll-limit))
         (step-size (if screen
                        (window-text-height nil t)
                      image-roll-step-size))

         ;; determine number of pages to forward/backward
         ;; (required if pages are small)
         (n 0)
         (available-height step-size)
         (remaining-height available-height)
         new-vscroll)
    (cond (backward
           (cl-decf available-height (window-vscroll nil t))
           (while (> available-height 0)
             (setq remaining-height available-height)
             (setq n (1+ n))
             (cl-decf available-height (image-roll-overlay-height (- current-page n))))
           (setq n (- n)))
          (t
           (cl-decf available-height (- (image-roll-overlay-height current-page)
                                        (window-vscroll nil t)))
           (while (> available-height 0)
             (setq remaining-height available-height)
             (setq n (1+ n))
             (cl-decf available-height (image-roll-overlay-height (+ current-page n))))))

    (when backward
      (setq step-size (- step-size)))

    (image-roll-debug 'n)

    (if (= n 0)
        (setq new-vscroll (+ (window-vscroll nil t) step-size))
      (setq new-vscroll (+ (window-vscroll nil t) remaining-height)))


    (if (cond ((< n 0)
               (forward-line n)
               (cl-decf (image-roll-current-page))
               (image-set-window-vscroll
                (- (image-roll-overlay-height (image-roll-current-page))
                   remaining-height)))
              ((> n 0)
               (forward-line n)
               (cl-incf (image-roll-current-page) n)
               (image-set-window-vscroll
                remaining-height))
              ((> (image-roll-debug 'new-vscroll)
                  (image-roll-debug 'visible-pages-vscroll-limit))
               (image-set-window-vscroll new-vscroll)))
        (image-roll-update-displayed-pages)
      (image-set-window-vscroll new-vscroll))))

(defun image-roll-scroll-backward ()
  (interactive)
  (image-roll-scroll-forward t))

(defun image-roll-scroll-screen-forward ()
  (interactive)
  (image-roll-scroll-forward nil t))

(defun image-roll-scroll-screen-backward ()
  (interactive)
  (image-roll-scroll-forward t t))

(defun image-roll-demo-display-page (page)
  "Return demo image of page.
This function is used for the image-roll-demo."
  (image-roll-debug 'page)
  (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-configuration-change-hook 'image-roll--redisplay 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 "<down>") 'image-roll-scroll-forward)
        (define-key map (kbd "<up>") 'image-roll-scroll-backward)
        (define-key map (kbd "<next>") 'image-roll-next-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)
        map))

(when (featurep 'evil)
  (evil-define-key 'motion image-roll-mode-map
    "j" 'image-roll-scroll-forward
    "k" 'image-roll-scroll-backward
    "J" 'image-roll-next-page
    "K" 'image-roll-previous-page
    (kbd "C-j") 'image-roll-scroll-screen-forward
    (kbd "C-k") 'image-roll-scroll-screen-backward))

(defun image-roll-demo (&optional page-size pages)
  (interactive)
  (with-current-buffer (get-buffer-create "*image-roll-demo*")
    (erase-buffer)
    (image-roll-mode)
    (setq cursor-type nil)
    (setq image-roll-step-size 50)
    (setq-local image-roll-demo-page-size (or page-size
                                              (lambda ()
                                                (let ((w (window-pixel-width)))
                                                  (cons w (* 1.4 w))))))
    (setq-local image-roll-demo-number-of-pages (or pages 1000))
    (setq image-roll-center t)
    (switch-to-buffer (current-buffer))))

  reply	other threads:[~2022-04-28 16:28 UTC|newest]

Thread overview: 13+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2022-04-26 12:21 Question about (excessive?) ram usage when many overlays (with large vscroll) dalanicolai
2022-04-26 12:33 ` Eli Zaretskii
2022-04-26 13:24   ` Eli Zaretskii
2022-04-27 14:13     ` dalanicolai
2022-04-27 15:44       ` Eli Zaretskii
2022-04-27 17:13       ` Stefan Monnier
2022-04-27 17:18         ` Eli Zaretskii
2022-04-26 12:49 ` Po Lu
2022-04-27 14:01   ` dalanicolai
2022-04-28 11:56   ` dalanicolai
2022-04-28 12:06     ` Po Lu
2022-04-28 16:28       ` dalanicolai [this message]
2022-04-28 16:48         ` dalanicolai

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to='CACJP=3n6AnVSQyejmi8Ki9U_m9HXKOBTEsjA4sMJQ3krbxp6ig@mail.gmail.com' \
    --to=dalanicolai@gmail.com \
    --cc=emacs-devel@gnu.org \
    --cc=luangruo@yahoo.com \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).