Files
emacs/lisp/org-appear/org-appear.el
2025-06-22 17:08:08 +02:00

430 lines
17 KiB
EmacsLisp

;;; org-appear.el --- Auto-toggle Org elements -*- lexical-binding: t; -*-
;; Portions of code in this file are taken from org-fragtog https://github.com/io12/org-fragtog
;; org-fragtog Copyright (C) 2020 Benjamin Levy - MIT/X11 License
;; org-appear Copyright (C) 2021 Alice Istleyeva - MIT License
;; Author: Alice Istleyeva <awth13@gmail.com>
;; Package-Version: 20240716.1413
;; Package-Revision: 32ee50f8fdfa
;; Description: Toggle Org mode element visibility upon entering and leaving
;; Homepage: https://github.com/awth13/org-appear
;; Package-Requires: ((emacs "29.1") (org "9.3"))
;; Permission is hereby granted, free of charge, to any person obtaining a copy
;; of this software and associated documentation files (the "Software"), to deal
;; in the Software without restriction, including without limitation the rights
;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
;; copies of the Software, and to permit persons to whom the Software is
;; furnished to do so, subject to the following conditions:
;;
;; The above copyright notice and this permission notice shall be included in all
;; copies or substantial portions of the Software.
;;
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
;; SOFTWARE.
;;; Commentary:
;; This package enables automatic visibility toggling of various Org elements depending on cursor position.
;; It supports automatic toggling of emphasis markers, links, subscripts and
;; superscripts, entities, and keywords. By default, toggling is instantaneous
;; and only affects emphasis markers. If Org mode custom variables that control
;; visibility of elements are configured to show hidden parts, the respective
;; `org-appear' settings do not have an effect.
;;; Code:
(require 'org)
(require 'org-element)
(require 'subr-x) ; Compatibility
(defgroup org-appear nil
"Auto-toggle Org elements."
:group 'org)
(defcustom org-appear-trigger 'always
"Method of triggering element toggling.
`always' means that elements are toggled every time they are under the cursor.
`on-change' means that elements are toggled only when the buffer is modified
or when the element under the cursor is clicked with a mouse.
`manual' means that toggling starts on call to `org-appear-manual-start'
and stops on call to `org-appear-manual-stop'."
:type '(choice (const :tag "Always" always)
(const :tag "Only on change" on-change)
(const :tag "Manual" manual))
:group 'org-appear)
(defcustom org-appear-autoemphasis t
"Non-nil enables automatic toggling of emphasised and verbatim markers.
Does not have an effect if `org-hide-emphasis-markers' is nil."
:type 'boolean
:group 'org-appear)
(defcustom org-appear-autosubmarkers nil
"Non-nil enables automatic toggling of subscript and superscript markers.
Does not have an effect if `org-pretty-entities' is nil."
:type 'boolean
:group 'org-appear)
(defcustom org-appear-autoentities nil
"Non-nil enables automatic toggling of org entities.
Does not have an effect if `org-pretty-entities' is nil."
:type 'boolean
:group 'org-appear)
(defcustom org-appear-autolinks nil
"Non-nil enables automatic toggling of links.
If set to the symbol `just-brackets', links will be shown with
brackets around them without showing the link target. Does not
have an effect if `org-link-descriptive' is nil."
:type '(choice (const :tag "Ignore links" nil)
(const :tag "Toggle full link" t)
(const :tag "Toggle brackets" just-brackets))
:group 'org-appear)
(defcustom org-appear-autokeywords nil
"Non-nil enables automatic toggling of keywords.
Does not have an effect if `org-hidden-keywords' is nil."
:type 'boolean
:group 'org-appear)
(defcustom org-appear-inside-latex nil
"Also applies toggling inside Latex fragments and environments.
Sub- and superscript markers are toggled if `org-appear-autosubmarkers' is
non-nil. Entities are toggled if `org-appear-autoentities' is non-nil."
:type 'boolean
:group 'org-appear)
(defcustom org-appear-delay 0.0
"Seconds of delay before toggling an element."
:type 'number
:group 'org-appear)
(defcustom org-appear-manual-linger nil
"Whether to hide the element on manual stop.
If true, hide upon navigating away."
:type 'boolean
:group 'org-appear)
(defvar-local org-appear--timer nil
"Current active timer.")
;;;###autoload
(define-minor-mode org-appear-mode
"A minor mode that automatically toggles elements in Org mode."
:init-value nil
:lighter nil
:keymap nil
(cond
(org-appear-mode
(org-appear--set-elements)
(add-hook 'post-command-hook #'org-appear--post-cmd nil t)
(add-hook 'pre-command-hook #'org-appear--pre-cmd nil t)
(when (eq org-appear-trigger 'on-change)
(add-hook 'mouse-leave-buffer-hook #'org-appear--after-change nil t)
(add-hook 'after-change-functions #'org-appear--after-change nil t)))
(t
;; Clean up current element when disabling the mode
(when-let ((current-elem (org-appear--current-elem)))
(org-appear--hide-invisible current-elem)
(when org-appear--timer
(cancel-timer org-appear--timer)
(setq org-appear--timer nil)))
(remove-hook 'post-command-hook #'org-appear--post-cmd t)
(remove-hook 'pre-command-hook #'org-appear--pre-cmd t)
(when (eq org-appear-trigger 'on-change)
(remove-hook 'mouse-leave-buffer-hook #'org-appear--after-change t)
(remove-hook 'after-change-functions #'org-appear--after-change t)))))
(defvar org-appear-elements nil
"List of Org elements to toggle.")
(defvar-local org-appear--prev-elem nil
"Previous element that surrounded the cursor.
nil if the cursor was not on an element.")
(defvar-local org-appear--do-buffer nil
"Non-nil when `org-appear-mode' is notified to start toggling.")
(defvar-local org-appear--elem-toggled nil
"Non-nil if the last encountered element has been toggled.")
(defun org-appear--set-elements ()
"Add elements to toggle to `org-appear-elements'."
(let ((emphasis-elements '(bold
italic
underline
strike-through
verbatim
code))
(script-elements '(subscript
superscript))
(entity-elements '(entity))
(link-elements '(link))
(keyword-elements '(keyword))
(latex-elements '(latex-fragment latex-environment)))
;; HACK: is there a better way to do this?
(setq-local org-appear--prev-elem nil)
(setq org-appear-elements nil) ; reset
(when (and org-hide-emphasis-markers org-appear-autoemphasis)
(setq org-appear-elements (append org-appear-elements emphasis-elements)))
(when (and org-pretty-entities org-appear-autosubmarkers)
(setq org-appear-elements (append org-appear-elements script-elements)))
(when (and org-pretty-entities org-appear-autoentities)
(setq org-appear-elements (append org-appear-elements entity-elements)))
(when (and org-link-descriptive org-appear-autolinks)
(setq org-appear-elements (append org-appear-elements link-elements)))
(when (and org-hidden-keywords org-appear-autokeywords)
(setq org-appear-elements (append org-appear-elements keyword-elements)))
(when org-appear-inside-latex
(setq org-appear-elements (append org-appear-elements latex-elements)))))
(defun org-appear--post-cmd ()
"This function is executed by `post-command-hook' in `org-appear-mode'.
It handles toggling elements depending on whether the cursor entered or exited them."
(let* ((prev-elem org-appear--prev-elem)
(prev-elem-start (org-element-property :begin prev-elem))
(current-elem (org-appear--current-elem))
(current-elem-start (org-element-property :begin current-elem)))
;; After leaving an element
(when (and prev-elem
org-appear--elem-toggled
(not (equal prev-elem-start current-elem-start)))
;; Forget element
(setq org-appear--elem-toggled nil)
;; If timer for prev-elem fired and was expired
(if (not org-appear--timer)
(save-excursion
(goto-char prev-elem-start)
;; Reevaluate `org-element-context' in case the bounds
;; of the previous element changed
(org-appear--hide-invisible (org-element-context)))
(cancel-timer org-appear--timer)
(setq org-appear--timer nil)))
;; Inside an element
(when (and current-elem (or (eq org-appear-trigger 'always)
org-appear--do-buffer
org-appear--elem-toggled))
;; Mark element as toggled to continue toggling and ignore buffer state
(setq org-appear--elem-toggled t)
;; New element, delay first unhiding
(when (and (eq org-appear-trigger 'always)
(> org-appear-delay 0)
(not (eq prev-elem-start current-elem-start)))
(setq org-appear--timer (run-with-idle-timer org-appear-delay
nil
#'org-appear--show-with-lock
current-elem
t)))
;; Not a new element
(when (not org-appear--timer)
(org-appear--show-with-lock current-elem)))
(setq org-appear--prev-elem current-elem)
(when (not (eq org-appear-trigger 'manual))
(setq org-appear--do-buffer nil))))
(defun org-appear--after-change (&rest _args)
"This function is executed by `after-change-functions' in `org-appear-mode'.
It signals that elements in the current buffer must be toggled."
(setq org-appear--do-buffer 't))
(defun org-appear-manual-start ()
"Signal that elements in the current buffer must be toggled."
(setq org-appear--do-buffer 't))
(defun org-appear-manual-stop ()
"Signal that elements in the current buffer must no longer be toggled."
(when (not org-appear-manual-linger)
(when-let ((current-elem (org-appear--current-elem)))
(org-appear--hide-invisible current-elem))
(setq org-appear--elem-toggled nil))
(setq org-appear--do-buffer nil))
(defun org-appear--pre-cmd ()
"This function is executed by `pre-command-hook' in `org-appear-mode'.
It hides elements before commands that modify the buffer based on column width."
(when (memq this-command '(org-fill-paragraph
org-ctrl-c-ctrl-c))
(when-let ((current-elem (org-appear--current-elem)))
(org-appear--hide-invisible current-elem))))
(defun org-appear--current-elem ()
"Return element at point.
Return nil if element is not supported by `org-appear-mode'."
(when-let ((elem (org-element-context)))
(let* ((elem-type (car elem))
(elem-end (- (org-element-property :end elem)
(1- (org-element-property :post-blank elem))))
(link-ignore-p (and (eq elem-type 'link)
(or (string-match-p "[Cc]ite"
(org-element-property :type elem))
(memq (org-element-property :format elem)
'(plain angle)))))
(key-ignore-p (and (eq elem-type 'keyword)
(not (memq (intern (downcase
(org-element-property :key elem)))
org-hidden-keywords))))
(script-ignore-p (and (or (eq elem-type 'subscript)
(eq elem-type 'superscript))
(not (org-element-property :use-brackets-p elem))
(not (eq org-use-sub-superscripts t)))))
(if (and (memq elem-type org-appear-elements)
(< (point) elem-end) ; Ignore post-element whitespace
(not link-ignore-p) ; Ignore plain and org-ref links
(not key-ignore-p) ; Ignore unhidden keywords
(not script-ignore-p)) ; Ignore sub/supercripts ignored by Org
elem
nil))))
(defun org-appear--parse-elem (elem)
"Return bounds of element ELEM.
Return nil if element cannot be parsed."
(let* ((elem-type (car elem))
(elem-tag (cond ((memq elem-type '(bold
italic
underline
strike-through
verbatim
code))
'emph)
((memq elem-type '(subscript
superscript))
'script)
((eq elem-type 'entity)
'entity)
((eq elem-type 'link)
'link)
((eq elem-type 'keyword)
'keyword)
((memq elem-type '(latex-fragment latex-environment))
'latex-fragment)
(t nil)))
(elem-start (org-element-property :begin elem))
(elem-end (org-element-property :end elem))
(elem-content-start (org-element-property :contents-begin elem))
(elem-content-end (org-element-property :contents-end elem))
;; Some elements have extra spaces at the end
;; The number of spaces is stored in the post-blank property
(post-elem-spaces (org-element-property :post-blank elem))
(elem-end-real (- elem-end post-elem-spaces)))
;; Only sub/superscript elements are guaranteed to have
;; contents-begin and contents-end properties
(when elem-tag
`(:start ,elem-start
:end ,elem-end-real
:visible-start ,(pcase elem-tag
('emph (1+ elem-start))
('script elem-content-start)
('link (or elem-content-start (+ elem-start 2))))
:visible-end ,(pcase elem-tag
('emph (1- elem-end-real))
('script elem-content-end)
('link (or elem-content-end (- elem-end-real 2))))))))
(defun org-appear--show-invisible (elem)
"Silently remove invisible property from invisible parts of element ELEM."
(let* ((elem-at-point (org-appear--parse-elem elem))
(elem-type (car elem))
(start (plist-get elem-at-point :start))
(end (plist-get elem-at-point :end))
(visible-start (plist-get elem-at-point :visible-start))
(visible-end (plist-get elem-at-point :visible-end)))
(when (and (eq org-appear-autolinks 'just-brackets)
(eq elem-type 'link))
(setq start (1- visible-start))
(setq end (1+ visible-end)))
(with-silent-modifications
(cond ((eq elem-type 'entity)
(decompose-region start end))
((memq elem-type '(latex-fragment latex-environment))
(when org-appear-autosubmarkers
(remove-text-properties start end '(invisible)))
(when org-appear-autoentities
(decompose-region start end)))
((eq elem-type 'keyword)
(remove-text-properties start end '(invisible org-link)))
((and (featurep 'org-fold)
(eq elem-type 'link)
(eq org-fold-core-style 'text-properties))
(remove-text-properties start
visible-start
(list (org-fold-core--property-symbol-get-create 'org-link) nil))
(remove-text-properties visible-end
end
(list (org-fold-core--property-symbol-get-create 'org-link) nil)))
(t
(remove-text-properties start visible-start '(invisible org-link))
(remove-text-properties visible-end end '(invisible org-link)))))))
(defun org-appear--show-with-lock (elem &optional renew)
"Show invisible parts of element ELEM.
When RENEW is non-nil, obtain element at point instead."
;; When called with timer, element might be different upon arrival
(when renew
(setq elem (org-appear--current-elem))
(setq org-appear--prev-elem elem)
(setq org-appear--timer nil))
(when-let ((elem-start (org-element-property :begin elem))
(elem-end (org-element-property :end elem)))
;; Call `font-lock-ensure' before unhiding to prevent `jit-lock-mode'
;; from refontifying the element region after changes in buffer
(font-lock-ensure elem-start elem-end)
(org-appear--show-invisible elem)))
(defun org-appear--hide-invisible (elem)
"Silently add invisible property to invisible parts of element ELEM."
(let* ((elem-at-point (org-appear--parse-elem elem))
(elem-type (car elem))
(start (plist-get elem-at-point :start))
(end (plist-get elem-at-point :end))
(visible-start (plist-get elem-at-point :visible-start))
(visible-end (plist-get elem-at-point :visible-end)))
(when elem-at-point
(when (and (eq org-appear-autolinks 'just-brackets)
(eq elem-type 'link))
(setq start (1- visible-start))
(setq end (1+ visible-end)))
(with-silent-modifications
(cond ((eq elem-type 'entity)
(compose-region start end (org-element-property :utf-8 elem))
(font-lock-flush start end))
((memq elem-type '(keyword latex-fragment latex-environment))
(font-lock-flush start end))
((and (featurep 'org-fold)
(eq elem-type 'link)
(eq org-fold-core-style 'text-properties))
(put-text-property start
visible-start
(org-fold-core--property-symbol-get-create 'org-link)
'org-link)
(put-text-property visible-end
end
(org-fold-core--property-symbol-get-create 'org-link)
'org-link))
(t
(put-text-property start visible-start 'invisible 'org-link)
(put-text-property visible-end end 'invisible 'org-link)
(font-lock-flush start end))))
;; Call `font-lock-ensure' after flushing to prevent `jit-lock-mode'
;; from refontifying the next element entered
(font-lock-ensure start end))))
(provide 'org-appear)
;;; org-appear.el ends here