ox: Fix smart inner quotes

* lisp/ox.el (org-export--smart-quote-status): Fix inner smart quotes.
* testing/lisp/test-ox.el (test-org-export/activate-smart-quotes): Add
  tests.

Reported-by: "T.F. Torrey" <tftorrey@tftorrey.com>
<http://permalink.gmane.org/gmane.emacs.orgmode/100779>
This commit is contained in:
Nicolas Goaziou 2015-09-02 21:02:41 +02:00
parent 7c49b7a66c
commit d66d6f55e0
2 changed files with 62 additions and 44 deletions

View File

@ -5174,62 +5174,65 @@ INFO is the current export state, as a plist."
table))) table)))
(value (gethash parent cache 'missing-data))) (value (gethash parent cache 'missing-data)))
(if (not (eq value 'missing-data)) (cdr (assq s value)) (if (not (eq value 'missing-data)) (cdr (assq s value))
(let (level1-open level2-open full-status) (let (level1-open full-status)
(org-element-map parent 'plain-text (org-element-map parent 'plain-text
(lambda (text) (lambda (text)
(let ((start 0) current-status) (let ((start 0) current-status)
(while (setq start (string-match "['\"]" text start)) (while (setq start (string-match "['\"]" text start))
(incf start)
(push (push
(cond (cond
((equal (match-string 0 text) "\"") ((equal (match-string 0 text) "\"")
(setf level1-open (not level1-open)) (setf level1-open (not level1-open))
(setf level2-open nil)
(if level1-open 'opening-double-quote 'closing-double-quote)) (if level1-open 'opening-double-quote 'closing-double-quote))
;; Not already in a level 1 quote: this is an ;; Not already in a level 1 quote: this is an
;; apostrophe. ;; apostrophe.
((not level1-open) 'apostrophe) ((not level1-open) 'apostrophe)
;; Apostrophe. ;; Extract previous char and next char. As
((org-string-match-p "\\S-'\\S-" text) 'apostrophe) ;; a special case, they can also be set to `blank',
;; Apostrophe at the beginning of a string. Check ;; `no-blank' or nil. Then determine if current
;; white space at the end of the last object. ;; match is allowed as an opening quote or a closing
((and (org-string-match-p "\\`'\\S-" text) ;; quote.
(let ((p (org-export-get-previous-element text info))) (t
(and p (let* ((previous
(if (stringp p) (if (> start 0) (substring text (1- start) start)
(not (org-string-match-p "[ \t]\\'" p)) (let ((p (org-export-get-previous-element
(memq (org-element-property :post-blank p) text info)))
'(0 nil)))))) (cond ((not p) nil)
'apostrophe) ((stringp p) (substring p (1- (length p))))
;; Apostrophe at the end of a string. Check white ((memq (org-element-property :post-blank p)
;; space at the beginning of the next object, which '(0 nil))
;; can only happen if that object is a string. 'no-blank)
((and (org-string-match-p "\\S-'\\'" text) (t 'blank)))))
(next
(if (< (1+ start) (length text))
(substring text (1+ start) (+ start 2))
(let ((n (org-export-get-next-element text info))) (let ((n (org-export-get-next-element text info)))
(and n (cond ((not n) nil)
(not (and (stringp n) ((stringp n) (substring n 0 1))
(org-string-match-p "\\`[ \t]" n)))))) (t 'no-blank)))))
'apostrophe) (allow-open
;; Lonesome apostrophe. Check white space around (and (if (stringp previous)
;; both ends. (string-match "\\s\"\\|\\s-\\|\\s("
((and (equal text "'") previous)
(let ((p (org-export-get-previous-element text info))) (memq previous '(blank nil)))
(and p (if (stringp next)
(if (stringp p) (string-match "\\w\\|\\s.\\|\\s_" next)
(not (org-string-match-p "[ \t]\\'" p)) (eq next 'no-blank))))
(memq (org-element-property :post-blank p) (allow-close
'(0 nil))) (and (if (stringp previous)
(let ((n (org-export-get-next-element text info))) (string-match "\\w\\|\\s.\\|\\s_" previous)
(and n (eq previous 'no-blank))
(not (and (stringp n) (if (stringp next)
(org-string-match-p "\\`[ \t]" (string-match "\\s-\\|\\s)\\|\\s.\\|\\s\""
n)))))))) next)
'apostrophe) (memq next '(blank nil))))))
;; Else, consider it as a level 2 quote. (cond
(t (setf level2-open (not level2-open)) ((and allow-open allow-close) (error "Should not happen"))
(if level2-open 'opening-single-quote (allow-open 'opening-single-quote)
'closing-single-quote))) (allow-close 'closing-single-quote)
current-status)) (t 'apostrophe)))))
current-status)
(setq start (1+ start)))
(when current-status (when current-status
(push (cons text (nreverse current-status)) full-status)))) (push (cons text (nreverse current-status)) full-status))))
info nil org-element-recursive-objects) info nil org-element-recursive-objects)

View File

@ -2821,6 +2821,21 @@ Another text. (ref:text)
(org-element-map tree 'plain-text (org-element-map tree 'plain-text
(lambda (s) (org-export-activate-smart-quotes s :utf-8 info)) (lambda (s) (org-export-activate-smart-quotes s :utf-8 info))
info))))) info)))))
;; Inner quotes: close to special symbols.
(should
(equal '("« outer (« inner ») outer »")
(let ((org-export-default-language "fr"))
(org-test-with-parsed-data "\"outer ('inner') outer\""
(org-element-map tree 'plain-text
(lambda (s) (org-export-activate-smart-quotes s :utf-8 info))
info)))))
(should
(equal '("« « inner » »")
(let ((org-export-default-language "fr"))
(org-test-with-parsed-data "\"'inner'\""
(org-element-map tree 'plain-text
(lambda (s) (org-export-activate-smart-quotes s :utf-8 info))
info)))))
;; Apostrophe: standard test. ;; Apostrophe: standard test.
(should (should
(equal '("It « shouldnt » fail") (equal '("It « shouldnt » fail")