Revert "Un-fontlock sub/superscripts when point enters them"

This reverts commit 102832e66f.

See <https://lists.gnu.org/archive/cgi-bin/namazu.cgi?query=%2Bmessage-id%3A%3C87y3g43mjy.fsf%40nicolasgoaziou.fr%3E&submit=Search&idxname=emacs-orgmode>
This commit is contained in:
Aaron Ecay 2018-05-27 21:27:10 +01:00
parent f35994b314
commit c32938b7fd
1 changed files with 33 additions and 74 deletions

View File

@ -5700,21 +5700,13 @@ stacked delimiters is N. Escaping delimiters is not possible."
"\\(?:" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)" "\\(?:" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)"
"\\|" "\\|"
"\\(?:\\*\\|[+-]?[[:alnum:].,\\]*[[:alnum:]]\\)\\)") "\\(?:\\*\\|[+-]?[[: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 (defconst org-match-substring-with-braces-regexp
(concat (concat
"\\(\\S-\\)\\([_^]\\)" "\\(\\S-\\)\\([_^]\\)"
"\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)") "\\(" (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 () (defun org-make-link-regexps ()
"Update the link regular expressions. "Update the link regular expressions.
@ -6612,46 +6604,18 @@ If TAG is a number, get the corresponding match group."
((raise 0.5))) ((raise 0.5)))
"Display properties for showing superscripts and subscripts.") "Display properties for showing superscripts and subscripts.")
(defun org--remove-sub-superscipt-font-lock-properties (outer-beg end) (defun org-remove-font-lock-display-properties (beg end)
"Remove the raise and invisible properties that are used to "Remove specific display properties that have been added by font lock.
show superscripts and subscripts." The will remove the raise properties that are used to show superscripts
(let ((beg outer-beg) next prop) and subscripts."
(let (next prop)
(while (< beg end) (while (< beg end)
(setq next (next-single-property-change beg 'display nil end) (setq next (next-single-property-change beg 'display nil end)
prop (get-text-property beg 'display)) prop (get-text-property beg 'display))
(when (member prop org-script-display) (when (member prop org-script-display)
(put-text-property beg next 'display nil)) (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)))) (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) (defun org-raise-scripts (limit)
"Add raise properties to sub/superscripts." "Add raise properties to sub/superscripts."
(when (and org-pretty-entities org-pretty-entities-include-sub-superscripts (when (and org-pretty-entities org-pretty-entities-include-sub-superscripts
@ -6660,9 +6624,6 @@ show superscripts and subscripts."
org-match-substring-regexp org-match-substring-regexp
org-match-substring-with-braces-regexp) org-match-substring-with-braces-regexp)
limit t)) limit 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 (let* ((pos (point)) table-p comment-p
(mpos (match-beginning 3)) (mpos (match-beginning 3))
(emph-p (get-text-property mpos 'org-emphasis)) (emph-p (get-text-property mpos 'org-emphasis))
@ -6675,22 +6636,20 @@ show superscripts and subscripts."
;; Handle a_b^c ;; Handle a_b^c
(when (member (char-after) '(?_ ?^)) (goto-char (1- pos))) (when (member (char-after) '(?_ ?^)) (goto-char (1- pos)))
(unless (or comment-p emph-p link-p keyw-p) (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) (put-text-property (match-beginning 3) (match-end 0)
'display 'display
(if (equal (char-after (match-beginning 2)) ?^) (if (equal (char-after (match-beginning 2)) ?^)
(nth (if table-p 3 1) org-script-display) (nth (if table-p 3 1) org-script-display)
(nth (if table-p 2 0) org-script-display))) (nth (if table-p 2 0) org-script-display)))
(add-text-properties (match-beginning 2) (match-end 2) (add-text-properties (match-beginning 2) (match-end 2)
'(invisible org-script)) (list 'invisible t))
(when (and (eq (char-after (match-beginning 3)) ?{) (when (and (eq (char-after (match-beginning 3)) ?{)
(eq (char-before (match-end 3)) ?})) (eq (char-before (match-end 3)) ?}))
(add-text-properties (match-beginning 3) (1+ (match-beginning 3)) (add-text-properties (match-beginning 3) (1+ (match-beginning 3))
'(invisible org-script)) (list 'invisible t))
(add-text-properties (1- (match-end 3)) (match-end 3) (add-text-properties (1- (match-end 3)) (match-end 3)
'(invisible org-script)))) (list 'invisible t))))
t)))) t)))
(defun org-remove-empty-overlays-at (pos) (defun org-remove-empty-overlays-at (pos)
"Remove outline overlays that do not contain non-white stuff." "Remove outline overlays that do not contain non-white stuff."