From 9fb2e047d2963ff5f4218d43bbb006898e8eac6f Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Thu, 8 Dec 2016 09:44:26 +0100 Subject: [PATCH] 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'. --- lisp/org-element.el | 4 +- lisp/org.el | 133 +++++++++++-------------------- testing/lisp/test-org-element.el | 67 +++++++--------- 3 files changed, 74 insertions(+), 130 deletions(-) diff --git a/lisp/org-element.el b/lisp/org-element.el index b86244eb6..c311cb75e 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 f642000eb..a61a7a47c 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 2a507f8ea..5968e7883 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")))