summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2016-12-08 09:44:26 +0100
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2016-12-12 22:21:17 +0100
commit9fb2e047d2963ff5f4218d43bbb006898e8eac6f (patch)
treeed8ec497e95ba78e659837ba8b75d6729c16c5ad
parent05223fc6fa68d7677412d4b79ea6f59a113deaf1 (diff)
downloadorg-mode-9fb2e047d2963ff5f4218d43bbb006898e8eac6f.tar.gz
Split `org-emph-re' and `org-verbatim-re'
* lisp/org.el (org-set-emph-re): Refactor code. Rip "~" and "=" markers off `org-emph-re'. (org-do-emphasis-faces): (org-sort-remove-invisible): Handle both `org-emph-re' and `org-verbatim-re'. (org-in-verbatim-emphasis): Use `org-verbatim-re' instead of `org-emph-re'. * lisp/org-element.el (org-element-code-parser): (org-element-verbatim-parser): Use `org-verbatim-re' instead of `org-emph-re'. * testing/lisp/test-org-element.el (test-org-element/bold-parser): (test-org-element/code-parser): (test-org-element/italic-parser): (test-org-element/strike-through-parser): (test-org-element/underline-parser): (test-org-element/verbatim-parser): Update tests, which no longer need to bind `org-emph-re'.
-rw-r--r--lisp/org-element.el4
-rw-r--r--lisp/org.el133
-rw-r--r--testing/lisp/test-org-element.el67
3 files changed, 74 insertions, 130 deletions
diff --git a/lisp/org-element.el b/lisp/org-element.el
index b86244e..c311cb7 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -2754,7 +2754,7 @@ keywords. Otherwise, return nil.
Assume point is at the first tilde marker."
(save-excursion
(unless (bolp) (backward-char 1))
- (when (looking-at org-emph-re)
+ (when (looking-at org-verbatim-re)
(let ((begin (match-beginning 2))
(value (match-string-no-properties 4))
(post-blank (progn (goto-char (match-end 2))
@@ -3765,7 +3765,7 @@ and cdr is a plist with `:value', `:begin', `:end' and
Assume point is at the first equal sign marker."
(save-excursion
(unless (bolp) (backward-char 1))
- (when (looking-at org-emph-re)
+ (when (looking-at org-verbatim-re)
(let ((begin (match-beginning 2))
(value (match-string-no-properties 4))
(post-blank (progn (goto-char (match-end 2))
diff --git a/lisp/org.el b/lisp/org.el
index f642000..a61a7a4 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -4462,8 +4462,10 @@ After a match, the match groups contain these elements:
3 The leading marker like * or /, indicating the type of highlighting
4 The text between the emphasis markers, not including the markers
5 The character after the match, empty at the end of a line")
+
(defvar org-verbatim-re nil
"Regular expression for matching verbatim text.")
+
(defvar org-emphasis-regexp-components) ; defined just below
(defvar org-emphasis-alist) ; defined just below
(defun org-set-emph-re (var val)
@@ -4472,54 +4474,17 @@ After a match, the match groups contain these elements:
(when (and (boundp 'org-emphasis-alist)
(boundp 'org-emphasis-regexp-components)
org-emphasis-alist org-emphasis-regexp-components)
- (let* ((e org-emphasis-regexp-components)
- (pre (car e))
- (post (nth 1 e))
- (border (nth 2 e))
- (body (nth 3 e))
- (nl (nth 4 e))
- (body1 (concat body "*?"))
- (markers (mapconcat 'car org-emphasis-alist ""))
- (vmarkers (mapconcat
- (lambda (x) (if (eq (nth 2 x) 'verbatim) (car x) ""))
- org-emphasis-alist "")))
- ;; make sure special characters appear at the right position in the class
- (if (string-match "\\^" markers)
- (setq markers (concat (replace-match "" t t markers) "^")))
- (if (string-match "-" markers)
- (setq markers (concat (replace-match "" t t markers) "-")))
- (if (string-match "\\^" vmarkers)
- (setq vmarkers (concat (replace-match "" t t vmarkers) "^")))
- (if (string-match "-" vmarkers)
- (setq vmarkers (concat (replace-match "" t t vmarkers) "-")))
- (if (> nl 0)
- (setq body1 (concat body1 "\\(?:\n" body "*?\\)\\{0,"
- (int-to-string nl) "\\}")))
- ;; Make the regexp
- (setq org-emph-re
- (concat "\\([" pre "]\\|^\\)"
- "\\("
- "\\([" markers "]\\)"
- "\\("
- "[^" border "]\\|"
- "[^" border "]"
- body1
- "[^" border "]"
- "\\)"
- "\\3\\)"
- "\\([" post "]\\|$\\)"))
- (setq org-verbatim-re
- (concat "\\([" pre "]\\|^\\)"
- "\\("
- "\\([" vmarkers "]\\)"
- "\\("
- "[^" border "]\\|"
- "[^" border "]"
- body1
- "[^" border "]"
- "\\)"
- "\\3\\)"
- "\\([" post "]\\|$\\)")))))
+ (pcase-let*
+ ((`(,pre ,post ,border ,body ,nl) org-emphasis-regexp-components)
+ (body (if (<= nl 0) body
+ (format "%s*?\\(?:\n%s*?\\)\\{0,%d\\}" body body nl)))
+ (template
+ (format (concat "\\([%s]\\|^\\)" ;before markers
+ "\\(\\([%%s]\\)\\([^%s]\\|[^%s]%s[^%s]\\)\\3\\)"
+ "\\([%s]\\|$\\)") ;after markers
+ pre border border body border post)))
+ (setq org-emph-re (format template "*/_+"))
+ (setq org-verbatim-re (format template "=~")))))
;; This used to be a defcustom (Org <8.0) but allowing the users to
;; set this option proved cumbersome. See this message/thread:
@@ -5876,32 +5841,29 @@ This should be called after the variable `org-link-parameters' has changed."
(defun org-do-emphasis-faces (limit)
"Run through the buffer and emphasize strings."
- (let (rtn a)
- (while (and (not rtn) (re-search-forward org-emph-re limit t))
- (let* ((border (char-after (match-beginning 3)))
- (bre (regexp-quote (char-to-string border))))
- (when (and (not (= border (char-after (match-beginning 4))))
- (not (string-match-p (concat bre ".*" bre)
- (replace-regexp-in-string
- "\n" " "
- (substring (match-string 2) 1 -1)))))
- (setq rtn t)
- (setq a (assoc (match-string 3) org-emphasis-alist))
- (font-lock-prepend-text-property (match-beginning 2) (match-end 2)
- 'face
- (nth 1 a))
- (and (nth 2 a)
- (org-remove-flyspell-overlays-in
- (match-beginning 0) (match-end 0)))
- (add-text-properties (match-beginning 2) (match-end 2)
- '(font-lock-multiline t org-emphasis t))
- (when org-hide-emphasis-markers
- (add-text-properties (match-end 4) (match-beginning 5)
- '(invisible org-link))
- (add-text-properties (match-beginning 3) (match-end 3)
- '(invisible org-link)))))
- (goto-char (1+ (match-beginning 0))))
- rtn))
+ (let ((quick-re (format "\\([%s]\\|^\\)\\([~=*/_+]\\)"
+ (car org-emphasis-regexp-components))))
+ (catch :exit
+ (while (re-search-forward quick-re limit t)
+ (let* ((marker (match-string 2))
+ (verbatim? (member marker '("~" "="))))
+ (when (save-excursion
+ (goto-char (match-beginning 0))
+ (looking-at (if verbatim? org-verbatim-re org-emph-re)))
+ (pcase-let ((`(,_ ,face ,_) (assoc marker org-emphasis-alist)))
+ (font-lock-prepend-text-property
+ (match-beginning 2) (match-end 2) 'face face)
+ (when verbatim?
+ (org-remove-flyspell-overlays-in
+ (match-beginning 0) (match-end 0)))
+ (add-text-properties (match-beginning 2) (match-end 2)
+ '(font-lock-multiline t org-emphasis t))
+ (when org-hide-emphasis-markers
+ (add-text-properties (match-end 4) (match-beginning 5)
+ '(invisible org-link))
+ (add-text-properties (match-beginning 3) (match-end 3)
+ '(invisible org-link)))
+ (throw :exit t))))))))
(defun org-emphasize (&optional char)
"Insert or change an emphasis, i.e. a font like bold or italic.
@@ -9006,18 +8968,14 @@ Optional argument WITH-CASE means sort case-sensitively."
(org-call-with-arg 'org-sort-entries with-case))))
(defun org-sort-remove-invisible (s)
- "Remove invisible links from string S."
+ "Remove invisible part of links and emphasis markers from string S."
(remove-text-properties 0 (length s) org-rm-props s)
- (while (string-match org-bracket-link-regexp s)
- (setq s (replace-match (if (match-end 2)
- (match-string 3 s)
- (match-string 1 s))
- t t s)))
- (let ((st (format " %s " s)))
- (while (string-match org-emph-re st)
- (setq st (replace-match (format " %s " (match-string 4 st)) t t st)))
- (setq s (substring st 1 -1)))
- s)
+ (replace-regexp-in-string
+ org-verbatim-re (lambda (m) (format "%s " (match-string 4 m)))
+ (replace-regexp-in-string
+ org-emph-re (lambda (m) (format " %s " (match-string 4 m)))
+ (org-link-display-format s)
+ t t) t t))
(defvar org-priority-regexp) ; defined later in the file
@@ -22004,10 +21962,9 @@ With prefix arg UNCOMPILED, load the uncompiled versions."
(defun org-in-verbatim-emphasis ()
(save-match-data
- (and (org-in-regexp org-emph-re 2)
+ (and (org-in-regexp org-verbatim-re 2)
(>= (point) (match-beginning 3))
- (<= (point) (match-end 4))
- (member (match-string 3) '("=" "~")))))
+ (<= (point) (match-end 4)))))
(defun org-overlay-display (ovl text &optional face evap)
"Make overlay OVL display TEXT with face FACE."
diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el
index 2a507f8..5968e78 100644
--- a/testing/lisp/test-org-element.el
+++ b/testing/lisp/test-org-element.el
@@ -456,16 +456,14 @@ Some other text
"Test `bold' parser."
;; Standard test.
(should
- (let ((org-emph-re "\\([ ('\"{]\\|^\\)\\(\\([+*/_=~]\\)\\([^ \n,\"']\\|[^ \n,\"'].*?\\(?:\n.*?\\)\\{0,1\\}[^ \n,\"']\\)\\3\\)\\([- .,:!?;'\")}\\]\\|$\\)"))
- (org-test-with-temp-text "*bold*"
- (org-element-map (org-element-parse-buffer) 'bold 'identity nil t))))
+ (org-test-with-temp-text "*bold*"
+ (org-element-map (org-element-parse-buffer) 'bold #'identity nil t)))
;; Multi-line markup.
(should
(equal
(org-element-contents
- (let ((org-emph-re "\\([ ('\"{]\\|^\\)\\(\\([+*/_=~]\\)\\([^ \n,\"']\\|[^ \n,\"'].*?\\(?:\n.*?\\)\\{0,1\\}[^ \n,\"']\\)\\3\\)\\([- .,:!?;'\")}\\]\\|$\\)"))
- (org-test-with-temp-text "*first line\nsecond line*"
- (org-element-map (org-element-parse-buffer) 'bold 'identity nil t))))
+ (org-test-with-temp-text "*first line\nsecond line*"
+ (org-element-map (org-element-parse-buffer) 'bold #'identity nil t)))
'("first line\nsecond line"))))
@@ -523,18 +521,16 @@ Some other text
"Test `code' parser."
;; Regular test.
(should
- (let ((org-emph-re "\\([ ('\"{]\\|^\\)\\(\\([+*/_=~]\\)\\([^ \n,\"']\\|[^ \n,\"'].*?\\(?:\n.*?\\)\\{0,1\\}[^ \n,\"']\\)\\3\\)\\([- .,:!?;'\")}\\]\\|$\\)"))
- (org-test-with-temp-text "~code~"
- (org-element-map (org-element-parse-buffer) 'code 'identity))))
+ (org-test-with-temp-text "~code~"
+ (org-element-map (org-element-parse-buffer) 'code #'identity)))
;; Multi-line markup.
(should
(equal
(org-element-property
:value
- (let ((org-emph-re "\\([ ('\"{]\\|^\\)\\(\\([+*/_=~]\\)\\([^ \n,\"']\\|[^ \n,\"'].*?\\(?:\n.*?\\)\\{0,1\\}[^ \n,\"']\\)\\3\\)\\([- .,:!?;'\")}\\]\\|$\\)"))
- (org-test-with-temp-text "~first line\nsecond line~"
- (org-element-map
- (org-element-parse-buffer) 'code 'identity nil t))))
+ (org-test-with-temp-text "~first line\nsecond line~"
+ (org-element-map
+ (org-element-parse-buffer) 'code #'identity nil t)))
"first line\nsecond line")))
@@ -1369,16 +1365,14 @@ DEADLINE: <2012-03-29 thu.>"
"Test `italic' parser."
;; Regular test.
(should
- (let ((org-emph-re "\\([ ('\"{]\\|^\\)\\(\\([+*/_=~]\\)\\([^ \n,\"']\\|[^ \n,\"'].*?\\(?:\n.*?\\)\\{0,1\\}[^ \n,\"']\\)\\3\\)\\([- .,:!?;'\")}\\]\\|$\\)"))
- (org-test-with-temp-text "/italic/"
- (org-element-map (org-element-parse-buffer) 'italic 'identity nil t))))
+ (org-test-with-temp-text "/italic/"
+ (org-element-map (org-element-parse-buffer) 'italic #'identity nil t)))
;; Multi-line markup.
(should
(equal
(org-element-contents
- (let ((org-emph-re "\\([ ('\"{]\\|^\\)\\(\\([+*/_=~]\\)\\([^ \n,\"']\\|[^ \n,\"'].*?\\(?:\n.*?\\)\\{0,1\\}[^ \n,\"']\\)\\3\\)\\([- .,:!?;'\")}\\]\\|$\\)"))
- (org-test-with-temp-text "/first line\nsecond line/"
- (org-element-map (org-element-parse-buffer) 'italic 'identity nil t))))
+ (org-test-with-temp-text "/first line\nsecond line/"
+ (org-element-map (org-element-parse-buffer) 'italic #'identity nil t)))
'("first line\nsecond line"))))
@@ -2184,17 +2178,15 @@ Outside list"
"Test `strike-through' parser."
;; Regular test.
(should
- (let ((org-emph-re "\\([ ('\"{]\\|^\\)\\(\\([+*/_=~]\\)\\([^ \n,\"']\\|[^ \n,\"'].*?\\(?:\n.*?\\)\\{0,1\\}[^ \n,\"']\\)\\3\\)\\([- .,:!?;'\")}\\]\\|$\\)"))
- (org-test-with-temp-text "+strike-through+"
- (org-element-map (org-element-parse-buffer) 'strike-through 'identity))))
+ (org-test-with-temp-text "+strike-through+"
+ (org-element-map (org-element-parse-buffer) 'strike-through #'identity)))
;; Multi-line markup.
(should
(equal
(org-element-contents
- (let ((org-emph-re "\\([ ('\"{]\\|^\\)\\(\\([+*/_=~]\\)\\([^ \n,\"']\\|[^ \n,\"'].*?\\(?:\n.*?\\)\\{0,1\\}[^ \n,\"']\\)\\3\\)\\([- .,:!?;'\")}\\]\\|$\\)"))
- (org-test-with-temp-text "+first line\nsecond line+"
- (org-element-map
- (org-element-parse-buffer) 'strike-through 'identity nil t))))
+ (org-test-with-temp-text "+first line\nsecond line+"
+ (org-element-map
+ (org-element-parse-buffer) 'strike-through #'identity nil t)))
'("first line\nsecond line"))))
@@ -2375,17 +2367,15 @@ Outside list"
"Test `underline' parser."
;; Regular test.
(should
- (let ((org-emph-re "\\([ ('\"{]\\|^\\)\\(\\([+*/_=~]\\)\\([^ \n,\"']\\|[^ \n,\"'].*?\\(?:\n.*?\\)\\{0,1\\}[^ \n,\"']\\)\\3\\)\\([- .,:!?;'\")}\\]\\|$\\)"))
- (org-test-with-temp-text "_underline_"
- (org-element-map (org-element-parse-buffer) 'underline 'identity))))
+ (org-test-with-temp-text "_underline_"
+ (org-element-map (org-element-parse-buffer) 'underline #'identity)))
;; Multi-line markup.
(should
(equal
(org-element-contents
- (let ((org-emph-re "\\([ ('\"{]\\|^\\)\\(\\([+*/_=~]\\)\\([^ \n,\"']\\|[^ \n,\"'].*?\\(?:\n.*?\\)\\{0,1\\}[^ \n,\"']\\)\\3\\)\\([- .,:!?;'\")}\\]\\|$\\)"))
- (org-test-with-temp-text "_first line\nsecond line_"
- (org-element-map
- (org-element-parse-buffer) 'underline 'identity nil t))))
+ (org-test-with-temp-text "_first line\nsecond line_"
+ (org-element-map
+ (org-element-parse-buffer) 'underline #'identity nil t)))
'("first line\nsecond line"))))
@@ -2395,18 +2385,15 @@ Outside list"
"Test `verbatim' parser."
;; Regular test.
(should
- (let ((org-emph-re "\\([ ('\"{]\\|^\\)\\(\\([+*/_=~]\\)\\([^ \n,\"']\\|[^ \n,\"'].*?\\(?:\n.*?\\)\\{0,1\\}[^ \n,\"']\\)\\3\\)\\([- .,:!?;'\")}\\]\\|$\\)"))
- (org-test-with-temp-text "=verbatim="
- (org-element-map (org-element-parse-buffer) 'verbatim 'identity))))
+ (org-test-with-temp-text "=verbatim="
+ (org-element-map (org-element-parse-buffer) 'verbatim #'identity)))
;; Multi-line markup.
(should
(equal
(org-element-property
:value
- (let ((org-emph-re "\\([ ('\"{]\\|^\\)\\(\\([+*/_=~]\\)\\([^ \n,\"']\\|[^ \n,\"'].*?\\(?:\n.*?\\)\\{0,1\\}[^ \n,\"']\\)\\3\\)\\([- .,:!?;'\")}\\]\\|$\\)"))
- (org-test-with-temp-text "=first line\nsecond line="
- (org-element-map
- (org-element-parse-buffer) 'verbatim 'identity nil t))))
+ (org-test-with-temp-text "=first line\nsecond line="
+ (org-element-map (org-element-parse-buffer) 'verbatim #'identity nil t)))
"first line\nsecond line")))