Function: org-export--smart-quote-status

org-export--smart-quote-status is a byte-compiled function defined in ox.el.gz.

Signature

(org-export--smart-quote-status S INFO)

Documentation

Return smart quote status at the beginning of string S.

INFO is the current export state, as a plist.

Source Code

;; Defined in /usr/src/emacs/lisp/org/ox.el.gz
(defun org-export--smart-quote-status (s info)
  "Return smart quote status at the beginning of string S.
INFO is the current export state, as a plist."
  (let* ((parent (org-element-parent s))
	 (cache (or (plist-get info :smart-quote-cache)
		    (let ((table (make-hash-table :test #'eq)))
		      (plist-put info :smart-quote-cache table)
		      table)))
	 (value (gethash (cons parent (org-element-secondary-p s)) cache 'missing-data)))
    (if (not (eq value 'missing-data)) (cdr (assq s value))
      (let (level1-open full-status)
	(org-element-map
	    (let ((secondary (org-element-secondary-p s)))
	      (if secondary (org-element-property secondary parent)
		(org-element-contents parent)))
	    'plain-text
	  (lambda (text)
	    (let ((start 0) current-status)
	      (while (setq start (string-match "['\"]" text start))
		(push
		 (cond
		  ((equal (match-string 0 text) "\"")
		   (setf level1-open (not level1-open))
		   (if level1-open 'primary-opening 'primary-closing))
		  ;; Not already in a level 1 quote: this is an
		  ;; apostrophe.
		  ((not level1-open) 'apostrophe)
		  ;; Extract previous char and next char.  As
		  ;; a special case, they can also be set to `blank',
		  ;; `no-blank' or nil.  Then determine if current
		  ;; match is allowed as an opening quote or a closing
		  ;; quote.
		  (t
		   (let* ((previous
			   (if (> start 0) (substring text (1- start) start)
			     (let ((p (org-export-get-previous-element
				       text info)))
			       (cond ((not p) nil)
				     ((stringp p) (substring p -1))
				     ((memq (org-element-post-blank p)
					    '(0 nil))
				      'no-blank)
				     (t 'blank)))))
			  (next
			   (if (< (1+ start) (length text))
			       (substring text (1+ start) (+ start 2))
			     (let ((n (org-export-get-next-element text info)))
			       (cond ((not n) nil)
				     ((stringp n) (substring n 0 1))
				     (t 'no-blank)))))
			  (allow-open
			   (and (if (stringp previous)
				    (string-match "\\s\"\\|\\s-\\|\\s("
						  previous)
				  (memq previous '(blank nil)))
				(if (stringp next)
				    (string-match "\\w\\|\\s.\\|\\s_" next)
				  (eq next 'no-blank))))
			  (allow-close
			   (and (if (stringp previous)
				    (string-match "\\w\\|\\s.\\|\\s_" previous)
				  (eq previous 'no-blank))
				(if (stringp next)
				    (string-match "\\s-\\|\\s)\\|\\s.\\|\\s\""
						  next)
				  (memq next '(blank nil))))))
		     (cond
		      ((and allow-open allow-close) (error "Should not happen"))
		      (allow-open 'secondary-opening)
		      (allow-close 'secondary-closing)
		      (t 'apostrophe)))))
		 current-status)
		(cl-incf start))
	      (when current-status
		(push (cons text (nreverse current-status)) full-status))))
	  info nil org-element-recursive-objects)
        ;; When quotes are not balanced, treat them as apostrophes.
        (setq full-status (nreverse full-status))
        (let (primary-openings secondary-openings)
          (dolist (substatus full-status)
            (let ((status (cdr substatus)))
              (while status
                (pcase (car status)
                  (`apostrophe nil)
                  (`primary-opening
                   (push status primary-openings))
                  (`secondary-opening
                   (push status secondary-openings))
                  (`secondary-closing
                   (if secondary-openings
                       ;; Remove matched opening.
                       (pop secondary-openings)
                     ;; No matching openings for a given closing.  Replace
                     ;; it with apostrophe.
                     (setcar status 'apostrophe)))
                  (`primary-closing
                   (when secondary-openings
                     ;; Some secondary opening quotes are not closed
                     ;; within "...".  Replace them all with apostrophes.
                     (dolist (opening secondary-openings)
                       (setcar opening 'apostrophe))
                     (setq secondary-openings nil))
                   (if primary-openings
                       ;; Remove matched opening.
                       (pop primary-openings)
                     ;; No matching openings for a given closing.
                     (error "This should no happen"))))
                (setq status (cdr status)))))
          (when primary-openings
            ;; Trailing unclosed "
            (unless (= 1 (length primary-openings))
              (error "This should not happen"))
            ;; Mark for not replacing.
            (setcar (car primary-openings) nil)
            ;; Mark all the secondary openings and closings after
            ;; trailing unclosed " as apostrophes.
            (let ((after-unbalanced-primary nil))
              (dolist (substatus full-status)
                (let ((status (cdr substatus)))
                  (while status
                    (when (eq status (car primary-openings))
                      (setq after-unbalanced-primary t))
                    (when after-unbalanced-primary
                      (when (memq (car status) '(secondary-opening secondary-closing))
                        (setcar status 'apostrophe)))
                    (setq status (cdr status))))))))
	(puthash (cons parent (org-element-secondary-p s)) full-status cache)
	(cdr (assq s full-status))))))