org-export: Implement a generic smart quote module

* contrib/lisp/org-export.el (org-export-options-alist): Add an option
  item to toggle smart quotes during export.
(org-export-with-smart-quotes, org-export-smart-quotes-alist,
org-export-smart-quotes-regexps): New variables.
(org-export-activate-smart-quotes): New function.
(org-export-data): Remove residual text properties.
* testing/lisp/test-org-export.el: Add tests.

2 files changed, 299 insertions, 6 deletions

diff --git a/contrib/lisp/org-export.el b/contrib/lisp/org-export.el
index 4c89c66..8bfaf64 100644
--- a/contrib/lisp/org-export.el
+++ b/contrib/lisp/org-export.el
@@ -124,6 +124,7 @@
     (:with-inlinetasks nil "inline" org-export-with-inlinetasks)
     (:with-plannings nil "p" org-export-with-planning)
     (:with-priority nil "pri" org-export-with-priority)
+    (:with-smart-quotes nil "'" org-export-with-smart-quotes)
     (:with-special-strings nil "-" org-export-with-special-strings)
     (:with-statistics-cookies nil "stat" org-export-with-statistics-cookies)
     (:with-sub-superscript nil "^" org-export-with-sub-superscripts)
@@ -471,6 +472,13 @@ This option can also be set with the #+SELECT_TAGS: keyword."
   :group 'org-export-general
   :type '(repeat (string :tag "Tag")))
 
+(defcustom org-export-with-smart-quotes nil
+  "Non-nil means activate smart quotes during export.
+This option can also be set with the #+OPTIONS: line,
+e.g. \"':t\"."
+  :group 'org-export-general
+  :type 'boolean)
+
 (defcustom org-export-with-special-strings t
   "Non-nil means interpret \"\\-\", \"--\" and \"---\" for export.
 
@@ -1188,6 +1196,11 @@ structure of the values."
 ;;   - category :: option
 ;;   - type :: symbol (nil, t)
 ;;
+;; + `:with-smart-quotes' :: Non-nil means activate smart quotes in
+;;      plain text.
+;;   - category :: option
+;;   - type :: symbol (nil, t)
+;;
 ;; + `:with-special-strings' :: Non-nil means transcoding should
 ;;      interpret special strings in plain text.
 ;;   - category :: option
@@ -1883,13 +1896,15 @@ Return transcoded string."
 	      (cond
 	       ;; Ignored element/object.
 	       ((memq data (plist-get info :ignore-list)) nil)
-	       ;; Plain text.
+	       ;; Plain text.  All residual text properties from parse
+	       ;; tree (i.e. `:parent' property) are removed.
 	       ((eq type 'plain-text)
-		(org-export-filter-apply-functions
-		 (plist-get info :filter-plain-text)
-		 (let ((transcoder (org-export-transcoder data info)))
-		   (if transcoder (funcall transcoder data info) data))
-		 info))
+		(org-no-properties
+		 (org-export-filter-apply-functions
+		  (plist-get info :filter-plain-text)
+		  (let ((transcoder (org-export-transcoder data info)))
+		    (if transcoder (funcall transcoder data info) data))
+		  info)))
 	       ;; Uninterpreted element/object: change it back to Org
 	       ;; syntax and export again resulting raw string.
 	       ((not (org-export--interpret-p data info))
@@ -4188,6 +4203,197 @@ Return a list of src-block elements with a caption."
   (org-export-collect-elements 'src-block info))
 
 
+;;;; Smart Quotes
+
+(defconst org-export-smart-quotes-alist
+  '(("de"
+     (opening-double-quote :utf-8 "„" :html "„" :latex "\"`"
+			   :texinfo "@quotedblbase{}")
+     (closing-double-quote :utf-8 "“" :html "“" :latex "\"'"
+			   :texinfo "@quotedblleft{}")
+     (opening-single-quote :utf-8 "‚" :html "‚" :latex "\\glq{}"
+			   :texinfo "@quotesinglbase{}")
+     (closing-single-quote :utf-8 "‘" :html "‘" :latex "\\grq{}"
+			   :texinfo "@quoteleft{}")
+     (apostrophe :utf-8 "’" :html "’"))
+    ("en"
+     (opening-double-quote :utf-8 "“" :html "“" :latex "``" :texinfo "``")
+     (closing-double-quote :utf-8 "”" :html "”" :latex "''" :texinfo "''")
+     (opening-single-quote :utf-8 "‘" :html "‘" :latex "`" :texinfo "`")
+     (closing-single-quote :utf-8 "’" :html "’" :latex "'" :texinfo "'")
+     (apostrophe :utf-8 "’" :html "’"))
+    ("es"
+     (opening-double-quote :utf-8 "«" :html "«" :latex "\\guillemotleft{}"
+			   :texinfo "@guillemetleft{}")
+     (closing-double-quote :utf-8 "»" :html "»" :latex "\\guillemotright{}"
+			   :texinfo "@guillemetright{}")
+     (opening-single-quote :utf-8 "“" :html "“" :latex "``" :texinfo "``")
+     (closing-single-quote :utf-8 "”" :html "”" :latex "''" :texinfo "''")
+     (apostrophe :utf-8 "’" :html "’"))
+    ("fr"
+     (opening-double-quote :utf-8 "« " :html "« " :latex "\\og "
+			   :texinfo "@guillemetleft{}@tie{}")
+     (closing-double-quote :utf-8 " »" :html " »" :latex "\\fg{}"
+			   :texinfo "@tie{}@guillemetright{}")
+     (opening-single-quote :utf-8 "« " :html "« " :latex "\\og "
+			   :texinfo "@guillemetleft{}@tie{}")
+     (closing-single-quote :utf-8 " »" :html " »" :latex "\\fg{}"
+			   :texinfo "@tie{}@guillemetright{}")
+     (apostrophe :utf-8 "’" :html "’")))
+  "Smart quotes translations.
+
+Alist whose CAR is a language string and CDR is an alist with
+quote type as key and a plist associating various encodings to
+their translation as value.
+
+A quote type can be any symbol among `opening-double-quote',
+`closing-double-quote', `opening-single-quote',
+`closing-single-quote' and `apostrophe'.
+
+Valid encodings include `:utf-8', `:html', `:latex' and
+`:texinfo'.
+
+If no translation is found, the quote character is left as-is.")
+
+(defconst org-export-smart-quotes-regexps
+  (list
+   ;; Possible opening quote at beginning of string.
+   "\\`\\([\"']\\)\\(\\w\\|\\s.\\|\\s_\\)"
+   ;; Possible closing quote at beginning of string.
+   "\\`\\([\"']\\)\\(\\s-\\|\\s)\\|\\s.\\)"
+   ;; Possible apostrophe at beginning of string.
+   "\\`\\('\\)\\S-"
+   ;; Opening single and double quotes.
+   "\\(?:\\s-\\|\\s(\\)\\([\"']\\)\\(?:\\w\\|\\s.\\|\\s_\\)"
+   ;; Closing single and double quotes.
+   "\\(?:\\w\\|\\s.\\|\\s_\\)\\([\"']\\)\\(?:\\s-\\|\\s)\\|\\s.\\)"
+   ;; Apostrophe.
+   "\\S-\\('\\)\\S-"
+   ;; Possible opening quote at end of string.
+   "\\(?:\\s-\\|\\s(\\)\\([\"']\\)\\'"
+   ;; Possible closing quote at end of string.
+   "\\(?:\\w\\|\\s.\\|\\s_\\)\\([\"']\\)\\'"
+   ;; Possible apostrophe at end of string.
+   "\\S-\\('\\)\\'")
+  "List of regexps matching a quote or an apostrophe.
+In every regexp, quote or apostrophe matched is put in group 1.")
+
+(defun org-export-activate-smart-quotes (s encoding info &optional original)
+  "Replace regular quotes with \"smart\" quotes in string S.
+
+ENCODING is a symbol among `:html', `:latex' and `:utf-8'.  INFO
+is a plist used as a communication channel.
+
+The function has to retrieve information about string
+surroundings in parse tree.  It can only happen with an
+unmodified string.  Thus, if S has already been through another
+process, a non-nil ORIGINAL optional argument will provide that
+original string.
+
+Return the new string."
+  (if (equal s "") ""
+    (let ((quotes-alist (cdr (assoc (plist-get info :language)
+				    org-export-smart-quotes-alist))))
+      ;; 1. Replace quote character at the beginning of S.
+      (let* ((prev (org-export-get-previous-element (or original s) info))
+	     (pre-blank (and prev (org-element-property :post-blank prev))))
+	(cond
+	 ;; Apostrophe?
+	 ((and prev (zerop pre-blank)
+	       (string-match (nth 2 org-export-smart-quotes-regexps) s))
+	  (let ((smart-quote
+		 (plist-get (cdr (assq 'apostrophe quotes-alist)) encoding)))
+	    (when smart-quote
+	      (setq s (replace-match smart-quote nil t s 1)))))
+	 ;; Closing quote?
+	 ((and prev (zerop pre-blank)
+	       (string-match (nth 1 org-export-smart-quotes-regexps) s))
+	  (let ((smart-quote
+		 (plist-get (cdr (assq (if (equal (match-string 1 s) "'")
+					   'closing-single-quote
+					 'closing-double-quote)
+				       quotes-alist))
+			    encoding)))
+	    (when smart-quote
+	      (setq s (replace-match smart-quote nil t s 1)))))
+	 ;; Opening quote?
+	 ((and (or (not prev) (> pre-blank 0))
+	       (string-match (nth 0 org-export-smart-quotes-regexps) s))
+	  (let ((smart-quote
+		 (plist-get (cdr (assq (if (equal (match-string 1 s) "'")
+					   'opening-single-quote
+					 'opening-double-quote)
+				       quotes-alist))
+			    encoding)))
+	    (when smart-quote
+	      (setq s (replace-match smart-quote nil t s 1)))))))
+      ;; 2. Replace quotes in the middle of the string.
+      (setq s
+	    ;; Opening quotes.
+	    (replace-regexp-in-string
+	     (nth 3 org-export-smart-quotes-regexps)
+	     (lambda (text)
+	       (or (plist-get
+		    (cdr (assq (if (equal (match-string 1 text) "'")
+				   'opening-single-quote
+				 'opening-double-quote)
+			       quotes-alist))
+		    encoding)
+		   (match-string 1 text)))
+	     s nil t 1))
+      (setq s
+	    (replace-regexp-in-string
+	     ;; Closing quotes.
+	     (nth 4 org-export-smart-quotes-regexps)
+	     (lambda (text)
+	       (or (plist-get
+		    (cdr (assq (if (equal (match-string 1 text) "'")
+				   'closing-single-quote
+				 'closing-double-quote)
+			       quotes-alist))
+		    encoding)
+		   (match-string 1 text)))
+	     s nil t 1))
+      (setq s
+	    (replace-regexp-in-string
+	     ;; Apostrophes.
+	     (nth 5 org-export-smart-quotes-regexps)
+	     (lambda (text)
+	       (or (plist-get (cdr (assq 'apostrophe quotes-alist)) encoding)
+		   (match-string 1 text)))
+	     s nil t 1))
+      ;; 3. Replace quote character at the end of S.
+      (let ((next (org-export-get-next-element (or original s) info)))
+	(cond
+	 ;; Apostrophe?
+	 ((and next (string-match (nth 8 org-export-smart-quotes-regexps) s))
+	  (let ((smart-quote
+		 (plist-get (cdr (assq 'apostrophe quotes-alist)) encoding)))
+	    (when smart-quote (setq s (replace-match smart-quote nil t s 1)))))
+	 ;; Closing quote?
+	 ((and (not next)
+	       (string-match (nth 7 org-export-smart-quotes-regexps) s))
+	  (let ((smart-quote
+		 (plist-get (cdr (assq (if (equal (match-string 1 s) "'")
+					   'closing-single-quote
+					 'closing-double-quote)
+				       quotes-alist))
+			    encoding)))
+	    (when smart-quote (setq s (replace-match smart-quote nil t s 1)))))
+	 ;; Opening quote?
+	 ((and next (string-match (nth 6 org-export-smart-quotes-regexps) s))
+	  (let ((smart-quote
+		 (plist-get (cdr (assq (if (equal (match-string 1 s) "'")
+					   'opening-single-quote
+					 'opening-double-quote)
+				       quotes-alist))
+			    encoding)))
+	    (when smart-quote
+	      (setq s (replace-match smart-quote nil t s 1)))))))
+      ;; Return string with smart quotes.
+      s)))
+
+
 ;;;; Topology
 ;;
 ;; Here are various functions to retrieve information about the
diff --git a/testing/lisp/test-org-export.el b/testing/lisp/test-org-export.el
index c8a1cd7..e2a4e83 100644
--- a/testing/lisp/test-org-export.el
+++ b/testing/lisp/test-org-export.el
@@ -1143,6 +1143,93 @@ Another text. (ref:text)
 
 
 
+;;; Smart Quotes
+
+(ert-deftest test-org-export/activate-smart-quotes ()
+  "Test `org-export-activate-smart-quotes' specifications."
+  ;; Opening double quotes: standard test.
+  (should
+   (equal
+    '("some “paragraph")
+    (let ((org-export-default-language "en"))
+      (org-test-with-parsed-data "some \"paragraph"
+	(org-element-map
+	 tree 'plain-text
+	 (lambda (s) (org-export-activate-smart-quotes s :html info))
+	 info)))))
+  ;; Opening quotes: at the beginning of a paragraph.
+  (should
+   (equal
+    '("“begin")
+    (let ((org-export-default-language "en"))
+      (org-test-with-parsed-data "\"begin"
+	(org-element-map
+	 tree 'plain-text
+	 (lambda (s) (org-export-activate-smart-quotes s :html info))
+	 info)))))
+  ;; Opening quotes: after an object.
+  (should
+   (equal
+    '("“begin")
+    (let ((org-export-default-language "en"))
+      (org-test-with-parsed-data "=verb= \"begin"
+	(org-element-map
+	 tree 'plain-text
+	 (lambda (s) (org-export-activate-smart-quotes s :html info))
+	 info)))))
+  ;; Closing quotes: standard test.
+  (should
+   (equal
+    '("some” paragraph")
+    (let ((org-export-default-language "en"))
+      (org-test-with-parsed-data "some\" paragraph"
+	(org-element-map
+	 tree 'plain-text
+	 (lambda (s) (org-export-activate-smart-quotes s :html info))
+	 info)))))
+  ;; Closing quotes: at the end of a paragraph.
+  (should
+   (equal
+    '("end”")
+    (let ((org-export-default-language "en"))
+      (org-test-with-parsed-data "end\""
+	(org-element-map
+	 tree 'plain-text
+	 (lambda (s) (org-export-activate-smart-quotes s :html info))
+	 info)))))
+  ;; Apostrophe: standard test.
+  (should
+   (equal
+    '("It shouldn’t fail")
+    (let ((org-export-default-language "en"))
+      (org-test-with-parsed-data "It shouldn't fail"
+	(org-element-map
+	 tree 'plain-text
+	 (lambda (s) (org-export-activate-smart-quotes s :html info))
+	 info)))))
+  ;; Apostrophe: before an object.
+  (should
+   (equal
+    '("a’")
+    (let ((org-export-default-language "en"))
+      (org-test-with-parsed-data "a'=b="
+	(org-element-map
+	 tree 'plain-text
+	 (lambda (s) (org-export-activate-smart-quotes s :html info))
+	 info)))))
+  ;; Apostrophe: after an object.
+  (should
+   (equal
+    '("’s")
+    (let ((org-export-default-language "en"))
+      (org-test-with-parsed-data "=code='s"
+	(org-element-map
+	 tree 'plain-text
+	 (lambda (s) (org-export-activate-smart-quotes s :html info))
+	 info))))))
+
+
+
 ;;; Tables
 
 (ert-deftest test-org-export/special-column ()