From mboxrd@z Thu Jan 1 00:00:00 1970 From: Aaron Ecay Subject: [PATCH 2/3] Introduce machinery to ox.el for concordance generation Date: Sun, 31 Mar 2013 23:15:00 -0400 Message-ID: <1364786101-16603-3-git-send-email-aaronecay@gmail.com> References: <1364786101-16603-1-git-send-email-aaronecay@gmail.com> Mime-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Return-path: Received: from eggs.gnu.org ([208.118.235.92]:44183) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UMVDL-0002T8-Nl for emacs-orgmode@gnu.org; Sun, 31 Mar 2013 23:15:23 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1UMVDH-0003hE-3a for emacs-orgmode@gnu.org; Sun, 31 Mar 2013 23:15:19 -0400 Received: from mail-qe0-f52.google.com ([209.85.128.52]:55736) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UMVDG-0003hA-Tz for emacs-orgmode@gnu.org; Sun, 31 Mar 2013 23:15:15 -0400 Received: by mail-qe0-f52.google.com with SMTP id jy17so1029902qeb.11 for ; Sun, 31 Mar 2013 20:15:14 -0700 (PDT) In-Reply-To: <1364786101-16603-1-git-send-email-aaronecay@gmail.com> List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: emacs-orgmode@gnu.org * 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