[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[O] [PATCH 2/3] Introduce machinery to ox.el for concordance generation
From: |
Aaron Ecay |
Subject: |
[O] [PATCH 2/3] Introduce machinery to ox.el for concordance generation |
Date: |
Sun, 31 Mar 2013 23:15:00 -0400 |
* lisp/ox.el (org-export-concordance): New buffer-local variable
(org-export-with-concordance): New user option
(org-export--concordance-propertize),
(org-export--concordance-propertize-pre),
(org-export--build-concordance),
(org-export--read-concordance): New functions
(org-export-data): Call org-export–concordance-propertize where
appropriate
(org-export-as),
(org-export-to-buffer),
(org-export-to-file): Handle concordance generation
The general idea is as follows:
1) Before copying the buffer for export, call org-export--propertize-pre
to add line-number properties to the buffer
2) The parser sees these properties during export (previous commit)
3) org-export-data adds text properties to the strings it generates,
indicating which lines they originated from (using function
org-export--propertize)
4) These properties survive into the output buffer (because export no
longer calls org-no-properties)
5) After export is finished, org-export-build-concordance walks the
result buffer, calculating a concordance of source lines and output
lines.
6) This value is stored in the org buffer’s org-export-concordance local
variable
---
lisp/ox.el | 151 +++++++++++++++++++++++++++++++++++++++++++++++++------------
1 file changed, 121 insertions(+), 30 deletions(-)
diff --git a/lisp/ox.el b/lisp/ox.el
index ff6407b..e1c76bd 100644
--- a/lisp/ox.el
+++ b/lisp/ox.el
@@ -302,6 +302,13 @@ and its CDR is a list of export options.")
This marker will be used with `C-u C-c C-e' to make sure export repetition
uses the same subtree if the previous command was restricted to a subtree.")
+(defvar org-export-concordance nil
+ "The concordance resulting from the last export operation.
+
+The variable is always buffer-local, and only manipulated if
+`org-export-with-concordance' is set.")
+(make-variable-buffer-local 'org-export-concordance)
+
;;; User-configurable Variables
;;
@@ -351,6 +358,16 @@ e.g. \"c:t\"."
:group 'org-export-general
:type 'boolean)
+(defcustom org-export-with-concordance nil
+ "Non-nil means to generate a concordance.
+
+This is currently useful only for the LaTeX backend (and derived
+backends), which can use it to patch the SyncTeX file generated
+by LaTeX, so that it is possible to jump back and forth between
+the org file and resulting pdf."
+ :group 'org-export-general
+ :type 'boolean)
+
(defcustom org-export-with-creator 'comment
"Non-nil means the postamble should contain a creator sentence.
@@ -2040,6 +2057,61 @@ INFO is a plist containing export directives."
(let ((transcoder (cdr (assq type (plist-get info :translate-alist)))))
(and (functionp transcoder) transcoder)))))
+(defun org-export--concordance-propertize (data string)
+ "Add line number text properties to STRING, based on DATA.
+
+This will allow the construction of a concordance from the
+completed string."
+ (let ((len (length string)))
+ (when (> len 1)
+ (put-text-property 0 1 'org-line-num
+ (org-element-property :begin-line data)
+ string)
+ (put-text-property (1- len) len 'org-line-num
+ (org-element-property :end-line data)
+ string)))
+ string)
+
+(defun org-export--concordance-propertize-pre ()
+ "Put line-number text properties on a buffer.
+
+Each line gets a org-line-num-pre property, which is its line
+number in the buffer before any export operations have changed
+the buffer."
+ ;; This is called from `org-export-as', which has issued
+ ;; `save-restriction'.
+ (widen)
+ (while (= 0 (forward-line 1))
+ (put-text-property (point) (point-at-eol) 'org-line-num-pre
+ (line-number-at-pos))))
+
+(defun org-export--build-concordance ()
+ "Build a concordance, based on text props in an exported buffer."
+ (save-excursion
+ (let ((res '())
+ next)
+ (goto-char (point-min))
+ (while (setq next (next-single-property-change (point) 'org-line-num))
+ (goto-char next)
+ (setq res (cons (cons (line-number-at-pos)
+ (get-text-property (point) 'org-line-num))
+ res))
+ (forward-char 1))
+ (setq res (nreverse res))
+ (setq next res)
+ (while (cdr next)
+ (if (equal (caar next) (caadr next))
+ (setcdr next (cddr next))
+ (setq next (cdr next))))
+ res)))
+
+(defun org-export--read-concordance (concordance src-line)
+ "Get the original line number from CONCORDANCE for output line SRC-LINE."
+ (while (and (caadr concordance)
+ (<= (caadr concordance) src-line))
+ (setq concordance (cdr concordance)))
+ (cdar concordance))
+
(defun org-export-data (data info)
"Convert DATA into current back-end format.
@@ -2056,11 +2128,16 @@ Return transcoded string."
((memq data (plist-get info :ignore-list)) nil)
;; Plain text.
((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))
+ (let* ((transcoder (org-export-transcoder data info))
+ (transcoded-string (if transcoder
+ (funcall transcoder data info)
+ data))
+ (propertized-string (org-export--concordance-propertize
+ data transcoded-string)))
+ (org-export-filter-apply-functions
+ (plist-get info :filter-plain-text)
+ propertized-string
+ info)))
;; Uninterpreted element/object: change it back to Org
;; syntax and export again resulting raw string.
((not (org-export--interpret-p data info))
@@ -2081,15 +2158,18 @@ Return transcoded string."
(and (eq type 'headline)
(eq (plist-get info :with-archived-trees) 'headline)
(org-element-property :archivedp data)))
- (let ((transcoder (org-export-transcoder data info)))
- (or (and (functionp transcoder)
- (funcall transcoder data nil info))
- ;; Export snippets never return a nil value so
- ;; that white spaces following them are never
- ;; ignored.
- (and (eq type 'export-snippet) ""))))
- ;; Element/Object with contents.
- (t
+ (let* ((transcoder (org-export-transcoder data info))
+ (transcoded-string
+ (or (and (functionp transcoder)
+ (funcall transcoder data nil info))
+ ;; Export snippets never return a nil value so
+ ;; that white spaces following them are never
+ ;; ignored.
+ (and (eq type 'export-snippet) ""))))
+ (and transcoded-string
+ (org-export--concordance-propertize data
transcoded-string))))
+ ;; Element/Object with contents.
+ (t
(let ((transcoder (org-export-transcoder data info)))
(when transcoder
(let* ((greaterp (memq type org-element-greater-elements))
@@ -2118,11 +2198,13 @@ Return transcoded string."
data)
(memq (org-element-type parent)
'(footnote-definition item))))))))
- "")))
- (funcall transcoder data
- (if (not greaterp) contents
- (org-element-normalize-string contents))
- info))))))))
+ ""))
+ (transcoded-string
+ (funcall transcoder data
+ (if (not greaterp) contents
+ (org-element-normalize-string contents))
+ info)))
+ (org-export--concordance-propertize data
transcoded-string))))))))
;; Final result will be memoized before being returned.
(puthash
data
@@ -2893,6 +2975,8 @@ Return code as a string."
;; created, where include keywords, macros are expanded and
;; code blocks are evaluated.
(org-export-with-buffer-copy
+ (when org-export-with-concordance
+ (org-export--concordance-propertize-pre))
;; Run first hook with current back-end as argument.
(run-hook-with-args 'org-export-before-processing-hook backend)
(org-export-expand-include-keyword)
@@ -2953,15 +3037,12 @@ Return code as a string."
(funcall inner-template body info)))
(template (cdr (assq 'template
(plist-get info :translate-alist)))))
- ;; Remove all text properties since they cannot be
- ;; retrieved from an external process. Finally call
- ;; final-output filter and return result.
- (org-no-properties
- (org-export-filter-apply-functions
- (plist-get info :filter-final-output)
- (if (or (not (functionp template)) body-only) full-body
- (funcall template full-body info))
- info))))))))
+ ;; Call final-output filter and return result.
+ (org-export-filter-apply-functions
+ (plist-get info :filter-final-output)
+ (if (or (not (functionp template)) body-only) full-body
+ (funcall template full-body info))
+ info)))))))
;;;###autoload
(defun org-export-to-buffer
@@ -2980,11 +3061,16 @@ see.
Depending on `org-export-copy-to-kill-ring', add buffer contents
to kill ring. Return buffer."
(let ((out (org-export-as backend subtreep visible-only body-only ext-plist))
- (buffer (get-buffer-create buffer)))
+ (buffer (get-buffer-create buffer))
+ concordance)
(with-current-buffer buffer
(erase-buffer)
(insert out)
+ (when org-export-with-concordance
+ (setq concordance (org-export--build-concordance)))
(goto-char (point-min)))
+ (when concordance
+ (setq org-export-concordance concordance))
;; Maybe add buffer contents to kill ring.
(when (and (org-export--copy-to-kill-ring-p) (org-string-nw-p out))
(org-kill-new out))
@@ -3009,11 +3095,16 @@ to kill ring. Return output file's name."
;; we'd rather avoid needless transcoding of parse tree.
(unless (file-writable-p file) (error "Output file not writable"))
;; Insert contents to a temporary buffer and write it to FILE.
- (let ((out (org-export-as backend subtreep visible-only body-only
ext-plist)))
+ (let ((out (org-export-as backend subtreep visible-only body-only ext-plist))
+ concordance)
(with-temp-buffer
(insert out)
+ (when org-export-with-concordance
+ (setq concordance (org-export--build-concordance)))
(let ((coding-system-for-write org-export-coding-system))
(write-file file)))
+ (when concordance
+ (setq org-export-concordance concordance))
;; Maybe add file contents to kill ring.
(when (and (org-export--copy-to-kill-ring-p) (org-string-nw-p out))
(org-kill-new out)))
--
1.8.2