summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAaron Ecay <aaronecay@gmail.com>2018-05-27 17:13:59 +0100
committerAaron Ecay <aaronecay@gmail.com>2018-05-27 17:13:59 +0100
commit102832e66ffe660111056c16f3c19ac1d956aa02 (patch)
treed40bf76e8092c7d1454d0257aa085bea187bfd93
parent5192e810aedc33a48d2a70ecfdab526e39a53be1 (diff)
downloadorg-mode-102832e66ffe660111056c16f3c19ac1d956aa02.tar.gz
Un-fontlock sub/superscripts when point enters them
* lisp/org.el (org-remove-font-lock-display-properties): Rename to ‘org-remove-font-lock-display-properties’. It is a more specific/accurate name. (org-match-substring-with-braces-regexp): (org-match-substring-regexp): Add a note to docstrings about what the match groups are. (org-raise-scripts--post-command-hook): New function, modeled on ‘prettify-symbols--post-command-hook’. (org-raise-scripts): Use the above. Inspired by <https://lists.gnu.org/archive/cgi-bin/namazu.cgi?query=%2Bmessage-id%3A%3C518DCC34-E435-42F7-A15E-FAE7727033F8%40scratch.space%3E&submit=Search&idxname=emacs-orgmode>
-rw-r--r--lisp/org.el107
1 files changed, 74 insertions, 33 deletions
diff --git a/lisp/org.el b/lisp/org.el
index 448e5fb..d00c3c2 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -5700,13 +5700,21 @@ stacked delimiters is N. Escaping delimiters is not possible."
"\\(?:" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)"
"\\|"
"\\(?:\\*\\|[+-]?[[:alnum:].,\\]*[[:alnum:]]\\)\\)")
- "The regular expression matching a sub- or superscript.")
+ "The regular expression matching a sub- or superscript.
+
+Match groups:
+1: The preceding character (non-whitespace)
+2: The underscore or caret
+3: Entire sub/superscript
+4: (if present) the portion inside the braces/parens")
(defconst org-match-substring-with-braces-regexp
(concat
"\\(\\S-\\)\\([_^]\\)"
"\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)")
- "The regular expression matching a sub- or superscript, forcing braces.")
+ "The regular expression matching a sub- or superscript, forcing braces.
+
+Match groups: see `org-match-substring-regexp'.")
(defun org-make-link-regexps ()
"Update the link regular expressions.
@@ -6604,18 +6612,46 @@ If TAG is a number, get the corresponding match group."
((raise 0.5)))
"Display properties for showing superscripts and subscripts.")
-(defun org-remove-font-lock-display-properties (beg end)
- "Remove specific display properties that have been added by font lock.
-The will remove the raise properties that are used to show superscripts
-and subscripts."
- (let (next prop)
+(defun org--remove-sub-superscipt-font-lock-properties (outer-beg end)
+ "Remove the raise and invisible properties that are used to
+show superscripts and subscripts."
+ (let ((beg outer-beg) next prop)
(while (< beg end)
(setq next (next-single-property-change beg 'display nil end)
prop (get-text-property beg 'display))
(when (member prop org-script-display)
(put-text-property beg next 'display nil))
+ (setq beg next))
+ (setq beg outer-beg)
+ (while (< beg end)
+ (setq next (next-single-property-change beg 'invisible nil end)
+ prop (get-text-property beg 'invisible))
+ (when (eq prop 'org-script)
+ (put-text-property beg next 'invisible nil))
(setq beg next))))
+(defvar-local org-raise-scripts--current-script-bounds nil)
+
+(cl-pushnew '(org-script . t) text-property-default-nonsticky)
+
+(defun org-raise-scripts--post-command-hook ()
+ "Modeled after `prettify-symbols--post-command-hook'."
+ (when (and org-raise-scripts--current-script-bounds
+ (or (< (point) (nth 0 org-raise-scripts--current-script-bounds))
+ (> (point) (nth 1 org-raise-scripts--current-script-bounds))))
+ (apply #'font-lock-flush org-raise-scripts--current-script-bounds)
+ (setq org-raise-scripts--current-script-bounds nil))
+ (let ((bounds (get-text-property (point) 'org-script)))
+ (when bounds
+ (let ((start (nth 0 bounds))
+ (end (nth 1 bounds)))
+ (setq org-raise-scripts--current-script-bounds bounds)
+ (with-silent-modifications
+ (org-remove-font-lock-display-properties start end))))))
+(add-hook 'org-mode-hook
+ (lambda ()
+ (add-hook 'post-command-hook #'org-raise-scripts--post-command-hook nil 'local)))
+
(defun org-raise-scripts (limit)
"Add raise properties to sub/superscripts."
(when (and org-pretty-entities org-pretty-entities-include-sub-superscripts
@@ -6624,32 +6660,37 @@ and subscripts."
org-match-substring-regexp
org-match-substring-with-braces-regexp)
limit t))
- (let* ((pos (point)) table-p comment-p
- (mpos (match-beginning 3))
- (emph-p (get-text-property mpos 'org-emphasis))
- (link-p (get-text-property mpos 'mouse-face))
- (keyw-p (eq 'org-special-keyword (get-text-property mpos 'face))))
- (goto-char (point-at-bol))
- (setq table-p (looking-at-p org-table-dataline-regexp)
- comment-p (looking-at-p "^[ \t]*#[ +]"))
- (goto-char pos)
- ;; Handle a_b^c
- (when (member (char-after) '(?_ ?^)) (goto-char (1- pos)))
- (unless (or comment-p emph-p link-p keyw-p)
- (put-text-property (match-beginning 3) (match-end 0)
- 'display
- (if (equal (char-after (match-beginning 2)) ?^)
- (nth (if table-p 3 1) org-script-display)
- (nth (if table-p 2 0) org-script-display)))
- (add-text-properties (match-beginning 2) (match-end 2)
- (list 'invisible t))
- (when (and (eq (char-after (match-beginning 3)) ?{)
- (eq (char-before (match-end 3)) ?}))
- (add-text-properties (match-beginning 3) (1+ (match-beginning 3))
- (list 'invisible t))
- (add-text-properties (1- (match-end 3)) (match-end 3)
- (list 'invisible t))))
- t)))
+ (unless (and org-raise-scripts--current-script-bounds
+ (> (point) (nth 0 org-raise-scripts--current-script-bounds))
+ (<= (point) (nth 1 org-raise-scripts--current-script-bounds)))
+ (let* ((pos (point)) table-p comment-p
+ (mpos (match-beginning 3))
+ (emph-p (get-text-property mpos 'org-emphasis))
+ (link-p (get-text-property mpos 'mouse-face))
+ (keyw-p (eq 'org-special-keyword (get-text-property mpos 'face))))
+ (goto-char (point-at-bol))
+ (setq table-p (looking-at-p org-table-dataline-regexp)
+ comment-p (looking-at-p "^[ \t]*#[ +]"))
+ (goto-char pos)
+ ;; Handle a_b^c
+ (when (member (char-after) '(?_ ?^)) (goto-char (1- pos)))
+ (unless (or comment-p emph-p link-p keyw-p)
+ (put-text-property (match-beginning 2) (match-end 0)
+ 'org-script (list (match-beginning 2) (match-end 0)))
+ (put-text-property (match-beginning 3) (match-end 0)
+ 'display
+ (if (equal (char-after (match-beginning 2)) ?^)
+ (nth (if table-p 3 1) org-script-display)
+ (nth (if table-p 2 0) org-script-display)))
+ (add-text-properties (match-beginning 2) (match-end 2)
+ '(invisible org-script))
+ (when (and (eq (char-after (match-beginning 3)) ?{)
+ (eq (char-before (match-end 3)) ?}))
+ (add-text-properties (match-beginning 3) (1+ (match-beginning 3))
+ '(invisible org-script))
+ (add-text-properties (1- (match-end 3)) (match-end 3)
+ '(invisible org-script))))
+ t))))
(defun org-remove-empty-overlays-at (pos)
"Remove outline overlays that do not contain non-white stuff."