org: restrict inline image display to narrowed part
* lisp/org.el (org-display-inline-images): Clarify documentation and introduce the narrowing borders to the function.
This commit is contained in:
Marco Wahl
parent
3649d95b13
commit
43c086f4f7
221
lisp/org.el
221
lisp/org.el
|
|
@ -16661,120 +16661,123 @@ exported files will look like.
|
||||||
|
|
||||||
When optional argument REFRESH is non-nil, refresh existing
|
When optional argument REFRESH is non-nil, refresh existing
|
||||||
images between BEG and END. This will create new image displays
|
images between BEG and END. This will create new image displays
|
||||||
only if necessary. BEG and END default to the buffer
|
only if necessary.
|
||||||
boundaries."
|
|
||||||
|
BEG and END define the considered part. They default to the
|
||||||
|
buffer boundaries with possible narrowing."
|
||||||
(interactive "P")
|
(interactive "P")
|
||||||
(when (display-graphic-p)
|
(when (display-graphic-p)
|
||||||
(unless refresh
|
(unless refresh
|
||||||
(org-remove-inline-images)
|
(org-remove-inline-images)
|
||||||
(when (fboundp 'clear-image-cache) (clear-image-cache)))
|
(when (fboundp 'clear-image-cache) (clear-image-cache)))
|
||||||
(org-with-point-at (or beg 1)
|
(let ((end (or end (point-max))))
|
||||||
(let* ((case-fold-search t)
|
(org-with-point-at (or beg (point-min))
|
||||||
(file-extension-re (image-file-name-regexp))
|
(let* ((case-fold-search t)
|
||||||
(link-abbrevs (mapcar #'car
|
(file-extension-re (image-file-name-regexp))
|
||||||
(append org-link-abbrev-alist-local
|
(link-abbrevs (mapcar #'car
|
||||||
org-link-abbrev-alist)))
|
(append org-link-abbrev-alist-local
|
||||||
;; Check absolute, relative file names and explicit
|
org-link-abbrev-alist)))
|
||||||
;; "file:" links. Also check link abbreviations since
|
;; Check absolute, relative file names and explicit
|
||||||
;; some might expand to "file" links.
|
;; "file:" links. Also check link abbreviations since
|
||||||
(file-types-re
|
;; some might expand to "file" links.
|
||||||
(format "\\[\\[\\(?:file%s:\\|attachment:\\|[./~]\\)\\|\\]\\[\\(<?file:\\)"
|
(file-types-re
|
||||||
(if (not link-abbrevs) ""
|
(format "\\[\\[\\(?:file%s:\\|attachment:\\|[./~]\\)\\|\\]\\[\\(<?file:\\)"
|
||||||
(concat "\\|" (regexp-opt link-abbrevs))))))
|
(if (not link-abbrevs) ""
|
||||||
(while (re-search-forward file-types-re end t)
|
(concat "\\|" (regexp-opt link-abbrevs))))))
|
||||||
(let* ((link (org-element-lineage
|
(while (re-search-forward file-types-re end t)
|
||||||
(save-match-data (org-element-context))
|
(let* ((link (org-element-lineage
|
||||||
'(link) t))
|
(save-match-data (org-element-context))
|
||||||
(linktype (org-element-property :type link))
|
'(link) t))
|
||||||
(inner-start (match-beginning 1))
|
(linktype (org-element-property :type link))
|
||||||
(path
|
(inner-start (match-beginning 1))
|
||||||
(cond
|
(path
|
||||||
;; No link at point; no inline image.
|
(cond
|
||||||
((not link) nil)
|
;; No link at point; no inline image.
|
||||||
;; File link without a description. Also handle
|
((not link) nil)
|
||||||
;; INCLUDE-LINKED here since it should have
|
;; File link without a description. Also handle
|
||||||
;; precedence over the next case. I.e., if link
|
;; INCLUDE-LINKED here since it should have
|
||||||
;; contains filenames in both the path and the
|
;; precedence over the next case. I.e., if link
|
||||||
;; description, prioritize the path only when
|
;; contains filenames in both the path and the
|
||||||
;; INCLUDE-LINKED is non-nil.
|
;; description, prioritize the path only when
|
||||||
((or (not (org-element-property :contents-begin link))
|
;; INCLUDE-LINKED is non-nil.
|
||||||
include-linked)
|
((or (not (org-element-property :contents-begin link))
|
||||||
(and (or (equal "file" linktype)
|
include-linked)
|
||||||
(equal "attachment" linktype))
|
(and (or (equal "file" linktype)
|
||||||
(org-element-property :path link)))
|
(equal "attachment" linktype))
|
||||||
;; Link with a description. Check if description
|
(org-element-property :path link)))
|
||||||
;; is a filename. Even if Org doesn't have syntax
|
;; Link with a description. Check if description
|
||||||
;; for those -- clickable image -- constructs, fake
|
;; is a filename. Even if Org doesn't have syntax
|
||||||
;; them, as in `org-export-insert-image-links'.
|
;; for those -- clickable image -- constructs, fake
|
||||||
((not inner-start) nil)
|
;; them, as in `org-export-insert-image-links'.
|
||||||
(t
|
((not inner-start) nil)
|
||||||
(org-with-point-at inner-start
|
(t
|
||||||
(and (looking-at
|
(org-with-point-at inner-start
|
||||||
(if (char-equal ?< (char-after inner-start))
|
(and (looking-at
|
||||||
org-link-angle-re
|
(if (char-equal ?< (char-after inner-start))
|
||||||
org-link-plain-re))
|
org-link-angle-re
|
||||||
;; File name must fill the whole
|
org-link-plain-re))
|
||||||
;; description.
|
;; File name must fill the whole
|
||||||
(= (org-element-property :contents-end link)
|
;; description.
|
||||||
(match-end 0))
|
(= (org-element-property :contents-end link)
|
||||||
(match-string 2)))))))
|
(match-end 0))
|
||||||
(when (and path (string-match-p file-extension-re path))
|
(match-string 2)))))))
|
||||||
(let ((file (if (equal "attachment" linktype)
|
(when (and path (string-match-p file-extension-re path))
|
||||||
(progn
|
(let ((file (if (equal "attachment" linktype)
|
||||||
(require 'org-attach)
|
(progn
|
||||||
(ignore-errors (org-attach-expand path)))
|
(require 'org-attach)
|
||||||
(expand-file-name path))))
|
(ignore-errors (org-attach-expand path)))
|
||||||
(when (and file (file-exists-p file))
|
(expand-file-name path))))
|
||||||
(let ((width
|
(when (and file (file-exists-p file))
|
||||||
;; Apply `org-image-actual-width' specifications.
|
(let ((width
|
||||||
(cond
|
;; Apply `org-image-actual-width' specifications.
|
||||||
((eq org-image-actual-width t) nil)
|
(cond
|
||||||
((listp org-image-actual-width)
|
((eq org-image-actual-width t) nil)
|
||||||
(or
|
((listp org-image-actual-width)
|
||||||
;; First try to find a width among
|
(or
|
||||||
;; attributes associated to the paragraph
|
;; First try to find a width among
|
||||||
;; containing link.
|
;; attributes associated to the paragraph
|
||||||
(pcase (org-element-lineage link '(paragraph))
|
;; containing link.
|
||||||
(`nil nil)
|
(pcase (org-element-lineage link '(paragraph))
|
||||||
(p
|
(`nil nil)
|
||||||
(let* ((case-fold-search t)
|
(p
|
||||||
(end (org-element-property :post-affiliated p))
|
(let* ((case-fold-search t)
|
||||||
(re "^[ \t]*#\\+attr_.*?: +.*?:width +\\(\\S-+\\)"))
|
(end (org-element-property :post-affiliated p))
|
||||||
(when (org-with-point-at
|
(re "^[ \t]*#\\+attr_.*?: +.*?:width +\\(\\S-+\\)"))
|
||||||
(org-element-property :begin p)
|
(when (org-with-point-at
|
||||||
(re-search-forward re end t))
|
(org-element-property :begin p)
|
||||||
(string-to-number (match-string 1))))))
|
(re-search-forward re end t))
|
||||||
;; Otherwise, fall-back to provided number.
|
(string-to-number (match-string 1))))))
|
||||||
(car org-image-actual-width)))
|
;; Otherwise, fall-back to provided number.
|
||||||
((numberp org-image-actual-width)
|
(car org-image-actual-width)))
|
||||||
org-image-actual-width)
|
((numberp org-image-actual-width)
|
||||||
(t nil)))
|
org-image-actual-width)
|
||||||
(old (get-char-property-and-overlay
|
(t nil)))
|
||||||
(org-element-property :begin link)
|
(old (get-char-property-and-overlay
|
||||||
'org-image-overlay)))
|
(org-element-property :begin link)
|
||||||
(if (and (car-safe old) refresh)
|
'org-image-overlay)))
|
||||||
(image-refresh (overlay-get (cdr old) 'display))
|
(if (and (car-safe old) refresh)
|
||||||
(let ((image (create-image file
|
(image-refresh (overlay-get (cdr old) 'display))
|
||||||
(and (image-type-available-p 'imagemagick)
|
(let ((image (create-image file
|
||||||
width 'imagemagick)
|
(and (image-type-available-p 'imagemagick)
|
||||||
nil
|
width 'imagemagick)
|
||||||
:width width)))
|
nil
|
||||||
(when image
|
:width width)))
|
||||||
(let ((ov (make-overlay
|
(when image
|
||||||
(org-element-property :begin link)
|
(let ((ov (make-overlay
|
||||||
(progn
|
(org-element-property :begin link)
|
||||||
(goto-char
|
(progn
|
||||||
(org-element-property :end link))
|
(goto-char
|
||||||
(skip-chars-backward " \t")
|
(org-element-property :end link))
|
||||||
(point)))))
|
(skip-chars-backward " \t")
|
||||||
(overlay-put ov 'display image)
|
(point)))))
|
||||||
(overlay-put ov 'face 'default)
|
(overlay-put ov 'display image)
|
||||||
(overlay-put ov 'org-image-overlay t)
|
(overlay-put ov 'face 'default)
|
||||||
(overlay-put
|
(overlay-put ov 'org-image-overlay t)
|
||||||
ov 'modification-hooks
|
(overlay-put
|
||||||
(list 'org-display-inline-remove-overlay))
|
ov 'modification-hooks
|
||||||
(overlay-put ov 'keymap image-map)
|
(list 'org-display-inline-remove-overlay))
|
||||||
(push ov org-inline-image-overlays)))))))))))))))
|
(overlay-put ov 'keymap image-map)
|
||||||
|
(push ov org-inline-image-overlays))))))))))))))))
|
||||||
|
|
||||||
(defun org-display-inline-remove-overlay (ov after _beg _end &optional _len)
|
(defun org-display-inline-remove-overlay (ov after _beg _end &optional _len)
|
||||||
"Remove inline-display overlay if a corresponding region is modified."
|
"Remove inline-display overlay if a corresponding region is modified."
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue