summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2019-02-22 14:15:33 +0100
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2019-02-22 15:15:20 +0100
commit93c3d9d281cc3c7c447a248d6d8b00f14e72b52f (patch)
treef8349247bdf926404863cdff4f8076964d0d827c
parent29fe5a7d7f24d131567e87672c832d4cae1cb799 (diff)
downloadorg-mode-93c3d9d281cc3c7c447a248d6d8b00f14e72b52f.tar.gz
Fix `org-display-inline-images' with "clickable images"
* lisp/org.el (org-display-inline-images): Even though Org syntax doesn't support nested links, display an image when the function is called on a link that contains a single file name in its description. Reported-by: "Dietrich Foethke" <foethke@web.de> <http://lists.gnu.org/r/emacs-orgmode/2019-02/msg00280.html>
-rw-r--r--lisp/org.el192
1 files changed, 108 insertions, 84 deletions
diff --git a/lisp/org.el b/lisp/org.el
index 1d9e984..b44b61c 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -18752,7 +18752,8 @@ conventions:
from `image-file-name-regexp' and it has no contents.
2. Its description consists in a single link of the previous
- type.
+ type. In this case, that link must be a well-formed plain
+ or angle link, i.e., it must have an explicit \"file\" type.
When optional argument INCLUDE-LINKED is non-nil, also links with
a text description part will be inlined. This can be nice for
@@ -18768,89 +18769,112 @@ boundaries."
(unless refresh
(org-remove-inline-images)
(when (fboundp 'clear-image-cache) (clear-image-cache)))
- (org-with-wide-buffer
- (goto-char (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\\)"
- (if (not link-abbrevs) ""
- (format "\\|\\(?:%s:\\)"
- (regexp-opt link-abbrevs))))))
- (while (re-search-forward file-types-re end t)
- (let ((link (save-match-data (org-element-context))))
- ;; Check if we're at an inline image, i.e., an image file
- ;; link without a description (unless INCLUDE-LINKED is
- ;; non-nil).
- (when (and (equal "file" (org-element-property :type link))
- (or include-linked
- (null (org-element-contents link)))
- (string-match-p file-extension-re
- (org-element-property :path link)))
- (let ((file (expand-file-name
- (org-link-unescape
- (org-element-property :path link)))))
- (when (file-exists-p file)
- (let ((width
- ;; Apply `org-image-actual-width' specifications.
- (cond
- ((not (image-type-available-p 'imagemagick)) nil)
- ((eq org-image-actual-width t) nil)
- ((listp org-image-actual-width)
- (or
- ;; First try to find a width among
- ;; attributes associated to the paragraph
- ;; containing link.
- (let ((paragraph
- (let ((e link))
- (while (and (setq e (org-element-property
- :parent e))
- (not (eq (org-element-type e)
- 'paragraph))))
- e)))
- (when paragraph
- (save-excursion
- (goto-char (org-element-property :begin paragraph))
- (when
- (re-search-forward
- "^[ \t]*#\\+attr_.*?: +.*?:width +\\(\\S-+\\)"
- (org-element-property
- :post-affiliated paragraph)
- t)
- (string-to-number (match-string 1))))))
- ;; Otherwise, fall-back to provided number.
- (car org-image-actual-width)))
- ((numberp org-image-actual-width)
- org-image-actual-width)))
- (old (get-char-property-and-overlay
- (org-element-property :begin link)
- 'org-image-overlay)))
- (if (and (car-safe old) refresh)
- (image-refresh (overlay-get (cdr old) 'display))
- (let ((image (create-image file
- (and width 'imagemagick)
- nil
- :width width)))
- (when image
- (let ((ov (make-overlay
- (org-element-property :begin link)
- (progn
- (goto-char
- (org-element-property :end link))
- (skip-chars-backward " \t")
- (point)))))
- (overlay-put ov 'display image)
- (overlay-put ov 'face 'default)
- (overlay-put ov 'org-image-overlay t)
- (overlay-put
- ov 'modification-hooks
- (list 'org-display-inline-remove-overlay))
- (push ov org-inline-image-overlays)))))))))))))))
+ (org-with-point-at (or beg 1)
+ (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:\\|[./~]\\)\\|\\]\\[\\(<?file:\\)"
+ (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))
+ (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 (equal "file" (org-element-property :type link))
+ (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-angle-link-re
+ org-plain-link-re))
+ ;; File name must fill the whole
+ ;; description.
+ (= (org-element-property :contents-end link)
+ (match-end 0))
+ (match-string 2)))))))
+ (when (and path (string-match-p file-extension-re path))
+ (let ((file (expand-file-name (org-link-unescape path))))
+ (when (file-exists-p file)
+ (let ((width
+ ;; Apply `org-image-actual-width' specifications.
+ (cond
+ ((not (image-type-available-p 'imagemagick)) nil)
+ ((eq org-image-actual-width t) nil)
+ ((listp org-image-actual-width)
+ (or
+ ;; First try to find a width among
+ ;; attributes associated to the paragraph
+ ;; containing link.
+ (let ((paragraph
+ (let ((e link))
+ (while (and (setq e (org-element-property
+ :parent e))
+ (not (eq (org-element-type e)
+ 'paragraph))))
+ e)))
+ (when paragraph
+ (save-excursion
+ (goto-char (org-element-property :begin paragraph))
+ (when
+ (re-search-forward
+ "^[ \t]*#\\+attr_.*?: +.*?:width +\\(\\S-+\\)"
+ (org-element-property
+ :post-affiliated paragraph)
+ t)
+ (string-to-number (match-string 1))))))
+ ;; Otherwise, fall-back to provided number.
+ (car org-image-actual-width)))
+ ((numberp org-image-actual-width)
+ org-image-actual-width)))
+ (old (get-char-property-and-overlay
+ (org-element-property :begin link)
+ 'org-image-overlay)))
+ (if (and (car-safe old) refresh)
+ (image-refresh (overlay-get (cdr old) 'display))
+ (let ((image (create-image file
+ (and width 'imagemagick)
+ nil
+ :width width)))
+ (when image
+ (let ((ov (make-overlay
+ (org-element-property :begin link)
+ (progn
+ (goto-char
+ (org-element-property :end link))
+ (skip-chars-backward " \t")
+ (point)))))
+ (overlay-put ov 'display image)
+ (overlay-put ov 'face 'default)
+ (overlay-put ov 'org-image-overlay t)
+ (overlay-put
+ ov 'modification-hooks
+ (list 'org-display-inline-remove-overlay))
+ (push ov org-inline-image-overlays)))))))))))))))
(defun org-display-inline-remove-overlay (ov after _beg _end &optional _len)
"Remove inline-display overlay if a corresponding region is modified."