org-mode inline images display with `insert-sliced-image`
When displaying inline images in org-mode it sort of acts like a single line. Like this it is impossible to scroll through a big image. Emacs will jump to the top of the image then just after it.
Really would like to get sliced image display working with org-mode, so that I can view bigger inline images without having to open them in a new window and play with zoom.
What I aim for is something shown in the latter part of this gif:
NOTE: this gif isn't showing org-mode, I know this. But this type of image display would be really-really nice in org-mode. Source of the gif: emacs-hnreader
This sliced image is an Emacs feature: https://www.gnu.org/software/emacs/manual/html_node/elisp/Showing-Images.html
There was also a question about this over on emacs SO, but never got any attention: https://emacs.stackexchange.com/questions/40550/org-mode-and-insert-sliced-image
Solution
This effect can be achieved by copying the insert-sliced-image loop into org-display-inline-images and tracking the resulting lists of overlays, instead of single overlays as is currently done. Putting the following in your init.el after requiring org should do the trick. (inspiration from https://github.com/thanhvg/emacs-hnreader)
;; Image display
(defvar-local org-inline-image-overlay-families nil
"A list of elements corresponding to displayed inline images in the
current buffer. Each element is a list of overlays making up the
displayed image.
The first element in each list is an overlay over the dummy characters
inserted to position the slices. The remaining elements are the slices
themselves; the last element is the topmost slice.")
(put 'org-inline-image-overlay-families 'permanent-local t)
(defun org--delete-inline-image-overlay-family (ovfam)
"Delete the overlay family OVFAM from its buffer."
(dolist (ov (cdr ovfam))
(delete-overlay ov))
(delete-region (overlay-start (car ovfam)) (1+ (overlay-end (car ovfam)))))
(defun org--inline-image-overlay-families (&optional beg end)
"Return image overlay families which start between BEG and END."
(let* ((beg (or beg (point-min)))
(end (or end (point-max)))
(overlays (overlays-in beg end))
result)
(dolist (ovfam org-inline-image-overlay-families result)
(when (memq (car (last ovfam)) overlays)
(push ovfam result)))))
(defun org-toggle-inline-images (&optional include-linked beg end)
"Toggle the display of inline images.
INCLUDE-LINKED is passed to `org-display-inline-images'."
(interactive "P")
(if (org--inline-image-overlay-families beg end)
(progn
(org-remove-inline-images beg end)
(when (called-interactively-p 'interactive)
(message "Inline image display turned off")))
(org-display-inline-images include-linked nil beg end)
(when (called-interactively-p 'interactive)
(let ((new (org--inline-image-overlay-families beg end)))
(message (if new
(format "%d images displayed inline"
(length new))
"No images to display inline"))))))
(defun org--make-inline-image-overlay (start end spec)
"Make overlay from START to END with display value SPEC.
The overlay is returned."
(let ((ov (make-overlay start end)))
(overlay-put ov 'display spec)
(overlay-put ov 'face 'default)
(overlay-put ov 'org-image-overlay t)
(overlay-put ov 'modification-hooks
(list 'org-display-inline-remove-overlay-family))
(when (boundp 'image-map)
(overlay-put ov 'keymap image-map))
ov))
(defun org-display-inline-images (&optional include-linked refresh beg end)
"Display inline images.
An inline image is a link which follows either of these
conventions:
1. Its path is a file with an extension matching return value
from `image-file-name-regexp' and it has no contents.
2. Its description consists in a single link of the previous
type. In this case, that link must be a well-formed plain
or angle link, i.e., it must have an explicit \"file\" or
\"attachment\" type.
Equip each image with the key-map `image-map'.
When optional argument INCLUDE-LINKED is non-nil, also links with
a text description part will be inlined. This can be nice for
a quick look at those images, but it does not reflect what
exported files will look like.
When optional argument REFRESH is non-nil, refresh existing
images between BEG and END. This will create new image displays
only if necessary.
BEG and END define the considered part. They default to the
buffer boundaries with possible narrowing."
(interactive "P")
(when (display-graphic-p)
(when refresh
(org-remove-inline-images beg end)
(when (fboundp 'clear-image-cache) (clear-image-cache)))
(let ((end (or end (point-max))))
(org-with-point-at (or beg (point-min))
(let* ((case-fold-search t)
(file-extension-re (image-file-name-regexp))
(link-abbrevs (mapcar #'car
(append org-link-abbrev-alist-local
org-link-abbrev-alist)))
;; Check absolute, relative file names and explicit
;; "file:" links. Also check link abbreviations since
;; some might expand to "file" links.
(file-types-re
(format "\\[\\[\\(?:file%s:\\|attachment:\\|[./~]\\)\\|\\]\\[\\(<?\\(?:file\\|attachment\\):\\)"
(if (not link-abbrevs) ""
(concat "\\|" (regexp-opt link-abbrevs))))))
(while (re-search-forward file-types-re end t)
(let* ((link (org-element-lineage
(save-match-data (org-element-context))
'(link) t))
(linktype (org-element-property :type link))
(inner-start (match-beginning 1))
(path
(cond
;; No link at point; no inline image.
((not link) nil)
;; File link without a description. Also handle
;; INCLUDE-LINKED here since it should have
;; precedence over the next case. I.e., if link
;; contains filenames in both the path and the
;; description, prioritize the path only when
;; INCLUDE-LINKED is non-nil.
((or (not (org-element-property :contents-begin link))
include-linked)
(and (or (equal "file" linktype)
(equal "attachment" linktype))
(org-element-property :path link)))
;; Link with a description. Check if description
;; is a filename. Even if Org doesn't have syntax
;; for those -- clickable image -- constructs, fake
;; them, as in `org-export-insert-image-links'.
((not inner-start) nil)
(t
(org-with-point-at inner-start
(and (looking-at
(if (char-equal ?< (char-after inner-start))
org-link-angle-re
org-link-plain-re))
;; File name must fill the whole
;; description.
(= (org-element-property :contents-end link)
(match-end 0))
(progn
(setq linktype (match-string 1))
(match-string 2))))))))
(when (and path (string-match-p file-extension-re path))
(let ((file (if (equal "attachment" linktype)
(progn
(require 'org-attach)
(ignore-errors (org-attach-expand path)))
(expand-file-name path))))
(when (and file (file-exists-p file))
(let ((width (org-display-inline-image--width link))
(old (get-char-property-and-overlay
(org-element-property :begin link)
'org-image-overlay)))
(if (and (car-safe old) refresh)
(image-flush (overlay-get (cdr old) 'display))
(let ((image (org--create-inline-image file width)))
(when image
(let* ((image-pixel-cons (image-size image t))
(image-pixel-h (cdr image-pixel-cons))
(y 0.0) (dy (/ (default-font-height) image-pixel-h 1.0))
(dummy-zone-start nil)
(dummy-zone-end nil)
(ovfam nil))
(image-flush image)
(org-with-point-at (org-element-property :begin link)
(while (< y 1.0)
(if (= y 0.0)
;; Overlay link
(push (org--make-inline-image-overlay
(point)
(org-element-property :end link)
(list (list 'slice 0 0.0 1.0 dy) image))
ovfam)
;; Overlay dummy lines
(move-end-of-line 1)
(insert (propertize "\n" 'line-height t))
(let ((start (point)))
(insert " ")
(if (not dummy-zone-start)
(setq dummy-zone-start (pos-bol)))
(push (org--make-inline-image-overlay
start
(point)
(list (list 'slice 0 y 1.0 dy) image))
ovfam)))
(setq y (+ y dy)))
(setq dummy-zone-end (point)))
(push (make-overlay dummy-zone-start dummy-zone-end) ovfam)
(push ovfam org-inline-image-overlay-families))))))))))))))))
(defun org-display-inline-remove-overlay-family (ov after _beg _end &optional _len)
"Remove inline-display overlay family if a corresponding region is modified."
(when (and ov after)
(when (overlay-get ov 'org-image-overlay)
(image-flush (overlay-get ov 'display))) ;; cdr here?
(catch 'break
(dolist (ovfam org-inline-image-overlay-families)
(when (memq ov ovfam)
(setq org-inline-image-overlay-families
(delq ovfam org-inline-image-overlay-families))
(org--delete-inline-image-overlay-family ovfam)
(throw 'break))))))
(defun org-remove-inline-images (&optional beg end)
"Remove inline display of images which start between BEG and END."
(interactive)
(let* ((beg (or beg (point-min)))
(end (or end (point-max)))
(overlays (overlays-in beg end)))
(dolist (ovfam org-inline-image-overlay-families)
(when (memq (car (last ovfam)) overlays)
(setq org-inline-image-overlay-families
(delq ovfam org-inline-image-overlay-families))
(org--delete-inline-image-overlay-family ovfam)))))
- how to copy hyperlinks to emacs?
- How to [tar and] compress marked files in Emacs
- PHP syntax highlighter for Emacs
- Starting a simple program in Clojure in emacs cider and getting "No such namespace: hello"
- Emacs: how to bind a key tapped twice?
- Centre Emacs buffer within window
- Execute Perl in Emacs, most basic
- delete line backwards (Emacs)
- Emacs disable mouse-1 in dired
- How do I duplicate a whole line in Emacs?
- How to step through some Common Lisp code, inspecting the return value of forms?
- emacs markdown mode selecting org-mode header level?
- How to convert list to string in Emacs Lisp
- How to load program reading stdin and taking parameters in gdb?
- How to make org-capture open buffers in new vertical split window in emacs?
- Emacs and tree-sitter: Problems with installing c++ language grammar
- unbound slot only in child class but not in parent
- rlanguageserver: Disable specific linter and avoid line-breaking
- How can one quickly browse through lots of files in Emacs?
- self-contained portable emacs
- Emacs preview-latex to format python comments and docstrings
- Is there a emacs valgrind interface?
- How can I re-enable ctrl-s inside Emacs inside GNU screen?
- How to make a link to external file line in Emacs org-mode
- Emacs error when loading a created file into .emacs
- in Emacs, how to enable automatic hiding of dired details?
- Set variable under specific mode emacs
- How do I prevent org-mode from executing all of the babel source blocks?
- Emacs org-mode, repeat tasks M-F but not weekends?
- In Emacs, how to automatically enable a minor mode based on buffer name?