mirror/org-mode
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-11-26 07:33:39 +00:00
Code

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

Browse Source
This commit is contained in:
Carsten Dominik 2012-05-10 12:18:49 +02:00
commit 3216210668
34 changed files with 4366 additions and 2584 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
Makefile
View File

@ -19,18 +19,18 @@ help::
$(info ============)
$(info )
$(info make help - show brief help)
$(info make targets - dito)
$(info make targets - ditto)
$(info make helpall - show extended help)
$(info )
$(info Build and Check)
$(info ===============)
$(info make - build Org ELisp and all documentation)
$(info make all - dito)
$(info make all - ditto)
$(info make compile - build Org ELisp files)
$(info make autoloads - create org-install.el to load org in-place)
$(info make check - build Org ELisp files and run test suite)
helpall::
$(info make test - dito)
$(info make test - ditto)
$(info make compile-dirty - build only stale Org ELisp files)
$(info make test-dirty - check without building first)
$(info )
@ -54,9 +54,9 @@ helpall::
$(info make cleandirs - clean in etc/, lisp/ and doc/)
$(info make cleancontrib - remove remnants in contrib/)
$(info make cleandoc - remove built documentation)
$(info make cleandocs - dito)
$(info make cleandocs - ditto)
$(info make cleanlisp - remove built Org ELisp files)
$(info make cleanelc - dito)
$(info make cleanelc - ditto)
$(info make cleanrel - remove release remnants)
$(info make cleantest - remove check remnants)
$(info make clean-install - remove previous Org installation)
@ -66,14 +66,14 @@ helpall::
help::
$(info make doc - build all documentation)
helpall::
$(info make docs - dito)
$(info make docs - ditto)
help::
$(info make info - build Info documentation)
helpall::
$(info make html - build HTML documentation)
$(info make pdf - build PDF documentation)
$(info make card - build reference cards)
$(info make refcard - dito)
$(info make refcard - ditto)
help::
$(info )
$(info Installation)

4
UTILITIES/manfull.pl
View File

@ -12,10 +12,10 @@ while (<IN>) {
print OUT '<link rel="stylesheet" href="http://orgmode.org/org-manual.css" type="text/css" />';
} elsif (/<div class="contents">/) {
print OUT;
print OUT '<div id="table-of-contents">';
print OUT '<p>This is the official manual for the latest <a href="http://orgmode.org">Org-mode</a> release.</p><div id="table-of-contents">';
} elsif (/<h2>Table of Contents<\/h2>/) {
print OUT;
print OUT '<div id="text-table-of-contents">';
print OUT '<a href="http://orgmode.org">http://orgmode.org</a><br/><div id="text-table-of-contents">';
$toc = 1;
} elsif (/<\/div>/ and $toc) {
print OUT "</div></div></div>";

1
UTILITIES/mansplit.pl
View File

@ -10,6 +10,7 @@
$contents = <<EOF;
<div id="table-of-contents">
<p>This is the official manual for the latest <a href="http://orgmode.org">Org-mode</a> release.</p>
<h2>Table of Contents</h2>
<div id="text-table-of-contents">
<ul>

330
contrib/lisp/org-drill.el
View File

@ -1,28 +1,28 @@
;; -*- coding: utf-8-unix -*-
;; org-drill.el - Self-testing using spaced repetition
;;
;; Author: Paul Sexton <eeeickythump@gmail.com>
;; Version: 2.3.5
;; Repository at http://bitbucket.org/eeeickythump/org-drill/
;;
;; This file is not part of GNU Emacs.
;;
;; Synopsis
;; ========
;;
;; Uses the SuperMemo spaced repetition algorithms to conduct interactive
;; "drill sessions", where the material to be remembered is presented to the
;; student in random order. The student rates his or her recall of each item,
;; and this information is used to schedule the item for later revision.
;;
;; Each drill session can be restricted to topics in the current buffer
;; (default), one or several files, all agenda files, or a subtree. A single
;; topic can also be drilled.
;;
;; Different "card types" can be defined, which present their information to
;; the student in different ways.
;;
;; See the file README.org in the repository for more detailed documentation.
;;; -*- coding: utf-8-unix -*-
;;; org-drill.el - Self-testing using spaced repetition
;;;
;;; Author: Paul Sexton <eeeickythump@gmail.com>
;;; Version: 2.3.6
;;; Repository at http://bitbucket.org/eeeickythump/org-drill/
;;;
;;;
;;; Synopsis
;;; ========
;;;
;;; Uses the SuperMemo spaced repetition algorithms to conduct interactive
;;; "drill sessions", where the material to be remembered is presented to the
;;; student in random order. The student rates his or her recall of each item,
;;; and this information is used to schedule the item for later revision.
;;;
;;; Each drill session can be restricted to topics in the current buffer
;;; (default), one or several files, all agenda files, or a subtree. A single
;;; topic can also be drilled.
;;;
;;; Different "card types" can be defined, which present their information to
;;; the student in different ways.
;;;
;;; See the file README.org for more detailed documentation.
(eval-when-compile (require 'cl))
(eval-when-compile (require 'hi-lock))
@ -37,6 +37,7 @@
:group 'org-link)
(defcustom org-drill-question-tag
"drill"
"Tag which topics must possess in order to be identified as review topics
@ -53,6 +54,7 @@ Nil means unlimited."
:type '(choice integer (const nil)))
(defcustom org-drill-maximum-duration
20
"Maximum duration of a drill session, in minutes.
@ -105,7 +107,7 @@ Possible values:
but a warning message is printed when each leech item is
presented."
:group 'org-drill
:type '(choice (const warn) (const skip) (const nil)))
:type '(choice (const 'warn) (const 'skip) (const nil)))
(defface org-drill-visible-cloze-face
@ -260,9 +262,9 @@ directory All files with the extension '.org' in the same
;; 'file-no-restriction' means current file/buffer, ignoring restrictions
;; 'directory' means all *.org files in current directory
:group 'org-drill
:type '(choice (const file) (const tree) (const file-no-restriction)
(const file-with-archives) (const agenda)
(const agenda-with-archives) (const directory)
:type '(choice (const 'file) (const 'tree) (const 'file-no-restriction)
(const 'file-with-archives) (const 'agenda)
(const 'agenda-with-archives) (const 'directory)
list))
@ -288,7 +290,7 @@ Available choices are:
adjusting intervals when items are reviewed early or late has been taken
from SM11, a later version of the algorithm, and included in Simple8."
:group 'org-drill
:type '(choice (const sm2) (const sm5) (const simple8)))
:type '(choice (const 'sm2) (const 'sm5) (const 'simple8)))
(defcustom org-drill-optimal-factor-matrix
@ -619,7 +621,7 @@ situation use `org-part-of-drill-entry-p'."
(defun org-drill-goto-entry (marker)
(org-pop-to-buffer-same-window (marker-buffer marker))
(switch-to-buffer (marker-buffer marker))
(goto-char marker))
@ -1507,18 +1509,38 @@ concealed by an overlay that displays the string TEXT."
(org-drill-unreplace-entry-text))))
(defun org-drill-replace-entry-text (text)
(defmacro with-replaced-entry-text-multi (replacements &rest body)
"During the execution of BODY, the entire text of the current entry is
concealed by an overlay that displays the overlays in REPLACEMENTS."
`(progn
(org-drill-replace-entry-text ,replacements t)
(unwind-protect
(progn
,@body)
(org-drill-unreplace-entry-text))))
(defun org-drill-replace-entry-text (text &optional multi-p)
"Make an overlay that conceals the entire text of the item, not
including properties or the contents of subheadings. The overlay shows
the string TEXT.
If MULTI-P is non-nil, TEXT must be a list of values which are legal
for the `display' text property. The text of the item will be temporarily
replaced by all of these items, in the order in which they appear in
the list.
Note: does not actually alter the item."
(let ((ovl (make-overlay (point-min)
(save-excursion
(outline-next-heading)
(point)))))
(overlay-put ovl 'category
'org-drill-replaced-text-overlay)
(overlay-put ovl 'display text)))
(cond
((and multi-p
(listp text))
(org-drill-replace-entry-text-multi text))
(t
(let ((ovl (make-overlay (point-min)
(save-excursion
(outline-next-heading)
(point)))))
(overlay-put ovl 'category
'org-drill-replaced-text-overlay)
(overlay-put ovl 'display text)))))
(defun org-drill-unreplace-entry-text ()
@ -1528,6 +1550,27 @@ Note: does not actually alter the item."
(delete-overlay ovl)))))
(defun org-drill-replace-entry-text-multi (replacements)
"Make overlays that conceal the entire text of the item, not
including properties or the contents of subheadings. The overlay shows
the string TEXT.
Note: does not actually alter the item."
(let ((ovl nil)
(p-min (point-min))
(p-max (save-excursion
(outline-next-heading)
(point))))
(assert (>= (- p-max p-min) (length replacements)))
(dotimes (i (length replacements))
(setq ovl (make-overlay (+ p-min (* 2 i))
(if (= i (1- (length replacements)))
p-max
(+ p-min (* 2 i) 1))))
(overlay-put ovl 'category
'org-drill-replaced-text-overlay)
(overlay-put ovl 'display (nth i replacements)))))
(defmacro with-replaced-entry-heading (heading &rest body)
`(progn
(org-drill-replace-entry-heading ,heading)
@ -1577,7 +1620,8 @@ Note: does not actually alter the item."
(with-hidden-cloze-hints
(with-hidden-cloze-text
(org-drill-hide-all-subheadings-except nil)
(org-display-inline-images t)
(ignore-errors
(org-display-inline-images t))
(org-cycle-hide-drawers 'all)
(prog1 (org-drill-presentation-prompt)
(org-drill-hide-subheadings-if 'org-drill-entry-p))))))
@ -1586,6 +1630,8 @@ Note: does not actually alter the item."
(defun org-drill-present-default-answer (reschedule-fn)
(org-drill-hide-subheadings-if 'org-drill-entry-p)
(org-drill-unhide-clozed-text)
(ignore-errors
(org-display-inline-images t))
(with-hidden-cloze-hints
(funcall reschedule-fn)))
@ -1600,7 +1646,8 @@ Note: does not actually alter the item."
(goto-char (nth (random* (min 2 (length drill-sections)))
drill-sections))
(org-show-subtree)))
(org-display-inline-images t)
(ignore-errors
(org-display-inline-images t))
(org-cycle-hide-drawers 'all)
(prog1 (org-drill-presentation-prompt)
(org-drill-hide-subheadings-if 'org-drill-entry-p)))))))
@ -1616,7 +1663,8 @@ Note: does not actually alter the item."
(save-excursion
(goto-char (nth (random* (length drill-sections)) drill-sections))
(org-show-subtree)))
(org-display-inline-images t)
(ignore-errors
(org-display-inline-images t))
(org-cycle-hide-drawers 'all)
(prog1 (org-drill-presentation-prompt)
(org-drill-hide-subheadings-if 'org-drill-entry-p)))))))
@ -1694,7 +1742,8 @@ items if FORCE-SHOW-FIRST or FORCE-SHOW-LAST is non-nil)."
;; while (org-pos-in-regexp (match-beginning 0)
;; org-bracket-link-regexp 1))
;; (org-drill-hide-matched-cloze-text)))))
(org-display-inline-images t)
(ignore-errors
(org-display-inline-images t))
(org-cycle-hide-drawers 'all)
(prog1 (org-drill-presentation-prompt)
(org-drill-hide-subheadings-if 'org-drill-entry-p)
@ -1741,7 +1790,8 @@ the second to last, etc."
(incf cnt)
(if (= cnt to-hide)
(org-drill-hide-matched-cloze-text)))))))
(org-display-inline-images t)
(ignore-errors
(org-display-inline-images t))
(org-cycle-hide-drawers 'all)
(prog1 (org-drill-presentation-prompt)
(org-drill-hide-subheadings-if 'org-drill-entry-p)
@ -1905,25 +1955,25 @@ pieces rather than one."
question
(org-drill-hide-all-subheadings-except nil)
(org-cycle-hide-drawers 'all)
(ignore-errors
(org-display-inline-images t))
(prog1 (org-drill-presentation-prompt)
(org-drill-hide-subheadings-if 'org-drill-entry-p)))))
;;; The following macro is necessary because `org-save-outline-visibility'
;;; currently discards the value returned by its body and returns a garbage
;;; value instead. (as at org mode v 7.5)
(defmacro org-drill-save-visibility (&rest body)
"Store the current visibility state of the org buffer, and restore it
after executing BODY. Return the value of the last expression
in BODY."
(let ((retval (gensym)))
`(let ((,retval nil))
(org-save-outline-visibility t
(setq ,retval
(progn
,@body)))
,retval)))
(defun org-drill-present-card-using-multiple-overlays (replacements &optional answer)
"TEXTS is a list of valid values for the 'display' text property.
Present these overlays, in sequence, as the only
visible content of the card."
(with-hidden-comments
(with-replaced-entry-text-multi
replacements
(org-drill-hide-all-subheadings-except nil)
(org-cycle-hide-drawers 'all)
(ignore-errors
(org-display-inline-images t))
(prog1 (org-drill-presentation-prompt)
(org-drill-hide-subheadings-if 'org-drill-entry-p)))))
(defun org-drill-entry ()
@ -1945,38 +1995,41 @@ See `org-drill' for more details."
;; (org-back-to-heading))
(let ((card-type (org-entry-get (point) "DRILL_CARD_TYPE"))
(answer-fn 'org-drill-present-default-answer)
(cont nil))
(org-drill-save-visibility
(save-restriction
(org-narrow-to-subtree)
(org-show-subtree)
(org-cycle-hide-drawers 'all)
(cont nil)
;; fontification functions in `outline-view-change-hook' can cause big
;; slowdowns, so we temporarily bind this variable to nil here.
(outline-view-change-hook nil))
(org-save-outline-visibility t
(save-restriction
(org-narrow-to-subtree)
(org-show-subtree)
(org-cycle-hide-drawers 'all)
(let ((presentation-fn (cdr (assoc card-type org-drill-card-type-alist))))
(if (listp presentation-fn)
(psetq answer-fn (or (second presentation-fn)
'org-drill-present-default-answer)
presentation-fn (first presentation-fn)))
(cond
((null presentation-fn)
(message "%s:%d: Unrecognised card type '%s', skipping..."
(buffer-name) (point) card-type)
(sit-for 0.5)
'skip)
(t
(setq cont (funcall presentation-fn))
(cond
((not cont)
(message "Quit")
nil)
((eql cont 'edit)
'edit)
((eql cont 'skip)
'skip)
(t
(save-excursion
(funcall answer-fn
(lambda () (org-drill-reschedule)))))))))))))
(let ((presentation-fn (cdr (assoc card-type org-drill-card-type-alist))))
(if (listp presentation-fn)
(psetq answer-fn (or (second presentation-fn)
'org-drill-present-default-answer)
presentation-fn (first presentation-fn)))
(cond
((null presentation-fn)
(message "%s:%d: Unrecognised card type '%s', skipping..."
(buffer-name) (point) card-type)
(sit-for 0.5)
'skip)
(t
(setq cont (funcall presentation-fn))
(cond
((not cont)
(message "Quit")
nil)
((eql cont 'edit)
'edit)
((eql cont 'skip)
'skip)
(t
(save-excursion
(funcall answer-fn
(lambda () (org-drill-reschedule)))))))))))))
(defun org-drill-entries-pending-p ()
@ -2356,12 +2409,12 @@ than starting a new one."
(org-map-drill-entries
(lambda ()
(org-drill-progress-message
(+ (length *org-drill-new-entries*)
(length *org-drill-overdue-entries*)
(length *org-drill-young-mature-entries*)
(length *org-drill-old-mature-entries*)
(length *org-drill-failed-entries*))
(incf cnt))
(+ (length *org-drill-new-entries*)
(length *org-drill-overdue-entries*)
(length *org-drill-young-mature-entries*)
(length *org-drill-old-mature-entries*)
(length *org-drill-failed-entries*))
(incf cnt))
(cond
((not (org-drill-entry-p))
nil) ; skip
@ -2448,7 +2501,9 @@ than starting a new one."
(cond
(end-pos
(when (markerp end-pos)
(org-drill-goto-entry end-pos))
(org-drill-goto-entry end-pos)
(org-reveal)
(org-show-entry))
(let ((keystr (command-keybinding-to-string 'org-drill-resume)))
(message
"You can continue the drill session with the command `org-drill-resume'.%s"
@ -2600,7 +2655,7 @@ the tag 'imported'."
(unless path
(setq path (org-get-outline-path)))
(org-copy-subtree)
(org-pop-to-buffer-same-window dest)
(switch-to-buffer dest)
(setq m
(condition-case nil
(org-find-olp path t)
@ -2682,7 +2737,7 @@ copy them across."
scheduled-time (org-get-scheduled-time (point)))
(save-excursion
;; go to matching entry in destination buffer
(org-pop-to-buffer-same-window (marker-buffer marker))
(switch-to-buffer (marker-buffer marker))
(goto-char marker)
(org-drill-strip-entry-data)
(unless (zerop total-repeats)
@ -2738,7 +2793,14 @@ copy them across."
("imperfect" "darkturquoise")
("present perfect" "royalblue")
;; future tenses
("future" "green"))
("future" "green")
;; moods (backgrounds).
("indicative" nil) ; default
("subjunctive" "medium blue")
("conditional" "grey30")
("negative imperative" "red4")
("positive imperative" "darkgreen")
)
"Alist where each entry has the form (TENSE COLOUR), where
TENSE is a string naming a tense in which verbs can be
conjugated, and COLOUR is a string specifying a foreground colour
@ -2754,50 +2816,72 @@ the name of the tense.")
(inf-hint (org-entry-get (point) "VERB_INFINITIVE_HINT" t))
(translation (org-entry-get (point) "VERB_TRANSLATION" t))
(tense (org-entry-get (point) "VERB_TENSE" nil))
(mood (org-entry-get (point) "VERB_MOOD" nil))
(highlight-face nil))
(unless (and infinitive translation tense)
(error "Missing information for verb conjugation card (%s, %s, %s) at %s"
infinitive translation tense (point)))
(setq tense (downcase (car (read-from-string tense)))
(unless (and infinitive translation (or tense mood))
(error "Missing information for verb conjugation card (%s, %s, %s, %s) at %s"
infinitive translation tense mood (point)))
(setq tense (if tense (downcase (car (read-from-string tense))))
mood (if mood (downcase (car (read-from-string mood))))
infinitive (car (read-from-string infinitive))
inf-hint (if inf-hint (car (read-from-string inf-hint)))
translation (car (read-from-string translation)))
(setq highlight-face
(list :foreground
(or (second (assoc-string tense org-drill-verb-tense-alist t))
"red")))
"hotpink")
:background
(second (assoc-string mood org-drill-verb-tense-alist t))))
(setq infinitive (propertize infinitive 'face highlight-face))
(setq translation (propertize translation 'face highlight-face))
(setq tense (propertize tense 'face highlight-face))
(list infinitive inf-hint translation tense)))
(if tense (setq tense (propertize tense 'face highlight-face)))
(if mood (setq mood (propertize mood 'face highlight-face)))
(list infinitive inf-hint translation tense mood)))
(defun org-drill-present-verb-conjugation ()
"Present a drill entry whose card type is 'conjugate'."
(destructuring-bind (infinitive inf-hint translation tense)
(org-drill-get-verb-conjugation-info)
(org-drill-present-card-using-text
(cond
((zerop (random* 2))
(format "\nTranslate the verb\n\n%s\n\nand conjugate for the %s tense.\n\n"
infinitive tense))
(t
(format "\nGive the verb that means\n\n%s %s\n
and conjugate for the %s tense.\n\n"
translation
(if inf-hint (format " [HINT: %s]" inf-hint) "")
tense))))))
(flet ((tense-and-mood-to-string
(tense mood)
(cond
((and tense mood)
(format "%s tense, %s mood" tense mood))
(tense
(format "%s tense" tense))
(mood
(format "%s mood" mood)))))
(destructuring-bind (infinitive inf-hint translation tense mood)
(org-drill-get-verb-conjugation-info)
(org-drill-present-card-using-text
(cond
((zerop (random* 2))
(format "\nTranslate the verb\n\n%s\n\nand conjugate for the %s.\n\n"
infinitive (tense-and-mood-to-string tense mood)))
(t
(format "\nGive the verb that means\n\n%s %s\n
and conjugate for the %s.\n\n"
translation
(if inf-hint (format " [HINT: %s]" inf-hint) "")
(tense-and-mood-to-string tense mood))))))))
(defun org-drill-show-answer-verb-conjugation (reschedule-fn)
"Show the answer for a drill item whose card type is 'conjugate'.
RESCHEDULE-FN must be a function that calls `org-drill-reschedule' and
returns its return value."
(destructuring-bind (infinitive inf-hint translation tense)
(destructuring-bind (infinitive inf-hint translation tense mood)
(org-drill-get-verb-conjugation-info)
(with-replaced-entry-heading
(format "%s tense of %s ==> %s\n\n"
(capitalize tense)
(format "%s of %s ==> %s\n\n"
(capitalize
(cond
((and tense mood)
(format "%s tense, %s mood" tense mood))
(tense
(format "%s tense" tense))
(mood
(format "%s mood" mood))))
infinitive translation)
(funcall reschedule-fn))))

149
contrib/lisp/org-e-ascii.el
View File

@ -39,8 +39,6 @@
(declare-function org-element-normalize-string "org-element" (s))
(declare-function org-element-map "org-element"
(data types fun &optional info first-match))
(declare-function org-element-time-stamp-interpreter
"org-element" (time-stamp contents))
(declare-function org-export-collect-footnote-definitions
"org-export" (data info))
@ -64,7 +62,6 @@
(declare-function org-export-resolve-fuzzy-link "org-export" (link info))
(declare-function org-export-resolve-id-link "org-export" (link info))
(declare-function org-export-resolve-ref-link "org-export" (link info))
(declare-function org-export-secondary-string "org-export" (secondary info))
(declare-function
org-export-to-file "org-export"
(backend file &optional subtreep visible-only body-only ext-plist))
@ -371,7 +368,7 @@ The function must accept six parameters:
TODO-TYPE the todo type, a symbol among `todo', `done' and nil.
PRIORITY the inlinetask priority, as a string
NAME the inlinetask name, as a string.
TAGS the inlinetask tags, as a string.
TAGS the inlinetask tags, as a list of strings.
CONTENTS the contents of the inlinetask, as a string.
The function should return either the string to be exported or
@ -583,19 +580,20 @@ title."
;; All tests passed: build numbering string.
(concat
(mapconcat
#'number-to-string
'number-to-string
(org-export-get-headline-number element info) ".")
" ")))
(text (org-export-secondary-string
(org-element-property :title element) info))
(text (org-export-data (org-element-property :title element) info))
(todo
(and (plist-get info :with-todo-keywords)
(let ((todo (org-element-property :todo-keyword element)))
(and todo
(concat (org-export-secondary-string todo info) " ")))))
(and todo (concat (org-export-data todo info) " ")))))
(tags (and (not notags)
(plist-get info :with-tags)
(org-element-property :tags element)))
(let ((tag-list (org-element-property :tags element)))
(and tag-list
(format ":%s:"
(mapconcat 'identity tag-list ":"))))))
(priority
(and (plist-get info :with-priority)
(concat (org-element-property :priority element) " ")))
@ -645,8 +643,7 @@ keyword."
(org-e-ascii--fill-string
(format
title-fmt reference
(if (not caption) name
(org-export-secondary-string (car caption) info)))
(if (not caption) name (org-export-data (car caption) info)))
(org-e-ascii--current-text-width element info) info)))))
(defun org-e-ascii--build-toc (info &optional n keyword)
@ -711,9 +708,8 @@ generation. INFO is a plist used as a communication channel."
(org-e-ascii--fill-string
(let ((caption (org-element-property :caption src-block)))
(if (not caption) (org-element-property :name src-block)
(org-export-secondary-string
;; Use short name in priority, if available.
(or (cdr caption) (car caption)) info)))
(org-export-data (or (cdr caption) (car caption)) info)))
(- text-width (length initial-text)) info)
(length initial-text))))))
(org-export-collect-listings info) "\n")))))
@ -751,8 +747,7 @@ generation. INFO is a plist used as a communication channel."
(let ((caption (org-element-property :caption table)))
(if (not caption) (org-element-property :name table)
;; Use short name in priority, if available.
(org-export-secondary-string
(or (cdr caption) (car caption)) info)))
(org-export-data (or (cdr caption) (car caption)) info)))
(- text-width (length initial-text)) info)
(length initial-text))))))
(org-export-collect-tables info) "\n")))))
@ -811,7 +806,7 @@ channel."
(let ((type (org-element-property :type link))
(anchor (let ((desc (org-element-contents link)))
(if (not desc) (org-element-property :raw-link link)
(org-export-secondary-string desc info)))))
(org-export-data desc info)))))
(cond
;; Coderefs, radio links and fuzzy links are ignored.
((member type '("coderef" "radio" "fuzzy")) nil)
@ -849,12 +844,12 @@ channel."
"Return document title, as a string.
INFO is a plist used as a communication channel."
(let ((text-width org-e-ascii-text-width)
(title (org-export-secondary-string (plist-get info :title) info))
(title (org-export-data (plist-get info :title) info))
(author (and (plist-get info :with-author)
(let ((auth (plist-get info :author)))
(and auth (org-export-secondary-string auth info)))))
(and auth (org-export-data auth info)))))
(email (and (plist-get info :with-email)
(org-export-secondary-string (plist-get info :email) info)))
(org-export-data (plist-get info :email) info)))
(date (plist-get info :date)))
;; There are two types of title blocks depending on the presence
;; of a title to display.
@ -964,7 +959,7 @@ holding export options."
;; Fill paragraph once footnote ID is inserted in
;; order to have a correct length for first line.
(org-e-ascii--fill-string
(concat id (org-export-secondary-string def info))
(concat id (org-export-data def info))
text-width info))))))
definitions "\n\n"))))
;; 5. Creator. Ignore `comment' value as there are no comments in
@ -1018,6 +1013,22 @@ holding contextual information."
contents (org-e-ascii--current-text-width center-block info) 'center))
;;;; Clock
(defun org-e-ascii-clock (clock contents info)
"Transcode a CLOCK object from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual
information."
(concat org-clock-string " "
(org-translate-time (org-element-property :value clock))
(let ((time (org-element-property :time clock)))
(and time
(concat " => "
(apply 'format
"%2s:%02s"
(org-split-string time ":")))))))
;;;; Code
(defun org-e-ascii-code (code contents info)
@ -1057,7 +1068,7 @@ holding contextual information."
(defun org-e-ascii-dynamic-block (dynamic-block contents info)
"Transcode a DYNAMIC-BLOCK element from Org to ASCII.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information. See `org-export-data'."
holding contextual information."
contents)
@ -1095,7 +1106,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(defun org-e-ascii-export-block (export-block contents info)
"Transcode a EXPORT-BLOCK element from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual information."
(when (string= (org-element-property :type export-block) "ascii")
(when (string= (org-element-property :type export-block) "ASCII")
(org-remove-indentation (org-element-property :value export-block))))
@ -1105,8 +1116,8 @@ CONTENTS is nil. INFO is a plist holding contextual information."
"Transcode a FIXED-WIDTH element from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual information."
(org-e-ascii--box-string
(replace-regexp-in-string
"^[ \t]*: ?" "" (org-element-property :value fixed-width)) info))
(org-remove-indentation
(org-element-property :value fixed-width)) info))
;;;; Footnote Definition
@ -1212,24 +1223,28 @@ contextual information."
"Transcode an INLINETASK element from Org to ASCII.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
(let ((width (org-e-ascii--current-text-width inlinetask info))
(title (org-export-secondary-string
(org-element-property :title inlinetask) info))
(todo (and (plist-get info :with-todo-keywords)
(let ((todo (org-element-property
:todo-keyword inlinetask)))
(and todo
(org-export-secondary-string todo info)))))
(todo-type (org-element-property :todo-type inlinetask))
(tags (and (plist-get info :with-tags)
(org-element-property :tags inlinetask)))
(priority (and (plist-get info :with-priority)
(org-element-property :priority inlinetask))))
(let ((width (org-e-ascii--current-text-width inlinetask info)))
;; If `org-e-ascii-format-inlinetask-function' is provided, call it
;; with appropriate arguments.
(if (functionp org-e-ascii-format-inlinetask-function)
(funcall org-e-ascii-format-inlinetask-function
todo todo-type priority title tags contents width)
;; todo.
(and (plist-get info :with-todo-keywords)
(let ((todo (org-element-property
:todo-keyword inlinetask)))
(and todo (org-export-data todo info))))
;; todo-type
(org-element-property :todo-type inlinetask)
;; priority
(and (plist-get info :with-priority)
(org-element-property :priority inlinetask))
;; title
(org-export-data (org-element-property :title inlinetask) info)
;; tags
(and (plist-get info :with-tags)
(org-element-property :tags inlinetask))
;; contents and width
contents width)
;; Otherwise, use a default template.
(let* ((utf8p (eq (plist-get info :ascii-charset) 'utf-8)))
(org-e-ascii--indent-string
@ -1275,10 +1290,8 @@ contextual information."
(org-list-bullet-string
(case (org-element-property :type (org-export-get-parent item info))
(descriptive
(concat
(org-export-secondary-string
(org-element-property :tag item) info)
": "))
(concat (org-export-data (org-element-property :tag item) info)
": "))
(ordered
;; Return correct number for ITEM, paying attention to
;; counters.
@ -1379,7 +1392,7 @@ INFO is a plist holding contextual information."
;; Do not apply a special syntax on radio links. Though, parse
;; and transcode path to have a proper display of contents.
((string= type "radio")
(org-export-secondary-string
(org-export-data
(org-element-parse-secondary-string
(org-element-property :path link)
(cdr (assq 'radio-target org-element-object-restrictions)))
@ -1460,15 +1473,30 @@ INFO is a plist used as a communication channel."
(replace-regexp-in-string "---" "—" text)))))
;;;; Property Drawer
;;;; Planning
(defun org-e-ascii-property-drawer (property-drawer contents info)
"Transcode a PROPERTY-DRAWER element from Org to ASCII.
(defun org-e-ascii-planning (planning contents info)
"Transcode a PLANNING element from Org to ASCII.
CONTENTS is nil. INFO is a plist used as a communication
channel."
;; The property drawer isn't exported but we want separating blank
;; lines nonetheless.
"")
(mapconcat
'identity
(delq nil
(list (let ((closed (org-element-property :closed planning)))
(when closed (concat org-closed-string " "
(org-translate-time closed))))
(let ((deadline (org-element-property :deadline planning)))
(when deadline (concat org-deadline-string " "
(org-translate-time deadline))))
(let ((scheduled (org-element-property :scheduled planning)))
(when scheduled (concat org-scheduled-string " "
(org-translate-time scheduled))))))
" "))
;;;; Property Drawer
;;
;; Property drawers are ignored.
;;;; Quote Block
@ -1491,9 +1519,8 @@ holding contextual information."
CONTENTS is nil. INFO is a plist holding contextual information."
(let ((width (org-e-ascii--current-text-width quote-section info))
(value
(org-export-secondary-string
(org-remove-indentation
(org-element-property :value quote-section))
(org-export-data
(org-remove-indentation (org-element-property :value quote-section))
info)))
(org-e-ascii--indent-string
value
@ -1635,9 +1662,10 @@ are ignored. "
(setq max-width
(max (length
(org-export-data
(elt (if specialp (car (org-element-contents row))
(org-element-contents row))
col)
(org-element-contents
(elt (if specialp (car (org-element-contents row))
(org-element-contents row))
col))
info))
max-width))))
max-width)))
@ -1722,13 +1750,12 @@ a communication channel."
;; Targets are invisible.
;;;; Time-stamp
;;;; Timestamp
(defun org-e-ascii-time-stamp (time-stamp contents info)
"Transcode a TIME-STAMP object from Org to ASCII.
(defun org-e-ascii-timestamp (timestamp contents info)
"Transcode a TIMESTAMP object from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual information."
;; Return time-stamps as-is.
(org-element-time-stamp-interpreter time-stamp contents))
(org-translate-time (org-element-property :value timestamp)))
;;;; Underline

179
contrib/lisp/org-e-html.el
View File

@ -71,7 +71,6 @@
"org-export" (extension &optional subtreep pub-dir))
(declare-function org-export-resolve-coderef "org-export" (ref info))
(declare-function org-export-resolve-fuzzy-link "org-export" (link info))
(declare-function org-export-secondary-string "org-export" (secondary info))
(declare-function org-export-solidify-link-text "org-export" (s))
(declare-function
org-export-to-buffer "org-export"
@ -582,7 +581,7 @@ CSS classes, then this prefix can be very useful."
:group 'org-export-e-html
:type 'string)
;;;; Time-stamps
;;;; Timestamps
;;;; Statistics Cookie
;;;; Subscript
;;;; Superscript
@ -785,7 +784,7 @@ When nil, also column one will use data tags."
;;;; Target
;;;; Time-stamp
;;;; Timestamp
;;;; Verbatim
;;;; Verse Block
@ -841,25 +840,25 @@ When nil, the links still point to the plain `.org' file."
"Function to format headline text.
This function will be called with 5 arguments:
TODO the todo keyword \(string or nil\).
TODO-TYPE the type of todo \(symbol: `todo', `done', nil\)
PRIORITY the priority of the headline \(integer or nil\)
TEXT the main headline text \(string\).
TAGS the tags string, separated with colons \(string or nil\).
TODO the todo keyword (string or nil).
TODO-TYPE the type of todo (symbol: `todo', `done', nil)
PRIORITY the priority of the headline (integer or nil)
TEXT the main headline text (string).
TAGS the tags (string or nil).
The function result will be used in the section format string.
As an example, one could set the variable to the following, in
order to reproduce the default set-up:
\(defun org-e-html-format-headline \(todo todo-type priority text tags\)
\(defun org-e-html-format-headline \(todo todo-type priority text tags)
\"Default format function for an headline.\"
\(concat \(when todo
\(format \"\\\\textbf{\\\\textsc{\\\\textsf{%s}}} \" todo\)\)
\(format \"\\\\textbf{\\\\textsc{\\\\textsf{%s}}} \" todo))
\(when priority
\(format \"\\\\framebox{\\\\#%c} \" priority\)\)
\(format \"\\\\framebox{\\\\#%c} \" priority))
text
\(when tags \(format \"\\\\hfill{}\\\\textsc{%s}\" tags\)\)\)\)"
\(when tags (format \"\\\\hfill{}\\\\textsc{%s}\" tags))))"
:group 'org-export-e-html
:type 'function)
@ -895,20 +894,20 @@ returned as-is."
:type 'string)
;;;; Time-stamps
;;;; Timestamps
(defcustom org-e-html-active-timestamp-format "\\textit{%s}"
"A printf format string to be applied to active time-stamps."
"A printf format string to be applied to active timestamps."
:group 'org-export-e-html
:type 'string)
(defcustom org-e-html-inactive-timestamp-format "\\textit{%s}"
"A printf format string to be applied to inactive time-stamps."
"A printf format string to be applied to inactive timestamps."
:group 'org-export-e-html
:type 'string)
(defcustom org-e-html-diary-timestamp-format "\\textit{%s}"
"A printf format string to be applied to diary time-stamps."
"A printf format string to be applied to diary timestamps."
:group 'org-export-e-html
:type 'string)
@ -973,7 +972,7 @@ The function must accept six parameters:
TODO-TYPE the todo type, a symbol among `todo', `done' and nil.
PRIORITY the inlinetask priority, as a string
NAME the inlinetask name, as a string.
TAGS the inlinetask tags, as a string.
TAGS the inlinetask tags, as a list of strings.
CONTENTS the contents of the inlinetask, as a string.
The function should return the string to be exported.
@ -986,19 +985,19 @@ in order to mimic default behaviour:
\(let \(\(full-title
\(concat
\(when todo
\(format \"\\\\textbf{\\\\textsf{\\\\textsc{%s}}} \" todo\)\)
\(when priority \(format \"\\\\framebox{\\\\#%c} \" priority\)\)
\(format \"\\\\textbf{\\\\textsf{\\\\textsc{%s}}} \" todo))
\(when priority (format \"\\\\framebox{\\\\#%c} \" priority))
title
\(when tags \(format \"\\\\hfill{}\\\\textsc{%s}\" tags\)\)\)\)\)
\(format \(concat \"\\\\begin{center}\\n\"
\(when tags (format \"\\\\hfill{}\\\\textsc{%s}\" tags)))))
\(format (concat \"\\\\begin{center}\\n\"
\"\\\\fbox{\\n\"
\"\\\\begin{minipage}[c]{.6\\\\textwidth}\\n\"
\"%s\\n\\n\"
\"\\\\rule[.8em]{\\\\textwidth}{2pt}\\n\\n\"
\"%s\"
\"\\\\end{minipage}}\"
\"\\\\end{center}\"\)
full-title contents\)\)"
\"\\\\end{center}\")
full-title contents))"
:group 'org-export-e-html
:type 'function)
@ -1364,8 +1363,7 @@ Replaces invalid characters with \"_\"."
(cons n (if (equal (org-element-type raw) 'org-data)
(org-trim (org-export-data raw info))
(format "<p>%s</p>"
(org-trim
(org-export-secondary-string raw info))))))))
(org-trim (org-export-data raw info))))))))
(when fn-alist
(org-e-html-format-footnotes-section
(nth 4 (or (assoc (plist-get info :language)
@ -1407,15 +1405,14 @@ For non-floats, see `org-e-html--wrap-label'."
;; Option caption format with short name.
((cdr caption)
(format "\\caption[%s]{%s%s}\n"
(org-export-secondary-string (cdr caption) info)
(org-export-data (cdr caption) info)
label-str
(org-export-secondary-string (car caption) info)))
(org-export-data (car caption) info)))
;; Standard caption format.
;; (t (format "\\caption{%s%s}\n"
;; label-str
;; (org-export-secondary-string (car caption) info)))
(t (org-export-secondary-string (car caption) info)))))
;; (org-export-data (car caption) info)))
(t (org-export-data (car caption) info)))))
(defun org-e-html--find-verb-separator (s)
"Return a character not used in string S.
@ -1454,10 +1451,10 @@ This function shouldn't be used for floats. See
;;; Template
(defun org-e-html-meta-info (info)
(let* ((title (org-export-secondary-string (plist-get info :title) info))
(let* ((title (org-export-data (plist-get info :title) info))
(author (and (plist-get info :with-author)
(let ((auth (plist-get info :author)))
(and auth (org-export-secondary-string auth info)))))
(and auth (org-export-data auth info)))))
(description (plist-get info :description))
(keywords (plist-get info :keywords)))
(concat
@ -1519,9 +1516,9 @@ This function shouldn't be used for floats. See
(defun org-e-html-preamble (info)
(when (plist-get info :html-preamble)
(let* ((title (org-export-secondary-string (plist-get info :title) info))
(let* ((title (org-export-data (plist-get info :title) info))
(date (org-e-html-format-date info))
(author (org-export-secondary-string (plist-get info :author) info))
(author (org-export-data (plist-get info :author) info))
(lang-words (or (assoc (plist-get info :language)
org-export-language-setup)
(assoc "en" org-export-language-setup)))
@ -1670,8 +1667,7 @@ original parsed data. INFO is a plist holding export options."
(nth 1 org-e-html-divs)))
;; document title
(format "
<h1 class=\"title\">%s</h1>\n" (org-export-secondary-string
(plist-get info :title) info))
<h1 class=\"title\">%s</h1>\n" (org-export-data (plist-get info :title) info))
;; table of contents
(let ((depth (plist-get info :with-toc)))
(when (wholenump depth) (org-e-html-toc depth info)))
@ -1719,7 +1715,7 @@ original parsed data. INFO is a plist holding export options."
(concat org-e-html-tag-class-prefix
(org-e-html-fix-class-name tag))
tag))
(org-split-string tags ":") "&nbsp;"))))
tags "&nbsp;"))))
;;;; Headline
@ -1852,6 +1848,23 @@ holding contextual information."
(format "<div style=\"text-align: center\">\n%s</div>" contents)))
;;;; Clock
(defun org-e-html-clock (clock contents info)
"Transcode a CLOCK element from Org to HTML.
CONTENTS is nil. INFO is a plist used as a communication
channel."
(format "<p>
<span class=\"timestamp-wrapper\">
<span class=\"timestamp-kwd\">%s</span> <span class=\"timestamp\">%s</span>%s
</span>
</p>"
org-clock-string
(org-translate-time (org-element-property :value clock))
(let ((time (org-element-property :time clock)))
(and time (format " <span class=\"timestamp\">(%s)</span>" time)))))
;;;; Code
(defun org-e-html-code (code contents info)
@ -1950,7 +1963,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(defun org-e-html-export-block (export-block contents info)
"Transcode a EXPORT-BLOCK element from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual information."
(when (string= (org-element-property :type export-block) "latex")
(when (string= (org-element-property :type export-block) "HTML")
(org-remove-indentation (org-element-property :value export-block))))
@ -1959,13 +1972,12 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(defun org-e-html-fixed-width (fixed-width contents info)
"Transcode a FIXED-WIDTH element from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual information."
(let* ((value (org-element-normalize-string
(replace-regexp-in-string
"^[ \t]*: ?" ""
(org-element-property :value fixed-width)))))
(org-e-html--wrap-label
fixed-width (format "\n<pre class=\"example\">\n%s\n</pre>"
(org-e-html-do-format-code value)))))
(org-e-html--wrap-label
fixed-width
(format "\n<pre class=\"example\">\n%s</pre>"
(org-e-html-do-format-code
(org-remove-indentation
(org-element-property :value fixed-width))))))
;;;; Footnote Definition
@ -2014,15 +2026,12 @@ holding contextual information."
(mapconcat 'number-to-string
headline-number ".")))
(todo (and (plist-get info :with-todo-keywords)
(let ((todo (org-element-property
:todo-keyword headline)))
(and todo
(org-export-secondary-string todo info)))))
(let ((todo (org-element-property :todo-keyword headline)))
(and todo (org-export-data todo info)))))
(todo-type (and todo (org-element-property :todo-type headline)))
(priority (and (plist-get info :with-priority)
(org-element-property :priority headline)))
(text (org-export-secondary-string
(org-element-property :title headline) info))
(text (org-export-data (org-element-property :title headline) info))
(tags (and (plist-get info :with-tags)
(org-element-property :tags headline)))
(headline-label (concat "sec-" (mapconcat 'number-to-string
@ -2047,12 +2056,10 @@ CONTENTS holds the contents of the headline. INFO is a plist
holding contextual information."
(let* ((numberedp (org-export-numbered-headline-p headline info))
(level (org-export-get-relative-level headline info))
(text (org-export-secondary-string
(org-element-property :title headline) info))
(text (org-export-data (org-element-property :title headline) info))
(todo (and (plist-get info :with-todo-keywords)
(let ((todo (org-element-property
:todo-keyword headline)))
(and todo (org-export-secondary-string todo info)))))
(let ((todo (org-element-property :todo-keyword headline)))
(and todo (org-export-data todo info)))))
(todo-type (and todo (org-element-property :todo-type headline)))
(tags (and (plist-get info :with-tags)
(org-element-property :tags headline)))
@ -2212,15 +2219,12 @@ contextual information."
"Transcode an ITEM element from Org to HTML.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
;; Grab `:level' from plain-list properties, which is always the
;; first element above current item.
(let* ((plain-list (org-export-get-parent item info))
(type (org-element-property :type plain-list))
(level (org-element-property :level plain-list))
(counter (org-element-property :counter item))
(checkbox (org-element-property :checkbox item))
(tag (let ((tag (org-element-property :tag item)))
(and tag (org-export-secondary-string tag info)))))
(and tag (org-export-data tag info)))))
(org-e-html-format-list-item
contents type checkbox (or tag counter))))
@ -2436,7 +2440,7 @@ INFO is a plist holding contextual information. See
((string= type "radio")
(format "<a href=\"#%s\">%s</a>"
(org-export-solidify-link-text path)
(org-export-secondary-string
(org-export-data
(org-element-parse-secondary-string
path (org-element-restriction 'radio-target))
info)))
@ -2451,7 +2455,7 @@ INFO is a plist holding contextual information. See
('nil
(format "<i>%s</i>"
(or desc
(org-export-secondary-string
(org-export-data
(org-element-property :raw-link link) info))))
;; Fuzzy link points to an invisible target.
(keyword nil)
@ -2468,7 +2472,7 @@ INFO is a plist holding contextual information. See
(cond
(desc desc)
((plist-get info :section-numbers) section-no)
(t (org-export-secondary-string
(t (org-export-data
(org-element-property :title destination) info))))
(format "<a href=\"#%s\">%s</a>" label desc)))
;; Fuzzy link points to a target. Do as above.
@ -2634,6 +2638,34 @@ contextual information."
text)
;; Planning
(defun org-e-html-planning (planning contents info)
"Transcode a PLANNING element from Org to HTML.
CONTENTS is nil. INFO is a plist used as a communication
channel."
(let ((span-fmt "<span class=\"timestamp-kwd\">%s</span> <span class=\"timestamp\">%s</span>"))
(format
"<p><span class=\"timestamp-wrapper\">%s</span></p>"
(mapconcat
'identity
(delq nil
(list
(let ((closed (org-element-property :closed planning)))
(when closed
(format span-fmt org-closed-string
(org-translate-time closed))))
(let ((deadline (org-element-property :deadline planning)))
(when deadline
(format span-fmt org-deadline-string
(org-translate-time deadline))))
(let ((scheduled (org-element-property :scheduled planning)))
(when scheduled
(format span-fmt org-scheduled-string
(org-translate-time scheduled))))))
" "))))
;;;; Property Drawer
(defun org-e-html-property-drawer (property-drawer contents info)
@ -2933,24 +2965,15 @@ information."
(format "<a id=\"%s\" name=\"%s\"/>" id id)))
;;;; Time-stamp
;;;; Timestamp
(defun org-e-html-time-stamp (time-stamp contents info)
"Transcode a TIME-STAMP object from Org to HTML.
(defun org-e-html-timestamp (timestamp contents info)
"Transcode a TIMESTAMP object from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual
information."
(let ((value (org-element-property :value time-stamp))
(type (org-element-property :type time-stamp))
(appt-type (org-element-property :appt-type time-stamp)))
(setq value (org-translate-time (org-export-secondary-string value info)))
(setq appt-type (case appt-type
(scheduled org-scheduled-string)
(deadline org-deadline-string)
(closed org-closed-string)))
(format "<span class=\"timestamp-wrapper\">%s%s</span>"
(if (not appt-type) ""
(format "<span class=\"timestamp-kwd\">%s</span> " appt-type))
(format "<span class=\"timestamp\">%s</span>" value))))
(let ((value (org-translate-time (org-element-property :value timestamp))))
(format "<span class=\"timestamp-wrapper\"><span class=\"timestamp\">%s</span></span>"
value)))
;;;; Underline

443
contrib/lisp/org-e-latex.el
View File

@ -19,9 +19,9 @@
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; This library implements a LaTeX back-end for Org generic exporter.
;;
;; To test it, run
;;
;; M-: (org-export-to-buffer 'e-latex "*Test e-LaTeX*") RET
@ -29,7 +29,7 @@
;; in an org-mode buffer then switch to the buffer to see the LaTeX
;; export. See contrib/lisp/org-export.el for more details on how
;; this exporter works.
;;
;; It introduces three new buffer keywords: "LATEX_CLASS",
;; "LATEX_CLASS_OPTIONS" and "LATEX_HEADER".
@ -71,7 +71,6 @@
"org-export" (extension &optional subtreep pub-dir))
(declare-function org-export-resolve-coderef "org-export" (ref info))
(declare-function org-export-resolve-fuzzy-link "org-export" (link info))
(declare-function org-export-secondary-string "org-export" (secondary info))
(declare-function org-export-solidify-link-text "org-export" (s))
(declare-function
org-export-to-buffer "org-export"
@ -267,25 +266,27 @@ argument."
"Function to format headline text.
This function will be called with 5 arguments:
TODO the todo keyword \(string or nil\).
TODO-TYPE the type of todo \(symbol: `todo', `done', nil\)
PRIORITY the priority of the headline \(integer or nil\)
TEXT the main headline text \(string\).
TAGS the tags string, separated with colons \(string or nil\).
TODO the todo keyword (string or nil).
TODO-TYPE the type of todo (symbol: `todo', `done', nil)
PRIORITY the priority of the headline (integer or nil)
TEXT the main headline text (string).
TAGS the tags as a list of strings (list of strings or nil).
The function result will be used in the section format string.
As an example, one could set the variable to the following, in
order to reproduce the default set-up:
\(defun org-e-latex-format-headline \(todo todo-type priority text tags\)
\(defun org-e-latex-format-headline (todo todo-type priority text tags)
\"Default format function for an headline.\"
\(concat \(when todo
\(format \"\\\\textbf{\\\\textsc{\\\\textsf{%s}}} \" todo\)\)
\(concat (when todo
\(format \"\\\\textbf{\\\\textsc{\\\\textsf{%s}}} \" todo))
\(when priority
\(format \"\\\\framebox{\\\\#%c} \" priority\)\)
\(format \"\\\\framebox{\\\\#%c} \" priority))
text
\(when tags \(format \"\\\\hfill{}\\\\textsc{%s}\" tags\)\)\)\)"
\(when tags
\(format \"\\\\hfill{}\\\\textsc{%s}\"
\(mapconcat 'identity tags \":\"))))"
:group 'org-export-e-latex
:type 'function)
@ -298,20 +299,20 @@ order to reproduce the default set-up:
:type 'string)
;;;; Time-stamps
;;;; Timestamps
(defcustom org-e-latex-active-timestamp-format "\\textit{%s}"
"A printf format string to be applied to active time-stamps."
"A printf format string to be applied to active timestamps."
:group 'org-export-e-latex
:type 'string)
(defcustom org-e-latex-inactive-timestamp-format "\\textit{%s}"
"A printf format string to be applied to inactive time-stamps."
"A printf format string to be applied to inactive timestamps."
:group 'org-export-e-latex
:type 'string)
(defcustom org-e-latex-diary-timestamp-format "\\textit{%s}"
"A printf format string to be applied to diary time-stamps."
"A printf format string to be applied to diary timestamps."
:group 'org-export-e-latex
:type 'string)
@ -448,7 +449,7 @@ The function must accept six parameters:
TODO-TYPE the todo type, a symbol among `todo', `done' and nil.
PRIORITY the inlinetask priority, as a string
NAME the inlinetask name, as a string.
TAGS the inlinetask tags, as a string.
TAGS the inlinetask tags, as a list of strings.
CONTENTS the contents of the inlinetask, as a string.
The function should return the string to be exported.
@ -458,22 +459,24 @@ in order to mimic default behaviour:
\(defun org-e-latex-format-inlinetask \(todo type priority name tags contents\)
\"Format an inline task element for LaTeX export.\"
\(let \(\(full-title
\(let ((full-title
\(concat
\(when todo
\(format \"\\\\textbf{\\\\textsf{\\\\textsc{%s}}} \" todo\)\)
\(when priority \(format \"\\\\framebox{\\\\#%c} \" priority\)\)
\(format \"\\\\textbf{\\\\textsf{\\\\textsc{%s}}} \" todo))
\(when priority (format \"\\\\framebox{\\\\#%c} \" priority))
title
\(when tags \(format \"\\\\hfill{}\\\\textsc{%s}\" tags\)\)\)\)\)
\(format \(concat \"\\\\begin{center}\\n\"
\(when tags
\(format \"\\\\hfill{}\\\\textsc{:%s:}\"
\(mapconcat 'identity tags \":\")))))
\(format (concat \"\\\\begin{center}\\n\"
\"\\\\fbox{\\n\"
\"\\\\begin{minipage}[c]{.6\\\\textwidth}\\n\"
\"%s\\n\\n\"
\"\\\\rule[.8em]{\\\\textwidth}{2pt}\\n\\n\"
\"%s\"
\"\\\\end{minipage}}\"
\"\\\\end{center}\"\)
full-title contents\)\)"
\"\\\\end{center}\")
full-title contents))"
:group 'org-export-e-latex
:type 'function)
@ -746,13 +749,13 @@ For non-floats, see `org-e-latex--wrap-label'."
;; Option caption format with short name.
((cdr caption)
(format "\\caption[%s]{%s%s}\n"
(org-export-secondary-string (cdr caption) info)
(org-export-data (cdr caption) info)
label-str
(org-export-secondary-string (car caption) info)))
(org-export-data (car caption) info)))
;; Standard caption format.
(t (format "\\caption{%s%s}\n"
label-str
(org-export-secondary-string (car caption) info))))))
(org-export-data (car caption) info))))))
(defun org-e-latex--guess-inputenc (header)
"Set the coding system in inputenc to what the buffer is.
@ -838,7 +841,7 @@ See `org-e-latex-text-markup-alist' for details."
(while (string-match "[\\{}$%&_#~^]" text)
(setq char (match-string 0 text))
(if (> (match-beginning 0) 0)
(setq rtn (concat rtn (substring value 0 (match-beginning 0)))))
(setq rtn (concat rtn (substring text 0 (match-beginning 0)))))
(setq text (substring text (1+ (match-beginning 0))))
(setq char (or (cdr (assoc char trans)) (concat "\\" char))
rtn (concat rtn char)))
@ -858,7 +861,7 @@ See `org-e-latex-text-markup-alist' for details."
"Return complete document string after LaTeX conversion.
CONTENTS is the transcoded contents string. INFO is a plist
holding export options."
(let ((title (org-export-secondary-string (plist-get info :title) info)))
(let ((title (org-export-data (plist-get info :title) info)))
(concat
;; 1. Time-stamp.
(and (plist-get info :time-stamp-file)
@ -890,10 +893,9 @@ holding export options."
;; 5. Author.
(let ((author (and (plist-get info :with-author)
(let ((auth (plist-get info :author)))
(and auth (org-export-secondary-string auth info)))))
(and auth (org-export-data auth info)))))
(email (and (plist-get info :with-email)
(org-export-secondary-string
(plist-get info :email) info))))
(org-export-data (plist-get info :email) info))))
(cond ((and author email (not (string= "" email)))
(format "\\author{%s\\thanks{%s}}\n" author email))
(author (format "\\author{%s}\n" author))
@ -941,6 +943,11 @@ holding export options."
;;; Transcode Functions
;;;; Babel Call
;;
;; Babel Calls are ignored.
;;;; Bold
(defun org-e-latex-bold (bold contents info)
@ -961,6 +968,22 @@ holding contextual information."
(format "\\begin{center}\n%s\\end{center}" contents)))
;;;; Clock
(defun org-e-latex-clock (clock contents info)
"Transcode a CLOCK element from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual
information."
(concat
"\\noindent"
(format "\\textbf{%s} " org-clock-string)
(format org-e-latex-inactive-timestamp-format
(concat (org-translate-time (org-element-property :value clock))
(let ((time (org-element-property :time clock)))
(and time (format " (%s)" time)))))
"\\\\"))
;;;; Code
(defun org-e-latex-code (code contents info)
@ -971,12 +994,12 @@ channel."
;;;; Comment
;;
;; Comments are ignored.
;;;; Comment Block
;;
;; Comment Blocks are ignored.
@ -1041,7 +1064,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(defun org-e-latex-export-block (export-block contents info)
"Transcode a EXPORT-BLOCK element from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual information."
(when (string= (org-element-property :type export-block) "latex")
(when (string= (org-element-property :type export-block) "LATEX")
(org-remove-indentation (org-element-property :value export-block))))
@ -1050,16 +1073,15 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(defun org-e-latex-fixed-width (fixed-width contents info)
"Transcode a FIXED-WIDTH element from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual information."
(let* ((value (org-element-normalize-string
(replace-regexp-in-string
"^[ \t]*: ?" ""
(org-element-property :value fixed-width)))))
(org-e-latex--wrap-label
fixed-width (format "\\begin{verbatim}\n%s\\end{verbatim}" value))))
(org-e-latex--wrap-label
fixed-width
(format "\\begin{verbatim}\n%s\\end{verbatim}"
(org-remove-indentation
(org-element-property :value fixed-width)))))
;;;; Footnote Definition
;;
;; Footnote Definitions are ignored.
@ -1117,10 +1139,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
"\\footnotetext[%s]{%s}"
(org-export-get-footnote-number ref info)
(org-trim
(funcall
(if (eq (org-element-property :type ref) 'inline)
'org-export-secondary-string
'org-export-data)
(org-export-data
(org-export-get-footnote-definition ref info) info))))
(funcall search-refs def) ""))))))))
@ -1157,12 +1176,11 @@ holding contextual information."
((= (length sec) 4)
(if numberedp (concat (car sec) "\n%s" (nth 1 sec))
(concat (nth 2 sec) "\n%s" (nth 3 sec)))))))
(text (org-export-secondary-string
(org-element-property :title headline) info))
(text (org-export-data (org-element-property :title headline) info))
(todo
(and (plist-get info :with-todo-keywords)
(let ((todo (org-element-property :todo-keyword headline)))
(and todo (org-export-secondary-string todo info)))))
(and todo (org-export-data todo info)))))
(todo-type (and todo (org-element-property :todo-type headline)))
(tags (and (plist-get info :with-tags)
(org-element-property :tags headline)))
@ -1179,7 +1197,9 @@ holding contextual information."
(format "\\textbf{\\textsf{\\textsc{%s}}} " todo))
(when priority (format "\\framebox{\\#%c} " priority))
text
(when tags (format "\\hfill{}\\textsc{%s}" tags)))))
(when tags
(format "\\hfill{}\\textsc{:%s:}"
(mapconcat 'identity tags ":"))))))
;; Associate some \label to the headline for internal links.
(headline-label
(format "\\label{sec-%s}\n"
@ -1228,7 +1248,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Inline Babel Call
;;
;; Inline Babel Calls are ignored.
@ -1276,13 +1296,10 @@ contextual information."
"Transcode an INLINETASK element from Org to LaTeX.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
(let ((title (org-export-secondary-string
(org-element-property :title inlinetask) info))
(let ((title (org-export-data (org-element-property :title inlinetask) info))
(todo (and (plist-get info :with-todo-keywords)
(let ((todo (org-element-property
:todo-keyword inlinetask)))
(and todo
(org-export-secondary-string todo info)))))
(let ((todo (org-element-property :todo-keyword inlinetask)))
(and todo (org-export-data todo info)))))
(todo-type (org-element-property :todo-type inlinetask))
(tags (and (plist-get info :with-tags)
(org-element-property :tags inlinetask)))
@ -1301,7 +1318,8 @@ holding contextual information."
(when todo (format "\\textbf{\\textsf{\\textsc{%s}}} " todo))
(when priority (format "\\framebox{\\#%c} " priority))
title
(when tags (format "\\hfill{}\\textsc{%s}" tags)))))
(when tags (format "\\hfill{}\\textsc{:%s:}"
(mapconcat 'identity tags ":"))))))
(format (concat "\\begin{center}\n"
"\\fbox{\n"
"\\begin{minipage}[c]{.6\\textwidth}\n"
@ -1329,22 +1347,23 @@ contextual information."
"Transcode an ITEM element from Org to LaTeX.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
;; Grab `:level' from plain-list properties, which is always the
;; first element above current item.
(let* ((level (org-element-property :level (org-export-get-parent item info)))
(counter (let ((count (org-element-property :counter item)))
(and count
(< level 4)
(format "\\setcounter{enum%s}{%s}\n"
(nth level '("i" "ii" "iii" "iv"))
(1- count)))))
(let* ((counter
(let ((count (org-element-property :counter item))
(level
(loop for parent in (org-export-get-genealogy item info)
count (eq (org-element-type parent) 'plain-list)
until (eq (org-element-type parent) 'headline))))
(and count
(< level 5)
(format "\\setcounter{enum%s}{%s}\n"
(nth (1- level) '("i" "ii" "iii" "iv"))
(1- count)))))
(checkbox (let ((checkbox (org-element-property :checkbox item)))
(cond ((eq checkbox 'on) "$\\boxtimes$ ")
((eq checkbox 'off) "$\\Box$ ")
((eq checkbox 'trans) "$\\boxminus$ "))))
(tag (let ((tag (org-element-property :tag item)))
(and tag
(format "[%s]" (org-export-secondary-string tag info))))))
(and tag (format "[%s]" (org-export-data tag info))))))
(concat counter "\\item" tag " " checkbox contents)))
@ -1470,7 +1489,7 @@ used as a communication channel."
\\centering
\\includegraphics[%s]{%s}
%s\\end{wrapfigure}" placement attr path caption))
(mulicolumn (format "\\begin{figure*}%s
(multicolumn (format "\\begin{figure*}%s
\\centering
\\includegraphics[%s]{%s}
%s\\end{figure*}" placement attr path caption))
@ -1514,7 +1533,7 @@ INFO is a plist holding contextual information. See
((string= type "radio")
(format "\\hyperref[%s]{%s}"
(org-export-solidify-link-text path)
(org-export-secondary-string
(org-export-data
(org-element-parse-secondary-string
path (cdr (assq 'radio-target org-element-object-restrictions)))
info)))
@ -1529,7 +1548,7 @@ INFO is a plist holding contextual information. See
('nil
(format "\\texttt{%s}"
(or desc
(org-export-secondary-string
(org-export-data
(org-element-property :raw-link link) info))))
;; Fuzzy link points to an invisible target.
(keyword nil)
@ -1548,7 +1567,7 @@ INFO is a plist holding contextual information. See
(format "\\ref{%s}" label)
(format "\\hyperref[%s]{%s}" label
(or desc
(org-export-secondary-string
(org-export-data
(org-element-property :title destination) info))))))
;; Fuzzy link points to a target. Do as above.
(otherwise
@ -1571,11 +1590,6 @@ INFO is a plist holding contextual information. See
(t (format "\\texttt{%s}" desc)))))
;;;; Babel Call
;; Babel Calls are ignored.
;;;; Macro
(defun org-e-latex-macro (macro contents info)
@ -1669,6 +1683,40 @@ contextual information."
text)
;;;; Planning
(defun org-e-latex-planning (planning contents info)
"Transcode a PLANNING element from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual
information."
(concat
"\\noindent"
(mapconcat
'identity
(delq nil
(list
(let ((closed (org-element-property :closed planning)))
(when closed
(concat
(format "\\textbf{%s} " org-closed-string)
(format org-e-latex-inactive-timestamp-format
(org-translate-time closed)))))
(let ((deadline (org-element-property :deadline planning)))
(when deadline
(concat
(format "\\textbf{%s} " org-deadline-string)
(format org-e-latex-active-timestamp-format
(org-translate-time deadline)))))
(let ((scheduled (org-element-property :scheduled planning)))
(when scheduled
(concat
(format "\\textbf{%s} " org-scheduled-string)
(format org-e-latex-active-timestamp-format
(org-translate-time scheduled)))))))
" ")
"\\\\"))
;;;; Property Drawer
(defun org-e-latex-property-drawer (property-drawer contents info)
@ -1808,12 +1856,11 @@ contextual information."
(or (cadr (assq (intern lang) org-e-latex-listings-langs)) lang))
(caption-str
(when caption
(let ((main (org-export-secondary-string (car caption) info)))
(let ((main (org-export-data (car caption) info)))
(if (not (cdr caption)) (format "{%s}" main)
(format
"{[%s]%s}"
(org-export-secondary-string (cdr caption) info)
main))))))
(format "{[%s]%s}"
(org-export-data (cdr caption) info)
main))))))
(concat
;; Options.
(format "\\lstset{%s}\n"
@ -1885,16 +1932,77 @@ contextual information."
;;;; Table
;;
;; `org-e-latex-table' is the entry point for table transcoding. It
;; takes care of tables with a "verbatim" attribute. Otherwise, it
;; delegates the job to either `org-e-latex-table--table.el-table' or
;; `org-e-latex-table--org-table' functions, depending of the type of
;; the table.
;;
;; `org-e-latex-table--align-string' is a subroutine used to build
;; alignment string for Org tables.
(defun org-e-latex-table--format-string (table info)
"Return an appropriate format string for TABLE.
(defun org-e-latex-table (table contents info)
"Transcode a TABLE element from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual information."
(cond
;; Case 1: verbatim table.
((or org-e-latex-tables-verbatim
(let ((attr (mapconcat 'identity
(org-element-property :attr_latex table)
" ")))
(and attr (string-match "\\<verbatim\\>" attr))))
(format "\\begin{verbatim}\n%s\n\\end{verbatim}"
;; Re-create table, without affiliated keywords.
(org-trim
(org-element-interpret-data
`(table nil ,@(org-element-contents table))))))
;; Case 2: table.el table. Convert it using appropriate tools.
((eq (org-element-property :type table) 'table.el)
(org-e-latex-table--table.el-table table contents info))
;; Case 3: Standard table.
(t (org-e-latex-table--org-table table contents info))))
TABLE-INFO is the plist containing format info about the table,
as returned by `org-export-table-format-info'. INFO is a plist
used as a communication channel.
(defun org-e-latex-table--align-string (table info)
"Return an appropriate LaTeX alignment string.
TABLE is the considered table. INFO is a plist used as
a communication channel."
(let ((attr (mapconcat 'identity
(org-element-property :attr_latex table)
" ")))
(if (string-match "\\<align=\\(\\S-+\\)" attr) (match-string 1 attr)
(let (alignment)
;; Extract column groups and alignment from first (non-rule)
;; row.
(org-element-map
(org-element-map
table 'table-row
(lambda (row)
(and (eq (org-element-property :type row) 'standard) row))
info 'first-match)
'table-cell
(lambda (cell)
(let ((borders (org-export-table-cell-borders cell info)))
;; Check left border for the first cell only.
(when (and (memq 'left borders) (not alignment))
(push "|" alignment))
(push (case (org-export-table-cell-alignment cell info)
(left "l")
(right "r")
(center "c"))
alignment)
(when (memq 'right borders) (push "|" alignment))))
info)
(apply 'concat (reverse alignment))))))
The format string leaves one placeholder for the body of the
table."
(defun org-e-latex-table--org-table (table contents info)
"Return appropriate LaTeX code for an Org table.
TABLE is the table type element to transcode. CONTENTS is its
contents, as a string. INFO is a plist used as a communication
channel.
This function assumes TABLE has `org' as its `:type' attribute."
(let* ((label (org-element-property :name table))
(caption (org-e-latex--caption/label-string
(org-element-property :caption table) label info))
@ -1933,10 +2041,11 @@ table."
;; Longtable.
((string= "longtable" table-env)
(format
"\\begin{longtable}{%s}\n%s%%s%s\\end{longtable}"
"\\begin{longtable}{%s}\n%s%s%s\\end{longtable}"
alignment
(if (or (not org-e-latex-table-caption-above) (string= "" caption)) ""
(concat (org-trim caption) "\\\\\n"))
contents
(if (or org-e-latex-table-caption-above (string= "" caption)) ""
(concat (org-trim caption) "\\\\\n"))))
;; Others.
@ -1945,91 +2054,55 @@ table."
(format "\\begin{%s}%s\n" float-env placement)
(if org-e-latex-table-caption-above caption "")))
(when org-e-latex-tables-centered "\\begin{center}\n")
(format "\\begin{%s}%s{%s}\n%%s\\end{%s}"
(format "\\begin{%s}%s{%s}\n%s\\end{%s}"
table-env
(if width (format "{%s}" width) "") alignment table-env)
(if width (format "{%s}" width) "")
alignment
contents
table-env)
(when org-e-latex-tables-centered "\n\\end{center}")
(when float-env
(concat (if org-e-latex-table-caption-above "" caption)
(format "\n\\end{%s}" float-env))))))))
(defun org-e-latex-table--align-string (table info)
"Return an appropriate LaTeX alignment string.
TABLE is the considered table. INFO is a plist used as
a communication channel."
(let ((attr (mapconcat 'identity
(org-element-property :attr_latex table)
" ")))
(if (and attr (string-match "\\<align=\\(\\S-+\\)" attr))
(match-string 1 attr)
(let (alignment)
;; Extract column groups and alignment from first (non-rule)
;; row.
(org-element-map
(org-element-map table 'table-row 'identity info 'first-match)
'table-cell
(lambda (cell)
(let ((borders (org-export-table-cell-borders cell info)))
;; Check left border for the first cell only.
(when (and (memq 'left borders) (not alignment))
(push "|" alignment))
(push (case (org-export-table-cell-alignment cell info)
(left "l")
(right "r")
(center "c"))
alignment)
(when (memq 'right borders) (push "|" alignment))))
info)
(apply 'concat (reverse alignment))))))
(defun org-e-latex-table--table.el-table (table contents info)
"Return appropriate LaTeX code for a table.el table.
(defun org-e-latex-table (table contents info)
"Transcode a TABLE element from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual information."
(cond
;; Case 1: verbatim table.
((or org-e-latex-tables-verbatim
(let ((attr (mapconcat 'identity
(org-element-property :attr_latex table)
" ")))
(and attr (string-match "\\<verbatim\\>" attr))))
(format "\\begin{verbatim}\n%s\n\\end{verbatim}"
;; Re-create table, without affiliated keywords.
(org-trim
(org-element-interpret-data
`(org-data nil (table nil ,@(org-element-contents table)))))))
;; Case 2: table.el table. Convert it using appropriate tools.
((eq (org-element-property :type table) 'table.el)
(require 'table)
;; Ensure "*org-export-table*" buffer is empty.
(with-current-buffer (get-buffer-create "*org-export-table*")
(erase-buffer))
(let ((output (with-temp-buffer
(insert (org-element-property :value table))
(goto-char 1)
(re-search-forward "^[ \t]*|[^|]" nil t)
(table-generate-source 'latex "*org-export-table*")
(with-current-buffer "*org-export-table*"
(org-trim (buffer-string))))))
(kill-buffer (get-buffer "*org-export-table*"))
;; Remove left out comments.
(while (string-match "^%.*\n" output)
(setq output (replace-match "" t t output)))
;; When the "rmlines" attribute is provided, remove all hlines
;; but the the one separating heading from the table body.
(let ((attr (mapconcat 'identity
(org-element-property :attr_latex table)
" ")))
(when (and attr (string-match "\\<rmlines\\>" attr))
(let ((n 0) (pos 0))
(while (and (< (length output) pos)
(setq pos (string-match "^\\\\hline\n?" output pos)))
(incf n)
(unless (= n 2)
(setq output (replace-match "" nil nil output)))))))
(if (not org-e-latex-tables-centered) output
(format "\\begin{center}\n%s\n\\end{center}" output))))
;; Case 3: Standard table.
(t (format (org-e-latex-table--format-string table info) contents))))
TABLE is the table type element to transcode. CONTENTS is its
contents, as a string. INFO is a plist used as a communication
channel.
This function assumes TABLE has `table.el' as its `:type'
attribute."
(require 'table)
;; Ensure "*org-export-table*" buffer is empty.
(with-current-buffer (get-buffer-create "*org-export-table*")
(erase-buffer))
(let ((output (with-temp-buffer
(insert (org-element-property :value table))
(goto-char 1)
(re-search-forward "^[ \t]*|[^|]" nil t)
(table-generate-source 'latex "*org-export-table*")
(with-current-buffer "*org-export-table*"
(org-trim (buffer-string))))))
(kill-buffer (get-buffer "*org-export-table*"))
;; Remove left out comments.
(while (string-match "^%.*\n" output)
(setq output (replace-match "" t t output)))
;; When the "rmlines" attribute is provided, remove all hlines but
;; the the one separating heading from the table body.
(let ((attr (mapconcat 'identity
(org-element-property :attr_latex table)
" ")))
(when (and attr (string-match "\\<rmlines\\>" attr))
(let ((n 0) (pos 0))
(while (and (< (length output) pos)
(setq pos (string-match "^\\\\hline\n?" output pos)))
(incf n)
(unless (= n 2)
(setq output (replace-match "" nil nil output)))))))
(if (not org-e-latex-tables-centered) output
(format "\\begin{center}\n%s\n\\end{center}" output))))
;;;; Table Cell
@ -2107,27 +2180,19 @@ information."
(org-export-solidify-link-text (org-element-property :value target))))
;;;; Time-stamp
;;;; Timestamp
(defun org-e-latex-time-stamp (time-stamp contents info)
"Transcode a TIME-STAMP object from Org to LaTeX.
(defun org-e-latex-timestamp (timestamp contents info)
"Transcode a TIMESTAMP object from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual
information."
(let ((value (org-element-property :value time-stamp))
(type (org-element-property :type time-stamp))
(appt-type (org-element-property :appt-type time-stamp)))
(concat (cond ((eq appt-type 'scheduled)
(format "\\textbf{\\textsc{%s}} " org-scheduled-string))
((eq appt-type 'deadline)
(format "\\textbf{\\textsc{%s}} " org-deadline-string))
((eq appt-type 'closed)
(format "\\textbf{\\textsc{%s}} " org-closed-string)))
(cond ((memq type '(active active-range))
(format org-e-latex-active-timestamp-format value))
((memq type '(inactive inactive-range))
(format org-e-latex-inactive-timestamp-format value))
(t
(format org-e-latex-diary-timestamp-format value))))))
(let ((value (org-translate-time (org-element-property :value timestamp)))
(type (org-element-property :type timestamp)))
(cond ((memq type '(active active-range))
(format org-e-latex-active-timestamp-format value))
((memq type '(inactive inactive-range))
(format org-e-latex-inactive-timestamp-format value))
(t (format org-e-latex-diary-timestamp-format value)))))
;;;; Underline

173
contrib/lisp/org-e-odt.el
View File

@ -47,10 +47,10 @@
;; progress. See org-html.el.
(defun org-e-odt-format-preamble (info)
(let* ((title (org-export-secondary-string (plist-get info :title) info))
(let* ((title (org-export-data (plist-get info :title) info))
(author (and (plist-get info :with-author)
(let ((auth (plist-get info :author)))
(and auth (org-export-secondary-string auth info)))))
(and auth (org-export-data auth info)))))
(date (plist-get info :date))
(iso-date (org-e-odt-format-date date))
(date (org-e-odt-format-date date "%d %b %Y"))
@ -859,10 +859,9 @@ ATTR is a string of other attributes of the a element."
(caption (org-element-property :caption caption-from))
(short-caption (cdr caption))
;; transcode captions.
(caption (and (car caption)
(org-export-secondary-string (car caption) info)))
(caption (and (car caption) (org-export-data (car caption) info)))
(short-caption (and short-caption
(org-export-secondary-string short-caption info))))
(org-export-data short-caption info))))
(when (or label caption)
(let* ((default-category
(cond
@ -1079,9 +1078,9 @@ ATTR is a string of other attributes of the a element."
(insert "\n</manifest:manifest>"))))
(defun org-e-odt-update-meta-file (info) ; FIXME opt-plist
(let ((title (org-export-secondary-string (plist-get info :title) info))
(let ((title (org-export-data (plist-get info :title) info))
(author (or (let ((auth (plist-get info :author)))
(and auth (org-export-secondary-string auth info))) ""))
(and auth (org-export-data auth info))) ""))
(date (org-e-odt-format-date (plist-get info :date)))
(email (plist-get info :email))
(keywords (plist-get info :keywords))
@ -1371,7 +1370,6 @@ formula file."
"org-export" (extension &optional subtreep pub-dir))
(declare-function org-export-resolve-coderef "org-export" (ref info))
(declare-function org-export-resolve-fuzzy-link "org-export" (link info))
(declare-function org-export-secondary-string "org-export" (secondary info))
(declare-function org-export-solidify-link-text "org-export" (s))
(declare-function
org-export-to-buffer "org-export"
@ -2280,7 +2278,7 @@ configuration."
;;;; Tags
;;;; Time-stamps
;;;; Timestamps
;;;; Statistics Cookie
;;;; Subscript
;;;; Superscript
@ -2327,7 +2325,7 @@ configuration."
;;;; Table
;;;; Target
;;;; Time-stamp
;;;; Timestamp
;;;; Verbatim
;;;; Verse Block
@ -2378,20 +2376,20 @@ order to reproduce the default set-up:
;;;; Footnotes
;;;; Time-stamps
;;;; Timestamps
(defcustom org-e-odt-active-timestamp-format "\\textit{%s}"
"A printf format string to be applied to active time-stamps."
"A printf format string to be applied to active timestamps."
:group 'org-export-e-odt
:type 'string)
(defcustom org-e-odt-inactive-timestamp-format "\\textit{%s}"
"A printf format string to be applied to inactive time-stamps."
"A printf format string to be applied to inactive timestamps."
:group 'org-export-e-odt
:type 'string)
(defcustom org-e-odt-diary-timestamp-format "\\textit{%s}"
"A printf format string to be applied to diary time-stamps."
"A printf format string to be applied to diary timestamps."
:group 'org-export-e-odt
:type 'string)
@ -2692,7 +2690,7 @@ Replaces invalid characters with \"_\"."
(org-e-odt-format-fontify
x (concat "" ;; org-e-odt-tag-class-prefix
(org-e-odt-fix-class-name x))))
(org-split-string tags ":")
tags
(org-e-odt-format-spaces 1)) "tag")))
(defun org-e-odt-format-section-number (&optional snumber level)
@ -2743,15 +2741,14 @@ For non-floats, see `org-e-odt--wrap-label'."
;; Option caption format with short name.
((cdr caption)
(format "\\caption[%s]{%s%s}\n"
(org-export-secondary-string (cdr caption) info)
(org-export-data (cdr caption) info)
label-str
(org-export-secondary-string (car caption) info)))
(org-export-data (car caption) info)))
;; Standard caption format.
;; (t (format "\\caption{%s%s}\n"
;; label-str
;; (org-export-secondary-string (car caption) info)))
(t (org-export-secondary-string (car caption) info)))))
;; (org-export-data (car caption) info)))
(t (org-export-data (car caption) info)))))
(defun org-e-odt--find-verb-separator (s)
"Return a character not used in string S.
@ -2947,6 +2944,22 @@ holding contextual information."
(org-e-odt--wrap-label center-block contents))
;;;; Clock
(defun org-e-odt-clock (clock contents info)
"Transcode a CLOCK element from Org to HTML.
CONTENTS is nil. INFO is a plist used as a communication
channel."
(org-e-odt-format-fontify
(concat (org-e-odt-format-fontify org-clock-string "timestamp-kwd")
(org-e-odt-format-fontify
(concat (org-translate-time (org-element-property :value clock))
(let ((time (org-element-property :time clock)))
(and time (format " (%s)" time))))
"timestamp"))
"timestamp-wrapper"))
;;;; Code
(defun org-e-odt-code (code contents info)
@ -3029,7 +3042,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(defun org-e-odt-export-block (export-block contents info)
"Transcode a EXPORT-BLOCK element from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual information."
(when (string= (org-element-property :type export-block) "latex")
(when (string= (org-element-property :type export-block) "ODT")
(org-remove-indentation (org-element-property :value export-block))))
@ -3038,12 +3051,10 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(defun org-e-odt-fixed-width (fixed-width contents info)
"Transcode a FIXED-WIDTH element from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual information."
(let* ((value (org-element-normalize-string
(replace-regexp-in-string
"^[ \t]*: ?" ""
(org-element-property :value fixed-width)))))
(org-e-odt--wrap-label
fixed-width (org-e-odt-format-source-code-or-example value nil))))
(org-e-odt--wrap-label
fixed-width
(org-e-odt-format-source-code-or-example
(org-element-property :value fixed-width) nil)))
;;;; Footnote Definition
@ -3057,7 +3068,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(if (equal (org-element-type raw) 'org-data)
(org-trim (org-export-data raw info)) ; fix paragraph style
(org-e-odt-format-stylized-paragraph
'footnote (org-trim (org-export-secondary-string raw info)))))
'footnote (org-trim (org-export-data raw info)))))
(defvar org-e-odt-footnote-separator
(org-e-odt-format-fontify "," 'superscript))
@ -3111,15 +3122,12 @@ holding contextual information."
(mapconcat 'number-to-string
headline-number ".")))
(todo (and (plist-get info :with-todo-keywords)
(let ((todo (org-element-property
:todo-keyword headline)))
(and todo
(org-export-secondary-string todo info)))))
(let ((todo (org-element-property :todo-keyword headline)))
(and todo (org-export-data todo info)))))
(todo-type (and todo (org-element-property :todo-type headline)))
(priority (and (plist-get info :with-priority)
(org-element-property :priority headline)))
(text (org-export-secondary-string
(org-element-property :title headline) info))
(text (org-export-data (org-element-property :title headline) info))
(tags (and (plist-get info :with-tags)
(org-element-property :tags headline)))
(headline-label (concat "sec-" (mapconcat 'number-to-string
@ -3145,8 +3153,7 @@ holding contextual information."
(let* ((numberedp (org-export-numbered-headline-p headline info))
;; Get level relative to current parsed data.
(level (org-export-get-relative-level headline info))
(text (org-export-secondary-string
(org-element-property :title headline) info))
(text (org-export-data (org-element-property :title headline) info))
;; Create the headline text.
(full-text (org-e-odt-format-headline--wrap headline info)))
(cond
@ -3276,15 +3283,12 @@ contextual information."
"Transcode an ITEM element from Org to HTML.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
;; Grab `:level' from plain-list properties, which is always the
;; first element above current item.
(let* ((plain-list (org-export-get-parent item info))
(type (org-element-property :type plain-list))
(level (org-element-property :level plain-list))
(counter (org-element-property :counter item))
(checkbox (org-element-property :checkbox item))
(tag (let ((tag (org-element-property :tag item)))
(and tag (org-export-secondary-string tag info)))))
(and tag (org-export-data tag info)))))
(org-e-odt-format-list-item
contents type checkbox (or tag counter))))
@ -3349,9 +3353,8 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(processing-type (plist-get info :LaTeX-fragments))
(caption (org-element-property :caption latex-environment))
(short-caption (and (cdr caption)
(org-export-secondary-string (cdr caption) info)))
(caption (and (car caption)
(org-export-secondary-string (car caption) info)))
(org-export-data (cdr caption) info)))
(caption (and (car caption) (org-export-data (car caption) info)))
(label (org-element-property :name latex-environment))
(attr nil) ; FIXME
(label (org-element-property :name latex-environment)))
@ -3578,7 +3581,7 @@ INFO is a plist holding contextual information. See
;; display of the contents.
((string= type "radio")
(org-e-odt-format-internal-link
(org-export-secondary-string
(org-export-data
(org-element-parse-secondary-string
path (org-element-restriction 'radio-target))
info)
@ -3593,7 +3596,7 @@ INFO is a plist holding contextual information. See
;; Fuzzy link points nowhere.
('nil
(org-e-odt-format-fontify
(or desc (org-export-secondary-string
(or desc (org-export-data
(org-element-property :raw-link link) info))
'emphasis))
;; Fuzzy link points to an invisible target.
@ -3611,7 +3614,7 @@ INFO is a plist holding contextual information. See
(cond
(desc desc)
((plist-get info :section-numbers) section-no)
(t (org-export-secondary-string
(t (org-export-data
(org-element-property :title destination) info))))
(org-e-odt-format-internal-link desc label)))
;; Fuzzy link points to a target. Do as above.
@ -3759,6 +3762,32 @@ contextual information."
text)
;;;; Planning
(defun org-e-odt-planning (planning contents info)
"Transcode a PLANNING element from Org to HTML.
CONTENTS is nil. INFO is a plist used as a communication
channel."
(org-e-odt-format-fontify
(concat
(let ((closed (org-element-property :closed planning)))
(when closed
(concat (org-e-odt-format-fontify org-closed-string "timestamp-kwd")
(org-e-odt-format-fontify (org-translate-time closed)
"timestamp"))))
(let ((deadline (org-element-property :deadline planning)))
(when deadline
(concat (org-e-odt-format-fontify org-deadline-string "timestamp-kwd")
(org-e-odt-format-fontify (org-translate-time deadline)
"timestamp"))))
(let ((scheduled (org-element-property :scheduled planning)))
(when scheduled
(concat (org-e-odt-format-fontify org-scheduled-string "timestamp-kwd")
(org-e-odt-format-fontify (org-translate-time scheduled)
"timestamp")))))
"timestamp-wrapper"))
;;;; Property Drawer
(defun org-e-odt-property-drawer (property-drawer contents info)
@ -3829,14 +3858,13 @@ contextual information."
(let* ((lang (org-element-property :language src-block))
(caption (org-element-property :caption src-block))
(short-caption (and (cdr caption)
(org-export-secondary-string (cdr caption) info)))
(caption (and (car caption)
(org-export-secondary-string (car caption) info)))
(org-export-data (cdr caption) info)))
(caption (and (car caption) (org-export-data (car caption) info)))
(label (org-element-property :name src-block)))
;; FIXME: Handle caption
;; caption-str (when caption)
;; (main (org-export-secondary-string (car caption) info))
;; (secondary (org-export-secondary-string (cdr caption) info))
;; (main (org-export-data (car caption) info))
;; (secondary (org-export-data (cdr caption) info))
;; (caption-str (org-e-odt--caption/label-string caption label info))
(let* ((captions (org-e-odt-format-label src-block info 'definition))
(caption (car captions)) (short-caption (cdr captions)))
@ -4104,40 +4132,17 @@ information."
"" (org-export-solidify-link-text (org-element-property :value target))))
;;;; Time-stamp
;;;; Timestamp
(defun org-e-odt-time-stamp (time-stamp contents info)
"Transcode a TIME-STAMP object from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual
information."
;; (let ((value (org-element-property :value time-stamp))
;; (type (org-element-property :type time-stamp))
;; (appt-type (org-element-property :appt-type time-stamp)))
;; (concat (cond ((eq appt-type 'scheduled)
;; (format "\\textbf{\\textsc{%s}} " org-scheduled-string))
;; ((eq appt-type 'deadline)
;; (format "\\textbf{\\textsc{%s}} " org-deadline-string))
;; ((eq appt-type 'closed)
;; (format "\\textbf{\\textsc{%s}} " org-closed-string)))
;; (cond ((memq type '(active active-range))
;; (format org-e-odt-active-timestamp-format value))
;; ((memq type '(inactive inactive-range))
;; (format org-e-odt-inactive-timestamp-format value))
;; (t
;; (format org-e-odt-diary-timestamp-format value)))))
(let ((value (org-element-property :value time-stamp))
(type (org-element-property :type time-stamp))
(appt-type (org-element-property :appt-type time-stamp)))
(setq value (org-export-secondary-string value info))
(org-e-odt-format-fontify
(concat
(org-e-odt-format-fontify
(cond ((eq appt-type 'scheduled) org-scheduled-string)
((eq appt-type 'deadline) org-deadline-string)
((eq appt-type 'closed) org-closed-string)) "timestamp-kwd")
;; FIXME: (org-translate-time value)
(org-e-odt-format-fontify value "timestamp"))
"timestamp-wrapper")))
(defun org-e-odt-timestamp (timestamp contents info)
"Transcode a TIMESTAMP object from Org to HTML.
CONTENTS is nil. INFO is a plist used as a communication
channel."
(org-e-odt-format-fontify
(org-e-odt-format-fontify
(org-translate-time (org-element-property :value timestamp))
"timestamp")
"timestamp-wrapper"))
;;;; Underline

1828
contrib/lisp/org-element.el
View File

File diff suppressed because it is too large Load Diff

619
contrib/lisp/org-export.el
View File

File diff suppressed because it is too large Load Diff

8
doc/org.texi
View File

@ -2643,7 +2643,7 @@ formulas or Elisp formulas:
Input duration values must be of the form @code{[HH:MM[:SS]}, where seconds
are optional. With the @code{T} flag, computed durations will be displayed
as @code{[HH:MM:SS} (see the first formula above). With the @code{t} flag,
as @code{HH:MM:SS} (see the first formula above). With the @code{t} flag,
computed durations will be displayed according to the value of the variable
@code{org-table-duration-custom-format}, which defaults to @code{'hours} and
will display the result as a fraction of hours (see the second formula in the
@ -6465,6 +6465,9 @@ template in the usual way.
Visit the last stored capture item in its buffer.
@end table
To insert the capture at point in an Org buffer, call @code{org-capture} with
a @code{C-0} prefix argument.
@node Capture templates, , Using capture, Capture
@subsection Capture templates
@cindex templates, for Capture
@ -6672,6 +6675,7 @@ dynamic insertion of content. The templates are expanded in the order given her
@smallexample
%[@var{file}] @r{Insert the contents of the file given by @var{file}.}
%(@var{sexp}) @r{Evaluate Elisp @var{sexp} and replace with the result.}
@r{The sexp must return a string.}
%<...> @r{The result of format-time-string on the ... format specification.}
%t @r{Timestamp, date only.}
%T @r{Timestamp, with date and time.}
@ -12416,7 +12420,7 @@ Publishing to a local directory is also much faster than to a remote one, so
that you can afford more easily to republish entire projects. If you set
@code{org-publish-use-timestamps-flag} to @code{nil}, you gain the main
benefit of re-including any changed external files such as source example
files you might include with @code{#+INCLUDE}. The timestamp mechanism in
files you might include with @code{#+INCLUDE:}. The timestamp mechanism in
Org is not smart enough to detect if included files have been modified.
@node Sample configuration, Triggering publication, Uploading files, Publishing

2
lisp/ob-maxima.el
View File

@ -70,7 +70,7 @@ called by `org-babel-execute-src-block'."
(message "executing Maxima source code block")
(let ((result-params (split-string (or (cdr (assoc :results params)) "")))
(result
(let* ((cmdline (cdr (assoc :cmdline params)))
(let* ((cmdline (or (cdr (assoc :cmdline params)) ""))
(in-file (org-babel-temp-file "maxima-" ".max"))
(cmd (format "%s --very-quiet -r 'batchload(%S)$' %s"
org-babel-maxima-command in-file cmdline)))

2
lisp/ob.el
View File

@ -1577,7 +1577,7 @@ buffer or nil if no such result exists."
(catch 'is-a-code-block
(when (re-search-forward
(concat org-babel-result-regexp
"[ \t]" (regexp-quote name) "[ \t\n\f\v\r]+") nil t)
"[ \t]" (regexp-quote name) "[ \t]*[\n\f\v\r]") nil t)
(when (and (string= "name" (downcase (match-string 1)))
(or (beginning-of-line 1)
(looking-at org-babel-src-block-regexp)

96
lisp/org-agenda.el
View File

@ -1953,11 +1953,10 @@ The following commands are available:
(org-add-hook 'post-command-hook 'org-agenda-post-command-hook nil 'local)
(org-add-hook 'pre-command-hook 'org-unhighlight nil 'local)
;; Make sure properties are removed when copying text
(when (boundp 'buffer-substring-filters)
(org-set-local 'buffer-substring-filters
(cons (lambda (x)
(set-text-properties 0 (length x) nil x) x)
buffer-substring-filters)))
(make-local-variable 'filter-buffer-substring-functions)
(add-hook 'filter-buffer-substring-functions
(lambda (fun start end delete)
(substring-no-properties (funcall fun start end delete))))
(unless org-agenda-keep-modes
(setq org-agenda-follow-mode org-agenda-start-with-follow-mode
org-agenda-entry-text-mode org-agenda-start-with-entry-text-mode
@ -1989,9 +1988,10 @@ The following commands are available:
(org-defkey org-agenda-mode-map "\C-k" 'org-agenda-kill)
(org-defkey org-agenda-mode-map "\C-c\C-w" 'org-agenda-refile)
(org-defkey org-agenda-mode-map "m" 'org-agenda-bulk-mark)
(org-defkey org-agenda-mode-map "*" 'org-agenda-bulk-mark-all)
(org-defkey org-agenda-mode-map "%" 'org-agenda-bulk-mark-regexp)
(org-defkey org-agenda-mode-map "u" 'org-agenda-bulk-unmark)
(org-defkey org-agenda-mode-map "U" 'org-agenda-bulk-remove-all-marks)
(org-defkey org-agenda-mode-map "U" 'org-agenda-bulk-unmark-all)
(org-defkey org-agenda-mode-map "A" 'org-agenda-append-agenda)
(org-defkey org-agenda-mode-map "B" 'org-agenda-bulk-action)
(org-defkey org-agenda-mode-map "\C-c\C-x!" 'org-reload)
@ -2198,9 +2198,10 @@ The following commands are available:
["Delete subtree" org-agenda-kill t])
("Bulk action"
["Mark entry" org-agenda-bulk-mark t]
["Mark all" org-agenda-bulk-mark-all t]
["Mark matching regexp" org-agenda-bulk-mark-regexp t]
["Unmark entry" org-agenda-bulk-unmark t]
["Unmark all entries" org-agenda-bulk-remove-all-marks :active t :keys "C-u s"])
["Unmark all entries" org-agenda-bulk-unmark-all :active t :keys "C-u s"])
["Act on all marked" org-agenda-bulk-action t]
"--"
("Tags and Properties"
@ -4748,7 +4749,9 @@ function from a program - use `org-agenda-get-day-entries' instead."
;; I am not sure if this works with sticky agendas, because the marker
;; list is then no longer a global variable.
(org-agenda-reset-markers))
(org-compile-prefix-format 'agenda)
;; Prevent `org-compile-prefix-format' to fail when there is no agenda
(when (buffer-live-p org-agenda-buffer)
(org-compile-prefix-format 'agenda))
(org-set-sorting-strategy 'agenda)
(setq args (or args '(:deadline :scheduled :timestamp :sexp)))
(let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry))
@ -4979,13 +4982,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
0 'org-hd-marker a))
(cons (marker-position mm) a)))
deadline-results))
(remove-re
(concat
(regexp-quote
(format-time-string
"<%Y-%m-%d"
(encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
".*?>"))
(remove-re org-ts-regexp)
(regexp
(concat
(if org-agenda-include-inactive-timestamps "[[<]" "<")
@ -6888,10 +6885,9 @@ With prefix ARG, go backward that many times the current span."
(defun org-agenda-view-mode-dispatch ()
"Call one of the view mode commands."
(interactive)
(message "View: [d]ay [w]eek [m]onth [y]ear [SPC]reset [q]uit/abort
time[G]rid [[]inactive [f]ollow [l]og [L]og-all [c]lockcheck
[a]rch-trees [A]rch-files clock[R]eport include[D]iary
[E]ntryText")
(message "View: [d]ay [w]eek [m]onth [y]ear [SPC]reset [q]uit/abort
time[G]rid [[]inactive [f]ollow [l]og [L]og-all [c]lockcheck
[a]rch-trees [A]rch-files clock[R]eport include[D]iary [E]ntryText")
(let ((a (read-char-exclusive)))
(case a
(?\ (call-interactively 'org-agenda-reset-view))
@ -8346,6 +8342,12 @@ top-level as top-level entries at the end of the file."
:version "24.1"
:type 'boolean)
(defcustom org-agenda-bulk-mark-char ">"
"A single-character string to be used as the bulk mark."
:group 'org-agenda
:version "24.1"
:type 'string)
(defun org-agenda-add-entry-to-org-agenda-diary-file (type text &optional d1 d2)
"Add a diary entry with TYPE to `org-agenda-diary-file'.
If TEXT is not empty, it will become the headline of the new entry, and
@ -8622,7 +8624,7 @@ This is a command that has to be installed in `calendar-mode-map'."
(unless m (error "Nothing to mark at point"))
(push m org-agenda-bulk-marked-entries)
(setq ov (make-overlay (point-at-bol) (+ 2 (point-at-bol))))
(org-overlay-display ov "> "
(org-overlay-display ov (concat org-agenda-bulk-mark-char " ")
(org-get-todo-face "TODO")
'evaporate)
(overlay-put ov 'type 'org-marked-entry-overlay))
@ -8632,34 +8634,42 @@ This is a command that has to be installed in `calendar-mode-map'."
(message "%d entries marked for bulk action"
(length org-agenda-bulk-marked-entries))))))
(defun org-agenda-bulk-mark-all ()
"Mark all entries for future agenda bulk action."
(interactive)
(org-agenda-bulk-mark-regexp "."))
(defun org-agenda-bulk-mark-regexp (regexp)
"Mark entries match REGEXP."
"Mark entries matching REGEXP for future agenda bulk action."
(interactive "sMark entries matching regexp: ")
(let (entries-marked)
(let ((entries-marked 0))
(save-excursion
(goto-char (point-min))
(goto-char (next-single-property-change (point) 'txt))
(while (re-search-forward regexp nil t)
(when (string-match regexp (get-text-property (point) 'txt))
(setq entries-marked (+ entries-marked 1))
(setq entries-marked (1+ entries-marked))
(call-interactively 'org-agenda-bulk-mark))))
(if (not entries-marked)
(message "No entry matching this regexp."))))
(defun org-agenda-bulk-unmark ()
(defun org-agenda-bulk-unmark (&optional arg)
"Unmark the entry at point for future bulk action."
(interactive)
(when (org-agenda-bulk-marked-p)
(org-agenda-bulk-remove-overlays
(point-at-bol) (+ 2 (point-at-bol)))
(setq org-agenda-bulk-marked-entries
(delete (org-get-at-bol 'org-hd-marker)
org-agenda-bulk-marked-entries)))
(beginning-of-line 2)
(while (and (get-char-property (point) 'invisible) (not (eobp)))
(beginning-of-line 2))
(message "%d entries marked for bulk action"
(length org-agenda-bulk-marked-entries)))
(interactive "P")
(if arg
(org-agenda-bulk-unmark-all)
(cond ((org-agenda-bulk-marked-p)
(org-agenda-bulk-remove-overlays
(point-at-bol) (+ 2 (point-at-bol)))
(setq org-agenda-bulk-marked-entries
(delete (org-get-at-bol 'org-hd-marker)
org-agenda-bulk-marked-entries))
(beginning-of-line 2)
(while (and (get-char-property (point) 'invisible) (not (eobp)))
(beginning-of-line 2))
(message "%d entries left marked for bulk action"
(length org-agenda-bulk-marked-entries)))
(t (message "No entry to unmark here")))))
(defun org-agenda-bulk-toggle ()
"Toggle marking the entry at point for bulk action."
@ -8680,13 +8690,15 @@ from the list in `org-agenda-bulk-marked-entries'."
(delete-overlay ov)))
(overlays-in (or beg (point-min)) (or end (point-max)))))
(defun org-agenda-bulk-remove-all-marks ()
(defun org-agenda-bulk-unmark-all ()
"Remove all marks in the agenda buffer.
This will remove the markers, and the overlays."
This will remove the markers and the overlays."
(interactive)
(mapc (lambda (m) (move-marker m nil)) org-agenda-bulk-marked-entries)
(setq org-agenda-bulk-marked-entries nil)
(org-agenda-bulk-remove-overlays (point-min) (point-max)))
(if (null org-agenda-bulk-marked-entries)
(message "No entry to unmark")
(mapc (lambda (m) (move-marker m nil)) org-agenda-bulk-marked-entries)
(setq org-agenda-bulk-marked-entries nil)
(org-agenda-bulk-remove-overlays (point-min) (point-max))))
(defcustom org-agenda-persistent-marks nil
"Non-nil means marked items will stay marked after a bulk action.
@ -8855,7 +8867,7 @@ The prefix arg is passed through to the command if possible."
(delete e org-agenda-bulk-marked-entries)))
(setq cnt (1+ cnt))))
(when (not org-agenda-persistent-marks)
(org-agenda-bulk-remove-all-marks))
(org-agenda-bulk-unmark-all))
(when redo-at-end (org-agenda-redo))
(message "Acted on %d entries%s%s"
cnt

30
lisp/org-bbdb.el
View File

@ -123,7 +123,6 @@
(declare-function diary-ordinal-suffix "diary-lib" (n))
(defvar date) ;; dynamically scoped from Org
(defvar name) ;; dynamically scoped from Org
;; Customization
@ -138,30 +137,31 @@
:require 'bbdb)
(defcustom org-bbdb-anniversary-format-alist
'(("birthday" lambda
(name years suffix)
(concat "Birthday: [[bbdb:" name "][" name " ("
(format "%s" years) ; handles numbers as well as strings
suffix ")]]"))
("wedding" lambda
(name years suffix)
(concat "[[bbdb:" name "][" name "'s "
(format "%s" years)
suffix " wedding anniversary]]")))
'(("birthday" .
(lambda (name years suffix)
(concat "Birthday: [[bbdb:" name "][" name " ("
(format "%s" years) ; handles numbers as well as strings
suffix ")]]")))
("wedding" .
(lambda (name years suffix)
(concat "[[bbdb:" name "][" name "'s "
(format "%s" years)
suffix " wedding anniversary]]"))))
"How different types of anniversaries should be formatted.
An alist of elements (STRING . FORMAT) where STRING is the name of an
anniversary class and format is either:
1) A format string with the following substitutions (in order):
* the name of the record containing this anniversary
* the number of years
* an ordinal suffix (st, nd, rd, th) for the year
- the name of the record containing this anniversary
- the number of years
- an ordinal suffix (st, nd, rd, th) for the year
2) A function to be called with three arguments: NAME YEARS SUFFIX
(string int string) returning a string for the diary or nil.
3) An Emacs Lisp form that should evaluate to a string (or nil) in the
scope of variables NAME, YEARS and SUFFIX (among others)."
:type 'sexp
:type '(alist :key-type (string :tag "Class")
:value-type (function :tag "Function"))
:group 'org-bbdb-anniversaries
:require 'bbdb)

59
lisp/org-clock.el
View File

@ -38,6 +38,7 @@
(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label))
(defvar org-time-stamp-formats)
(defvar org-ts-what)
(defvar org-frame-title-format-backup frame-title-format)
(defgroup org-clock nil
"Options concerning clocking working time in Org-mode."
@ -352,6 +353,19 @@ nil current clock is not displayed"
(const :tag "Both" both)
(const :tag "None" nil)))
(defcustom org-clock-frame-title-format '(t org-mode-line-string)
"The value for `frame-title-format' when clocking in.
When `org-clock-clocked-in-display' is set to 'frame-title
or 'both, clocking in will replace `frame-title-format' with
this value. Clocking out will restore `frame-title-format'.
`org-frame-title-string' is a format string using the same
specifications than `frame-title-format', which see."
:version "24.1"
:group 'org-clock
:type 'sexp)
(defvar org-clock-in-prepare-hook nil
"Hook run when preparing the clock.
This hook is run before anything happens to the task that
@ -374,8 +388,6 @@ to add an effort property.")
(defvar org-mode-line-string "")
(put 'org-mode-line-string 'risky-local-variable t)
(defvar org-frame-title-string '(" " org-mode-line-string))
(defvar org-clock-mode-line-timer nil)
(defvar org-clock-idle-timer nil)
(defvar org-clock-heading) ; defined in org.el
@ -551,7 +563,7 @@ If not, show simply the clocked time like 01:50."
'org-mode-line-clock-overrun 'org-mode-line-clock)))
(effort-str (format org-time-clocksum-format effort-h effort-m))
(clockstr (org-propertize
(concat "[%s/" effort-str
(concat " [%s/" effort-str
"] (" (replace-regexp-in-string "%" "%%" org-clock-heading) ")")
'face 'org-mode-line-clock)))
(format clockstr work-done-str))
@ -575,8 +587,7 @@ If not, show simply the clocked time like 01:50."
'help-echo (concat help-text ": " org-clock-heading))
(org-propertize clock-string 'help-echo help-text)))
'local-map org-clock-mode-line-map
'mouse-face (if (featurep 'xemacs) 'highlight 'mode-line-highlight)
))
'mouse-face (if (featurep 'xemacs) 'highlight 'mode-line-highlight)))
(if (and org-clock-task-overrun org-clock-task-overrun-text)
(setq org-mode-line-string
(concat (org-propertize
@ -670,7 +681,7 @@ use libnotify if available, or fall back on a message."
;; FIXME how to link to the Org icon?
;; :app-icon "~/.emacs.d/icons/mail.png"
:urgency 'low))
((org-program-exists "notify-send")
((executable-find "notify-send")
(start-process "emacs-timer-notification" nil
"notify-send" notification))
;; Maybe the handler will send a message, so only use message as
@ -686,18 +697,13 @@ Use alsa's aplay tool if available."
((stringp org-clock-sound)
(let ((file (expand-file-name org-clock-sound)))
(if (file-exists-p file)
(if (org-program-exists "aplay")
(if (executable-find "aplay")
(start-process "org-clock-play-notification" nil
"aplay" file)
(condition-case nil
(play-sound-file file)
(error (beep t) (beep t)))))))))
(defun org-program-exists (program-name)
"Checks whenever we can locate PROGRAM-NAME using the `which' executable."
(if (member system-type '(gnu/linux darwin))
(= 0 (call-process "which" nil nil nil program-name))))
(defvar org-clock-mode-line-entry nil
"Information for the modeline about the running clock.")
@ -1209,12 +1215,9 @@ the clocking selection, associated with the letter `d'."
(setq global-mode-string
(append global-mode-string '(org-mode-line-string)))))
;; add to frame title
(when (and (or (eq org-clock-clocked-in-display 'frame-title)
(eq org-clock-clocked-in-display 'both))
(listp frame-title-format))
(or (memq 'org-frame-title-string frame-title-format)
(setq frame-title-format
(append frame-title-format '(org-frame-title-string)))))
(when (or (eq org-clock-clocked-in-display 'frame-title)
(eq org-clock-clocked-in-display 'both))
(setq frame-title-format org-clock-frame-title-format))
(org-clock-update-mode-line)
(when org-clock-mode-line-timer
(cancel-timer org-clock-mode-line-timer)
@ -1371,9 +1374,7 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set."
(when (not (org-clocking-p))
(setq global-mode-string
(delq 'org-mode-line-string global-mode-string))
(when (listp frame-title-format)
(setq frame-title-format
(delq 'org-frame-title-string frame-title-format)))
(setq frame-title-format org-frame-title-format-backup)
(force-mode-line-update)
(if fail-quietly (throw 'exit t) (error "No active clock")))
(let (ts te s h m remove)
@ -1418,9 +1419,7 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set."
(setq org-clock-idle-timer nil))
(setq global-mode-string
(delq 'org-mode-line-string global-mode-string))
(when (listp frame-title-format)
(setq frame-title-format
(delq 'org-frame-title-string frame-title-format)))
(setq frame-title-format org-frame-title-format-backup)
(when org-clock-out-switch-to-state
(save-excursion
(org-back-to-heading t)
@ -1520,9 +1519,7 @@ UPDOWN tells whether to change 'up or 'down."
(when (not (org-clocking-p))
(setq global-mode-string
(delq 'org-mode-line-string global-mode-string))
(when (listp frame-title-format)
(setq frame-title-format
(delq 'org-frame-title-string frame-title-format)))
(setq frame-title-format org-frame-title-format-backup)
(force-mode-line-update)
(error "No active clock"))
(save-excursion ; Do not replace this with `with-current-buffer'.
@ -1535,9 +1532,7 @@ UPDOWN tells whether to change 'up or 'down."
(move-marker org-clock-hd-marker nil)
(setq global-mode-string
(delq 'org-mode-line-string global-mode-string))
(when (listp frame-title-format)
(setq frame-title-format
(delq 'org-frame-title-string frame-title-format)))
(setq frame-title-format org-frame-title-format-backup)
(force-mode-line-update)
(message "Clock canceled")
(run-hooks 'org-clock-cancel-hook))
@ -2349,7 +2344,9 @@ from the dynamic block definition."
hlc (org-minutes-to-hh:mm-string (nth 3 entry)) hlc ; time
"|\n" ; close line
)))))
(backward-delete-char 1)
;; When exporting subtrees or regions the region might be
;; activated, so let's disable ̀delete-active-region'
(let ((delete-active-region nil)) (backward-delete-char 1))
(if (setq formula (plist-get params :formula))
(cond
((eq formula '%)

8
lisp/org-colview.el
View File

@ -1083,6 +1083,14 @@ Don't set this, this is meant for dynamic scoping.")
(while l
(setq sum (+ (string-to-number (pop l)) (/ sum 60))))
sum))
((string-match (concat "\\([0-9.]+\\) *\\("
(regexp-opt (mapcar 'car org-effort-durations))
"\\)") s)
(setq s (concat "0:" (org-duration-string-to-minutes s t)))
(let ((l (nreverse (org-split-string s ":"))) (sum 0.0))
(while l
(setq sum (+ (string-to-number (pop l)) (/ sum 60))))
sum))
((memq fmt '(checkbox checkbox-n-of-m checkbox-percent))
(if (equal s "[X]") 1. 0.000001))
((memq fmt '(estimate)) (org-string-to-estimate s))

12
lisp/org-compat.el
View File

@ -34,7 +34,6 @@
(require 'org-macs)
(declare-function find-library-name "find-func" (library))
(declare-function w32-focus-frame "term/w32-win" (frame))
;; The following constant is for backward compatibility. We do not use
@ -331,15 +330,12 @@ Works on both Emacs and XEmacs."
(org-no-properties (substring string (or from 0) to))
(substring-no-properties string from to)))
(defun org-find-library-name (library)
(defmacro org-find-library-name (library)
(if (fboundp 'find-library-name)
(file-name-directory (find-library-name library))
`(file-name-directory (find-library-name ,library))
; XEmacs does not have `find-library-name'
(flet ((find-library-name-helper (filename ignored-codesys)
filename)
(find-library-name (library)
(find-library library nil 'find-library-name-helper)))
(file-name-directory (find-library-name library)))))
`(flet ((flnh (lib ignore) lib))
(file-name-directory (find-library ,library nil 'flnh)))))
(defun org-count-lines (s)
"How many lines in string S?"

2
lisp/org-docbook.el
View File

@ -629,7 +629,7 @@ publishing directory."
(insert org-export-docbook-doctype))
(insert "<!-- Date: " date " -->\n")
(insert (format "<!-- DocBook XML file generated by Org-mode %s Emacs %s -->\n"
org-version emacs-major-version))
(org-version) emacs-major-version))
(insert org-export-docbook-article-header)
(insert (format
"\n <title>%s</title>

8
lisp/org-exp-blocks.el
View File

@ -208,6 +208,12 @@ which defaults to the value of `org-export-blocks-witheld'."
(let ((replacement (save-match-data
(if (memq type org-export-blocks-witheld) ""
(apply func body headers)))))
;; ;; un-comment this code after the org-element merge
;; (save-match-data
;; (when (and replacement (string= replacement ""))
;; (delete-region
;; (car (org-element-collect-affiliated-keyword))
;; match-start)))
(when replacement
(delete-region match-start match-end)
(goto-char match-start) (insert replacement)
@ -234,7 +240,7 @@ which defaults to the value of `org-export-blocks-witheld'."
(file-name-as-directory
(expand-file-name
"../contrib"
(file-name-directory (find-library-name "org")))))))
(file-name-directory (org-find-library-name "org")))))))
"Path to the ditaa jar executable."
:group 'org-babel
:type 'string)

3
lisp/org-footnote.el
View File

@ -450,7 +450,8 @@ or new, let the user edit the definition of the footnote."
(error "Cannot insert a footnote here"))
(let* ((lbls (and (not (equal org-footnote-auto-label 'random))
(org-footnote-all-labels)))
(propose (org-footnote-unique-label lbls))
(propose (and (not (equal org-footnote-auto-label 'random))
(org-footnote-unique-label lbls)))
(label
(org-footnote-normalize-label
(cond

240
lisp/org-html.el
View File

@ -923,8 +923,8 @@ MAY-INLINE-P allows inlining it as an image."
(org-export-html-format-desc desc)
"</a>")))))
(defun org-html-handle-links (line opt-plist)
"Return LINE with markup of Org mode links.
(defun org-html-handle-links (org-line opt-plist)
"Return ORG-LINE with markup of Org mode links.
OPT-PLIST is the export options list."
(let ((start 0)
(current-dir (if buffer-file-name
@ -933,12 +933,12 @@ OPT-PLIST is the export options list."
(link-validate (plist-get opt-plist :link-validation-function))
type id-file fnc
rpl path attr desc descp desc1 desc2 link)
(while (string-match org-bracket-link-analytic-regexp++ line start)
(while (string-match org-bracket-link-analytic-regexp++ org-line start)
(setq start (match-beginning 0))
(setq path (save-match-data (org-link-unescape
(match-string 3 line))))
(match-string 3 org-line))))
(setq type (cond
((match-end 2) (match-string 2 line))
((match-end 2) (match-string 2 org-line))
((save-match-data
(or (file-name-absolute-p path)
(string-match "^\\.\\.?/" path)))
@ -946,7 +946,7 @@ OPT-PLIST is the export options list."
(t "internal")))
(setq path (org-extract-attributes path))
(setq attr (get-text-property 0 'org-attributes path))
(setq desc1 (if (match-end 5) (match-string 5 line))
(setq desc1 (if (match-end 5) (match-string 5 org-line))
desc2 (if (match-end 2) (concat type ":" path) path)
descp (and desc1 (not (equal desc1 desc2)))
desc (or desc1 desc2))
@ -1087,9 +1087,9 @@ OPT-PLIST is the export options list."
(setq rpl (concat "<i>&lt;" type ":"
(save-match-data (org-link-unescape path))
"&gt;</i>"))))
(setq line (replace-match rpl t t line)
(setq org-line (replace-match rpl t t org-line)
start (+ start (length rpl))))
line))
org-line))
;;; org-export-as-html
@ -1171,7 +1171,7 @@ PUB-DIR is set, use this as the publishing directory."
(org-current-export-dir
(or pub-dir (org-export-directory :html opt-plist)))
(org-current-export-file buffer-file-name)
(level 0) (line "") (origline "") txt todo
(level 0) (org-line "") (origline "") txt todo
(umax nil)
(umax-toc nil)
(filename (if to-buffer nil
@ -1426,9 +1426,9 @@ PUB-DIR is set, use this as the publishing directory."
(push "<ul>\n<li>" thetoc)
(setq lines
(mapcar
#'(lambda (line)
(if (and (string-match org-todo-line-regexp line)
(not (get-text-property 0 'org-protected line)))
#'(lambda (org-line)
(if (and (string-match org-todo-line-regexp org-line)
(not (get-text-property 0 'org-protected org-line)))
;; This is a headline
(progn
(setq have-headings t)
@ -1438,17 +1438,17 @@ PUB-DIR is set, use this as the publishing directory."
txt (save-match-data
(org-html-expand
(org-export-cleanup-toc-line
(match-string 3 line))))
(match-string 3 org-line))))
todo
(or (and org-export-mark-todo-in-toc
(match-beginning 2)
(not (member (match-string 2 line)
(not (member (match-string 2 org-line)
org-done-keywords)))
; TODO, not DONE
(and org-export-mark-todo-in-toc
(= level umax-toc)
(org-search-todo-below
line lines level))))
org-line lines level))))
(if (string-match
(org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt)
(setq txt (replace-match
@ -1477,11 +1477,11 @@ PUB-DIR is set, use this as the publishing directory."
(push "</li>\n</ul>" thetoc))
(push "\n" thetoc)))
;; Check for targets
(while (string-match org-any-target-regexp line)
(setq line (replace-match
(while (string-match org-any-target-regexp org-line)
(setq org-line (replace-match
(concat "@<span class=\"target\">"
(match-string 1 line) "@</span> ")
t t line)))
(match-string 1 org-line) "@</span> ")
t t org-line)))
(while (string-match "&lt;\\(&lt;\\)+\\|&gt;\\(&gt;\\)+" txt)
(setq txt (replace-match "" t t txt)))
(setq href
@ -1498,7 +1498,7 @@ PUB-DIR is set, use this as the publishing directory."
href txt) thetoc)
(setq org-last-level level)))))
line)
org-line)
lines))
(while (> org-last-level (1- org-min-level))
(setq org-last-level (1- org-last-level))
@ -1511,28 +1511,28 @@ PUB-DIR is set, use this as the publishing directory."
(org-open-par)
(while (setq line (pop lines) origline line)
(while (setq org-line (pop lines) origline org-line)
(catch 'nextline
;; end of quote section?
(when (and inquote (string-match org-outline-regexp-bol line))
(when (and inquote (string-match org-outline-regexp-bol org-line))
(insert "</pre>\n")
(org-open-par)
(setq inquote nil))
;; inside a quote section?
(when inquote
(insert (org-html-protect line) "\n")
(insert (org-html-protect org-line) "\n")
(throw 'nextline nil))
;; Fixed-width, verbatim lines (examples)
(when (and org-export-with-fixed-width
(string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" line))
(string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" org-line))
(when (not infixed)
(setq infixed t)
(org-close-par-maybe)
(insert "<pre class=\"example\">\n"))
(insert (org-html-protect (match-string 3 line)) "\n")
(insert (org-html-protect (match-string 3 org-line)) "\n")
(when (or (not lines)
(not (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)"
(car lines))))
@ -1542,17 +1542,17 @@ PUB-DIR is set, use this as the publishing directory."
(throw 'nextline nil))
;; Protected HTML
(when (and (get-text-property 0 'org-protected line)
(when (and (get-text-property 0 'org-protected org-line)
;; Make sure it is the entire line that is protected
(not (< (or (next-single-property-change
0 'org-protected line) 10000)
(length line))))
(let (par (ind (get-text-property 0 'original-indentation line)))
0 'org-protected org-line) 10000)
(length org-line))))
(let (par (ind (get-text-property 0 'original-indentation org-line)))
(when (re-search-backward
"\\(<p>\\)\\([ \t\r\n]*\\)\\=" (- (point) 100) t)
(setq par (match-string 1))
(replace-match "\\2\n"))
(insert line "\n")
(insert org-line "\n")
(while (and lines
(or (= (length (car lines)) 0)
(not ind)
@ -1564,144 +1564,144 @@ PUB-DIR is set, use this as the publishing directory."
(throw 'nextline nil))
;; Blockquotes, verse, and center
(when (equal "ORG-BLOCKQUOTE-START" line)
(when (equal "ORG-BLOCKQUOTE-START" org-line)
(org-close-par-maybe)
(insert "<blockquote>\n")
(org-open-par)
(throw 'nextline nil))
(when (equal "ORG-BLOCKQUOTE-END" line)
(when (equal "ORG-BLOCKQUOTE-END" org-line)
(org-close-par-maybe)
(insert "\n</blockquote>\n")
(org-open-par)
(throw 'nextline nil))
(when (equal "ORG-VERSE-START" line)
(when (equal "ORG-VERSE-START" org-line)
(org-close-par-maybe)
(insert "\n<p class=\"verse\">\n")
(setq org-par-open t)
(setq inverse t)
(throw 'nextline nil))
(when (equal "ORG-VERSE-END" line)
(when (equal "ORG-VERSE-END" org-line)
(insert "</p>\n")
(setq org-par-open nil)
(org-open-par)
(setq inverse nil)
(throw 'nextline nil))
(when (equal "ORG-CENTER-START" line)
(when (equal "ORG-CENTER-START" org-line)
(org-close-par-maybe)
(insert "\n<div style=\"text-align: center\">")
(org-open-par)
(throw 'nextline nil))
(when (equal "ORG-CENTER-END" line)
(when (equal "ORG-CENTER-END" org-line)
(org-close-par-maybe)
(insert "\n</div>")
(org-open-par)
(throw 'nextline nil))
(run-hooks 'org-export-html-after-blockquotes-hook)
(when inverse
(let ((i (org-get-string-indentation line)))
(let ((i (org-get-string-indentation org-line)))
(if (> i 0)
(setq line (concat (mapconcat 'identity
(setq org-line (concat (mapconcat 'identity
(make-list (* 2 i) "\\nbsp") "")
" " (org-trim line))))
(unless (string-match "\\\\\\\\[ \t]*$" line)
(setq line (concat line "\\\\")))))
" " (org-trim org-line))))
(unless (string-match "\\\\\\\\[ \t]*$" org-line)
(setq org-line (concat org-line "\\\\")))))
;; make targets to anchors
(setq start 0)
(while (string-match
"<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line start)
"<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" org-line start)
(cond
((get-text-property (match-beginning 1) 'org-protected line)
((get-text-property (match-beginning 1) 'org-protected org-line)
(setq start (match-end 1)))
((match-end 2)
(setq line (replace-match
(setq org-line (replace-match
(format
"@<a name=\"%s\" id=\"%s\">@</a>"
(org-solidify-link-text (match-string 1 line))
(org-solidify-link-text (match-string 1 line)))
t t line)))
((and org-export-with-toc (equal (string-to-char line) ?*))
(org-solidify-link-text (match-string 1 org-line))
(org-solidify-link-text (match-string 1 org-line)))
t t org-line)))
((and org-export-with-toc (equal (string-to-char org-line) ?*))
;; FIXME: NOT DEPENDENT on TOC?????????????????????
(setq line (replace-match
(setq org-line (replace-match
(concat "@<span class=\"target\">"
(match-string 1 line) "@</span> ")
;; (concat "@<i>" (match-string 1 line) "@</i> ")
t t line)))
(match-string 1 org-line) "@</span> ")
;; (concat "@<i>" (match-string 1 org-line) "@</i> ")
t t org-line)))
(t
(setq line (replace-match
(setq org-line (replace-match
(concat "@<a name=\""
(org-solidify-link-text (match-string 1 line))
"\" class=\"target\">" (match-string 1 line)
(org-solidify-link-text (match-string 1 org-line))
"\" class=\"target\">" (match-string 1 org-line)
"@</a> ")
t t line)))))
t t org-line)))))
(setq line (org-html-handle-time-stamps line))
(setq org-line (org-html-handle-time-stamps org-line))
;; replace "&" by "&amp;", "<" and ">" by "&lt;" and "&gt;"
;; handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>")
;; Also handle sub_superscripts and checkboxes
(or (string-match org-table-hline-regexp line)
(string-match "^[ \t]*\\([+]-\\||[ ]\\)[-+ |]*[+|][ \t]*$" line)
(setq line (org-html-expand line)))
(or (string-match org-table-hline-regexp org-line)
(string-match "^[ \t]*\\([+]-\\||[ ]\\)[-+ |]*[+|][ \t]*$" org-line)
(setq org-line (org-html-expand org-line)))
;; Format the links
(setq line (org-html-handle-links line opt-plist))
(setq org-line (org-html-handle-links org-line opt-plist))
;; TODO items
(if (and org-todo-line-regexp
(string-match org-todo-line-regexp line)
(string-match org-todo-line-regexp org-line)
(match-beginning 2))
(setq line
(concat (substring line 0 (match-beginning 2))
(setq org-line
(concat (substring org-line 0 (match-beginning 2))
"<span class=\""
(if (member (match-string 2 line)
(if (member (match-string 2 org-line)
org-done-keywords)
"done" "todo")
" " (org-export-html-get-todo-kwd-class-name
(match-string 2 line))
"\">" (match-string 2 line)
"</span>" (substring line (match-end 2)))))
(match-string 2 org-line))
"\">" (match-string 2 org-line)
"</span>" (substring org-line (match-end 2)))))
;; Does this contain a reference to a footnote?
(when org-export-with-footnotes
(setq start 0)
(while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line start)
(while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" org-line start)
;; Discard protected matches not clearly identified as
;; footnote markers.
(if (or (get-text-property (match-beginning 2) 'org-protected line)
(not (get-text-property (match-beginning 2) 'org-footnote line)))
(if (or (get-text-property (match-beginning 2) 'org-protected org-line)
(not (get-text-property (match-beginning 2) 'org-footnote org-line)))
(setq start (match-end 2))
(let ((n (match-string 2 line)) extra a)
(let ((n (match-string 2 org-line)) extra a)
(if (setq a (assoc n footref-seen))
(progn
(setcdr a (1+ (cdr a)))
(setq extra (format ".%d" (cdr a))))
(setq extra "")
(push (cons n 1) footref-seen))
(setq line
(setq org-line
(replace-match
(concat
(format
(concat "%s"
(format org-export-html-footnote-format
(concat "<a class=\"footref\" name=\"fnr.%s%s\" href=\"#fn.%s\">%s</a>")))
(or (match-string 1 line) "") n extra n n)
(or (match-string 1 org-line) "") n extra n n)
;; If another footnote is following the
;; current one, add a separator.
(if (save-match-data
(string-match "\\`\\[[0-9]+\\]"
(substring line (match-end 0))))
(substring org-line (match-end 0))))
org-export-html-footnote-separator
""))
t t line))))))
t t org-line))))))
(cond
((string-match "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" line)
((string-match "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" org-line)
;; This is a headline
(setq level (org-tr-level (- (match-end 1) (match-beginning 1)
level-offset))
txt (match-string 2 line))
txt (match-string 2 org-line))
(if (string-match quote-re0 txt)
(setq txt (replace-match "" t t txt)))
(if (<= level (max umax umax-toc))
@ -1712,19 +1712,19 @@ PUB-DIR is set, use this as the publishing directory."
head-count opt-plist)
;; QUOTES
(when (string-match quote-re line)
(when (string-match quote-re org-line)
(org-close-par-maybe)
(insert "<pre>")
(setq inquote t)))
((and org-export-with-tables
(string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
(string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" org-line))
(when (not table-open)
;; New table starts
(setq table-open t table-buffer nil table-orig-buffer nil))
;; Accumulate lines
(setq table-buffer (cons line table-buffer)
(setq table-buffer (cons org-line table-buffer)
table-orig-buffer (cons origline table-orig-buffer))
(when (or (not lines)
(not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
@ -1739,15 +1739,15 @@ PUB-DIR is set, use this as the publishing directory."
(t
;; This line either is list item or end a list.
(when (get-text-property 0 'list-item line)
(setq line (org-html-export-list-line
line
(get-text-property 0 'list-item line)
(get-text-property 0 'list-struct line)
(get-text-property 0 'list-prevs line))))
(when (get-text-property 0 'list-item org-line)
(setq org-line (org-html-export-list-line
org-line
(get-text-property 0 'list-item org-line)
(get-text-property 0 'list-struct org-line)
(get-text-property 0 'list-prevs org-line))))
;; Horizontal line
(when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" line)
(when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" org-line)
(if org-par-open
(insert "\n</p>\n<hr/>\n<p>\n")
(insert "\n<hr/>\n"))
@ -1756,44 +1756,44 @@ PUB-DIR is set, use this as the publishing directory."
;; Empty lines start a new paragraph. If hand-formatted lists
;; are not fully interpreted, lines starting with "-", "+", "*"
;; also start a new paragraph.
(if (string-match "^ [-+*]-\\|^[ \t]*$" line) (org-open-par))
(if (string-match "^ [-+*]-\\|^[ \t]*$" org-line) (org-open-par))
;; Is this the start of a footnote?
(when org-export-with-footnotes
(when (and (boundp 'footnote-section-tag-regexp)
(string-match (concat "^" footnote-section-tag-regexp)
line))
org-line))
;; ignore this line
(throw 'nextline nil))
(when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line)
(when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" org-line)
(org-close-par-maybe)
(let ((n (match-string 1 line)))
(let ((n (match-string 1 org-line)))
(setq org-par-open t
line (replace-match
org-line (replace-match
(format
(concat "<p class=\"footnote\">"
(format org-export-html-footnote-format
"<a class=\"footnum\" name=\"fn.%s\" href=\"#fnr.%s\">%s</a>"))
n n n) t t line)))))
n n n) t t org-line)))))
;; Check if the line break needs to be conserved
(cond
((string-match "\\\\\\\\[ \t]*$" line)
(setq line (replace-match "<br/>" t t line)))
((string-match "\\\\\\\\[ \t]*$" org-line)
(setq org-line (replace-match "<br/>" t t org-line)))
(org-export-preserve-breaks
(setq line (concat line "<br/>"))))
(setq org-line (concat org-line "<br/>"))))
;; Check if a paragraph should be started
(let ((start 0))
(while (and org-par-open
(string-match "\\\\par\\>" line start))
(string-match "\\\\par\\>" org-line start))
;; Leave a space in the </p> so that the footnote matcher
;; does not see this.
(if (not (get-text-property (match-beginning 0)
'org-protected line))
(setq line (replace-match "</p ><p >" t t line)))
'org-protected org-line))
(setq org-line (replace-match "</p ><p >" t t org-line)))
(setq start (match-end 0))))
(insert line "\n")))))
(insert org-line "\n")))))
;; Properly close all local lists and other lists
(when inquote
@ -1835,7 +1835,7 @@ PUB-DIR is set, use this as the publishing directory."
(split-string email ",+ *")
", "))
(creator-info
(concat "Org version " org-version " with Emacs version "
(concat "Org version " (org-version) " with Emacs version "
(number-to-string emacs-major-version))))
(when (plist-get opt-plist :html-postamble)
@ -1857,7 +1857,7 @@ PUB-DIR is set, use this as the publishing directory."
(insert "<p class=\"email\">" email "</p>\n"))
(when (plist-get opt-plist :creator-info)
(insert "<p class=\"creator\">"
(concat "Org version " org-version " with Emacs version "
(concat "Org version " (org-version) " with Emacs version "
(number-to-string emacs-major-version) "</p>\n")))
(insert html-validation-link "\n"))
(t
@ -2041,7 +2041,7 @@ for formatting. This is required for the DocBook exporter."
(lambda (x) (string-match "^[ \t]*|-" x))
(cdr lines)))))
(nline 0) fnum nfields i (cnt 0)
tbopen line fields html gr colgropen rowstart rowend
tbopen org-line fields html gr colgropen rowstart rowend
ali align aligns n)
(setq caption (and caption (org-html-do-expand caption)))
(when (and col-cookies org-table-clean-did-remove-column)
@ -2050,9 +2050,9 @@ for formatting. This is required for the DocBook exporter."
(if splice (setq head nil))
(unless splice (push (if head "<thead>" "<tbody>") html))
(setq tbopen t)
(while (setq line (pop lines))
(while (setq org-line (pop lines))
(catch 'next-line
(if (string-match "^[ \t]*|-" line)
(if (string-match "^[ \t]*|-" org-line)
(progn
(unless splice
(push (if head "</thead>" "</tbody>") html)
@ -2061,7 +2061,7 @@ for formatting. This is required for the DocBook exporter."
;; ignore this line
(throw 'next-line t)))
;; Break the line into fields
(setq fields (org-split-string line "[ \t]*|[ \t]*"))
(setq fields (org-split-string org-line "[ \t]*|[ \t]*"))
(unless fnum (setq fnum (make-vector (length fields) 0)
nfields (length fnum)))
(setq nline (1+ nline) i -1
@ -2176,14 +2176,14 @@ for formatting. This is required for the DocBook exporter."
This conversion does *not* use `table-generate-source' from table.el.
This has the advantage that Org-mode's HTML conversions can be used.
But it has the disadvantage, that no cell- or row-spanning is allowed."
(let (line field-buffer
(let (org-line field-buffer
(head org-export-highlight-first-table-line)
fields html empty i)
(setq html (concat html-table-tag "\n"))
(while (setq line (pop lines))
(while (setq org-line (pop lines))
(setq empty "&nbsp;")
(catch 'next-line
(if (string-match "^[ \t]*\\+-" line)
(if (string-match "^[ \t]*\\+-" org-line)
(progn
(if field-buffer
(progn
@ -2209,7 +2209,7 @@ But it has the disadvantage, that no cell- or row-spanning is allowed."
;; Ignore this line
(throw 'next-line t)))
;; Break the line into fields and store the fields
(setq fields (org-split-string line "[ \t]*|[ \t]*"))
(setq fields (org-split-string org-line "[ \t]*|[ \t]*"))
(if field-buffer
(setq field-buffer (mapcar
(lambda (x)
@ -2574,10 +2574,10 @@ Replaces invalid characters with \"_\" and then prepends a prefix."
(org-close-li)
(insert "</ul>\n")))
(defun org-html-export-list-line (line pos struct prevs)
"Insert list syntax in export buffer. Return LINE, maybe modified.
(defun org-html-export-list-line (org-line pos struct prevs)
"Insert list syntax in export buffer. Return ORG-LINE, maybe modified.
POS is the item position or line position the line had before
POS is the item position or org-line position the org-line had before
modifications to buffer. STRUCT is the list structure. PREVS is
the alist of previous items."
(let* ((get-type
@ -2626,10 +2626,10 @@ the alist of previous items."
"\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?"
"\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?"
"\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?"
"\\(.*\\)") line)
(let* ((checkbox (match-string 3 line))
(desc-tag (or (match-string 4 line) "???"))
(body (or (match-string 5 line) ""))
"\\(.*\\)") org-line)
(let* ((checkbox (match-string 3 org-line))
(desc-tag (or (match-string 4 org-line) "???"))
(body (or (match-string 5 org-line) ""))
(list-beg (org-list-get-list-begin pos struct prevs))
(firstp (= list-beg pos))
;; Always refer to first item to determine list type, in
@ -2663,9 +2663,9 @@ the alist of previous items."
;; Return modified line
body))
;; At a list ender: go to next line (side-effects only).
((equal "ORG-LIST-END-MARKER" line) (throw 'nextline nil))
((equal "ORG-LIST-END-MARKER" org-line) (throw 'nextline nil))
;; Not at an item: return line unchanged (side-effects only).
(t line))))
(t org-line))))
(provide 'org-html)

15
lisp/org-indent.el
View File

@ -183,9 +183,11 @@ during idle time." nil " Ind" nil
(org-set-local 'org-hide-leading-stars-before-indent-mode
org-hide-leading-stars)
(org-set-local 'org-hide-leading-stars t))
(make-local-variable 'buffer-substring-filters)
(add-to-list 'buffer-substring-filters
'org-indent-remove-properties-from-string)
(make-local-variable 'filter-buffer-substring-functions)
(add-hook 'filter-buffer-substring-functions
(lambda (fun start end delete)
(org-indent-remove-properties-from-string
(funcall fun start end delete))))
(org-add-hook 'after-change-functions 'org-indent-refresh-maybe nil 'local)
(org-add-hook 'before-change-functions
'org-indent-notify-modified-headline nil 'local)
@ -209,9 +211,10 @@ during idle time." nil " Ind" nil
(when (boundp 'org-hide-leading-stars-before-indent-mode)
(org-set-local 'org-hide-leading-stars
org-hide-leading-stars-before-indent-mode))
(setq buffer-substring-filters
(delq 'org-indent-remove-properties-from-string
buffer-substring-filters))
(remove-hook 'filter-buffer-substring-functions
(lambda (fun start end delete)
(org-indent-remove-properties-from-string
(funcall fun start end delete))))
(remove-hook 'after-change-functions 'org-indent-refresh-maybe 'local)
(remove-hook 'before-change-functions
'org-indent-notify-modified-headline 'local)

2
lisp/org-latex.el
View File

@ -1522,7 +1522,7 @@ OPT-PLIST is the options plist for current buffer."
(format "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={%s}}\n"
(org-export-latex-fontify-headline keywords)
(org-export-latex-fontify-headline description)
(concat "Emacs Org-mode version " org-version))
(concat "Emacs Org-mode version " (org-version)))
;; beginning of the document
"\n\\begin{document}\n\n"
;; insert the title command

82
lisp/org-list.el
View File

@ -714,15 +714,15 @@ Assume point is at an item."
;; equally indented than BEG-CELL's cdr. Also, store ending
;; position of items in END-LST-2.
(catch 'exit
(while t
(let ((ind (+ (or (get-text-property (point) 'original-indentation) 0)
(while t
(let ((ind (+ (or (get-text-property (point) 'original-indentation) 0)
(org-get-indentation))))
(cond
((>= (point) lim-down)
(cond
((>= (point) lim-down)
;; At downward limit: this is de facto the end of the
;; list. Save point as an ending position, and jump to
;; part 3.
(throw 'exit
(throw 'exit
(push (cons 0 (funcall end-before-blank)) end-lst-2)))
;; At a verbatim block, move to its end. Point is at bol
;; and 'org-example property is set by whole lines:
@ -1106,8 +1106,10 @@ It determines the number of whitespaces to append by looking at
(defun org-list-swap-items (beg-A beg-B struct)
"Swap item starting at BEG-A with item starting at BEG-B in STRUCT.
Blank lines at the end of items are left in place. Return the
new structure after the changes.
Blank lines at the end of items are left in place. Item
visibility is preserved. Return the new structure after the
changes.
Assume BEG-A is lesser than BEG-B and that BEG-A and BEG-B belong
to the same sub-list.
@ -1124,7 +1126,17 @@ This function modifies STRUCT."
(body-B (buffer-substring beg-B end-B-no-blank))
(between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B))
(sub-A (cons beg-A (org-list-get-subtree beg-A struct)))
(sub-B (cons beg-B (org-list-get-subtree beg-B struct))))
(sub-B (cons beg-B (org-list-get-subtree beg-B struct)))
;; Store overlays responsible for visibility status. We
;; also need to store their boundaries as they will be
;; removed from buffer.
(overlays (cons
(mapcar (lambda (ov)
(list ov (overlay-start ov) (overlay-end ov)))
(overlays-in beg-A end-A))
(mapcar (lambda (ov)
(list ov (overlay-start ov) (overlay-end ov)))
(overlays-in beg-B end-B)))))
;; 1. Move effectively items in buffer.
(goto-char beg-A)
(delete-region beg-A end-B-no-blank)
@ -1157,7 +1169,22 @@ This function modifies STRUCT."
(setcar e (+ pos (- size-B size-A)))
(setcar (nthcdr 6 e) (+ end-e (- size-B size-A))))))))
struct)
(sort struct (lambda (e1 e2) (< (car e1) (car e2)))))))
(setq struct (sort struct (lambda (e1 e2) (< (car e1) (car e2)))))
;; Restore visibility status, by moving overlays to their new
;; position.
(mapc (lambda (ov)
(move-overlay
(car ov)
(+ (nth 1 ov) (- (+ beg-B (- size-B size-A)) beg-A))
(+ (nth 2 ov) (- (+ beg-B (- size-B size-A)) beg-A))))
(car overlays))
(mapc (lambda (ov)
(move-overlay (car ov)
(+ (nth 1 ov) (- beg-A beg-B))
(+ (nth 2 ov) (- beg-A beg-B))))
(cdr overlays))
;; Return structure.
struct)))
(defun org-list-separating-blank-lines-number (pos struct prevs)
"Return number of blank lines that should separate items in list.
@ -1374,8 +1401,8 @@ If DEST is a buffer position, the function will assume it points
to another item in the same list as ITEM, and will move the
latter just before the former.
If DEST is `begin' \(respectively `end'\), ITEM will be moved at
the beginning \(respectively end\) of the list it belongs to.
If DEST is `begin' (respectively `end'), ITEM will be moved at
the beginning (respectively end) of the list it belongs to.
If DEST is a string like \"N\", where N is an integer, ITEM will
be moved at the Nth position in the list.
@ -1385,6 +1412,8 @@ added to the kill-ring.
If DEST is `delete', ITEM will be deleted.
Visibility of item is preserved.
This function returns, destructively, the new list structure."
(let* ((prevs (org-list-prevs-alist struct))
(item-end (org-list-get-item-end item struct))
@ -1427,7 +1456,9 @@ This function returns, destructively, the new list structure."
(org-list-get-last-item item struct prevs))
(point-at-eol)))))
(t dest)))
(org-M-RET-may-split-line nil))
(org-M-RET-may-split-line nil)
;; Store visibility.
(visibility (overlays-in item item-end)))
(cond
((eq dest 'delete) (org-list-delete-item item struct))
((eq dest 'kill)
@ -1463,9 +1494,14 @@ This function returns, destructively, the new list structure."
(+ end shift)))))))
moved-items))
(lambda (e1 e2) (< (car e1) (car e2))))))
;; 2. Eventually delete extra copy of the item and clean marker.
(prog1
(org-list-delete-item (marker-position item) struct)
;; 2. Restore visibility.
(mapc (lambda (ov)
(move-overlay ov
(+ (overlay-start ov) (- (point) item))
(+ (overlay-end ov) (- (point) item))))
visibility)
;; 3. Eventually delete extra copy of the item and clean marker.
(prog1 (org-list-delete-item (marker-position item) struct)
(move-marker item nil)))
(t struct))))
@ -2182,13 +2218,15 @@ item is invisible."
"Mark the current list.
If this is a sublist, only mark the sublist."
(interactive)
(let* ((item (org-list-get-item-begin))
(struct (org-list-struct))
(prevs (org-list-prevs-alist struct))
(lbeg (org-list-get-list-begin item struct prevs))
(lend (org-list-get-list-end item struct prevs)))
(push-mark lend nil t)
(goto-char lbeg)))
(if (not (org-at-item-p))
(error "Not on a list")
(let* ((item (org-list-get-item-begin))
(struct (org-list-struct))
(prevs (org-list-prevs-alist struct))
(lbeg (org-list-get-list-begin item struct prevs))
(lend (org-list-get-list-end item struct prevs)))
(push-mark lend nil t)
(goto-char lbeg))))
(defun org-list-repair ()
"Fix indentation, bullets and checkboxes is the list at point."

3
lisp/org-macs.el
View File

@ -372,7 +372,8 @@ point nowhere."
(defmacro org-with-limited-levels (&rest body)
"Execute BODY with limited number of outline levels."
`(let* ((org-outline-regexp (org-get-limited-outline-regexp))
`(let* ((org-called-with-limited-levels t)
(org-outline-regexp (org-get-limited-outline-regexp))
(outline-regexp org-outline-regexp)
(org-outline-regexp-at-bol (concat "^" org-outline-regexp)))
,@body))

3
lisp/org-odt.el
View File

@ -2383,8 +2383,7 @@ visually."
(org-odt-format-tags '("\n<meta:generator>" . "</meta:generator>")
(when org-export-creator-info
(format "Org-%s/Emacs-%s"
(if (boundp 'org-version) org-version
"Unknown")
(org-version)
emacs-version)))
(org-odt-format-tags '("\n<meta:keyword>" . "</meta:keyword>") keywords)
(org-odt-format-tags '("\n<dc:subject>" . "</dc:subject>") description)

43
lisp/org-remember.el
View File

@ -277,9 +277,6 @@ opposite case, the default, t, is more useful."
:group 'org-remember
:type 'boolean)
(defvar annotation) ; from remember.el, dynamically scoped in `remember-mode'
(defvar initial) ; from remember.el, dynamically scoped in `remember-mode'
;;;###autoload
(defun org-remember-insinuate ()
"Setup remember.el for use with Org-mode."
@ -431,10 +428,10 @@ to be run from that hook to function properly."
;; `initial' and `annotation' are bound in `remember'.
;; But if the property list has them, we prefer those values
(v-i (or (plist-get org-store-link-plist :initial)
(and (boundp 'initial) initial)
(and (boundp 'initial) (symbol-value 'initial))
""))
(v-a (or (plist-get org-store-link-plist :annotation)
(and (boundp 'annotation) annotation)
(and (boundp 'annotation) (symbol-value 'annotation))
""))
;; Is the link empty? Then we do not want it...
(v-a (if (equal v-a "[[]]") "" v-a))
@ -476,7 +473,7 @@ to be run from that hook to function properly."
(erase-buffer)
(insert (substitute-command-keys
(format
"## %s \"%s\" -> \"* %s\"
"## %s \"%s\" -> \"* %s\"
## C-u C-c C-c like C-c C-c, and immediately visit note at target location
## C-0 C-c C-c \"%s\" -> \"* %s\"
## %s to select file and header location interactively.
@ -505,18 +502,20 @@ to be run from that hook to function properly."
filename error)))))))
;; Simple %-escapes
(goto-char (point-min))
(while (re-search-forward "%\\([tTuUaiAcxkKI]\\)" nil t)
(unless (org-remember-escaped-%)
(when (and initial (equal (match-string 0) "%i"))
(save-match-data
(let* ((lead (buffer-substring
(point-at-bol) (match-beginning 0))))
(setq v-i (mapconcat 'identity
(org-split-string initial "\n")
(concat "\n" lead))))))
(replace-match
(or (eval (intern (concat "v-" (match-string 1)))) "")
t t)))
(let ((init (and (boundp 'initial)
(symbol-value 'initial))))
(while (re-search-forward "%\\([tTuUaiAcxkKI]\\)" nil t)
(unless (org-remember-escaped-%)
(when (and init (equal (match-string 0) "%i"))
(save-match-data
(let* ((lead (buffer-substring
(point-at-bol) (match-beginning 0))))
(setq v-i (mapconcat 'identity
(org-split-string init "\n")
(concat "\n" lead))))))
(replace-match
(or (eval (intern (concat "v-" (match-string 1)))) "")
t t))))
;; %() embedded elisp
(goto-char (point-min))
@ -536,10 +535,10 @@ to be run from that hook to function properly."
(when plist-p
(goto-char (point-min))
(while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t)
(unless (org-remember-escaped-%)
(and (setq x (or (plist-get org-store-link-plist
(intern (match-string 1))) ""))
(replace-match x t t)))))
(unless (org-remember-escaped-%)
(and (setq x (or (plist-get org-store-link-plist
(intern (match-string 1))) ""))
(replace-match x t t)))))
;; Turn on org-mode in the remember buffer, set local variables
(let ((org-inhibit-startup t)) (org-mode) (org-remember-mode 1))

12
lisp/org-special-blocks.el
View File

@ -80,17 +80,17 @@ seen. This is run after a few special cases are taken care of."
(add-hook 'org-export-latex-after-blockquotes-hook
'org-special-blocks-convert-latex-special-cookies)
(defvar line)
(defvar org-line)
(defun org-special-blocks-convert-html-special-cookies ()
"Converts the special cookies into div blocks."
;; Uses the dynamically-bound variable `line'.
(when (string-match "^ORG-\\(.*\\)-\\(START\\|END\\)$" line)
;; Uses the dynamically-bound variable `org-line'.
(when (string-match "^ORG-\\(.*\\)-\\(START\\|END\\)$" org-line)
(message "%s" (match-string 1))
(when (equal (match-string 2 line) "START")
(when (equal (match-string 2 org-line) "START")
(org-close-par-maybe)
(insert "\n<div class=\"" (match-string 1 line) "\">")
(insert "\n<div class=\"" (match-string 1 org-line) "\">")
(org-open-par))
(when (equal (match-string 2 line) "END")
(when (equal (match-string 2 org-line) "END")
(org-close-par-maybe)
(insert "\n</div>")
(org-open-par))

102
lisp/org-table.el
View File

@ -2090,22 +2090,23 @@ When NAMED is non-nil, look for a named equation."
(defun org-table-store-formulas (alist)
"Store the list of formulas below the current table."
(setq alist (sort alist 'org-table-formula-less-p))
(save-excursion
(goto-char (org-table-end))
(if (looking-at "\\([ \t]*\n\\)*[ \t]*\\(#\\+tblfm:\\)\\(.*\n?\\)")
(progn
;; don't overwrite TBLFM, we might use text properties to store stuff
(goto-char (match-beginning 3))
(delete-region (match-beginning 3) (match-end 0)))
(org-indent-line-function)
(insert (match-string 2)))
(insert " "
(mapconcat (lambda (x)
(concat
(if (equal (string-to-char (car x)) ?@) "" "$")
(car x) "=" (cdr x)))
alist "::")
"\n")))
(let ((case-fold-search t))
(save-excursion
(goto-char (org-table-end))
(if (looking-at "\\([ \t]*\n\\)*[ \t]*\\(#\\+tblfm:\\)\\(.*\n?\\)")
(progn
;; don't overwrite TBLFM, we might use text properties to store stuff
(goto-char (match-beginning 3))
(delete-region (match-beginning 3) (match-end 0)))
(org-indent-line-function)
(insert (or (match-string 2) "#+TBLFM:")))
(insert " "
(mapconcat (lambda (x)
(concat
(if (equal (string-to-char (car x)) ?@) "" "$")
(car x) "=" (cdr x)))
alist "::")
"\n"))))
(defsubst org-table-formula-make-cmp-string (a)
(when (string-match "\\`$[<>]" a)
@ -2277,7 +2278,7 @@ If yes, store the formula and apply it."
(when org-table-formula-evaluate-inline
(let* ((field (org-trim (or (org-table-get-field) "")))
named eq)
(when (string-match "^:?=\\(.*\\)" field)
(when (string-match "^:?=\\(.*[^=]\\)$" field)
(setq named (equal (string-to-char field) ?:)
eq (match-string 1 field))
(if (or (fboundp 'calc-eval)
@ -2370,7 +2371,7 @@ of the new mark."
(looking-at org-table-auto-recalculate-regexp))
(org-table-recalculate) t))
(defvar org-table-modes)
(defvar org-tbl-calc-modes) ;; Dynamically bound in `org-table-eval-formula'
(defsubst org-set-calc-mode (var &optional value)
(if (stringp var)
(setq var (assoc var '(("D" calc-angle-mode deg)
@ -2378,10 +2379,10 @@ of the new mark."
("F" calc-prefer-frac t)
("S" calc-symbolic-mode t)))
value (nth 2 var) var (nth 1 var)))
(if (memq var org-table-modes)
(setcar (cdr (memq var org-table-modes)) value)
(cons var (cons value org-table-modes)))
org-table-modes)
(if (memq var org-tbl-calc-modes)
(setcar (cdr (memq var org-tbl-calc-modes)) value)
(cons var (cons value org-tbl-calc-modes)))
org-tbl-calc-modes)
(defun org-table-eval-formula (&optional arg equation
suppress-align suppress-const
@ -2439,7 +2440,7 @@ not overwrite the stored one."
equation
(org-table-get-formula equation (equal arg '(4)))))
(n0 (org-table-current-column))
(modes (copy-sequence org-calc-default-modes))
(org-tbl-calc-modes (copy-sequence org-calc-default-modes))
(numbers nil) ; was a variable, now fixed default
(keep-empty nil)
n form form0 formrpl formrg bw fmt x ev orig c lispp literal
@ -2455,12 +2456,13 @@ not overwrite the stored one."
(setq c (string-to-char (match-string 1 fmt))
n (string-to-number (match-string 2 fmt)))
(if (= c ?p)
(setq modes (org-set-calc-mode 'calc-internal-prec n))
(setq modes (org-set-calc-mode
'calc-float-format
(list (cdr (assoc c '((?n . float) (?f . fix)
(?s . sci) (?e . eng))))
n))))
(setq org-tbl-calc-modes (org-set-calc-mode 'calc-internal-prec n))
(setq org-tbl-calc-modes
(org-set-calc-mode
'calc-float-format
(list (cdr (assoc c '((?n . float) (?f . fix)
(?s . sci) (?e . eng))))
n))))
(setq fmt (replace-match "" t t fmt)))
(if (string-match "T" fmt)
(setq duration t numbers t
@ -2481,7 +2483,7 @@ not overwrite the stored one."
(setq keep-empty t
fmt (replace-match "" t t fmt)))
(while (string-match "[DRFS]" fmt)
(setq modes (org-set-calc-mode (match-string 0 fmt)))
(setq org-tbl-calc-modes (org-set-calc-mode (match-string 0 fmt)))
(setq fmt (replace-match "" t t fmt)))
(unless (string-match "\\S-" fmt)
(setq fmt nil))))
@ -2590,10 +2592,15 @@ not overwrite the stored one."
duration-output-format) ev))
(or (fboundp 'calc-eval)
(error "Calc does not seem to be installed, and is needed to evaluate the formula"))
(setq ev (calc-eval (cons form modes) (if numbers 'num))
(setq ev (if (and duration (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" form))
form
(calc-eval (cons form org-tbl-calc-modes) (if numbers 'num)))
ev (if duration (org-table-time-seconds-to-string
(string-to-number ev)
duration-output-format) ev)))
(if (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" ev)
(string-to-number (org-table-time-string-to-seconds ev))
(string-to-number ev))
duration-output-format)
ev)))
(when org-table-formula-debug
(with-output-to-temp-buffer "*Substitution History*"
@ -3288,8 +3295,10 @@ For example: 28 -> AB."
"Convert a time string into numerical duration in seconds.
S can be a string matching either -?HH:MM:SS or -?HH:MM.
If S is a string representing a number, keep this number."
(let (hour minus min sec res)
(cond
(if (equal s "")
s
(let (hour minus min sec res)
(cond
((and (string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)" s))
(setq minus (< 0 (length (match-string 1 s)))
hour (string-to-number (match-string 2 s))
@ -3307,21 +3316,24 @@ If S is a string representing a number, keep this number."
(setq res (- (+ (* hour 3600) (* min 60))))
(setq res (+ (* hour 3600) (* min 60)))))
(t (setq res (string-to-number s))))
(number-to-string res)))
(number-to-string res))))
(defun org-table-time-seconds-to-string (secs &optional output-format)
"Convert a number of seconds to a time string.
If OUTPUT-FORMAT is non-nil, return a number of days, hours,
minutes or seconds."
(cond ((eq output-format 'days)
(format "%.3f" (/ (float secs) 86400)))
((eq output-format 'hours)
(format "%.2f" (/ (float secs) 3600)))
((eq output-format 'minutes)
(format "%.1f" (/ (float secs) 60)))
((eq output-format 'seconds)
(format "%d" secs))
(t (org-format-seconds "%.2h:%.2m:%.2s" secs))))
(let* ((secs0 (abs secs))
(res
(cond ((eq output-format 'days)
(format "%.3f" (/ (float secs0) 86400)))
((eq output-format 'hours)
(format "%.2f" (/ (float secs0) 3600)))
((eq output-format 'minutes)
(format "%.1f" (/ (float secs0) 60)))
((eq output-format 'seconds)
(format "%d" secs0))
(t (org-format-seconds "%.2h:%.2m:%.2s" secs0)))))
(if (< secs 0) (concat "-" res) res)))
(defun org-table-fedit-convert-buffer (function)
"Convert all references in this buffer, using FUNCTION."

595
lisp/org.el
View File

@ -218,13 +218,15 @@ With prefix arg HERE, insert it at point."
(let* ((origin default-directory)
(version (if (boundp 'org-release) org-release "N/A"))
(git-version (if (boundp 'org-git-version) org-git-version "N/A"))
(org-install (ignore-errors (find-library-name "org-install"))))
(setq version (format "Org-mode version %s (%s @ %s)"
version
git-version
(if org-install org-install "org-install.el can not be found!")))
(if here (insert version))
(message version)))
(org-install (ignore-errors (find-library-name "org-install")))
(version_ (format "Org-mode version %s (%s @ %s)"
version
git-version
(if org-install org-install "org-install.el can not be found!"))))
(if (org-called-interactively-p 'interactive)
(if here (insert version_)
(message version_))
version)))
;;; Compatibility constants
@ -3071,7 +3073,8 @@ and the clock summary:
(org-minutes-to-hh:mm-string (- effort clocksum))))))"
:group 'org-properties
:version "24.1"
:type 'alist)
:type '(alist :key-type (string :tag "Property")
:value-type (function :tag "Function")))
(defcustom org-use-property-inheritance nil
"Non-nil means properties apply also for sublevels.
@ -4806,10 +4809,11 @@ but the stars and the body are.")
"\\|" org-clock-string "\\)\\)?"
" *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?[]>]\\|<%%([^\r\n>]*>\\)")
org-planning-or-clock-line-re
(concat "\\(?:^[ \t]*\\(" org-scheduled-string
"\\|" org-deadline-string
"\\|" org-closed-string "\\|" org-clock-string
"\\)\\>\\)")
(concat "^[ \t]*\\("
org-scheduled-string "\\|"
org-deadline-string "\\|"
org-closed-string "\\|"
org-clock-string "\\)")
org-all-time-keywords
(mapcar (lambda (w) (substring w 0 -1))
(list org-scheduled-string org-deadline-string
@ -4940,12 +4944,6 @@ Stars are put in group 1 and the trimmed body in group 2.")
(defvar bidi-paragraph-direction)
(defvar buffer-face-mode-face)
(defvar org-auto-fill-fallback-function nil)
(defvar org-indent-line-fallback-function nil)
(defvar org-fill-paragraph-fallback-function nil)
(make-variable-buffer-local 'org-auto-fill-fallback-function)
(make-variable-buffer-local 'org-indent-line-fallback-function)
(make-variable-buffer-local 'org-fill-paragraph-fallback-function)
;;;###autoload
(define-derived-mode org-mode outline-mode "Org"
@ -5413,6 +5411,21 @@ will be prompted for."
:group 'org-appearance
:group 'org-babel)
(defcustom org-src-prevent-auto-filling nil
"When non-nil, prevent auto-filling in src blocks."
:type 'boolean
:version "24.1"
:group 'org-appearance
:group 'org-babel)
(defcustom org-allow-promoting-top-level-subtree nil
"When non-nil, allow promoting a top level subtree.
The leading star of the top level headline will be replaced
by a #."
:type 'boolean
:version "24.1"
:group 'org-appearance)
(defun org-fontify-meta-lines-and-blocks (limit)
(condition-case nil
(org-fontify-meta-lines-and-blocks-1 limit)
@ -5941,16 +5954,19 @@ needs to be inserted at a specific position in the font-lock sequence.")
(when org-pretty-entities
(catch 'match
(while (re-search-forward
"\\\\\\(frac[13][24]\\|[a-zA-Z]+\\)\\($\\|[^[:alpha:]\n]\\)"
"\\\\\\(frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]\n]\\)"
limit t)
(if (and (not (org-in-indented-comment-line))
(setq ee (org-entity-get (match-string 1)))
(= (length (nth 6 ee)) 1))
(progn
(let*
((end (if (equal (match-string 2) "{}")
(match-end 2)
(match-end 1))))
(add-text-properties
(match-beginning 0) (match-end 1)
(match-beginning 0) end
(list 'font-lock-fontified t))
(compose-region (match-beginning 0) (match-end 1)
(compose-region (match-beginning 0) end
(nth 6 ee) nil)
(backward-char 1)
(throw 'match t))))
@ -7458,6 +7474,8 @@ even level numbers will become the next higher odd number."
(define-obsolete-function-alias 'org-get-legal-level
'org-get-valid-level "23.1")))
(defvar org-called-with-limited-levels nil) ;; Dynamically bound in
;; ̀org-with-limited-levels'
(defun org-promote ()
"Promote the current heading higher up the tree.
If the region is active in `transient-mark-mode', promote all headings
@ -7468,11 +7486,16 @@ in the region."
after-change-functions))
(up-head (concat (make-string (org-get-valid-level level -1) ?*) " "))
(diff (abs (- level (length up-head) -1))))
(if (= level 1) (error "Cannot promote to level 0. UNDO to recover if necessary"))
(replace-match up-head nil t)
;; Fixup tag positioning
(and org-auto-align-tags (org-set-tags nil t))
(if org-adapt-indentation (org-fixup-indentation (- diff)))
(cond ((and (= level 1) org-called-with-limited-levels
org-allow-promoting-top-level-subtree)
(replace-match "# " nil t))
((= level 1)
(error "Cannot promote to level 0. UNDO to recover if necessary"))
(t (replace-match up-head nil t)))
;; Fixup tag positioning
(unless (= level 1)
(and org-auto-align-tags (org-set-tags nil t))
(if org-adapt-indentation (org-fixup-indentation (- diff))))
(run-hooks 'org-after-promote-entry-hook)))
(defun org-demote ()
@ -8363,23 +8386,23 @@ C-c C-c Set tags / toggle checkbox"
"Unconditionally turn on `orgstruct-mode'."
(orgstruct-mode 1))
(defvar org-fb-vars nil)
(make-variable-buffer-local 'org-fb-vars)
(defun orgstruct++-mode (&optional arg)
"Toggle `orgstruct-mode', the enhanced version of it.
In addition to setting orgstruct-mode, this also exports all indentation
and autofilling variables from org-mode into the buffer. It will also
recognize item context in multiline items.
Note that turning off orgstruct-mode will *not* remove the
indentation/paragraph settings. This can only be done by refreshing the
major mode, for example with \\[normal-mode]."
In addition to setting orgstruct-mode, this also exports all
indentation and autofilling variables from org-mode into the
buffer. It will also recognize item context in multiline items."
(interactive "P")
(setq arg (prefix-numeric-value (or arg (if orgstruct-mode -1 1)))
;; Set fallback functions
org-auto-fill-fallback-function auto-fill-function
org-indent-line-fallback-function indent-line-function
org-fill-paragraph-fallback-function fill-paragraph-function)
(setq arg (prefix-numeric-value (or arg (if orgstruct-mode -1 1))))
(if (< arg 1)
(orgstruct-mode -1)
(progn (orgstruct-mode -1)
(mapc (lambda(v)
(org-set-local (car v)
(if (eq (car-safe (cadr v)) 'quote) (cadadr v) (cadr v))))
org-fb-vars))
(orgstruct-mode 1)
(setq org-fb-vars nil)
(let (var val)
(mapc
(lambda (x)
@ -8387,6 +8410,7 @@ major mode, for example with \\[normal-mode]."
"^\\(paragraph-\\|auto-fill\\|fill-paragraph\\|adaptive-fill\\|indent-\\)"
(symbol-name (car x)))
(setq var (car x) val (nth 1 x))
(push (list var `(quote ,(eval var))) org-fb-vars)
(org-set-local var (if (eq (car-safe val) 'quote) (nth 1 val) val))))
org-local-vars)
(org-set-local 'orgstruct-is-++ t))))
@ -8610,7 +8634,7 @@ call CMD."
;;; Link abbreviations
(defun org-link-expand-abbrev (link)
"Apply replacements as defined in `org-link-abbrev-alist."
"Apply replacements as defined in `org-link-abbrev-alist'."
(if (string-match "^\\([^:]*\\)\\(::?\\(.*\\)\\)?$" link)
(let* ((key (match-string 1 link))
(as (or (assoc key org-link-abbrev-alist-local)
@ -9474,7 +9498,7 @@ If the link is in hidden text, expose it."
(string-match "\\([a-zA-Z0-9]+\\):\\(.*\\)" s))
(progn
(setq s (funcall org-link-translation-function
(match-string 1) (match-string 2)))
(match-string 1 s) (match-string 2 s)))
(concat (car s) ":" (cdr s)))
s))
@ -10685,7 +10709,7 @@ RFLOC can be a refile location obtained in a different way.
See also `org-refile-use-outline-path' and `org-completion-use-ido'.
If you are using target caching (see `org-refile-use-cache'),
You have to clear the target cache in order to find new targets.
you have to clear the target cache in order to find new targets.
This can be done with a 0 prefix (`C-0 C-c C-w') or a triple
prefix argument (`C-u C-u C-u C-c C-w')."
@ -10968,8 +10992,7 @@ this is used for the GOTO interface."
rtn))
((eq flag 'lambda)
;; exact match?
(assoc string thetable)))
))
(assoc string thetable)))))
args)))
;;;; Dynamic blocks
@ -12884,7 +12907,9 @@ headlines matching this string."
" *\\(\\<\\("
(mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
(org-re
"\\>\\)\\)? *\\(.*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$")))
(if todo-only
"\\>\\)\\)[ \t]+\\(.*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$"
"\\>\\)\\)? *\\([^ ].*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$"))))
(props (list 'face 'default
'done-face 'org-agenda-done
'undone-face 'default
@ -13465,94 +13490,104 @@ If DATA is nil or the empty string, any tags will be removed."
"Set the tags for the current headline.
With prefix ARG, realign all tags in headings in the current buffer."
(interactive "P")
(let* ((re org-outline-regexp-bol)
(current (unless arg (org-get-tags-string)))
(col (current-column))
(org-setting-tags t)
table current-tags inherited-tags ; computed below when needed
tags p0 c0 c1 rpl di tc level)
(if arg
(save-excursion
(goto-char (point-min))
(let ((buffer-invisibility-spec (org-inhibit-invisibility)))
(while (re-search-forward re nil t)
(org-set-tags nil t)
(end-of-line 1)))
(message "All tags realigned to column %d" org-tags-column))
(if just-align
(setq tags current)
;; Get a new set of tags from the user
(save-excursion
(setq table (append org-tag-persistent-alist
(or org-tag-alist (org-get-buffer-tags))
(and
org-complete-tags-always-offer-all-agenda-tags
(org-global-tags-completion-table
(org-agenda-files))))
org-last-tags-completion-table table
current-tags (org-split-string current ":")
inherited-tags (nreverse
(nthcdr (length current-tags)
(nreverse (org-get-tags-at))))
tags
(if (or (eq t org-use-fast-tag-selection)
(and org-use-fast-tag-selection
(delq nil (mapcar 'cdr table))))
(org-fast-tag-selection
current-tags inherited-tags table
(if org-fast-tag-selection-include-todo
org-todo-key-alist))
(let ((org-add-colon-after-tag-completion (< 1 (length table))))
(org-trim
(org-icompleting-read "Tags: "
'org-tags-completion-function
nil nil current 'org-tags-history))))))
(while (string-match "[-+&]+" tags)
;; No boolean logic, just a list
(setq tags (replace-match ":" t t tags))))
(if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
(let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
'region-start-level 'region))
org-loop-over-headlines-in-active-region)
(org-map-entries
;; We don't use ARG and JUST-ALIGN here these args are not
;; useful when looping over headlines
`(org-set-tags)
org-loop-over-headlines-in-active-region
cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
(let* ((re org-outline-regexp-bol)
(current (unless arg (org-get-tags-string)))
(col (current-column))
(org-setting-tags t)
table current-tags inherited-tags ; computed below when needed
tags p0 c0 c1 rpl di tc level)
(if arg
(save-excursion
(goto-char (point-min))
(let ((buffer-invisibility-spec (org-inhibit-invisibility)))
(while (re-search-forward re nil t)
(org-set-tags nil t)
(end-of-line 1)))
(message "All tags realigned to column %d" org-tags-column))
(if just-align
(setq tags current)
;; Get a new set of tags from the user
(save-excursion
(setq table (append org-tag-persistent-alist
(or org-tag-alist (org-get-buffer-tags))
(and
org-complete-tags-always-offer-all-agenda-tags
(org-global-tags-completion-table
(org-agenda-files))))
org-last-tags-completion-table table
current-tags (org-split-string current ":")
inherited-tags (nreverse
(nthcdr (length current-tags)
(nreverse (org-get-tags-at))))
tags
(if (or (eq t org-use-fast-tag-selection)
(and org-use-fast-tag-selection
(delq nil (mapcar 'cdr table))))
(org-fast-tag-selection
current-tags inherited-tags table
(if org-fast-tag-selection-include-todo
org-todo-key-alist))
(let ((org-add-colon-after-tag-completion (< 1 (length table))))
(org-trim
(org-icompleting-read "Tags: "
'org-tags-completion-function
nil nil current 'org-tags-history))))))
(while (string-match "[-+&]+" tags)
;; No boolean logic, just a list
(setq tags (replace-match ":" t t tags))))
(setq tags (replace-regexp-in-string "[,]" ":" tags))
(setq tags (replace-regexp-in-string "[,]" ":" tags))
(if org-tags-sort-function
(setq tags (mapconcat 'identity
(sort (org-split-string
tags (org-re "[^[:alnum:]_@#%]+"))
org-tags-sort-function) ":")))
(if org-tags-sort-function
(setq tags (mapconcat 'identity
(sort (org-split-string
tags (org-re "[^[:alnum:]_@#%]+"))
org-tags-sort-function) ":")))
(if (string-match "\\`[\t ]*\\'" tags)
(setq tags "")
(unless (string-match ":$" tags) (setq tags (concat tags ":")))
(unless (string-match "^:" tags) (setq tags (concat ":" tags))))
(if (string-match "\\`[\t ]*\\'" tags)
(setq tags "")
(unless (string-match ":$" tags) (setq tags (concat tags ":")))
(unless (string-match "^:" tags) (setq tags (concat ":" tags))))
;; Insert new tags at the correct column
(beginning-of-line 1)
(setq level (or (and (looking-at org-outline-regexp)
(- (match-end 0) (point) 1))
1))
(cond
((and (equal current "") (equal tags "")))
((re-search-forward
(concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$")
(point-at-eol) t)
(if (equal tags "")
(setq rpl "")
(goto-char (match-beginning 0))
(setq c0 (current-column)
;; compute offset for the case of org-indent-mode active
di (if org-indent-mode
(* (1- org-indent-indentation-per-level) (1- level))
0)
p0 (if (equal (char-before) ?*) (1+ (point)) (point))
tc (+ org-tags-column (if (> org-tags-column 0) (- di) di))
c1 (max (1+ c0) (if (> tc 0) tc (- (- tc) (length tags))))
rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags)))
(replace-match rpl t t)
(and (not (featurep 'xemacs)) c0 indent-tabs-mode (tabify p0 (point)))
tags)
(t (error "Tags alignment failed")))
(org-move-to-column col)
(unless just-align
(run-hooks 'org-after-tags-change-hook)))))
;; Insert new tags at the correct column
(beginning-of-line 1)
(setq level (or (and (looking-at org-outline-regexp)
(- (match-end 0) (point) 1))
1))
(cond
((and (equal current "") (equal tags "")))
((re-search-forward
(concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$")
(point-at-eol) t)
(if (equal tags "")
(setq rpl "")
(goto-char (match-beginning 0))
(setq c0 (current-column)
;; compute offset for the case of org-indent-mode active
di (if org-indent-mode
(* (1- org-indent-indentation-per-level) (1- level))
0)
p0 (if (equal (char-before) ?*) (1+ (point)) (point))
tc (+ org-tags-column (if (> org-tags-column 0) (- di) di))
c1 (max (1+ c0) (if (> tc 0) tc (- (- tc) (length tags))))
rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags)))
(replace-match rpl t t)
(and (not (featurep 'xemacs)) c0 indent-tabs-mode (tabify p0 (point)))
tags)
(t (error "Tags alignment failed")))
(org-move-to-column col)
(unless just-align
(run-hooks 'org-after-tags-change-hook))))))
(defun org-change-tag-in-region (beg end tag off)
"Add or remove TAG for each entry in the region.
@ -14713,10 +14748,10 @@ in the current file."
(interactive (list nil nil))
(let* ((property (or property (org-read-property-name)))
(value (or value (org-read-property-value property)))
(fn (assoc property org-properties-postprocess-alist)))
(fn (cdr (assoc property org-properties-postprocess-alist))))
(setq org-last-set-property property)
;; Possibly postprocess the inserted value:
(when fn (setq value (funcall (cadr fn) value)))
(when fn (setq value (funcall fn value)))
(unless (equal (org-entry-get nil property) value)
(org-entry-put nil property value))))
@ -16367,7 +16402,7 @@ effort string \"2hours\" is equivalent to 120 minutes."
:type '(alist :key-type (string :tag "Modifier")
:value-type (number :tag "Minutes")))
(defun org-duration-string-to-minutes (s)
(defun org-duration-string-to-minutes (s &optional output-to-string)
"Convert a duration string S to minutes.
A bare number is interpreted as minutes, modifiers can be set by
@ -16376,15 +16411,16 @@ customizing `org-effort-durations' (which see).
Entries containing a colon are interpreted as H:MM by
`org-hh:mm-string-to-minutes'."
(let ((result 0)
(re (concat "\\([0-9]+\\) *\\("
(re (concat "\\([0-9.]+\\) *\\("
(regexp-opt (mapcar 'car org-effort-durations))
"\\)")))
(while (string-match re s)
(incf result (* (cdr (assoc (match-string 2 s) org-effort-durations))
(string-to-number (match-string 1 s))))
(setq s (replace-match "" nil t s)))
(setq result (floor result))
(incf result (org-hh:mm-string-to-minutes s))
result))
(if output-to-string (number-to-string result) result)))
;;;; Files
@ -17034,7 +17070,7 @@ Some of the options can be changed using the variable
((eq processing-type 'imagemagick)
(unless executables-checked
(org-check-external-command
"converte" "you need to install imagemagick")
"convert" "you need to install imagemagick")
(setq executables-checked t))
(unless (file-exists-p movefile)
(org-create-formula-image-with-imagemagick
@ -17237,7 +17273,8 @@ inspection."
;; Use the requested file name and clean up
(copy-file pngfile tofile 'replace)
(loop for e in '(".dvi" ".tex" ".aux" ".log" ".png" ".out") do
(delete-file (concat texfilebase e)))
(if (file-exists-p (concat texfilebase e))
(delete-file (concat texfilebase e))))
pngfile))))
(defvar org-latex-to-pdf-process) ;; Defined in org-latex.el
@ -17309,7 +17346,8 @@ inspection."
(save-match-data
(shell-quote-argument (file-name-directory texfile)))
t t cmd)))
(shell-command cmd)))
(setq cmd (split-string cmd))
(eval (append (list 'call-process (pop cmd) nil nil nil) cmd))))
(error nil))
(cd dir))
(if (not (file-exists-p pdffile))
@ -17341,7 +17379,8 @@ inspection."
;; Use the requested file name and clean up
(copy-file pngfile tofile 'replace)
(loop for e in '(".pdf" ".tex" ".aux" ".log" ".png") do
(delete-file (concat texfilebase e)))
(if (file-exists-p (concat texfilebase e))
(delete-file (concat texfilebase e))))
pngfile))))
(defun org-splice-latex-header (tpl def-pkg pkg snippets-p &optional extra)
@ -19055,13 +19094,18 @@ argument ARG, change each line in region into an item."
"Convert headings to normal text, or items or text to headings.
If there is no active region, only the current line is considered.
If the first non blank line is an headline, remove the stars from
all headlines in the region.
With a \\[universal-argument] prefix, convert the whole list at
point into heading.
If it is a plain list item, turn all plain list items into headings.
In a region:
If it is a normal line, turn each and every normal line (i.e. not
an heading or an item) in the region into a heading.
- If the first non blank line is an headline, remove the stars
from all headlines in the region.
- If it is a normal line turn each and every normal line (i.e. not an
heading or an item) in the region into a heading.
- If it is a plain list item, turn all plain list items into headings.
When converting a line into a heading, the number of stars is chosen
such that the lines become children of the current entry. However,
@ -19078,8 +19122,14 @@ stars to add."
(skip-chars-forward " \r\t\n")
(point-at-bol)))))
beg end)
;; Determine boundaries of changes. If region ends at a bol, do
;; not consider the last line to be in the region.
;; Determine boundaries of changes. If a universal prefix has
;; been given, put the list in a region. If region ends at a bol,
;; do not consider the last line to be in the region.
(when (and current-prefix-arg (org-at-item-p))
(if (equal current-prefix-arg '(4)) (setq current-prefix-arg 1))
(org-mark-list))
(if (org-region-active-p)
(setq beg (funcall skip-blanks (region-beginning))
end (copy-marker (save-excursion
@ -20401,115 +20451,116 @@ If point is in an inline task, mark that task instead."
(defun org-indent-line-function ()
"Indent line depending on context."
(interactive)
(if org-indent-line-fallback-function
(funcall org-indent-line-fallback-function)
(let* ((pos (point))
(itemp (org-at-item-p))
(case-fold-search t)
(org-drawer-regexp (or org-drawer-regexp "\000"))
(inline-task-p (and (featurep 'org-inlinetask)
(org-inlinetask-in-task-p)))
(inline-re (and inline-task-p
(org-inlinetask-outline-regexp)))
column)
(beginning-of-line 1)
(let* ((pos (point))
(itemp (org-at-item-p))
(case-fold-search t)
(org-drawer-regexp (or org-drawer-regexp "\000"))
(inline-task-p (and (featurep 'org-inlinetask)
(org-inlinetask-in-task-p)))
(inline-re (and inline-task-p
(org-inlinetask-outline-regexp)))
column)
(beginning-of-line 1)
(cond
;; Comments
((looking-at "# ") (setq column 0))
;; Headings
((looking-at org-outline-regexp) (setq column 0))
;; Included files
((looking-at "#\\+include:") (setq column 0))
;; Footnote definition
((looking-at org-footnote-definition-re) (setq column 0))
;; Literal examples
((looking-at "[ \t]*:\\( \\|$\\)")
(setq column (org-get-indentation))) ; do nothing
;; Lists
((ignore-errors (goto-char (org-in-item-p)))
(setq column (if itemp
(org-get-indentation)
(org-list-item-body-column (point))))
(goto-char pos))
;; Drawers
((and (looking-at "[ \t]*:END:")
(save-excursion (re-search-backward org-drawer-regexp nil t)))
(save-excursion
(goto-char (1- (match-beginning 1)))
(setq column (current-column))))
;; Special blocks
((and (looking-at "[ \t]*#\\+end_\\([a-z]+\\)")
(save-excursion
(re-search-backward
(concat "^[ \t]*#\\+begin_" (downcase (match-string 1))) nil t)))
(setq column (org-get-indentation (match-string 0))))
((and (not (looking-at "[ \t]*#\\+begin_"))
(org-between-regexps-p "^[ \t]*#\\+begin_" "[ \t]*#\\+end_"))
(save-excursion
(re-search-backward "^[ \t]*#\\+begin_\\([a-z]+\\)" nil t))
(setq column
(cond ((equal (downcase (match-string 1)) "src")
;; src blocks: let `org-edit-src-exit' handle them
(org-get-indentation))
((equal (downcase (match-string 1)) "example")
(max (org-get-indentation)
(org-get-indentation (match-string 0))))
(t
(org-get-indentation (match-string 0))))))
;; This line has nothing special, look at the previous relevant
;; line to compute indentation
(t
(beginning-of-line 0)
(while (and (not (bobp))
(not (looking-at org-drawer-regexp))
;; When point started in an inline task, do not move
;; above task starting line.
(not (and inline-task-p (looking-at inline-re)))
;; Skip drawers, blocks, empty lines, verbatim,
;; comments, tables, footnotes definitions, lists,
;; inline tasks.
(or (and (looking-at "[ \t]*:END:")
(re-search-backward org-drawer-regexp nil t))
(and (looking-at "[ \t]*#\\+end_")
(re-search-backward "[ \t]*#\\+begin_"nil t))
(looking-at "[ \t]*[\n:#|]")
(looking-at org-footnote-definition-re)
(and (ignore-errors (goto-char (org-in-item-p)))
(goto-char
(org-list-get-top-point (org-list-struct))))
(and (not inline-task-p)
(featurep 'org-inlinetask)
(org-inlinetask-in-task-p)
(or (org-inlinetask-goto-beginning) t))))
(beginning-of-line 0))
(cond
;; Comments
((looking-at "# ") (setq column 0))
;; Headings
((looking-at org-outline-regexp) (setq column 0))
;; Included files
((looking-at "#\\+include:") (setq column 0))
;; Footnote definition
((looking-at org-footnote-definition-re) (setq column 0))
;; Literal examples
((looking-at "[ \t]*:\\( \\|$\\)")
(setq column (org-get-indentation))) ; do nothing
;; Lists
((ignore-errors (goto-char (org-in-item-p)))
(setq column (if itemp
(org-get-indentation)
(org-list-item-body-column (point))))
(goto-char pos))
;; Drawers
((and (looking-at "[ \t]*:END:")
(save-excursion (re-search-backward org-drawer-regexp nil t)))
(save-excursion
(goto-char (1- (match-beginning 1)))
;; There was an heading above.
((looking-at "\\*+[ \t]+")
(if (not org-adapt-indentation)
(setq column 0)
(goto-char (match-end 0))
(setq column (current-column))))
;; Special blocks
((and (looking-at "[ \t]*#\\+end_\\([a-z]+\\)")
(save-excursion
(re-search-backward
(concat "^[ \t]*#\\+begin_" (downcase (match-string 1))) nil t)))
(setq column (org-get-indentation (match-string 0))))
((and (not (looking-at "[ \t]*#\\+begin_"))
(org-between-regexps-p "^[ \t]*#\\+begin_" "[ \t]*#\\+end_"))
(save-excursion
(re-search-backward "^[ \t]*#\\+begin_\\([a-z]+\\)" nil t))
(setq column
(cond ((equal (downcase (match-string 1)) "src")
;; src blocks: let `org-edit-src-exit' handle them
(org-get-indentation))
((equal (downcase (match-string 1)) "example")
(max (org-get-indentation)
(org-get-indentation (match-string 0))))
(t
(org-get-indentation (match-string 0))))))
;; This line has nothing special, look at the previous relevant
;; line to compute indentation
(t
(beginning-of-line 0)
(while (and (not (bobp))
(not (looking-at org-drawer-regexp))
;; When point started in an inline task, do not move
;; above task starting line.
(not (and inline-task-p (looking-at inline-re)))
;; Skip drawers, blocks, empty lines, verbatim,
;; comments, tables, footnotes definitions, lists,
;; inline tasks.
(or (and (looking-at "[ \t]*:END:")
(re-search-backward org-drawer-regexp nil t))
(and (looking-at "[ \t]*#\\+end_")
(re-search-backward "[ \t]*#\\+begin_"nil t))
(looking-at "[ \t]*[\n:#|]")
(looking-at org-footnote-definition-re)
(and (ignore-errors (goto-char (org-in-item-p)))
(goto-char
(org-list-get-top-point (org-list-struct))))
(and (not inline-task-p)
(featurep 'org-inlinetask)
(org-inlinetask-in-task-p)
(or (org-inlinetask-goto-beginning) t))))
(beginning-of-line 0))
(cond
;; There was an heading above.
((looking-at "\\*+[ \t]+")
(if (not org-adapt-indentation)
(setq column 0)
(goto-char (match-end 0))
(setq column (current-column))))
;; A drawer had started and is unfinished
((looking-at org-drawer-regexp)
(goto-char (1- (match-beginning 1)))
(setq column (current-column)))
;; Else, nothing noticeable found: get indentation and go on.
(t (setq column (org-get-indentation))))))
;; Now apply indentation and move cursor accordingly
(goto-char pos)
(if (<= (current-column) (current-indentation))
(org-indent-line-to column)
(save-excursion (org-indent-line-to column)))
;; Special polishing for properties, see `org-property-format'
(setq column (current-column))
(beginning-of-line 1)
(if (looking-at
"\\([ \t]+\\)\\(:[-_0-9a-zA-Z]+:\\)[ \t]*\\(\\S-.*\\(\\S-\\|$\\)\\)")
(replace-match (concat (match-string 1)
(format org-property-format
(match-string 2) (match-string 3)))
t t))
(org-move-to-column column))))
;; A drawer had started and is unfinished
((looking-at org-drawer-regexp)
(goto-char (1- (match-beginning 1)))
(setq column (current-column)))
;; Else, nothing noticeable found: get indentation and go on.
(t (setq column (org-get-indentation))))))
;; Now apply indentation and move cursor accordingly
(goto-char pos)
(if (<= (current-column) (current-indentation))
(org-indent-line-to column)
(save-excursion (org-indent-line-to column)))
;; Special polishing for properties, see `org-property-format'
(setq column (current-column))
(beginning-of-line 1)
(if (looking-at
"\\([ \t]+\\)\\(:[-_0-9a-zA-Z]+:\\)[ \t]*\\(\\S-.*\\(\\S-\\|$\\)\\)")
(replace-match (concat (match-string 1)
(format org-property-format
(match-string 2) (match-string 3)))
t t))
(org-move-to-column column)
(when (and orgstruct-is-++ (eq pos (point)))
(org-let org-fb-vars
'(indent-according-to-mode)))))
(defun org-indent-drawer ()
"Indent the drawer at point."
@ -20552,6 +20603,8 @@ If point is in an inline task, mark that task instead."
(when folded (org-cycle)))
(message "Block at point indented"))
;; For reference, this is the default value of adaptive-fill-regexp
;; "[ \t]*\\([-|#;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*"
(defvar org-adaptive-fill-regexp-backup adaptive-fill-regexp
"Variable to store copy of `adaptive-fill-regexp'.
Since `adaptive-fill-regexp' is set to never match, we need to
@ -20704,15 +20757,13 @@ the functionality can be provided as a fall-back.")
(narrow-to-region (1+ (match-end 0))
(save-excursion (forward-paragraph 1) (point)))
(fill-paragraph justify) t))
;; Else falls back on `org-fill-paragraph-fallback-function'
(org-fill-paragraph-fallback-function
(funcall org-fill-paragraph-fallback-function justify))
;; Else simply call `fill-paragraph'.
;; Else fall back on fill-paragraph-function as possibly
;; defined in `org-fb-vars'
(orgstruct-is-++
(org-let org-fb-vars
'(fill-paragraph justify)))
(t nil))))
;; For reference, this is the default value of adaptive-fill-regexp
;; "[ \t]*\\([-|#;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*"
(defun org-adaptive-fill-function ()
"Return a fill prefix for org-mode files."
(let (itemp)
@ -20742,19 +20793,19 @@ the functionality can be provided as a fall-back.")
(defun org-auto-fill-function ()
"Auto-fill function."
(let (itemp prefix)
;; When in a list, compute an appropriate fill-prefix and make
;; sure it will be used by `do-auto-fill'.
(cond ((setq itemp (org-in-item-p))
(progn
(setq prefix (make-string (org-list-item-body-column itemp) ?\ ))
(flet ((fill-context-prefix (from to &optional flr) prefix))
(do-auto-fill))))
(org-auto-fill-fallback-function
(let ((fill-prefix ""))
(funcall org-auto-fill-fallback-function)))
;; Else just use `do-auto-fill'.
(t (do-auto-fill)))))
(unless (and org-src-prevent-auto-filling (org-in-src-block-p))
(let (itemp prefix)
;; When in a list, compute an appropriate fill-prefix and make
;; sure it will be used by `do-auto-fill'.
(cond ((setq itemp (org-in-item-p))
(progn
(setq prefix (make-string (org-list-item-body-column itemp) ?\ ))
(flet ((fill-context-prefix (from to &optional flr) prefix))
(do-auto-fill))))
(orgstruct-is-++
(org-let org-fb-vars
'(do-auto-fill)))
(t (do-auto-fill))))))
;;; Other stuff.

1660
testing/lisp/test-org-element.el
View File

File diff suppressed because it is too large Load Diff

60
testing/lisp/test-org-export.el
View File

@ -74,12 +74,12 @@ already filled in `info'."
(equal
(org-export-parse-option-keyword
"arch:headline creator:comment d:(\"TEST\")
^:{} toc:1 tags:not-in-toc tasks:todo num:2")
^:{} toc:1 tags:not-in-toc tasks:todo num:2 <:active")
'( :section-numbers
2
:with-archived-trees headline :with-creator comment
:with-drawers ("TEST") :with-sub-superscript {} :with-toc 1
:with-tags not-in-toc :with-tasks todo))))
:with-tags not-in-toc :with-tasks todo :with-timestamps active))))
(ert-deftest test-org-export/get-inbuffer-options ()
"Test reading all standard export keywords."
@ -207,12 +207,48 @@ already filled in `info'."
(org-test-with-temp-text ":TEST:\ncontents\n:END:"
(org-test-with-backend "test"
(should (equal (org-export-as 'test nil nil nil '(:with-drawers nil))
"")))))
(let ((org-drawers '("TEST")))
(org-test-with-temp-text ":TEST:\ncontents\n:END:"
(org-test-with-backend "test"
""))
(should (equal (org-export-as 'test nil nil nil '(:with-drawers t))
":TEST:\ncontents\n:END:\n"))))))
":TEST:\ncontents\n:END:\n")))))
(let ((org-drawers '("FOO" "BAR")))
(org-test-with-temp-text ":FOO:\nkeep\n:END:\n:BAR:\nremove\n:END:"
(org-test-with-backend "test"
(should
(equal (org-export-as 'test nil nil nil '(:with-drawers ("FOO")))
":FOO:\nkeep\n:END:\n")))))
;; Timestamps.
(org-test-with-temp-text "[2012-04-29 sun. 10:45]<2012-04-29 sun. 10:45>"
(org-test-with-backend "test"
(should
(equal (org-export-as 'test nil nil nil '(:with-timestamps t))
"[2012-04-29 sun. 10:45]<2012-04-29 sun. 10:45>\n"))
(should
(equal (org-export-as 'test nil nil nil '(:with-timestamps nil)) ""))
(should
(equal (org-export-as 'test nil nil nil '(:with-timestamps active))
"<2012-04-29 sun. 10:45>\n"))
(should
(equal (org-export-as 'test nil nil nil '(:with-timestamps inactive))
"[2012-04-29 sun. 10:45]\n"))))
;; Clocks.
(let ((org-clock-string "CLOCK:"))
(org-test-with-temp-text "CLOCK: [2012-04-29 sun. 10:45]"
(org-test-with-backend "test"
(should
(equal (org-export-as 'test nil nil nil '(:with-clocks t))
"CLOCK: [2012-04-29 sun. 10:45]\n"))
(should
(equal (org-export-as 'test nil nil nil '(:with-clocks nil)) "")))))
;; Plannings.
(let ((org-closed-string "CLOSED:"))
(org-test-with-temp-text "CLOSED: [2012-04-29 sun. 10:45]"
(org-test-with-backend "test"
(should
(equal (org-export-as 'test nil nil nil '(:with-plannings t))
"CLOSED: [2012-04-29 sun. 10:45]\n"))
(should
(equal (org-export-as 'test nil nil nil '(:with-plannings nil))
""))))))
(ert-deftest test-org-export/comment-tree ()
"Test if export process ignores commented trees."
@ -267,7 +303,7 @@ text
(ert-deftest test-org-export/export-snippet ()
"Test export snippets transcoding."
(org-test-with-temp-text "@test{A}@t{B}"
(org-test-with-temp-text "<test@A><t@B>"
(org-test-with-backend "test"
(flet ((org-test-export-snippet
(snippet contents info)
@ -688,8 +724,8 @@ Another text. (ref:text)
(org-element-map
(org-element-parse-buffer) 'table 'identity nil 'first-match)))))
(ert-deftest test-org-export/special-row ()
"Test if special rows in a table are properly recognized."
(ert-deftest test-org-export/table-row-is-special-p ()
"Test `org-export-table-row-is-special-p' specifications."
;; 1. A row is special if it has a special marking character in the
;; special column.
(org-test-with-parsed-data "| ! | 1 |"
@ -710,7 +746,7 @@ Another text. (ref:text)
(org-export-table-row-is-special-p
(org-element-map tree 'table-row 'identity nil 'first-match) info)))
;; 4. Everything else isn't considered as special.
(org-test-with-parsed-data "| a | | c |"
(org-test-with-parsed-data "| \alpha | | c |"
(should-not
(org-export-table-row-is-special-p
(org-element-map tree 'table-row 'identity nil 'first-match) info)))
@ -858,7 +894,7 @@ Another text. (ref:text)
(org-test-with-temp-text "
| text |
| some text |
| 12345 |"
| \alpha |"
(let* ((tree (org-element-parse-buffer))
(info `(:parse-tree ,tree)))
(should

163
testing/lisp/test-org-list.el
View File

@ -358,6 +358,169 @@
- Item 3.1
"))))
(ert-deftest test-org-list/move-item-down ()
"Test `org-move-item-down' specifications."
;; Standard test.
(org-test-with-temp-text "- item 1\n- item 2"
(org-move-item-down)
(should (equal (buffer-string)
"- item 2\n- item 1")))
;; Keep same column in item.
(org-test-with-temp-text "- item 1\n- item 2"
(forward-char 4)
(org-move-item-down)
(should (looking-at "em 1")))
;; Move sub-items.
(org-test-with-temp-text "- item 1\n - sub-item 1\n- item 2"
(org-move-item-down)
(should (equal (buffer-string)
"- item 2\n- item 1\n - sub-item 1")))
;; Preserve blank lines.
(org-test-with-temp-text "- item 1\n\n- item 2"
(let ((org-empty-line-terminates-plain-lists nil)) (org-move-item-down))
(should (equal (buffer-string) "- item 2\n\n- item 1")))
;; Error when trying to move the last item...
(org-test-with-temp-text "- item 1\n- item 2"
(forward-line)
(should-error (org-move-item-down)))
;; ... unless `org-list-use-circular-motion' is non-nil. In this
;; case, move to the first item.
(org-test-with-temp-text "- item 1\n- item 2\n- item 3"
(forward-line 2)
(let ((org-list-use-circular-motion t)) (org-move-item-down))
(should (equal (buffer-string) "- item 3\n- item 1\n- item 2\n")))
;; Preserve item visibility.
(org-test-with-temp-text "* Headline\n- item 1\n body 1\n- item 2\n body 2"
(let ((org-cycle-include-plain-lists t))
(search-forward "- item 1")
(org-cycle)
(search-forward "- item 2")
(org-cycle))
(search-backward "- item 1")
(org-move-item-down)
(forward-line)
(should (org-invisible-p2))
(search-backward " body 2")
(should (org-invisible-p2)))
;; Preserve children visibility.
(org-test-with-temp-text "* Headline
- item 1
- sub-item 1
sub-body 1
- item 2
- sub-item 2
sub-body 2"
(let ((org-cycle-include-plain-lists t))
(search-forward "- sub-item 1")
(org-cycle)
(search-forward "- sub-item 2")
(org-cycle))
(search-backward "- item 1")
(org-move-item-down)
(search-forward "sub-body 1")
(should (org-invisible-p2))
(search-backward "sub-body 2")
(should (org-invisible-p2)))
;; Preserve contents visibility.
(org-test-with-temp-text "
- item 1
#+BEGIN_CENTER
Text1
#+END_CENTER
- item 2
#+BEGIN_CENTER
Text2
#+END_CENTER"
(org-hide-block-all)
(search-forward "- item 1")
(org-move-item-down)
(search-forward "Text1")
(should (org-invisible-p2))
(search-backward "Text2")
(should (org-invisible-p2))))
(ert-deftest test-org-list/move-item-up ()
"Test `org-move-item-up' specifications."
;; Standard test.
(org-test-with-temp-text "- item 1\n- item 2"
(forward-line)
(org-move-item-up)
(should (equal (buffer-string)
"- item 2\n- item 1")))
;; Keep same column in item.
(org-test-with-temp-text "- item 1\n- item 2"
(forward-line)
(forward-char 4)
(org-move-item-up)
(should (looking-at "em 2")))
;; Move sub-items.
(org-test-with-temp-text "- item 1\n- item 2\n - sub-item 2"
(forward-line)
(org-move-item-up)
(should (equal (buffer-string)
"- item 2\n - sub-item 2\n- item 1")))
;; Preserve blank lines.
(org-test-with-temp-text "- item 1\n\n- item 2"
(search-forward "- item 2")
(let ((org-empty-line-terminates-plain-lists nil)) (org-move-item-up))
(should (equal (buffer-string) "- item 2\n\n- item 1")))
;; Error when trying to move the first item...
(org-test-with-temp-text "- item 1\n- item 2"
(should-error (org-move-item-up)))
;; ... unless `org-list-use-circular-motion' is non-nil. In this
;; case, move to the first item.
(org-test-with-temp-text "- item 1\n- item 2\n- item 3"
(let ((org-list-use-circular-motion t)) (org-move-item-up))
(should (equal (buffer-string) "- item 2\n- item 3\n- item 1")))
;; Preserve item visibility.
(org-test-with-temp-text "* Headline\n- item 1\n body 1\n- item 2\n body 2"
(let ((org-cycle-include-plain-lists t))
(search-forward "- item 1")
(org-cycle)
(search-forward "- item 2")
(org-cycle))
(org-move-item-up)
(forward-line)
(should (org-invisible-p2))
(search-forward " body 1")
(should (org-invisible-p2)))
;; Preserve children visibility.
(org-test-with-temp-text "* Headline
- item 1
- sub-item 1
sub-body 1
- item 2
- sub-item 2
sub-body 2"
(let ((org-cycle-include-plain-lists t))
(search-forward "- sub-item 1")
(org-cycle)
(search-forward "- sub-item 2")
(org-cycle))
(search-backward "- item 2")
(org-move-item-up)
(search-forward "sub-body 2")
(should (org-invisible-p2))
(search-forward "sub-body 1")
(should (org-invisible-p2)))
;; Preserve contents visibility.
(org-test-with-temp-text "
- item 1
#+BEGIN_CENTER
Text1
#+END_CENTER
- item 2
#+BEGIN_CENTER
Text2
#+END_CENTER"
(org-hide-block-all)
(search-forward "- item 2")
(org-move-item-up)
(search-forward "Text2")
(should (org-invisible-p2))
(search-forward "Text1")
(should (org-invisible-p2))))
(provide 'test-org-list)
;;; test-org-list.el ends here