From 620f1d5181fcd831544fca6ba39618bc0d9021b8 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Wed, 22 Feb 2012 17:35:52 +0100 Subject: [PATCH] org-export: Remove `:genealogy', introduce `:ignore-list' * EXPERIMENTAL/org-e-ascii.el (org-e-ascii--current-text-width, org-e-ascii-item, org-e-ascii-paragraph): Apply `:genealogy' removal. * EXPERIMENTAL/org-e-latex.el (org-e-latex-item): Apply `:genealogy' removal. * contrib/lisp/org-element.el (org-element-map): Do not compile genealogy. Also use `:ignore-list' when possible. * contrib/lisp/org-export.el (org-export-collect-tree-properties): Populate `:ignore-list' before starting to transcode each element in subtree. (org-export-get-min-level): Use `:ignore-list'. (org-export--skip-p): Renamed from `org-export-skip-p'. This is now an internal function. (org-export-data): Use and update `:ignore-list'. Do not update genealogy. (org-export-ignore-element): New function (org-export-last-sibling-p): Small refactoring. (org-export-resolve-fuzzy-link): Apply `:genealogy' removal. (org-export-get-genealogy): Use a more efficient algorithm. The equivalent of (plist-get info :genealogy) is now (org-export-get-genealogy blob info), blob being any element or object. --- EXPERIMENTAL/org-e-ascii.el | 6 +- EXPERIMENTAL/org-e-latex.el | 2 +- contrib/lisp/org-element.el | 46 ++++--- contrib/lisp/org-export.el | 312 +++++++++++++++++++++++++------------------- 4 files changed, 202 insertions(+), 164 deletions(-) diff --git a/EXPERIMENTAL/org-e-ascii.el b/EXPERIMENTAL/org-e-ascii.el index c02515e06..1522b1e83 100644 --- a/EXPERIMENTAL/org-e-ascii.el +++ b/EXPERIMENTAL/org-e-ascii.el @@ -514,7 +514,7 @@ INFO is a plist used as a communication channel." ;; Elements with a relative width: store maximum text width in ;; TOTAL-WIDTH. (otherwise - (let* ((genealogy (cons element (plist-get info :genealogy))) + (let* ((genealogy (cons element (org-export-get-genealogy element info))) ;; Total width is determined by the presence, or not, of an ;; inline task among ELEMENT parents. (total-width @@ -1280,7 +1280,7 @@ contextual information." ;; `:type' property from it. (org-list-bullet-string (let ((type (org-element-property - :type (car (plist-get info :genealogy))))) + :type (car (org-export-get-genealogy item info))))) (cond ((eq type 'descriptive) (concat @@ -1432,7 +1432,7 @@ information." CONTENTS is the contents of the paragraph, as a string. INFO is the plist used as a communication channel." (org-e-ascii--fill-string - (let ((parent (car (plist-get info :genealogy)))) + (let ((parent (car (org-export-get-genealogy paragraph info)))) ;; If PARAGRAPH is the first one in a list element, be sure to ;; add the check-box in front of it, before any filling. Later, ;; it would interfere with line width. diff --git a/EXPERIMENTAL/org-e-latex.el b/EXPERIMENTAL/org-e-latex.el index 7473d6452..452659ef8 100644 --- a/EXPERIMENTAL/org-e-latex.el +++ b/EXPERIMENTAL/org-e-latex.el @@ -1234,7 +1234,7 @@ contextual information." ;; Grab `:level' from plain-list properties, which is always the ;; first element above current item. (let* ((level (org-element-property - :level (car (plist-get info :genealogy)))) + :level (car (org-export-get-genealogy item info)))) (counter (let ((count (org-element-property :counter item))) (and count (< level 4) diff --git a/contrib/lisp/org-element.el b/contrib/lisp/org-element.el index 062ca83c0..40e9e405b 100644 --- a/contrib/lisp/org-element.el +++ b/contrib/lisp/org-element.el @@ -3037,13 +3037,12 @@ Nil values returned from FUN are ignored in the result." --acc (--check-blob (function - (lambda (--type types fun --blob --local) + (lambda (--type types fun --blob info) ;; Check if TYPE is matching among TYPES. If so, apply - ;; FUN to --BLOB and accumulate return value - ;; into --ACC. --LOCAL is the communication channel. - ;; If --BLOB has a secondary string that can contain - ;; objects with their type amond TYPES, look into that - ;; string first. + ;; FUN to --BLOB and accumulate return value into --ACC. + ;; INFO is the communication channel. If --BLOB has + ;; a secondary string that can contain objects with their + ;; type amond TYPES, look into that string first. (when (memq --type --restricts) (funcall --walk-tree @@ -3052,16 +3051,16 @@ Nil values returned from FUN are ignored in the result." ,@(org-element-property (cdr (assq --type org-element-secondary-value-alist)) --blob)) - --local)) + info)) (when (memq --type types) - (let ((result (funcall fun --blob --local))) + (let ((result (funcall fun --blob info))) (cond ((not result)) (first-match (throw 'first-match result)) (t (push result --acc)))))))) (--walk-tree (function - (lambda (--data --local) - ;; Recursively walk DATA. --LOCAL, if non-nil, is + (lambda (--data info) + ;; Recursively walk DATA. INFO, if non-nil, is ;; a plist holding contextual information. (mapc (lambda (--blob) @@ -3070,19 +3069,23 @@ Nil values returned from FUN are ignored in the result." ;; possible and allowed. (cond ;; Element or object not exportable. - ((and info (org-export-skip-p --blob info))) + ((member --blob (plist-get info :ignore-list))) ;; Archived headline: Maybe apply FUN on it, but - ;; skip contents. + ;; ignore contents. ((and info (eq --type 'headline) (eq (plist-get info :with-archived-trees) 'headline) (org-element-property :archivedp --blob)) - (funcall --check-blob --type types fun --blob --local)) + (funcall --check-blob + --type types fun + ;; Ensure --BLOB has no contents. + (list --type (nth 1 --blob)) + info)) ;; Limiting recursion to greater elements, and --BLOB ;; isn't one. ((and (eq --category 'greater-elements) (not (memq --type org-element-greater-elements))) - (funcall --check-blob --type types fun --blob --local)) + (funcall --check-blob --type types fun --blob info)) ;; Limiting recursion to elements, and --BLOB only ;; contains objects. ((and (eq --category 'elements) (eq --type 'paragraph))) @@ -3092,16 +3095,11 @@ Nil values returned from FUN are ignored in the result." (not (or (eq --type 'paragraph) (memq --type org-element-greater-elements) (memq --type org-element-recursive-objects)))) - (funcall --check-blob --type types fun --blob --local)) - ;; Recursion is possible and allowed: Update local - ;; information and move into --BLOB. - (t (funcall --check-blob --type types fun --blob --local) - (funcall - --walk-tree --blob - (org-combine-plists - --local - `(:genealogy - ,(cons --blob (plist-get --local :genealogy))))))))) + (funcall --check-blob --type types fun --blob info)) + ;; Recursion is possible and allowed: Maybe apply + ;; FUN to --BLOB, then move into it. + (t (funcall --check-blob --type types fun --blob info) + (funcall --walk-tree --blob info))))) (org-element-contents --data)))))) (catch 'first-match (funcall --walk-tree data info) diff --git a/contrib/lisp/org-export.el b/contrib/lisp/org-export.el index 5c05bf537..0901a4b1d 100644 --- a/contrib/lisp/org-export.el +++ b/contrib/lisp/org-export.el @@ -649,7 +649,7 @@ standard mode." ;; just before export, by `org-export-collect-tree-properties'. ;; ;; 3. Local options are updated during parsing, and their value -;; depends on the level of recursion. For now, only `:genealogy' +;; depends on the level of recursion. For now, only `:ignore-list' ;; belongs to that category. ;; Here is the full list of properties available during transcode @@ -697,11 +697,6 @@ standard mode." ;; - category :: option ;; - type :: alist (STRING . LIST) -;; + `:genealogy' :: Flat list of current object or element's parents -;; from closest to farthest. -;; - category :: local -;; - type :: list of elements and objects - ;; + `:headline-levels' :: Maximum level being exported as an ;; headline. Comparison is done with the relative level of ;; headlines in the parse tree, not necessarily with their @@ -716,12 +711,17 @@ standard mode." ;; - category :: tree ;; - type :: integer -;; + `:headline-numbering' :: Alist between headlines' beginning -;; position and their numbering, as a list of numbers +;; + `:headline-numbering' :: Alist between headlines and their +;; numbering, as a list of numbers ;; (cf. `org-export-get-headline-number'). ;; - category :: tree ;; - type :: alist (INTEGER . LIST) +;; + `:ignore-list' :: List of elements and objects that should be +;; ignored during export. +;; - category :: local +;; - type :: list of elements and objects + ;; + `:input-file' :: Full path to input file, if any. ;; - category :: option ;; - type :: string or nil @@ -1231,12 +1231,12 @@ retrieved." ;; Dedicated functions focus on computing the value of specific tree ;; properties during initialization. Thus, ;; `org-export-use-select-tag-p' determines if an headline makes use -;; of an export tag enforcing inclusion. `org-export-get-min-level' -;; gets the minimal exportable level, used as a basis to compute -;; relative level for headlines. `org-export-get-point-max' returns -;; the maximum exportable ending position in the parse tree. +;; of an export tag enforcing inclusion. `org-export-get-ignore-list' +;; marks collect elements and objects that should be skipped during +;; export, `org-export-get-min-level' gets the minimal exportable +;; level, used as a basis to compute relative level for headlines. ;; Eventually `org-export-collect-headline-numbering' builds an alist -;; between headlines' beginning position and their numbering. +;; between headlines and their numbering. (defun org-export-collect-tree-properties (data info backend) "Extract tree properties from parse tree. @@ -1256,6 +1256,8 @@ Following tree properties are set: `:headline-numbering' Alist of all headlines' beginning position as key an the associated numbering as value. +`:ignore-list' List of elements that should be ignored during export. + `:parse-tree' Whole parse tree. `:target-list' List of all targets in the parse tree. @@ -1265,15 +1267,19 @@ Following tree properties are set: ;; First, set `:use-select-tags' property, as it will be required ;; for further computations. (setq info - (org-combine-plists - info `(:use-select-tags ,(org-export-use-select-tags-p data info)))) - ;; Then get `:headline-offset' in order to be able to use + (plist-put info + :use-select-tags (org-export-use-select-tags-p data info))) + ;; Then get the list of elements and objects to ignore, and put it + ;; into `:ignore-list'. + (setq info + (plist-put info :ignore-list (org-export-get-ignore-list data info))) + ;; Finally get `:headline-offset' in order to be able to use ;; `org-export-get-relative-level'. (setq info - (org-combine-plists - info `(:headline-offset ,(- 1 (org-export-get-min-level data info))))) - ;; Now, get the rest of the tree properties, now `:use-select-tags' - ;; is set... + (plist-put info + :headline-offset (- 1 (org-export-get-min-level data info)))) + ;; Now, properties order doesn't matter: get the rest of the tree + ;; properties. (nconc `(:parse-tree ,data @@ -1303,13 +1309,14 @@ DATA is parsed tree as returned by `org-element-parse-buffer'. OPTIONS is a plist holding export options." (catch 'exit (let ((min-level 10000)) - (mapc (lambda (blob) - (when (and (eq (org-element-type blob) 'headline) - (not (org-export-skip-p blob options))) - (setq min-level - (min (org-element-property :level blob) min-level))) - (when (= min-level 1) (throw 'exit 1))) - (org-element-contents data)) + (mapc + (lambda (blob) + (when (and (eq (org-element-type blob) 'headline) + (not (org-export-ignored-p blob options))) + (setq min-level + (min (org-element-property :level blob) min-level))) + (when (= min-level 1) (throw 'exit 1))) + (org-element-contents data)) ;; If no headline was found, for the sake of consistency, set ;; minimum level to 1 nonetheless. (if (= min-level 10000) 1 min-level)))) @@ -1338,6 +1345,84 @@ associated numbering \(in the shape of a list of numbers\)." when (> idx relative-level) do (aset numbering idx 0))))) options))) +(defun org-export--skip-p (blob options) + "Non-nil when element or object BLOB should be skipped during export. +OPTIONS is the plist holding export options." + (case (org-element-type blob) + ;; Plain text is never skipped. + (plain-text nil) + ;; Check headline. + (headline + (let ((with-tasks (plist-get options :with-tasks)) + (todo (org-element-property :todo-keyword blob)) + (todo-type (org-element-property :todo-type blob)) + (archived (plist-get options :with-archived-trees)) + (tag-list (let ((tags (org-element-property :tags blob))) + (and tags (org-split-string tags ":"))))) + (or + ;; Ignore subtrees with an exclude tag. + (loop for k in (plist-get options :exclude-tags) + thereis (member k tag-list)) + ;; Ignore subtrees without a select tag, when such tag is found + ;; in the buffer. + (and (plist-get options :use-select-tags) + (loop for k in (plist-get options :select-tags) + never (member k tag-list))) + ;; Ignore commented sub-trees. + (org-element-property :commentedp blob) + ;; Ignore archived subtrees if `:with-archived-trees' is nil. + (and (not archived) (org-element-property :archivedp blob)) + ;; Ignore tasks, if specified by `:with-tasks' property. + (and todo (not with-tasks)) + (and todo + (memq with-tasks '(todo done)) + (not (eq todo-type with-tasks))) + (and todo + (consp with-tasks) + (not (member todo with-tasks)))))) + ;; Check time-stamp. + (time-stamp (not (plist-get options :with-timestamps))) + ;; Check drawer. + (drawer + (or (not (plist-get options :with-drawers)) + (and (consp (plist-get options :with-drawers)) + (not (member (org-element-property :drawer-name blob) + (plist-get options :with-drawers)))))) + ;; Check export snippet. + (export-snippet + (let* ((raw-back-end (org-element-property :back-end blob)) + (true-back-end + (or (cdr (assoc raw-back-end org-export-snippet-translation-alist)) + raw-back-end))) + (not (string= (symbol-name (plist-get options :back-end)) + true-back-end)))))) + +(defun org-export-get-ignore-list (data options) + "Return list of elements and objects to ignore during export. + +DATA is the parse tree to traverse. OPTIONS is the plist holding +export options. + +Return elements or objects to ignore as a list." + (let (ignore-list + (walk-data + (function + (lambda (data options) + ;; Collect ignored elements or objects into IGNORE-LIST. + (mapc + (lambda (el) + (if (org-export--skip-p el options) (push el ignore-list) + (let ((type (org-element-type el))) + (when (or (eq type 'org-data) + (memq type org-element-greater-elements) + (memq type org-element-recursive-objects) + (eq type 'paragraph)) + (funcall walk-data el options))))) + (org-element-contents data)))))) + (funcall walk-data data options) + ;; Return value. + ignore-list)) + ;;; The Transcoder @@ -1353,11 +1438,12 @@ associated numbering \(in the shape of a list of numbers\)." ;; `org-export-secondary-string' is provided for that specific task. ;; Internally, three functions handle the filtering of objects and -;; elements during the export. More precisely, `org-export-skip-p' -;; determines if the considered object or element should be ignored -;; altogether, `org-export-interpret-p' tells which elements or -;; objects should be seen as real Org syntax and `org-export-expand' -;; transforms the others back into their original shape. +;; elements during the export. In particular, +;; `org-export-ignore-element' mark an element or object so future +;; parse tree traversals skip it, `org-export-interpret-p' tells which +;; elements or objects should be seen as real Org syntax and +;; `org-export-expand' transforms the others back into their original +;; shape. (defun org-export-data (data backend info) "Convert DATA to a string into BACKEND format. @@ -1396,14 +1482,12 @@ Return transcoded string." ;; 1.0 A full Org document is inserted. ((eq type 'org-data) 'identity) ;; 1.1. BLOB should be ignored. - ((org-export-skip-p blob info) nil) + ((member blob (plist-get info :ignore-list)) nil) ;; 1.2. BLOB shouldn't be transcoded. Interpret it ;; back into Org syntax. - ((not (org-export-interpret-p blob info)) - 'org-export-expand) + ((not (org-export-interpret-p blob info)) 'org-export-expand) ;; 1.3. Else apply naming convention. - (t (let ((trans (intern - (format "org-%s-%s" backend type)))) + (t (let ((trans (intern (format "org-%s-%s" backend type)))) (and (fboundp trans) trans))))) ;; 2. Compute CONTENTS of BLOB. (contents @@ -1414,11 +1498,7 @@ Return transcoded string." ((eq type 'org-data) (org-export-data blob backend info)) ;; Case 2. For a recursive object. ((memq type org-element-recursive-objects) - (org-export-data - blob backend - (org-combine-plists - info - `(:genealogy ,(cons blob (plist-get info :genealogy)))))) + (org-export-data blob backend info)) ;; Case 3. For a recursive element. ((memq type org-element-greater-elements) ;; Ignore contents of an archived tree @@ -1428,11 +1508,7 @@ Return transcoded string." (eq (plist-get info :with-archived-trees) 'headline) (org-element-property :archivedp blob)) (org-element-normalize-string - (org-export-data - blob backend - (org-combine-plists - info `(:genealogy - ,(cons blob (plist-get info :genealogy)))))))) + (org-export-data blob backend info)))) ;; Case 4. For a paragraph. ((eq type 'paragraph) (let ((paragraph @@ -1443,13 +1519,12 @@ Return transcoded string." ;; indentation: there is none and it might be ;; misleading. (and (not (org-export-get-previous-element blob info)) - (let ((parent (caar (plist-get info :genealogy)))) - (memq parent '(footnote-definition item))))))) - (org-export-data - paragraph backend - (org-combine-plists - info `(:genealogy - ,(cons paragraph (plist-get info :genealogy))))))))) + (let ((parent + (car + (org-export-get-genealogy blob info)))) + (memq (org-element-type parent) + '(footnote-definition item))))))) + (org-export-data paragraph backend info))))) ;; 3. Transcode BLOB into RESULTS string. (results (cond ((not transcoder) nil) @@ -1458,20 +1533,32 @@ Return transcoded string." `(org-data nil ,(funcall transcoder blob contents)) backend info)) (t (funcall transcoder blob contents info))))) - ;; 4. Discard nil results. Otherwise, update INFO, append - ;; the same white space between elements or objects as in - ;; the original buffer, and call appropriate filters. - (when results - ;; No filter for a full document. - (if (eq type 'org-data) results - (org-export-filter-apply-functions - (plist-get info (intern (format ":filter-%s" type))) - (let ((post-blank (org-element-property :post-blank blob))) - (if (memq type org-element-all-elements) - (concat (org-element-normalize-string results) - (make-string post-blank ?\n)) - (concat results (make-string post-blank ? )))) - backend info))))))) + ;; 4. Return results. + (cond + ;; Discard nil results. Also ignore BLOB from further + ;; traversals in parse tree. + ((not results) (org-export-ignore-element blob info) nil) + ;; No filter for a full document. + ((eq type 'org-data) results) + ;; Otherwise, update INFO, append the same white space + ;; between elements or objects as in the original buffer, + ;; and call appropriate filters. + (t + (let ((results + (org-export-filter-apply-functions + (plist-get info (intern (format ":filter-%s" type))) + (let ((post-blank (org-element-property :post-blank blob))) + (if (memq type org-element-all-elements) + (concat (org-element-normalize-string results) + (make-string post-blank ?\n)) + (concat results (make-string post-blank ? )))) + backend info))) + ;; If BLOB was transcoded into an empty string, ignore it + ;; from subsequent traversals. + (unless (org-string-nw-p results) + (org-export-ignore-element blob info)) + ;; Eventually return string. + results))))))) (org-element-contents data) "")) (defun org-export-secondary-string (secondary backend info) @@ -1488,58 +1575,6 @@ Return transcoded string." (let ((s (if (listp secondary) secondary (list secondary)))) (org-export-data `(org-data nil ,@s) backend (copy-sequence info)))) -(defun org-export-skip-p (blob info) - "Non-nil when element or object BLOB should be skipped during export. -INFO is the plist holding export options." - (case (org-element-type blob) - ;; Plain text is never skipped. - (plain-text nil) - ;; Check headline. - (headline - (let ((with-tasks (plist-get info :with-tasks)) - (todo (org-element-property :todo-keyword blob)) - (todo-type (org-element-property :todo-type blob)) - (archived (plist-get info :with-archived-trees)) - (tag-list (let ((tags (org-element-property :tags blob))) - (and tags (org-split-string tags ":"))))) - (or - ;; Ignore subtrees with an exclude tag. - (loop for k in (plist-get info :exclude-tags) - thereis (member k tag-list)) - ;; Ignore subtrees without a select tag, when such tag is found - ;; in the buffer. - (and (plist-get info :use-select-tags) - (loop for k in (plist-get info :select-tags) - never (member k tag-list))) - ;; Ignore commented sub-trees. - (org-element-property :commentedp blob) - ;; Ignore archived subtrees if `:with-archived-trees' is nil. - (and (not archived) (org-element-property :archivedp blob)) - ;; Ignore tasks, if specified by `:with-tasks' property. - (and todo (not with-tasks)) - (and todo - (memq with-tasks '(todo done)) - (not (eq todo-type with-tasks))) - (and todo - (consp with-tasks) - (not (member todo with-tasks)))))) - ;; Check time-stamp. - (time-stamp (not (plist-get info :with-timestamps))) - ;; Check drawer. - (drawer - (or (not (plist-get info :with-drawers)) - (and (consp (plist-get info :with-drawers)) - (not (member (org-element-property :drawer-name blob) - (plist-get info :with-drawers)))))) - ;; Check export snippet. - (export-snippet - (let* ((raw-back-end (org-element-property :back-end blob)) - (true-back-end - (or (cdr (assoc raw-back-end org-export-snippet-translation-alist)) - raw-back-end))) - (not (string= (symbol-name (plist-get info :back-end)) - true-back-end)))))) - (defun org-export-interpret-p (blob info) "Non-nil if element or object BLOB should be interpreted as Org syntax. Check is done according to export options INFO, stored as @@ -1571,6 +1606,13 @@ contents, as a string or nil." (funcall (intern (format "org-element-%s-interpreter" (org-element-type blob))) blob contents)) +(defun org-export-ignore-element (element info) + "Add ELEMENT to `:ignore-list' in INFO. + +Any element in `:ignore-list' will be skipped when using +`org-element-map'. INFO is modified by side effects." + (plist-put info :ignore-list (cons element (plist-get info :ignore-list)))) + ;;; The Filter System @@ -2510,9 +2552,7 @@ INFO is the plist used as a communication channel." (defun org-export-last-sibling-p (headline info) "Non-nil when HEADLINE is the last sibling in its sub-tree. INFO is the plist used as a communication channel." - (equal - (car (last (org-element-contents (car (plist-get info :genealogy))))) - headline)) + (not (org-export-get-next-element headline info))) ;;;; For Links @@ -2625,7 +2665,7 @@ Assume LINK type is \"fuzzy\"." (when (eq (org-element-type parent) 'headline) (let ((foundp (funcall find-headline path parent))) (when foundp (throw 'exit foundp))))) - (plist-get info :genealogy)) nil) + (org-export-get-genealogy link info)) nil) ;; No match with a common ancestor: try the full parse-tree. (funcall find-headline path (plist-get info :parse-tree))))))) @@ -3111,18 +3151,18 @@ affiliated keyword." "Return genealogy relative to a given element or object. BLOB is the element or object being considered. INFO is a plist used as a communication channel." - ;; LOCALP tells if current `:genealogy' is sufficient to find parent - ;; headline, or if it should be computed. - (let ((localp (member blob (org-element-contents - (car (plist-get info :genealogy)))))) - (if localp (plist-get info :genealogy) - (catch 'exit - (org-element-map - (plist-get info :parse-tree) (org-element-type blob) - (lambda (el local) - (when (equal el blob) - (throw 'exit (plist-get local :genealogy)))) - info))))) + (let* ((end (org-element-property :end blob)) + (walk-data + (lambda (data genealogy) + (mapc + (lambda (el) + (cond + ((stringp el)) + ((equal el blob) (throw 'exit genealogy)) + ((>= (org-element-property :end el) end) + (funcall walk-data el (cons el genealogy))))) + (org-element-contents data))))) + (catch 'exit (funcall walk-data (plist-get info :parse-tree) nil) nil))) (defun org-export-get-parent-headline (blob info) "Return closest parent headline or nil. -- 2.11.4.GIT