Do not use org-fold to hide link parts

* lisp/ol.el (org-link--link-folding-spec):
(org-link--description-folding-spec):
(org-link-descriptive-ensure): Remove.
(org-toggle-link-display): Rely upon font-lock to update link display.
* lisp/org-agenda.el (org-agenda-mode): Remove no-longer-necessary
org-fold initializer.
* lisp/org-fold.el (org-fold-initialize): Remove link-related fold
types.
(org-fold-show-set-visibility):
* lisp/org-src.el (org-src-font-lock-fontify-block):
* lisp/org.el (org-do-emphasis-faces):
(org-unfontify-region): Remove special handling of link folds.
* lisp/org.el (org-mode): Remove folding setup for links.
(org-activate-links--text-properties): Remove.
(org-activate-links): Honor `org-link-descriptive' dynamically.

This change reflects de-facto situation where we cannot use folding
system to hide links reliably.  Even though we promise in Org 9.6 that
hidden parts of the link can be searched, the way it can be
implemented is not reliable and is working around upstream mechanisms.
Upstream changes are necessary to properly support isearch in text
hidden using text properties; workarounds attempted in org-fold-core
do not cut it because too many built-in Emacs libraries and also
third-party libraries rely upon internal implementation details of
isearch (due to limitations of its API).
This commit is contained in:
Ihor Radchenko 2024-05-02 10:27:32 +03:00
parent 646f6ec133
commit a2e5685e49
No known key found for this signature in database
GPG Key ID: 6470762A7DA11D8B
6 changed files with 17 additions and 156 deletions

View File

@ -206,7 +206,7 @@ This function is intended to be used as a :set function."
(set symbol value)
(dolist (buf (org-buffer-list))
(with-current-buffer buf
(org-link-descriptive-ensure))))
(org-restart-font-lock))))
(defcustom org-link-descriptive t
"Non-nil means Org displays descriptive links.
@ -649,22 +649,6 @@ exact and fuzzy text search.")
(defvar org-link--search-failed nil
"Non-nil when last link search failed.")
(defvar-local org-link--link-folding-spec '(org-link
(:global t)
(:ellipsis . nil)
(:isearch-open . t)
(:fragile . org-link--reveal-maybe))
"Folding spec used to hide invisible parts of links.")
(defvar-local org-link--description-folding-spec '(org-link-description
(:global t)
(:ellipsis . nil)
(:visible . t)
(:isearch-open . nil)
(:fragile . org-link--reveal-maybe))
"Folding spec used to reveal link description.")
;;; Internal Functions
@ -1679,18 +1663,12 @@ If the link is in hidden text, expose it."
(interactive)
(org-next-link t))
(defun org-link-descriptive-ensure ()
"Toggle the literal or descriptive display of links in current buffer if needed."
(org-fold-core-set-folding-spec-property
(car org-link--link-folding-spec)
:visible (not org-link-descriptive)))
;;;###autoload
(defun org-toggle-link-display ()
"Toggle the literal or descriptive display of links in current buffer."
(interactive)
(setq org-link-descriptive (not org-link-descriptive))
(org-link-descriptive-ensure))
(org-restart-font-lock))
;;;###autoload
(defun org-store-link (arg &optional interactive?)

View File

@ -2385,8 +2385,6 @@ The following commands are available:
org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode
org-agenda-archives-mode org-agenda-start-with-archives-mode))
(add-to-invisibility-spec '(org-filtered))
(org-fold-core-initialize `(,org-link--description-folding-spec
,org-link--link-folding-spec))
(easy-menu-change
'("Agenda") "Agenda Files"
(append

View File

@ -49,8 +49,6 @@
(require 'org-fold-core)
(defvar org-inlinetask-min-level)
(defvar org-link--link-folding-spec)
(defvar org-link--description-folding-spec)
(defvar org-odd-levels-only)
(defvar org-drawer-regexp)
(defvar org-property-end-re)
@ -280,9 +278,7 @@ Also, see `org-fold-catch-invisible-edits'."
(:isearch-open . t)
(:font-lock . t)
(:front-sticky . t)
(:alias . (drawer property-drawer)))
,org-link--description-folding-spec
,org-link--link-folding-spec)))
(:alias . (drawer property-drawer))))))
;;;; Searching and examining folded text
@ -679,19 +675,12 @@ DETAIL is either nil, `minimal', `local', `ancestors',
(org-with-point-at (car region)
(forward-line 0)
(let (font-lock-extend-region-functions)
(font-lock-fontify-region (max (point-min) (1- (car region))) (cdr region))))))
;; Unfold links.
(let (region)
(dolist (spec '(org-link org-link-description))
(setq region (org-fold-get-region-at-point spec))
(when region (org-fold-region (car region) (cdr region) nil spec)))))
(font-lock-fontify-region (max (point-min) (1- (car region))) (cdr region)))))))
(let (region)
(dolist (spec (org-fold-core-folding-spec-list))
;; Links are taken care by above.
(unless (memq spec '(org-link org-link-description))
(setq region (org-fold-get-region-at-point spec))
(when region
(org-fold-region (car region) (cdr region) nil spec))))))
(setq region (org-fold-get-region-at-point spec))
(when region
(org-fold-region (car region) (cdr region) nil spec)))))
(unless (org-before-first-heading-p)
(org-with-limited-levels
(cl-case detail

View File

@ -754,8 +754,6 @@ as `org-src-fontify-natively' is non-nil."
(s (and b (make-string (* (- e b) native-tab-width) ? ))))
(when (and b (< b e)) (add-text-properties b e `(display ,s)))
(forward-char)))))
;; Clear abbreviated link folding.
(org-fold-region start end nil 'org-link)
(add-text-properties
start end
'(font-lock-fontified t fontified t font-lock-multiline t))

View File

@ -4952,16 +4952,11 @@ The following commands are available:
(current-buffer)
'match-hash :read-related t))
(org-set-regexps-and-options)
(when (and org-link-descriptive
(eq org-fold-core-style 'overlays))
(add-to-invisibility-spec '(org-link)))
(add-to-invisibility-spec '(org-link))
(org-fold-initialize (or (and (stringp org-ellipsis) (not (equal "" org-ellipsis)) org-ellipsis)
"..."))
(make-local-variable 'org-link-descriptive)
(when (eq org-fold-core-style 'overlays) (add-to-invisibility-spec '(org-hide-block . t)))
(if org-link-descriptive
(org-fold-core-set-folding-spec-property (car org-link--link-folding-spec) :visible nil)
(org-fold-core-set-folding-spec-property (car org-link--link-folding-spec) :visible t))
(when (and (stringp org-ellipsis) (not (equal "" org-ellipsis)))
(unless org-display-table
(setq org-display-table (make-display-table)))
@ -5243,10 +5238,6 @@ stacked delimiters is N. Escaping delimiters is not possible."
(when verbatim?
(org-remove-flyspell-overlays-in
(match-beginning 0) (match-end 0))
(when (and (org-fold-core-folding-spec-p 'org-link)
(org-fold-core-folding-spec-p 'org-link-description))
(org-fold-region (match-beginning 0) (match-end 0) nil 'org-link)
(org-fold-region (match-beginning 0) (match-end 0) nil 'org-link-description))
(remove-text-properties (match-beginning 2) (match-end 2)
'(display t invisible t intangible t)))
(add-text-properties (match-beginning 2) (match-end 2)
@ -5314,7 +5305,7 @@ prompted for."
(insert string)
(and move (backward-char 1))))
(defun org-activate-links--overlays (limit)
(defun org-activate-links (limit)
"Add link properties to links.
This includes angle, plain, and bracket links."
(catch :exit
@ -5370,10 +5361,12 @@ This includes angle, plain, and bracket links."
;; Handle invisible parts in bracket links.
(remove-text-properties start end '(invisible nil))
(let ((hidden
(append `(invisible
,(or (org-link-get-parameter type :display)
'org-link))
properties)))
(if org-link-descriptive
(append `(invisible
,(or (org-link-get-parameter type :display)
'org-link))
properties)
properties)))
(add-text-properties start visible-start hidden)
(add-face-text-property start end face-property)
(add-text-properties visible-start visible-end properties)
@ -5385,99 +5378,6 @@ This includes angle, plain, and bracket links."
(funcall f start end path (eq style 'bracket))))
(throw :exit t))))) ;signal success
nil))
(defun org-activate-links--text-properties (limit)
"Add link properties to links.
This includes angle, plain, and bracket links."
(catch :exit
(while (re-search-forward org-link-any-re limit t)
(let* ((start (match-beginning 0))
(end (match-end 0))
(visible-start (or (match-beginning 3) (match-beginning 2)))
(visible-end (or (match-end 3) (match-end 2)))
(style (cond ((eq ?< (char-after start)) 'angle)
((eq ?\[ (char-after (1+ start))) 'bracket)
(t 'plain))))
(when (and (memq style org-highlight-links)
;; Do not span over paragraph boundaries.
(not (string-match-p org-element-paragraph-separate
(match-string 0)))
;; Do not confuse plain links with tags.
(not (and (eq style 'plain)
(let ((face (get-text-property
(max (1- start) (point-min)) 'face)))
(if (consp face) (memq 'org-tag face)
(eq 'org-tag face))))))
(let* ((link-object (save-excursion
(goto-char start)
(save-match-data (org-element-link-parser))))
(link (org-element-property :raw-link link-object))
(type (org-element-property :type link-object))
(path (org-element-property :path link-object))
(face-property (pcase (org-link-get-parameter type :face)
((and (pred functionp) face) (funcall face path))
((and (pred facep) face) face)
((and (pred consp) face) face) ;anonymous
(_ 'org-link)))
(properties ;for link's visible part
(list 'mouse-face (or (org-link-get-parameter type :mouse-face)
'highlight)
'keymap (or (org-link-get-parameter type :keymap)
org-mouse-map)
'help-echo (pcase (org-link-get-parameter type :help-echo)
((and (pred stringp) echo) echo)
((and (pred functionp) echo) echo)
(_ (concat "LINK: " link)))
'htmlize-link (pcase (org-link-get-parameter type
:htmlize-link)
((and (pred functionp) f) (funcall f))
(_ `(:uri ,link)))
'font-lock-multiline t)))
(org-remove-flyspell-overlays-in start end)
(org-rear-nonsticky-at end)
(if (not (eq 'bracket style))
(progn
(add-face-text-property start end face-property)
(add-text-properties start end properties))
;; Initialize folding when used outside org-mode.
(unless (or (derived-mode-p 'org-mode)
(and (org-fold-folding-spec-p 'org-link-description)
(org-fold-folding-spec-p 'org-link)))
(org-fold-initialize (or (and (stringp org-ellipsis) (not (equal "" org-ellipsis)) org-ellipsis)
"...")))
;; Handle invisible parts in bracket links.
(let ((spec (or (org-link-get-parameter type :display)
'org-link)))
(unless (org-fold-folding-spec-p spec)
(org-fold-add-folding-spec spec
(cdr org-link--link-folding-spec)
nil
'append)
(org-fold-core-set-folding-spec-property spec :visible t))
(org-fold-region start end nil 'org-link)
(org-fold-region start end nil 'org-link-description)
;; We are folding the whole emphasized text with SPEC
;; first. It makes everything invisible (or whatever
;; the user wants).
(org-fold-region start end t spec)
;; The visible part of the text is folded using
;; 'org-link-description, which is forcing this part of
;; the text to be visible.
(org-fold-region visible-start visible-end t 'org-link-description)
(add-text-properties start end properties)
(add-face-text-property start end face-property)
(org-rear-nonsticky-at visible-start)
(org-rear-nonsticky-at visible-end)))
(let ((f (org-link-get-parameter type :activate-func)))
(when (functionp f)
(funcall f start end path (eq style 'bracket))))
(throw :exit t))))) ;signal success
nil))
(defsubst org-activate-links (limit)
"Add link properties to links.
This includes angle, plain, and bracket links."
(if (eq org-fold-core-style 'text-properties)
(org-activate-links--text-properties limit)
(org-activate-links--overlays limit)))
(defun org-activate-code (limit)
(when (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t)
@ -5856,8 +5756,7 @@ highlighting was done, nil otherwise."
(when next-unfolded-newline
(org-with-wide-buffer
(when (and (> (match-beginning 0) (point-min))
(org-fold-folded-p (1- (match-beginning 0)))
(not (org-fold-folded-p (1- (match-beginning 0)) 'org-link)))
(org-fold-folded-p (1- (match-beginning 0))))
(put-text-property
(match-beginning 0) (match-end 0)
'face
@ -6237,8 +6136,6 @@ If TAG is a number, get the corresponding match group."
'(mouse-face t keymap t org-linked-text t
invisible t intangible t
org-emphasis t))
(org-fold-region beg end nil 'org-link)
(org-fold-region beg end nil 'org-link-description)
(org-fold-core-update-optimisation beg end)
(org-remove-font-lock-display-properties beg end)))

View File

@ -61,6 +61,7 @@ See https://github.com/yantar92/org/issues/4."
(org-test-with-temp-text "* Org link test
[[https://example.com][A link to a site]]"
(dotimes (_ 2)
(font-lock-ensure)
(goto-char 1)
(re-search-forward "\\[")
(should-not (org-xor org-link-descriptive (org-invisible-p)))