Merge branch 'master' of orgmode.org:org-mode

This commit is contained in:
Carsten Dominik 2013-08-30 17:10:45 +02:00
commit 31c2c517f4
13 changed files with 452 additions and 425 deletions

View File

@ -62,8 +62,8 @@
;; (see `org-koma-letter-subject-format')
;; - after-closing-order, a list of the ordering of headings with
;; special tags after closing (see
;; `org-koma-letter-special-tags-after-closing') -
;; after-letter-order, as above, but after the end of the letter
;; `org-koma-letter-special-tags-after-closing')
;; - after-letter-order, as above, but after the end of the letter
;; (see `org-koma-letter-special-tags-after-letter').
;;
;; The following variables works differently from the main LaTeX class
@ -91,7 +91,7 @@
;; (eval-after-load "ox-koma-letter"
;; '(org-koma-letter-plug-into-ox))
;;
;; to your init file. This will add a very sparse scrlttr2 class and
;; to your init file. This will add a sparse scrlttr2 class and
;; set it as the default `org-koma-latex-default-class'. You can also
;; add you own letter class. For instace:
;;
@ -138,8 +138,8 @@
"The sender's name.
This variable defaults to calling the function `user-full-name'
which just returns the current `user-full-name'. Alternatively a
string, nil or a function may be given. Functions must return a
which just returns the current function `user-full-name'. Alternatively a
string, nil or a function may be given. Functions must return a
string."
:group 'org-export-koma-letter
:type '(radio (function-item user-full-name)
@ -175,7 +175,11 @@ function may be given. Functions must return a string."
:type 'string)
(defcustom org-koma-letter-opening nil
"Letter's opening, as a string."
"Letter's opening, as a string.
If (1) this value is nil; (2) the letter is started with a
headline; and (3) `org-koma-letter-headline-is-opening-maybe' is
t the value opening will be implicit set as the headline title."
:group 'org-export-koma-letter
:type 'string)
@ -185,8 +189,7 @@ function may be given. Functions must return a string."
:type 'string)
(defcustom org-koma-letter-prefer-special-headings nil
"If both a TO or FROM is specified two places should the
heading version be preferred?"
"If TO and/or FROM is specified using both a heading and a keyword the heading value will be preferred if the variable is t."
:group 'org-export-koma-letter
:type 'boolean)
@ -196,21 +199,22 @@ function may be given. Functions must return a string."
:type 'string)
(defcustom org-koma-letter-subject-format t
"Use the title as the subject of the letter. At the time of
writing the following values are allowed:
"Use the title as the subject of the letter.
- afteropening: subject after opening
- beforeopening: subject before opening
- centered: subject centered
- left:subject left-justified
- right: subject right-justified
- titled: add title/description to subject
- underlined: set subject underlined (see note in text please)
At this time the following values are allowed:
- afteropening: subject after opening.
- beforeopening: subject before opening.
- centered: subject centered.
- left:subject left-justified.
- right: subject right-justified.
- titled: add title/description to subject.
- underlined: set subject underlined.
- untitled: do not add title/description to subject.
- No-export: do no insert a subject even if present.
Please refer to the KOMA-script manual (Table 4.16. in the
English manual of 2012-07-22)"
English manual of 2012-07-22)."
:type '(radio
(const :tag "No export" nil)
(const :tag "Default options" t)
@ -259,22 +263,30 @@ Use `foldmarks:true' to activate default fold marks or
:type 'boolean)
(defcustom org-koma-letter-default-class nil
"Default class for `org-koma-letter'. Must be a member of
`org-latex-classes'"
"Default class for `org-koma-letter'.
The value must be a member of `org-latex-classes'."
:group 'org-export-koma-letter
:type 'string)
(defcustom org-koma-letter-headline-is-opening-maybe t
"Whether a headline may be used as an opening.
A headline is only used if #+OPENING is not set. See also
`org-koma-letter-opening'."
:group 'org-export-koma-letter
:type 'boolean)
(defconst org-koma-letter-special-tags-in-letter '(to from)
"header tags related to the letter itself")
"Header tags related to the letter itself.")
(defconst org-koma-letter-special-tags-after-closing '(ps encl cc)
"Header tags to be inserted after closing")
"Header tags to be inserted after closing.")
(defconst org-koma-letter-special-tags-after-letter '(after_letter)
"Header tags to be inserted after closing")
"Header tags to be inserted after closing.")
(defvar org-koma-letter-special-contents nil
"holds special content temporarily.")
"Holds special content temporarily.")
@ -286,10 +298,10 @@ Use `foldmarks:true' to activate default fold marks or
(:latex-class "LATEX_CLASS" nil (if org-koma-letter-default-class
org-koma-letter-default-class
org-latex-default-class) t)
(:author "AUTHOR" nil (org-koma-letter--get-custom org-koma-letter-author) t)
(:author "AUTHOR" nil (org-koma-letter--get-value org-koma-letter-author) t)
(:from-address "FROM_ADDRESS" nil nil newline)
(:phone-number "PHONE_NUMBER" nil org-koma-letter-phone-number)
(:email "EMAIL" nil (org-koma-letter--get-custom org-koma-letter-email) t)
(:email "EMAIL" nil (org-koma-letter--get-value org-koma-letter-email) t)
(:to-address "TO_ADDRESS" nil nil newline)
(:place "PLACE" nil org-koma-letter-place)
(:opening "OPENING" nil org-koma-letter-opening)
@ -330,8 +342,7 @@ Use `foldmarks:true' to activate default fold marks or
;;; Initialize class function
(defun org-koma-letter-plug-into-ox ()
"Add a sparse `default-koma-letter' to `org-latex-classes' and set
`org-koma-letter-default-class' to `default-koma-letter'"
"Add a sparse `default-koma-letter' to `org-latex-classes' and set `org-koma-letter-default-class' to `default-koma-letter'."
(let ((class "default-koma-letter"))
(eval-after-load "ox-latex"
`(unless (member ,class 'org-latex-classes)
@ -343,20 +354,20 @@ Use `foldmarks:true' to activate default fold marks or
;;; Helper functions
(defun org-koma-letter-email ()
"Return the current `user-mail-address'"
"Return the current `user-mail-address'."
user-mail-address)
;; The following is taken from/inspired by ox-grof.el
;; Thanks, Luis!
(defun org-koma-letter--get-tagged-contents (key)
"Get tagged content from `org-koma-letter-special-contents'"
(cdr (assoc (org-koma-letter--get-custom key)
"Get contents from a headline tagged with KEY.
Technically, the contents is stored in `org-koma-letter-special-contents'."
(cdr (assoc (org-koma-letter--get-value key)
org-koma-letter-special-contents)))
(defun org-koma-letter--get-custom (value)
"Determines whether a value is nil, a string or a
function (a symobl). If it is a function it it evaluates it."
(defun org-koma-letter--get-value (value)
"Determines if VALUE is nil, a string, a function or a symbol and return a string or nil."
(when value
(cond ((stringp value) value)
((functionp value) (funcall value))
@ -364,20 +375,21 @@ function (a symobl). If it is a function it it evaluates it."
(t value))))
(defun org-koma-letter--prepare-special-contents-as-macro (a-list &optional keep-newlines no-tag)
"Finds all the components of `org-koma-letter-special-contents'
corresponding to members of the `a-list' and return them as a
string to be formatted. The function is used for inserting
content of speciall headings such as PS.
(defun org-koma-letter--special-contents-as-macro (a-list &optional keep-newlines no-tag)
"Find members of `org-koma-letter-special-contents' corresponding to A-LIST.
Return them as a string to be formatted.
If keep-newlines is t newlines will not be removed. If no-tag is
The function is used for inserting content of speciall headings
such as PS.
If KEEP-NEWLINES is t newlines will not be removed. If NO-TAG is
is t the content in `org-koma-letter-special-contents' will not
be wrapped in a macro named whatever the members of a-list are called.
"
be wrapped in a macro named whatever the members of A-LIST are
called."
(let (output)
(dolist (ac* a-list output)
(let*
((ac (org-koma-letter--get-custom ac*))
((ac (org-koma-letter--get-value ac*))
(x (org-koma-letter--get-tagged-contents ac)))
(when x
(setq output
@ -386,24 +398,26 @@ be wrapped in a macro named whatever the members of a-list are called.
;; sometimes LaTeX complains about newlines
;; at the end or beginning of macros. Remove them.
(org-koma-letter--format-string-as-macro
(if keep-newlines x (org-koma-letter--remove-offending-new-lines x))
(if keep-newlines x (org-koma-letter--normalize-string x))
(unless no-tag ac)))))))))
(defun org-koma-letter--format-string-as-macro (string &optional macro)
"If a macro is given format as string as \"\\macro{string}\" else as \"string\""
"Format STRING as \"\\macro{string}\" if MACRO is given else as \"string\"."
(if macro
(format "\\%s{%s}" macro string)
(format "%s" string)))
(defun org-koma-letter--remove-offending-new-lines (string)
"Remove new lines in the begging and end of `string'"
(defun org-koma-letter--normalize-string (string)
"Remove new lines in the beginning and end of `STRING'."
(replace-regexp-in-string "\\`[ \n\t]+\\|[\n\t ]*\\'" "" string))
(defun org-koma-letter--determine-special-value (info key)
"Determine who the letter is to and whom it is from.
oxkoma-letter allows two ways to specify these things. If both
are present return the preferred one as determined by
`org-koma-letter-prefer-special-headings'."
(defun org-koma-letter--determine-to-and-from (info key)
"Given INFO determine KEY for the letter.
KEY should be `to' or `from'.
`ox-koma-letter' allows two ways to specify to and from. If both
are present return the preferred one as determined by
`org-koma-letter-prefer-special-headings'."
(let* ((plist-alist '((from . :from-address)
(to . :to-address)))
(default-alist `((from ,org-koma-letter-from-address)
@ -423,7 +437,7 @@ be wrapped in a macro named whatever the members of a-list are called.
(when adr
(replace-regexp-in-string
"\n" "\\\\\\\\\n"
(org-koma-letter--remove-offending-new-lines adr)))))
(org-koma-letter--normalize-string adr)))))
;;; Transcode Functions
@ -482,6 +496,10 @@ appropriate place."
(push (cons tag contents)
org-koma-letter-special-contents)
nil)
(unless (or (plist-get info :opening)
(not org-koma-letter-headline-is-opening-maybe))
(plist-put info :opening
(org-export-data (org-element-property :title headline) info)))
contents)))
@ -522,7 +540,7 @@ holding export options."
info)))
(let ((lco (plist-get info :lco))
(author (plist-get info :author))
(from-address (org-koma-letter--determine-special-value info 'from))
(from-address (org-koma-letter--determine-to-and-from info 'from))
(phone-number (plist-get info :phone-number))
(email (plist-get info :email))
(signature (plist-get info :signature)))
@ -582,18 +600,18 @@ holding export options."
(format "\\setkomavar{subject}{%s}\n\n" subject))))
;; Letter start
(format "\\begin{letter}{%%\n%s}\n\n"
(org-koma-letter--determine-special-value info 'to))
(org-koma-letter--determine-to-and-from info 'to))
;; Opening.
(format "\\opening{%s}\n\n" (plist-get info :opening))
(format "\\opening{%s}\n\n" (or (plist-get info :opening) ""))
;; Letter body.
contents
;; Closing.
(format "\n\\closing{%s}\n" (plist-get info :closing))
(org-koma-letter--prepare-special-contents-as-macro
(format "\n\\closing{%s}\n" (or (plist-get info :closing) ""))
(org-koma-letter--special-contents-as-macro
(plist-get info :with-after-closing))
;; Letter end.
"\n\\end{letter}\n"
(org-koma-letter--prepare-special-contents-as-macro
(org-koma-letter--special-contents-as-macro
(plist-get info :with-after-letter) t t)
;; Document end.
"\n\\end{document}"

View File

@ -258,7 +258,7 @@ Returns a list
(save-excursion
(goto-char head)
(setq info (org-babel-parse-src-block-match))
(setq indent (nth 5 info))
(setq indent (car (last info)))
(setq info (butlast info))
(while (and (forward-line -1)
(looking-at org-babel-multi-line-header-regexp))

View File

@ -179,21 +179,20 @@ then create. Return the initialized session."
(require org-babel-python-mode)
(save-window-excursion
(let* ((session (if session (intern session) :default))
(python-buffer (org-babel-python-session-buffer session)))
(python-buffer (org-babel-python-session-buffer session))
(cmd (if (member system-type '(cygwin windows-nt ms-dos))
(concat org-babel-python-command " -i")
org-babel-python-command)))
(cond
((and (eq 'python org-babel-python-mode)
(fboundp 'run-python)) ; python.el
(if (version< "24.1" emacs-version)
(progn
(unless python-buffer
(setq python-buffer (org-babel-python-with-earmufs session)))
(let ((python-shell-buffer-name
(org-babel-python-without-earmufs python-buffer)))
(run-python
(if (member system-type '(cygwin windows-nt ms-dos))
(concat org-babel-python-command " -i")
org-babel-python-command))))
(run-python)))
(if (not (version< "24.1" emacs-version))
(run-python cmd)
(unless python-buffer
(setq python-buffer (org-babel-python-with-earmufs session)))
(let ((python-shell-buffer-name
(org-babel-python-without-earmufs python-buffer)))
(run-python cmd))))
((and (eq 'python-mode org-babel-python-mode)
(fboundp 'py-shell)) ; python-mode.el
;; Make sure that py-which-bufname is initialized, as otherwise

View File

@ -2643,17 +2643,15 @@ Assume point is at the first star marker."
CONTENTS is the contents of the object."
(format "*%s*" contents))
(defun org-element-text-markup-successor (limit)
(defun org-element-text-markup-successor ()
"Search for the next text-markup object.
LIMIT bounds the search.
Return value is a cons cell whose CAR is a symbol among `bold',
`italic', `underline', `strike-through', `code' and `verbatim'
and CDR is beginning position."
(save-excursion
(unless (bolp) (backward-char))
(when (re-search-forward org-emph-re limit t)
(when (re-search-forward org-emph-re nil t)
(let ((marker (match-string 3)))
(cons (cond
((equal marker "*") 'bold)
@ -2735,11 +2733,9 @@ CONTENTS is nil."
(org-element-property :name entity)
(when (org-element-property :use-brackets-p entity) "{}")))
(defun org-element-latex-or-entity-successor (limit)
(defun org-element-latex-or-entity-successor ()
"Search for the next latex-fragment or entity object.
LIMIT bounds the search.
Return value is a cons cell whose CAR is `entity' or
`latex-fragment' and CDR is beginning position."
(save-excursion
@ -2753,7 +2749,7 @@ Return value is a cons cell whose CAR is `entity' or
(concat (mapconcat (lambda (e) (nth 1 (assoc e org-latex-regexps)))
matchers "\\|")
"\\|" entity-re)
limit t)
nil t)
(goto-char (match-beginning 0))
(if (looking-at entity-re)
;; Determine if it's a real entity or a LaTeX command.
@ -2805,18 +2801,16 @@ CONTENTS is nil."
(org-element-property :back-end export-snippet)
(org-element-property :value export-snippet)))
(defun org-element-export-snippet-successor (limit)
(defun org-element-export-snippet-successor ()
"Search for the next export-snippet object.
LIMIT bounds the search.
Return value is a cons cell whose CAR is `export-snippet' and CDR
its beginning position."
(save-excursion
(let (beg)
(when (and (re-search-forward "@@[-A-Za-z0-9]+:" limit t)
(when (and (re-search-forward "@@[-A-Za-z0-9]+:" nil t)
(setq beg (match-beginning 0))
(search-forward "@@" limit t))
(search-forward "@@" nil t))
(cons 'export-snippet beg)))))
@ -2872,21 +2866,19 @@ CONTENTS is nil."
(concat ":" (org-element-interpret-data inline-def))))))
(format "[%s]" (concat label def))))
(defun org-element-footnote-reference-successor (limit)
(defun org-element-footnote-reference-successor ()
"Search for the next footnote-reference object.
LIMIT bounds the search.
Return value is a cons cell whose CAR is `footnote-reference' and
CDR is beginning position."
(save-excursion
(catch 'exit
(while (re-search-forward org-footnote-re limit t)
(while (re-search-forward org-footnote-re nil t)
(save-excursion
(let ((beg (match-beginning 0))
(count 1))
(backward-char)
(while (re-search-forward "[][]" limit t)
(while (re-search-forward "[][]" nil t)
(if (equal (match-string 0) "[") (incf count) (decf count))
(when (zerop count)
(throw 'exit (cons 'footnote-reference beg))))))))))
@ -2929,11 +2921,9 @@ CONTENTS is nil."
main-source)
(and post-options (format "[%s]" post-options)))))
(defun org-element-inline-babel-call-successor (limit)
(defun org-element-inline-babel-call-successor ()
"Search for the next inline-babel-call object.
LIMIT bounds the search.
Return value is a cons cell whose CAR is `inline-babel-call' and
CDR is beginning position."
(save-excursion
@ -2941,7 +2931,7 @@ CDR is beginning position."
;; `org-babel-inline-lob-one-liner-regexp'.
(when (re-search-forward
"call_\\([^()\n]+?\\)\\(?:\\[.*?\\]\\)?([^\n]*?)\\(\\[.*?\\]\\)?"
limit t)
nil t)
(cons 'inline-babel-call (match-beginning 0)))))
@ -2950,8 +2940,6 @@ CDR is beginning position."
(defun org-element-inline-src-block-parser ()
"Parse inline source block at point.
LIMIT bounds the search.
Return a list whose CAR is `inline-src-block' and CDR a plist
with `:begin', `:end', `:language', `:value', `:parameters' and
`:post-blank' as keywords.
@ -2986,16 +2974,14 @@ CONTENTS is nil."
(if arguments (format "[%s]" arguments) "")
body)))
(defun org-element-inline-src-block-successor (limit)
(defun org-element-inline-src-block-successor ()
"Search for the next inline-babel-call element.
LIMIT bounds the search.
Return value is a cons cell whose CAR is `inline-babel-call' and
CDR is beginning position."
(save-excursion
(unless (bolp) (backward-char))
(when (re-search-forward org-babel-inline-src-block-regexp limit t)
(when (re-search-forward org-babel-inline-src-block-regexp nil t)
(cons 'inline-src-block (match-beginning 1)))))
;;;; Italic
@ -3089,15 +3075,13 @@ Assume point is at the beginning of the line break."
CONTENTS is nil."
"\\\\\n")
(defun org-element-line-break-successor (limit)
(defun org-element-line-break-successor ()
"Search for the next line-break object.
LIMIT bounds the search.
Return value is a cons cell whose CAR is `line-break' and CDR is
beginning position."
(save-excursion
(let ((beg (and (re-search-forward "[^\\\\]\\(\\\\\\\\\\)[ \t]*$" limit t)
(let ((beg (and (re-search-forward "[^\\\\]\\(\\\\\\\\\\)[ \t]*$" nil t)
(goto-char (match-beginning 1)))))
;; A line break can only happen on a non-empty line.
(when (and beg (re-search-backward "\\S-" (point-at-bol) t))
@ -3210,28 +3194,24 @@ CONTENTS is the contents of the object, or nil."
raw-link
(if contents (format "[%s]" contents) "")))))
(defun org-element-link-successor (limit)
(defun org-element-link-successor ()
"Search for the next link object.
LIMIT bounds the search.
Return value is a cons cell whose CAR is `link' and CDR is
beginning position."
(save-excursion
(let ((link-regexp
(if (not org-target-link-regexp) org-any-link-re
(concat org-any-link-re "\\|" org-target-link-regexp))))
(when (re-search-forward link-regexp limit t)
(when (re-search-forward link-regexp nil t)
(cons 'link (match-beginning 0))))))
(defun org-element-plain-link-successor (limit)
(defun org-element-plain-link-successor ()
"Search for the next plain link object.
LIMIT bounds the search.
Return value is a cons cell whose CAR is `link' and CDR is
beginning position."
(and (save-excursion (re-search-forward org-plain-link-re limit t))
(and (save-excursion (re-search-forward org-plain-link-re nil t))
(cons 'link (match-beginning 0))))
@ -3279,17 +3259,15 @@ Assume point is at the macro."
CONTENTS is nil."
(org-element-property :value macro))
(defun org-element-macro-successor (limit)
(defun org-element-macro-successor ()
"Search for the next macro object.
LIMIT bounds the search.
Return value is cons cell whose CAR is `macro' and CDR is
beginning position."
(save-excursion
(when (re-search-forward
"{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}"
limit t)
nil t)
(cons 'macro (match-beginning 0)))))
@ -3325,15 +3303,13 @@ Assume point is at the radio target."
CONTENTS is the contents of the object."
(concat "<<<" contents ">>>"))
(defun org-element-radio-target-successor (limit)
(defun org-element-radio-target-successor ()
"Search for the next radio-target object.
LIMIT bounds the search.
Return value is a cons cell whose CAR is `radio-target' and CDR
is beginning position."
(save-excursion
(when (re-search-forward org-radio-target-regexp limit t)
(when (re-search-forward org-radio-target-regexp nil t)
(cons 'radio-target (match-beginning 0)))))
@ -3365,15 +3341,13 @@ Assume point is at the beginning of the statistics-cookie."
CONTENTS is nil."
(org-element-property :value statistics-cookie))
(defun org-element-statistics-cookie-successor (limit)
(defun org-element-statistics-cookie-successor ()
"Search for the next statistics cookie object.
LIMIT bounds the search.
Return value is a cons cell whose CAR is `statistics-cookie' and
CDR is beginning position."
(save-excursion
(when (re-search-forward "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]" limit t)
(when (re-search-forward "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]" nil t)
(cons 'statistics-cookie (match-beginning 0)))))
@ -3446,16 +3420,14 @@ CONTENTS is the contents of the object."
(if (org-element-property :use-brackets-p subscript) "_{%s}" "_%s")
contents))
(defun org-element-sub/superscript-successor (limit)
(defun org-element-sub/superscript-successor ()
"Search for the next sub/superscript object.
LIMIT bounds the search.
Return value is a cons cell whose CAR is either `subscript' or
`superscript' and CDR is beginning position."
(save-excursion
(unless (bolp) (backward-char))
(when (re-search-forward org-match-substring-regexp limit t)
(when (re-search-forward org-match-substring-regexp nil t)
(cons (if (string= (match-string 2) "_") 'subscript 'superscript)
(match-beginning 2)))))
@ -3522,11 +3494,9 @@ and `:post-blank' keywords."
CONTENTS is the contents of the cell, or nil."
(concat " " contents " |"))
(defun org-element-table-cell-successor (limit)
(defun org-element-table-cell-successor ()
"Search for the next table-cell object.
LIMIT bounds the search.
Return value is a cons cell whose CAR is `table-cell' and CDR is
beginning position."
(when (looking-at "[ \t]*.*?[ \t]*|") (cons 'table-cell (point))))
@ -3559,15 +3529,13 @@ Assume point is at the target."
CONTENTS is nil."
(format "<<%s>>" (org-element-property :value target)))
(defun org-element-target-successor (limit)
(defun org-element-target-successor ()
"Search for the next target object.
LIMIT bounds the search.
Return value is a cons cell whose CAR is `target' and CDR is
beginning position."
(save-excursion
(when (re-search-forward org-target-regexp limit t)
(when (re-search-forward org-target-regexp nil t)
(cons 'target (match-beginning 0)))))
@ -3745,11 +3713,9 @@ CONTENTS is nil."
(eq type 'active-range)
(and hour-end minute-end)))))))))
(defun org-element-timestamp-successor (limit)
(defun org-element-timestamp-successor ()
"Search for the next timestamp object.
LIMIT bounds the search.
Return value is a cons cell whose CAR is `timestamp' and CDR is
beginning position."
(save-excursion
@ -3759,7 +3725,7 @@ beginning position."
"\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)"
"\\|"
"\\(?:<%%\\(?:([^>\n]+)\\)>\\)")
limit t)
nil t)
(cons 'timestamp (match-beginning 0)))))
@ -3841,14 +3807,14 @@ CONTENTS is nil."
(limit &optional granularity special structure)
"Parse the element starting at point.
LIMIT bounds the search.
Return value is a list like (TYPE PROPS) where TYPE is the type
of the element and PROPS a plist of properties associated to the
element.
Possible types are defined in `org-element-all-elements'.
LIMIT bounds the search.
Optional argument GRANULARITY determines the depth of the
recursion. Allowed values are `headline', `greater-element',
`element', `object' or nil. When it is broader than `object' (or
@ -4398,57 +4364,56 @@ RESTRICTION is a list of object successors which are allowed in
the current object."
(let ((candidates 'initial))
(save-excursion
(goto-char beg)
(while (and (< (point) end)
(setq candidates (org-element--get-next-object-candidates
end restriction candidates)))
(let ((next-object
(let ((pos (apply 'min (mapcar 'cdr candidates))))
(save-excursion
(goto-char pos)
(funcall (intern (format "org-element-%s-parser"
(car (rassq pos candidates)))))))))
;; 1. Text before any object. Untabify it.
(let ((obj-beg (org-element-property :begin next-object)))
(unless (= (point) obj-beg)
(setq acc
(org-element-adopt-elements
acc
(replace-regexp-in-string
"\t" (make-string tab-width ? )
(buffer-substring-no-properties (point) obj-beg))))))
;; 2. Object...
(let ((obj-end (org-element-property :end next-object))
(cont-beg (org-element-property :contents-begin next-object)))
;; Fill contents of NEXT-OBJECT by side-effect, if it has
;; a recursive type.
(when (and cont-beg
(memq (car next-object) org-element-recursive-objects))
(save-restriction
(narrow-to-region
cont-beg
(org-element-property :contents-end next-object))
(save-restriction
(narrow-to-region beg end)
(goto-char (point-min))
(while (and (not (eobp))
(setq candidates
(org-element--get-next-object-candidates
restriction candidates)))
(let ((next-object
(let ((pos (apply 'min (mapcar 'cdr candidates))))
(save-excursion
(goto-char pos)
(funcall (intern (format "org-element-%s-parser"
(car (rassq pos candidates)))))))))
;; 1. Text before any object. Untabify it.
(let ((obj-beg (org-element-property :begin next-object)))
(unless (= (point) obj-beg)
(setq acc
(org-element-adopt-elements
acc
(replace-regexp-in-string
"\t" (make-string tab-width ? )
(buffer-substring-no-properties (point) obj-beg))))))
;; 2. Object...
(let ((obj-end (org-element-property :end next-object))
(cont-beg (org-element-property :contents-begin next-object)))
;; Fill contents of NEXT-OBJECT by side-effect, if it has
;; a recursive type.
(when (and cont-beg
(memq (car next-object) org-element-recursive-objects))
(org-element--parse-objects
(point-min) (point-max) next-object
(org-element-restriction next-object))))
(setq acc (org-element-adopt-elements acc next-object))
(goto-char obj-end))))
;; 3. Text after last object. Untabify it.
(unless (= (point) end)
(setq acc
(org-element-adopt-elements
acc
(replace-regexp-in-string
"\t" (make-string tab-width ? )
(buffer-substring-no-properties (point) end)))))
;; Result.
acc)))
cont-beg (org-element-property :contents-end next-object)
next-object (org-element-restriction next-object)))
(setq acc (org-element-adopt-elements acc next-object))
(goto-char obj-end))))
;; 3. Text after last object. Untabify it.
(unless (eobp)
(setq acc
(org-element-adopt-elements
acc
(replace-regexp-in-string
"\t" (make-string tab-width ? )
(buffer-substring-no-properties (point) end)))))
;; Result.
acc))))
(defun org-element--get-next-object-candidates (limit restriction objects)
(defun org-element--get-next-object-candidates (restriction objects)
"Return an alist of candidates for the next object.
LIMIT bounds the search, and RESTRICTION narrows candidates to
some object successors.
RESTRICTION is a list of object types, as symbols. Only
candidates with such types are looked after.
OBJECTS is the previous candidates alist. If it is set to
`initial', no search has been done before, and all symbols in
@ -4463,7 +4428,7 @@ beginning position."
;; allowed in RESTRICTION.
(mapcar
(lambda (res)
(funcall (intern (format "org-element-%s-successor" res)) limit))
(funcall (intern (format "org-element-%s-successor" res))))
restriction)
;; Focus on objects returned during last search. Keep those
;; still after point. Search again objects before it.
@ -4474,8 +4439,7 @@ beginning position."
(succ (or (cdr (assq type org-element-object-successor-alist))
type)))
(and succ
(funcall (intern (format "org-element-%s-successor" succ))
limit)))))
(funcall (intern (format "org-element-%s-successor" succ)))))))
objects))))
@ -4847,103 +4811,109 @@ object type, but always include `:begin', `:end', `:parent' and
Optional argument ELEMENT, when non-nil, is the closest element
containing point, as returned by `org-element-at-point'.
Providing it allows for quicker computation."
(org-with-wide-buffer
(let* ((origin (point))
(element (or element (org-element-at-point)))
(type (org-element-type element))
end)
;; Check if point is inside an element containing objects or at
;; a secondary string. In that case, move to beginning of the
;; element or secondary string and set END to the other side.
(if (not (or (let ((post (org-element-property :post-affiliated element)))
(and post (> post origin)
(< (org-element-property :begin element) origin)
(progn (beginning-of-line)
(looking-at org-element--affiliated-re)
(member (upcase (match-string 1))
org-element-parsed-keywords))
;; We're at an affiliated keyword. Change
;; type to retrieve correct restrictions.
(setq type 'keyword)
;; Determine if we're at main or dual value.
(if (and (match-end 2) (<= origin (match-end 2)))
(progn (goto-char (match-beginning 2))
(setq end (match-end 2)))
(goto-char (match-end 0))
(setq end (line-end-position)))))
(and (eq type 'item)
(let ((tag (org-element-property :tag element)))
(and tag
(progn
(beginning-of-line)
(search-forward tag (point-at-eol))
(goto-char (match-beginning 0))
(and (>= origin (point))
(<= origin
;; `1+' is required so some
;; successors can match
;; properly their object.
(setq end (1+ (match-end 0)))))))))
(and (memq type '(headline inlinetask))
(progn (beginning-of-line)
(skip-chars-forward "* ")
(setq end (point-at-eol))))
(and (memq type '(paragraph table-row verse-block))
(let ((cbeg (org-element-property
:contents-begin element))
(cend (org-element-property
:contents-end element)))
(and cbeg cend ; cbeg is nil for table rules
(>= origin cbeg)
(<= origin cend)
(progn (goto-char cbeg) (setq end cend)))))
(and (eq type 'keyword)
(let ((key (org-element-property :key element)))
(and (member key org-element-document-properties)
(progn (beginning-of-line)
(search-forward key (line-end-position) t)
(forward-char)
(setq end (line-end-position))))))))
element
(catch 'objects-forbidden
(org-with-wide-buffer
(let* ((origin (point))
(element (or element (org-element-at-point)))
(type (org-element-type element))
context)
;; Check if point is inside an element containing objects or at
;; a secondary string. In that case, narrow buffer to the
;; containing area. Otherwise, return ELEMENT.
(cond
;; At a parsed affiliated keyword, check if we're inside main
;; or dual value.
((let ((post (org-element-property :post-affiliated element)))
(and post (< origin post)))
(beginning-of-line)
(looking-at org-element--affiliated-re)
(cond
((not (member (upcase (match-string 1)) org-element-parsed-keywords))
(throw 'objects-forbidden element))
((< (match-end 0) origin)
(narrow-to-region (match-end 0) (line-end-position)))
((and (match-beginning 2)
(>= origin (match-beginning 2))
(< origin (match-end 2)))
(narrow-to-region (match-beginning 2) (match-end 2)))
(t (throw 'objects-forbidden element)))
;; Also change type to retrieve correct restrictions.
(setq type 'keyword))
;; At an item, objects can only be located within tag, if any.
((eq type 'item)
(let ((tag (org-element-property :tag element)))
(if (not tag) (throw 'objects-forbidden element)
(beginning-of-line)
(search-forward tag (line-end-position))
(goto-char (match-beginning 0))
(if (and (>= origin (point)) (< origin (match-end 0)))
(narrow-to-region (point) (match-end 0))
(throw 'objects-forbidden element)))))
;; At an headline or inlinetask, objects are located within
;; their title.
((memq type '(headline inlinetask))
(goto-char (org-element-property :begin element))
(skip-chars-forward "* ")
(if (and (>= origin (point)) (< origin (line-end-position)))
(narrow-to-region (point) (line-end-position))
(throw 'objects-forbidden element)))
;; At a paragraph, a table-row or a verse block, objects are
;; located within their contents.
((memq type '(paragraph table-row verse-block))
(let ((cbeg (org-element-property :contents-begin element))
(cend (org-element-property :contents-end element)))
;; CBEG is nil for table rules.
(if (and cbeg cend (>= origin cbeg) (< origin cend))
(narrow-to-region cbeg cend)
(throw 'objects-forbidden element))))
;; At a parsed keyword, objects are located within value.
((eq type 'keyword)
(if (not (member (org-element-property :key element)
org-element-document-properties))
(throw 'objects-forbidden element)
(beginning-of-line)
(search-forward ":")
(if (and (>= origin (point)) (< origin (line-end-position)))
(narrow-to-region (point) (line-end-position))
(throw 'objects-forbidden element))))
(t (throw 'objects-forbidden element)))
(goto-char (point-min))
(let ((restriction (org-element-restriction type))
(parent element)
(candidates 'initial))
(catch 'exit
(while (setq candidates (org-element--get-next-object-candidates
end restriction candidates))
(let ((closest-cand (rassq (apply 'min (mapcar 'cdr candidates))
candidates)))
;; If ORIGIN is before next object in element, there's
;; no point in looking further.
(if (> (cdr closest-cand) origin) (throw 'exit parent)
(let* ((object
(progn (goto-char (cdr closest-cand))
(funcall (intern (format "org-element-%s-parser"
(car closest-cand))))))
(cbeg (org-element-property :contents-begin object))
(cend (org-element-property :contents-end object))
(obj-end (org-element-property :end object)))
(cond
;; ORIGIN is after OBJECT, so skip it.
((<= obj-end origin)
(if (/= obj-end end) (goto-char obj-end)
(throw 'exit
(org-element-put-property
object :parent parent))))
;; ORIGIN is within a non-recursive object or at
;; an object boundaries: Return that object.
((or (not cbeg) (> cbeg origin) (< cend origin))
(throw 'exit
(org-element-put-property object :parent parent)))
;; Otherwise, move within current object and
;; restrict search to the end of its contents.
(t (goto-char cbeg)
(org-element-put-property object :parent parent)
(setq parent object
restriction (org-element-restriction object)
candidates 'initial
end cend)))))))
parent))))))
(parent element)
(candidates 'initial))
(catch 'exit
(while (setq candidates
(org-element--get-next-object-candidates
restriction candidates))
(let ((closest-cand (rassq (apply 'min (mapcar 'cdr candidates))
candidates)))
;; If ORIGIN is before next object in element, there's
;; no point in looking further.
(if (> (cdr closest-cand) origin) (throw 'exit parent)
(let* ((object
(progn (goto-char (cdr closest-cand))
(funcall (intern (format "org-element-%s-parser"
(car closest-cand))))))
(cbeg (org-element-property :contents-begin object))
(cend (org-element-property :contents-end object))
(obj-end (org-element-property :end object)))
(cond
;; ORIGIN is after OBJECT, so skip it.
((<= obj-end origin) (goto-char obj-end))
;; ORIGIN is within a non-recursive object or at
;; an object boundaries: Return that object.
((or (not cbeg) (< origin cbeg) (>= origin cend))
(throw 'exit
(org-element-put-property object :parent parent)))
;; Otherwise, move within current object and
;; restrict search to the end of its contents.
(t (goto-char cbeg)
(narrow-to-region (point) cend)
(org-element-put-property object :parent parent)
(setq parent object
restriction (org-element-restriction object)
candidates 'initial)))))))
parent))))))
(defun org-element-nested-p (elem-A elem-B)
"Non-nil when elements ELEM-A and ELEM-B are nested."

View File

@ -16077,7 +16077,7 @@ with the current time without prompting the user."
(setq dh (- h2 h1) dm (- m2 m1))
(if (< dm 0) (setq dm (+ dm 60) dh (1- dh)))
(concat t1 "+" (number-to-string dh)
(if (/= 0 dm) (concat ":" (number-to-string dm))))))))
(and (/= 0 dm) (format ":%02d" dm)))))))
(defun org-time-stamp-inactive (&optional arg)
"Insert an inactive time stamp.
@ -22198,7 +22198,15 @@ matches in paragraphs or comments, use it."
(make-string (org-list-item-body-column
(org-element-property :begin parent))
? ))
((looking-at adaptive-fill-regexp) (match-string 0))
((and adaptive-fill-regexp
;; Locally disable
;; `adaptive-fill-function' to let
;; `fill-context-prefix' handle
;; `adaptive-fill-regexp' variable.
(let (adaptive-fill-function)
(fill-context-prefix
post-affiliated
(org-element-property :end element)))))
((looking-at "[ \t]+") (match-string 0))
(t "")))))
(comment-block

View File

@ -2046,11 +2046,11 @@ contextual information."
(float-env
(cond ((and (not float) (plist-member attributes :float)) "%s")
((string= "multicolumn" float)
(format "\\begin{figure*}[%s]\n%s%%s\n\\end{figure*}"
(format "\\begin{figure*}[%s]\n%%s%s\n\\end{figure*}"
org-latex-default-figure-position
caption-str))
((or caption float)
(format "\\begin{figure}[H]\n%s%%s\n\\end{figure}"
(format "\\begin{figure}[H]\n%%s%s\n\\end{figure}"
caption-str))
(t "%s"))))
(format

View File

@ -173,7 +173,7 @@ be displayed when `org-export-show-temporary-export-buffer' is
non-nil."
(interactive)
(org-export-to-buffer 'org "*Org ORG Export*"
async subtreep visible-only ext-plist (lambda () (org-mode))))
async subtreep visible-only nil ext-plist (lambda () (org-mode))))
;;;###autoload
(defun org-org-export-to-org (&optional async subtreep visible-only ext-plist)

View File

@ -383,19 +383,19 @@ This splices all the components into the list."
(push p rtn)))
(nreverse (delete-dups (delq nil rtn)))))
(defvar org-sitemap-sort-files)
(defvar org-sitemap-sort-folders)
(defvar org-sitemap-ignore-case)
(defvar org-sitemap-requested)
(defvar org-sitemap-date-format)
(defvar org-sitemap-file-entry-format)
(defvar org-publish-sitemap-sort-files)
(defvar org-publish-sitemap-sort-folders)
(defvar org-publish-sitemap-ignore-case)
(defvar org-publish-sitemap-requested)
(defvar org-publish-sitemap-date-format)
(defvar org-publish-sitemap-file-entry-format)
(defun org-publish-compare-directory-files (a b)
"Predicate for `sort', that sorts folders and files for sitemap."
(let ((retval t))
(when (or org-sitemap-sort-files org-sitemap-sort-folders)
(when (or org-publish-sitemap-sort-files org-publish-sitemap-sort-folders)
;; First we sort files:
(when org-sitemap-sort-files
(case org-sitemap-sort-files
(when org-publish-sitemap-sort-files
(case org-publish-sitemap-sort-files
(alphabetically
(let* ((adir (file-directory-p a))
(aorg (and (string-match "\\.org$" a) (not adir)))
@ -405,7 +405,7 @@ This splices all the components into the list."
(org-publish-find-title a)) a))
(B (if borg (concat (file-name-directory b)
(org-publish-find-title b)) b)))
(setq retval (if org-sitemap-ignore-case
(setq retval (if org-publish-sitemap-ignore-case
(not (string-lessp (upcase B) (upcase A)))
(not (string-lessp B A))))))
((anti-chronologically chronologically)
@ -414,17 +414,17 @@ This splices all the components into the list."
(A (+ (lsh (car adate) 16) (cadr adate)))
(B (+ (lsh (car bdate) 16) (cadr bdate))))
(setq retval
(if (eq org-sitemap-sort-files 'chronologically) (<= A B)
(if (eq org-publish-sitemap-sort-files 'chronologically) (<= A B)
(>= A B)))))))
;; Directory-wise wins:
(when org-sitemap-sort-folders
(when org-publish-sitemap-sort-folders
;; a is directory, b not:
(cond
((and (file-directory-p a) (not (file-directory-p b)))
(setq retval (equal org-sitemap-sort-folders 'first)))
(setq retval (equal org-publish-sitemap-sort-folders 'first)))
;; a is not a directory, but b is:
((and (not (file-directory-p a)) (file-directory-p b))
(setq retval (equal org-sitemap-sort-folders 'last))))))
(setq retval (equal org-publish-sitemap-sort-folders 'last))))))
retval))
(defun org-publish-get-base-files-1
@ -457,7 +457,7 @@ matching the regexp SKIP-DIR when recursing through BASE-DIR."
(or (file-directory-p file)
(and match (string-match match file))))
(directory-files base-dir t)))))
(if (not org-sitemap-requested) all-files
(if (not org-publish-sitemap-requested) all-files
(sort all-files 'org-publish-compare-directory-files)))))
(defun org-publish-get-base-files (project &optional exclude-regexp)
@ -472,15 +472,15 @@ matching filenames."
(extension (or (plist-get project-plist :base-extension) "org"))
;; sitemap-... variables are dynamically scoped for
;; org-publish-compare-directory-files:
(org-sitemap-requested
(org-publish-sitemap-requested
(plist-get project-plist :auto-sitemap))
(sitemap-filename
(or (plist-get project-plist :sitemap-filename) "sitemap.org"))
(org-sitemap-sort-folders
(org-publish-sitemap-sort-folders
(if (plist-member project-plist :sitemap-sort-folders)
(plist-get project-plist :sitemap-sort-folders)
org-publish-sitemap-sort-folders))
(org-sitemap-sort-files
(org-publish-sitemap-sort-files
(cond ((plist-member project-plist :sitemap-sort-files)
(plist-get project-plist :sitemap-sort-files))
;; For backward compatibility:
@ -488,18 +488,19 @@ matching filenames."
(if (plist-get project-plist :sitemap-alphabetically)
'alphabetically nil))
(t org-publish-sitemap-sort-files)))
(org-sitemap-ignore-case
(org-publish-sitemap-ignore-case
(if (plist-member project-plist :sitemap-ignore-case)
(plist-get project-plist :sitemap-ignore-case)
org-publish-sitemap-sort-ignore-case))
(match (if (eq extension 'any) "^[^\\.]"
(concat "^[^\\.].*\\.\\(" extension "\\)$"))))
;; Make sure `org-sitemap-sort-folders' has an accepted value
(unless (memq org-sitemap-sort-folders '(first last))
(setq org-sitemap-sort-folders nil))
;; Make sure `org-publish-sitemap-sort-folders' has an accepted
;; value.
(unless (memq org-publish-sitemap-sort-folders '(first last))
(setq org-publish-sitemap-sort-folders nil))
(setq org-publish-temp-files nil)
(if org-sitemap-requested
(if org-publish-sitemap-requested
(pushnew (expand-file-name (concat base-dir sitemap-filename))
org-publish-temp-files))
(org-publish-get-base-files-1 base-dir recurse match
@ -588,8 +589,6 @@ Return output file name."
;; Remove opened buffer in the process.
(unless visitingp (kill-buffer work-buffer)))))
(defvar project-plist)
(defun org-publish-attachment (plist filename pub-dir)
"Publish a file with no transformation of any kind.
@ -678,10 +677,10 @@ If `:auto-sitemap' is set, publish the sitemap too. If
"sitemap.org"))
(sitemap-function (or (plist-get project-plist :sitemap-function)
'org-publish-org-sitemap))
(org-sitemap-date-format
(org-publish-sitemap-date-format
(or (plist-get project-plist :sitemap-date-format)
org-publish-sitemap-date-format))
(org-sitemap-file-entry-format
(org-publish-sitemap-file-entry-format
(or (plist-get project-plist :sitemap-file-entry-format)
org-publish-sitemap-file-entry-format))
(preparation-function
@ -775,7 +774,7 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
;; This is common to 'flat and 'tree
(let ((entry
(org-publish-format-file-entry
org-sitemap-file-entry-format file project-plist))
org-publish-sitemap-file-entry-format file project-plist))
(regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)"))
(cond ((string-match-p regexp entry)
(string-match regexp entry)
@ -791,11 +790,12 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
(or visiting (kill-buffer sitemap-buffer))))
(defun org-publish-format-file-entry (fmt file project-plist)
(format-spec fmt
`((?t . ,(org-publish-find-title file t))
(?d . ,(format-time-string org-sitemap-date-format
(org-publish-find-date file)))
(?a . ,(or (plist-get project-plist :author) user-full-name)))))
(format-spec
fmt
`((?t . ,(org-publish-find-title file t))
(?d . ,(format-time-string org-publish-sitemap-date-format
(org-publish-find-date file)))
(?a . ,(or (plist-get project-plist :author) user-full-name)))))
(defun org-publish-find-title (file &optional reset)
"Find the title of FILE in project."
@ -803,17 +803,16 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
(and (not reset) (org-publish-cache-get-file-property file :title nil t))
(let* ((org-inhibit-startup t)
(visiting (find-buffer-visiting file))
(buffer (or visiting (find-file-noselect file)))
title)
(buffer (or visiting (find-file-noselect file))))
(with-current-buffer buffer
(org-mode)
(setq title
(or (org-element-interpret-data
(plist-get (org-export-get-environment) :title))
(file-name-nondirectory (file-name-sans-extension file)))))
(unless visiting (kill-buffer buffer))
(org-publish-cache-set-file-property file :title title)
title)))
(let ((title
(let ((property (plist-get (org-export-get-environment) :title)))
(if property (org-element-interpret-data property)
(file-name-nondirectory (file-name-sans-extension file))))))
(unless visiting (kill-buffer buffer))
(org-publish-cache-set-file-property file :title title)
title)))))
(defun org-publish-find-date (file)
"Find the date of FILE in project.

View File

@ -112,7 +112,7 @@
(:section-numbers nil "num" org-export-with-section-numbers)
(:select-tags "SELECT_TAGS" nil org-export-select-tags split)
(:time-stamp-file nil "timestamp" org-export-time-stamp-file)
(:title "TITLE" nil org-export--default-title space)
(:title "TITLE" nil nil space)
(:with-archived-trees nil "arch" org-export-with-archived-trees)
(:with-author nil "author" org-export-with-author)
(:with-clocks nil "c" org-export-with-clocks)
@ -1743,7 +1743,8 @@ Assume buffer is in Org mode. Narrowing, if any, is ignored."
;; Return final value.
plist))))
;; Read options in the current buffer.
(setq plist (funcall get-options buffer-file-name nil))
(setq plist (funcall get-options
(and buffer-file-name (list buffer-file-name)) nil))
;; Parse keywords specified in `org-element-document-properties'
;; and return PLIST.
(dolist (keyword org-element-document-properties plist)
@ -1758,19 +1759,11 @@ Assume buffer is in Org mode. Narrowing, if any, is ignored."
(defun org-export--get-buffer-attributes ()
"Return properties related to buffer attributes, as a plist."
;; Store full path of input file name, or nil. For internal use.
(list :input-file (buffer-file-name (buffer-base-buffer))))
(defvar org-export--default-title nil) ; Dynamically scoped.
(defun org-export-store-default-title ()
"Return default title for current document, as a string.
Title is extracted from associated file name, if any, or buffer's
name."
(setq org-export--default-title
(or (let ((visited-file (buffer-file-name (buffer-base-buffer))))
(and visited-file
(let ((visited-file (buffer-file-name (buffer-base-buffer))))
(list :input-file visited-file
:title (if (not visited-file) (buffer-name (buffer-base-buffer))
(file-name-sans-extension
(file-name-nondirectory visited-file))))
(buffer-name (buffer-base-buffer)))))
(file-name-nondirectory visited-file))))))
(defun org-export--get-global-options (&optional backend)
"Return global export options as a plist.
@ -1783,8 +1776,9 @@ process."
(all (append (and backend (org-export-get-all-options backend))
org-export-options-alist)))
(dolist (cell all plist)
(let ((prop (car cell)))
(unless (plist-member plist prop)
(let ((prop (car cell))
(default-value (nth 3 cell)))
(unless (or (not default-value) (plist-member plist prop))
(setq plist
(plist-put
plist
@ -2256,9 +2250,10 @@ recursively convert DATA using BACKEND translation table."
;; memoization.
(org-combine-plists
info
(list :translate-alist (org-export-get-all-transcoders backend)
(list :back-end backend
:translate-alist (org-export-get-all-transcoders backend)
;; Size of the hash table is reduced since this function
;; will probably be used on short trees.
;; will probably be used on small trees.
:exported-data (make-hash-table :test 'eq :size 401)))))
(defun org-export--interpret-p (blob info)
@ -2760,7 +2755,8 @@ VALUE is ignored.
Call is done in a LIFO fashion, to be sure that developer
specified filters, if any, are called first."
(catch 'exit
(let ((backend-name (plist-get info :back-end)))
(let* ((backend (plist-get info :back-end))
(backend-name (and backend (org-export-backend-name backend))))
(dolist (filter filters value)
(let ((result (funcall filter value backend-name info)))
(cond ((not result) value)
@ -2975,10 +2971,6 @@ Return code as a string."
(and body-only 'body-only))))
(org-export--get-buffer-attributes)))
tree)
;; Store default title in `org-export--default-title' so that
;; `org-export-get-environment' can access it from buffer's
;; copy and then add it properly to communication channel.
(org-export-store-default-title)
;; Update communication channel and get parse tree. Buffer
;; isn't parsed directly. Instead, a temporary copy is
;; created, where include keywords, macros are expanded and
@ -4420,19 +4412,21 @@ Return value is the width given by the last width cookie in the
same column as TABLE-CELL, or nil."
(let* ((row (org-export-get-parent table-cell))
(table (org-export-get-parent row))
(column (let ((cells (org-element-contents row)))
(- (length cells) (length (memq table-cell cells)))))
(cells (org-element-contents row))
(columns (length cells))
(column (- columns (length (memq table-cell cells))))
(cache (or (plist-get info :table-cell-width-cache)
(plist-get (setq info
(plist-put info :table-cell-width-cache
(make-hash-table :test 'equal)))
(make-hash-table :test 'eq)))
:table-cell-width-cache)))
(key (cons table column))
(value (gethash key cache 'no-result)))
(if (not (eq value 'no-result)) value
(width-vector (or (gethash table cache)
(puthash table (make-vector columns 'empty) cache)))
(value (aref width-vector column)))
(if (not (eq value 'empty)) value
(let (cookie-width)
(dolist (row (org-element-contents table)
(puthash key cookie-width cache))
(aset width-vector column cookie-width))
(when (org-export-table-row-is-special-p row info)
;; In a special row, try to find a width cookie at COLUMN.
(let* ((value (org-element-contents
@ -4458,16 +4452,21 @@ same column as TABLE-CELL. If no such cookie is found, a default
alignment value will be deduced from fraction of numbers in the
column (see `org-table-number-fraction' for more information).
Possible values are `left', `right' and `center'."
;; Load `org-table-number-fraction' and `org-table-number-regexp'.
(require 'org-table)
(let* ((row (org-export-get-parent table-cell))
(table (org-export-get-parent row))
(column (let ((cells (org-element-contents row)))
(- (length cells) (length (memq table-cell cells)))))
(cells (org-element-contents row))
(columns (length cells))
(column (- columns (length (memq table-cell cells))))
(cache (or (plist-get info :table-cell-alignment-cache)
(plist-get (setq info
(plist-put info :table-cell-alignment-cache
(make-hash-table :test 'equal)))
:table-cell-alignment-cache))))
(or (gethash (cons table column) cache)
(make-hash-table :test 'eq)))
:table-cell-alignment-cache)))
(align-vector (or (gethash table cache)
(puthash table (make-vector columns nil) cache))))
(or (aref align-vector column)
(let ((number-cells 0)
(total-cells 0)
cookie-align
@ -4510,15 +4509,15 @@ Possible values are `left', `right' and `center'."
(incf number-cells))))))
;; Return value. Alignment specified by cookies has
;; precedence over alignment deduced from cell's contents.
(puthash (cons table column)
(cond ((equal cookie-align "l") 'left)
((equal cookie-align "r") 'right)
((equal cookie-align "c") 'center)
((>= (/ (float number-cells) total-cells)
org-table-number-fraction)
'right)
(t 'left))
cache)))))
(aset align-vector
column
(cond ((equal cookie-align "l") 'left)
((equal cookie-align "r") 'right)
((equal cookie-align "c") 'center)
((>= (/ (float number-cells) total-cells)
org-table-number-fraction)
'right)
(t 'left)))))))
(defun org-export-table-cell-borders (table-cell info)
"Return TABLE-CELL borders.
@ -5552,9 +5551,9 @@ EXT-PLIST are similar to those used in `org-export-as', which
see.
Optional argument POST-PROCESS is a function which should accept
no argument. It is called within the current process, from
BUFFER, with point at its beginning. Export back-ends can use it
to set a major mode there, e.g,
no argument. It is always called within the current process,
from BUFFER, with point at its beginning. Export back-ends can
use it to set a major mode there, e.g,
\(defun org-latex-export-as-latex
\(&optional async subtreep visible-only body-only ext-plist)
@ -5612,9 +5611,9 @@ EXT-PLIST are similar to those used in `org-export-as', which
see.
Optional argument POST-PROCESS is called with FILE as its
argument, in the asynchronous process. It has to return a file
name, or nil. Export back-ends can use this to send the output
file through additional processing, e.g,
argument and happens asynchronously when ASYNC is non-nil. It
has to return a file name, or nil. Export back-ends can use this
to send the output file through additional processing, e.g,
\(defun org-latex-export-to-latex
\(&optional async subtreep visible-only body-only ext-plist)

View File

@ -1167,6 +1167,20 @@ echo \"$data\"
(goto-char (match-beginning 0))
(org-babel-execute-src-block))))))
(ert-deftest test-ob/preserve-results-indentation ()
"Preserve indentation when executing a src block."
(should
(equal '(2 2)
(org-test-with-temp-text
" #+begin_src emacs-lisp\n (+ 1 1)\n #+end_src"
(org-babel-execute-src-block)
(buffer-string)
(let ((case-fold-search t)) (search-forward "#+results:"))
;; Check if both #+RESULTS: keyword and actual results are
;; indented by 2 columns.
(list (org-get-indentation)
(progn (forward-line) (org-get-indentation)))))))
(provide 'test-ob)
;;; test-ob ends here

View File

@ -501,7 +501,13 @@ Some other text
'(("test" "test" nil "test" "test" "test" "test"))))
(org-test-with-temp-text "\\test"
(org-element-map (org-element-parse-buffer) 'entity 'identity nil t))))
"test")))
"test"))
;; Special case: entity at the end of a container.
(should
(eq 'entity
(org-test-with-temp-text "*\\alpha \\beta*"
(search-forward "be")
(org-element-type (org-element-context))))))
;;;; Example Block
@ -1351,7 +1357,7 @@ e^{i\\pi}+1=0
(org-test-with-temp-text
"#+LINK: orgmode http://www.orgmode.org/\n[[orgmode:#docs]]"
(progn (org-mode-restart)
(goto-char (point-max))
(goto-char (1- (point-max)))
(org-element-property :type (org-element-context))))))
;; Link abbreviation in a secondary string.
(should

View File

@ -273,13 +273,30 @@
(buffer-string)))))
;; Auto fill paragraph when `adaptive-fill-regexp' matches.
(should
(equal "> 12345\n> 7890"
(equal "> 12345\n 7890"
(org-test-with-temp-text "> 12345 7890"
(let ((fill-column 5)
(adaptive-fill-regexp "[ \t]*>+[ \t]*"))
(let ((fill-column 10)
(adaptive-fill-regexp "[ \t]*>+[ \t]*")
(adaptive-fill-first-line-regexp "\\`[ ]*\\'"))
(end-of-line)
(org-auto-fill-function)
(buffer-string)))))
(should
(equal "> 12345\n> 12345\n> 7890"
(org-test-with-temp-text "> 12345\n> 12345 7890"
(let ((fill-column 10)
(adaptive-fill-regexp "[ \t]*>+[ \t]*"))
(goto-char (point-max))
(org-auto-fill-function)
(buffer-string)))))
(should-not
(equal " 12345\n *12345\n *12345"
(org-test-with-temp-text " 12345\n *12345 12345"
(let ((fill-column 10)
(adaptive-fill-regexp "[ \t]*>+[ \t]*"))
(goto-char (point-max))
(org-auto-fill-function)
(buffer-string)))))
;; Auto fill comments.
(should
(equal " # 12345\n # 7890"

View File

@ -2246,51 +2246,48 @@ Another text. (ref:text)
(ert-deftest test-org-export/table-cell-alignment ()
"Test `org-export-table-cell-alignment' specifications."
(let ((org-table-number-fraction 0.5)
(org-table-number-regexp "^[0-9]+$"))
;; 1. Alignment is primarily determined by alignment cookies.
(org-test-with-temp-text "| <l> | <c> | <r> |"
(let* ((tree (org-element-parse-buffer))
(info `(:parse-tree ,tree)))
(should
(equal
'(left center right)
(mapcar (lambda (cell) (org-export-table-cell-alignment cell info))
(org-element-map tree 'table-cell 'identity))))))
;; 2. The last alignment cookie has precedence.
(org-test-with-parsed-data "
;; 1. Alignment is primarily determined by alignment cookies.
(should
(equal '(left center right)
(let ((org-table-number-fraction 0.5)
(org-table-number-regexp "^[0-9]+$"))
(org-test-with-parsed-data "| <l> | <c> | <r> |"
(mapcar (lambda (cell)
(org-export-table-cell-alignment cell info))
(org-element-map tree 'table-cell 'identity))))))
;; 2. The last alignment cookie has precedence.
(should
(equal '(right right right)
(org-test-with-parsed-data "
| <l8> |
| cell |
| <r9> |"
(should
(equal
'(right right right)
(mapcar (lambda (cell) (org-export-table-cell-alignment cell info))
(org-element-map tree 'table-cell 'identity)))))
;; 3. If there's no cookie, cell's contents determine alignment.
;; A column mostly made of cells containing numbers will align
;; its cells to the right.
(org-test-with-parsed-data "
(mapcar (lambda (cell) (org-export-table-cell-alignment cell info))
(org-element-map tree 'table-cell 'identity)))))
;; 3. If there's no cookie, cell's contents determine alignment.
;; A column mostly made of cells containing numbers will align
;; its cells to the right.
(should
(equal '(right right right)
(let ((org-table-number-fraction 0.5)
(org-table-number-regexp "^[0-9]+$"))
(org-test-with-parsed-data "
| 123 |
| some text |
| 12345 |"
(should
(equal
'(right right right)
(mapcar (lambda (cell)
(org-export-table-cell-alignment cell info))
(org-element-map tree 'table-cell 'identity)))))
;; 4. Otherwise, they will be aligned to the left.
(org-test-with-parsed-data "
(mapcar (lambda (cell)
(org-export-table-cell-alignment cell info))
(org-element-map tree 'table-cell 'identity))))))
;; 4. Otherwise, they will be aligned to the left.
(should
(equal '(left left left)
(org-test-with-parsed-data "
| text |
| some text |
| \alpha |"
(should
(equal
'(left left left)
(mapcar (lambda (cell)
(org-export-table-cell-alignment cell info))
(org-element-map tree 'table-cell 'identity)))))))
(mapcar (lambda (cell)
(org-export-table-cell-alignment cell info))
(org-element-map tree 'table-cell 'identity info))))))
(ert-deftest test-org-export/table-cell-borders ()
"Test `org-export-table-cell-borders' specifications."