emacs-orgmode
[Top][All Lists]
Advanced

[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




reply via email to

[Prev in Thread] Current Thread [Next in Thread]