tec/org-mode
tec/org-mode
1
0
Fork 0
forked from mirrors/org-mode
Code Pull requests Releases Activity

Fix `org-display-inline-images' with "clickable images"

Browse source 
* 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>
This commit is contained in:
Nicolas Goaziou 2019-02-22 14:15:33 +01:00
parent 29fe5a7d7f
commit 93c3d9d281
1 changed files with 108 additions and 84 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

192
lisp/org.el
View file

@ -18752,7 +18752,8 @@ conventions:
from `image-file-name-regexp' and it has no contents. from `image-file-name-regexp' and it has no contents.
2. Its description consists in a single link of the previous 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 When optional argument INCLUDE-LINKED is non-nil, also links with
a text description part will be inlined. This can be nice for a text description part will be inlined. This can be nice for
@ -18768,89 +18769,112 @@ boundaries."
(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-wide-buffer (org-with-point-at (or beg 1)
(goto-char (or beg (point-min))) (let* ((case-fold-search t)
(let* ((case-fold-search t) (file-extension-re (image-file-name-regexp))
(file-extension-re (image-file-name-regexp)) (link-abbrevs (mapcar #'car
(link-abbrevs (mapcar #'car (append org-link-abbrev-alist-local
(append org-link-abbrev-alist-local org-link-abbrev-alist)))
org-link-abbrev-alist))) ;; Check absolute, relative file names and explicit
;; Check absolute, relative file names and explicit ;; "file:" links. Also check link abbreviations since
;; "file:" links. Also check link abbreviations since ;; some might expand to "file" links.
;; some might expand to "file" links. (file-types-re
(file-types-re (format "[][]\\[\\(?:file\\|[./~]%s\\)" (format "\\[\\[\\(?:file%s:\\|[./~]\\)\\|\\]\\[\\(<?file:\\)"
(if (not link-abbrevs) "" (if (not link-abbrevs) ""
(format "\\|\\(?:%s:\\)" (concat "\\|" (regexp-opt link-abbrevs))))))
(regexp-opt link-abbrevs)))))) (while (re-search-forward file-types-re end t)
(while (re-search-forward file-types-re end t) (let* ((link (org-element-lineage
(let ((link (save-match-data (org-element-context)))) (save-match-data (org-element-context))
;; Check if we're at an inline image, i.e., an image file '(link) t))
;; link without a description (unless INCLUDE-LINKED is (inner-start (match-beginning 1))
;; non-nil). (path
(when (and (equal "file" (org-element-property :type link)) (cond
(or include-linked ;; No link at point; no inline image.
(null (org-element-contents link))) ((not link) nil)
(string-match-p file-extension-re ;; File link without a description. Also handle
(org-element-property :path link))) ;; INCLUDE-LINKED here since it should have
(let ((file (expand-file-name ;; precedence over the next case. I.e., if link
(org-link-unescape ;; contains filenames in both the path and the
(org-element-property :path link))))) ;; description, prioritize the path only when
(when (file-exists-p file) ;; INCLUDE-LINKED is non-nil.
(let ((width ((or (not (org-element-property :contents-begin link))
;; Apply `org-image-actual-width' specifications. include-linked)
(cond (and (equal "file" (org-element-property :type link))
((not (image-type-available-p 'imagemagick)) nil) (org-element-property :path link)))
((eq org-image-actual-width t) nil) ;; Link with a description. Check if description
((listp org-image-actual-width) ;; is a filename. Even if Org doesn't have syntax
(or ;; for those -- clickable image -- constructs, fake
;; First try to find a width among ;; them, as in `org-export-insert-image-links'.
;; attributes associated to the paragraph ((not inner-start) nil)
;; containing link. (t
(let ((paragraph (org-with-point-at inner-start
(let ((e link)) (and (looking-at
(while (and (setq e (org-element-property (if (char-equal ?< (char-after inner-start))
:parent e)) org-angle-link-re
(not (eq (org-element-type e) org-plain-link-re))
'paragraph)))) ;; File name must fill the whole
e))) ;; description.
(when paragraph (= (org-element-property :contents-end link)
(save-excursion (match-end 0))
(goto-char (org-element-property :begin paragraph)) (match-string 2)))))))
(when (when (and path (string-match-p file-extension-re path))
(re-search-forward (let ((file (expand-file-name (org-link-unescape path))))
"^[ \t]*#\\+attr_.*?: +.*?:width +\\(\\S-+\\)" (when (file-exists-p file)
(org-element-property (let ((width
:post-affiliated paragraph) ;; Apply `org-image-actual-width' specifications.
t) (cond
(string-to-number (match-string 1)))))) ((not (image-type-available-p 'imagemagick)) nil)
;; Otherwise, fall-back to provided number. ((eq org-image-actual-width t) nil)
(car org-image-actual-width))) ((listp org-image-actual-width)
((numberp org-image-actual-width) (or
org-image-actual-width))) ;; First try to find a width among
(old (get-char-property-and-overlay ;; attributes associated to the paragraph
(org-element-property :begin link) ;; containing link.
'org-image-overlay))) (let ((paragraph
(if (and (car-safe old) refresh) (let ((e link))
(image-refresh (overlay-get (cdr old) 'display)) (while (and (setq e (org-element-property
(let ((image (create-image file :parent e))
(and width 'imagemagick) (not (eq (org-element-type e)
nil 'paragraph))))
:width width))) e)))
(when image (when paragraph
(let ((ov (make-overlay (save-excursion
(org-element-property :begin link) (goto-char (org-element-property :begin paragraph))
(progn (when
(goto-char (re-search-forward
(org-element-property :end link)) "^[ \t]*#\\+attr_.*?: +.*?:width +\\(\\S-+\\)"
(skip-chars-backward " \t") (org-element-property
(point))))) :post-affiliated paragraph)
(overlay-put ov 'display image) t)
(overlay-put ov 'face 'default) (string-to-number (match-string 1))))))
(overlay-put ov 'org-image-overlay t) ;; Otherwise, fall-back to provided number.
(overlay-put (car org-image-actual-width)))
ov 'modification-hooks ((numberp org-image-actual-width)
(list 'org-display-inline-remove-overlay)) org-image-actual-width)))
(push ov org-inline-image-overlays))))))))))))))) (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) (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."