procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Update to Org mode 7.4

Browse source
This commit is contained in:
Carsten Dominik 2010-12-11 17:42:53 +01:00
parent 39321b94bf
commit acedf35ce0
101 changed files with 4236 additions and 2707 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
doc/misc/ChangeLog
View file

@ -1,3 +1,25 @@
2010-12-11 Carsten Dominik <carsten.dominik@gmail.com>
* org.texi (Using capture): Document using prefix arguments for
finalizing capture.
(Agenda commands): Document prefix argument for the bulk scatter
command.
(Beamer class export): Document that also overlay arguments can be
passed to the column environment.
(Template elements): Document the new entry type.
2010-12-11 Puneeth Chaganti <punchagan@gmail.com>
* org.texi (Include files): Document :minlevel.
2010-12-11 Julien Danjou <julien@danjou.info>
* org.texi (Categories): Document category icons.
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* org.texi (noweb): Fix typo.
2010-12-06 Tassilo Horn <tassilo@member.fsf.org>
* gnus.texi (Server Commands): Point to the rest of the server

2073
doc/misc/org.texi
View file

File diff suppressed because it is too large Load diff

4
etc/ChangeLog
View file

@ -1,3 +1,7 @@
2010-12-11 Carsten Dominik <carsten.dominik@gmail.com>
* refcards/orgcard.tex: Cleanup.
2010-11-27 Ulrich Mueller <ulm@gentoo.org>
* HELLO: Add ancient Greek (Bug#7418).

151
etc/refcards/orgcard.tex
View file

@ -1,5 +1,5 @@
% Reference Card for Org Mode
\def\orgversionnumber{7.3}
\def\orgversionnumber{7.4}
\def\versionyear{2010} % latest update
\def\year{2010} % latest copyright year
@ -266,6 +266,10 @@
\def\threecol#1#2#3{\hskip\keyindent\relax#1\hfil&\kbd{#2}\hfil\quad
&\kbd{#3}\hfil\quad\cr}
\def\noteone{{\small \hfill [1]}}
\def\notetwo{{\small \hfill [2]}}
%**end of header
@ -274,14 +278,6 @@
\centerline{(for version \orgversionnumber)}
\section{Getting Started}
%
%\vskip -2mm
%\beginexample%
%(add-to-list 'auto-mode-alist '("\\\\.org\$" . org-mode))
%(define-key global-map "\\C-cl" 'org-store-link)$^1$
%(define-key global-map "\\C-ca" 'org-agenda)$^1$
%\endexample
%
\metax{To read the on-line documentation try}{M-x org-info}
\section{Visibility Cycling}
@ -298,7 +294,7 @@ \section{Motion}
\key{next/previous heading, same level}{C-c C-f/b}
\key{backward to higher level heading}{C-c C-u}
\key{jump to another place in document}{C-c C-j}
\key{previous/next plain list item}{S-UP/DOWN$^3$}
\key{previous/next plain list item}{S-UP/DOWN\notetwo}
\section{Structure Editing}
@ -310,17 +306,16 @@ \section{Structure Editing}
\key{turn item/line into headline}{C-c *}
\key{promote/demote heading}{M-LEFT/RIGHT}
\metax{promote/demote current subtree}{M-S-LEFT/RIGHT}
\metax{move subtree/list item up/down}{M-S-UP/DOWN}
\metax{sort subtree/region/plain-list}{C-c \^{}}
\metax{clone a subtree}{C-c C-x c}
\metax{refile subtree}{C-c C-w}
\metax{kill/copy subtree}{C-c C-x C-w/M-w}
\metax{yank subtree}{C-c C-x C-y or C-y}
\metax{narrow buffer to subtree / widen}{C-x n s/w}
\section{Archiving}
\section{Capture - Refile - Archiving}
\key{capture a new item (C-u C-u = goto last)}{C-c c \noteone}
\key{refile subtree (C-u C-u = goto last)}{C-c C-w}
\key{archive subtree using the default command}{C-c C-x C-a}
\key{move subtree to archive file}{C-c C-x C-s}
\key{toggle ARCHIVE tag / to ARCHIVE sibling}{C-c C-x a/A}
@ -330,7 +325,7 @@ \section{Filtering and Sparse Trees}
\key{construct a sparse tree by various criteria}{C-c /}
\key{view TODO's in sparse tree}{C-c / t/T}
\key{global TODO list in agenda mode}{C-c a t$^1$}
\key{global TODO list in agenda mode}{C-c a t \noteone}
\key{time sorted view of current org file}{C-c a L}
\section{Tables}
@ -428,7 +423,7 @@ \section{Tables}
\section{Links}
\key{globally store link to the current location}{C-c l$^1$}
\key{globally store link to the current location}{C-c l \noteone}
\key{insert a link (TAB completes stored links)}{C-c C-l}
\key{insert file link with file name completion}{C-u C-c C-l}
\key{edit (also hidden part of) link at point}{C-c C-l}
@ -444,35 +439,6 @@ \section{Links}
\key{edit code snippet of file at point}{C-c '}
\key{toggle inline display of linked images}{C-c C-x C-v}
% {\bf Internal Links}
% \key{\kbd{<<My Target>>}}{\rm target}
% \key{\kbd{<<<My Target>>>}}{\rm radio target$^2$}
% \key{\kbd{[[*this text]]}}{\rm find headline}
% \metax{\kbd{[[this text]]}}{\rm find target or text in buffer}
% \metax{\kbd{[[this text][description]]}}{\rm optional link text}
% {\bf External Links}
% \key{\kbd{file:/home/dominik/img/mars.jpg}}{\rm file, absolute}
% \key{\kbd{file:papers/last.pdf}}{\rm file, relative}
% \key{\kbd{file:projects.org::*that text}}{\rm find headline}
% \key{\kbd{file:projects.org::find me}}{\rm find trgt/string}
% %\key{\kbd{file:projects.org::/regexp/}}{\rm regexp search}
% \key{\kbd{http://www.astro.uva.nl/~dominik}}{\rm on the web}
% \key{\kbd{mailto:adent@galaxy.net}}{\rm Email address}
% \key{\kbd{news:comp.emacs}}{\rm Usenet group}
% \key{\kbd{bbdb:Richard Stallman}}{\rm BBDB person}
% \key{\kbd{gnus:group}}{\rm GNUS group}
% \key{\kbd{gnus:group\#id}}{\rm GNUS message}
% \key{\kbd{vm|wl|mhe|rmail:folder}}{\rm Mail folder}
% \key{\kbd{vm|wl|mhe|rmail:folder\#id}}{\rm Mail message}
% \key{\kbd{info:emacs:Regexps}}{\rm Info file:node}
% \key{\kbd{shell:ls *.org}}{\rm shell command}
% \key{\kbd{elisp:(calendar)}}{\rm elisp form}
% \metax{\kbd{[[external link][description]]}}{\rm optional link text}
% %\key{\kbd{vm://myself@some.where.org/folder\#id}}{\rm VM remote}
\section{Working with Code (Babel)}
\key{execute code block at point}{C-c C-c}
@ -494,25 +460,6 @@ \section{Working with Code (Babel)}
\key{load expanded body of the current code block into a session}{C-c C-v l}
\key{view sha1 hash of the current code block}{C-c C-v a}
% \section{Remember-mode Integration}
% See the manual for how to make remember.el use Org-mode links and
% files. The note-finishing command \kbd{C-c C-c} will first prompt for
% an org file. In the file, find a location with:
% \key{rotate subtree visibility}{TAB}
% \key{next heading}{DOWN}
% \key{previous heading}{UP}
% Insert the note with one of the following:
% \key{as sublevel of heading at cursor}{RET}
% \key{right here (cursor not on heading)}{RET}
% \key{before current heading}{LEFT}
% \key{after current heading}{RIGHT}
% \key{shortcut to end of buffer (cursor at buf-start)}{RET}
% \key{Abort}{q}
\section{Completion}
In-buffer completion completes TODO keywords at headline start, TeX
@ -538,11 +485,7 @@ \section{TODO Items and Checkboxes}
\key{set the priority of the current item}{C-c , [ABC]}
\key{remove priority cookie from current item}{C-c , SPC}
\key{raise/lower priority of current item}{S-UP/DOWN$^3$}
%\key{lower priority of current item}{S-DOWN$^3$}
%\key{\kbd{\#+SEQ_TODO: TODO TRY BLUFF DONE}}{\rm todo workflow}
%\key{\kbd{\#+TYP_TODO: Phil home work DONE}}{\rm todo types}
\key{raise/lower priority of current item}{S-UP/DOWN\notetwo}
\key{insert new checkbox item in plain list}{M-S-RET}
\key{toggle checkbox(es) in region/entry/at point}{C-c C-x C-b}
@ -585,8 +528,8 @@ \section{Timestamps}
\key{insert SCHEDULED timestamp}{C-c C-s}
\key{create sparse tree with all deadlines due}{C-c / d}
\key{the time between 2 dates in a time range}{C-c C-y}
\key{change timestamp at cursor by $\pm 1$ day}{S-RIGHT/LEFT$^3$}
\key{change year/month/day at cursor by $\pm 1$}{S-UP/DOWN$^3$}
\metax{change timestamp at cursor $\pm 1$ day}{S-RIGHT/LEFT\notetwo}
\key{change year/month/day at cursor by $\pm 1$}{S-UP/DOWN\notetwo}
\key{access the calendar for the current date}{C-c >}
\key{insert timestamp matching date in calendar}{C-c <}
\key{access agenda for current date}{C-c C-o}
@ -615,15 +558,15 @@ \section{Agenda Views}
\key{cycle through agenda file list}{C-'}
\key{set/remove restriction lock}{C-c C-x </>}
\key{compile agenda for the current week}{C-c a a$^1$}
\key{compile global TODO list}{C-c a t$^1$}
\key{compile TODO list for specific keyword}{C-c a T$^1$}
\key{match tags, TODO kwds, properties}{C-c a m$^1$}
\key{match only in TODO entries}{C-c a M$^1$}
\key{find stuck projects}{C-c a \#$^1$}
\key{show timeline of current org file}{C-c a L$^1$}
\key{configure custom commands}{C-c a C$^1$}
%\key{configure stuck projects}{C-c a !$^1$}
\key{compile agenda for the current week}{C-c a a \noteone}
\key{compile global TODO list}{C-c a t \noteone}
\key{compile TODO list for specific keyword}{C-c a T \noteone}
\key{match tags, TODO kwds, properties}{C-c a m \noteone}
\key{match only in TODO entries}{C-c a M \noteone}
\key{find stuck projects}{C-c a \# \noteone}
\key{show timeline of current org file}{C-c a L \noteone}
\key{configure custom commands}{C-c a C \noteone}
%\key{configure stuck projects}{C-c a ! \noteone}
\key{agenda for date at cursor}{C-c C-o}
{\bf Commands available in an agenda buffer}
@ -664,10 +607,10 @@ \section{Agenda Views}
\key{set/show tags of current headline}{: / T}
\key{set effort property (prefix=nth)}{e}
\key{set / compute priority of current item}{, / P}
\key{raise/lower priority of current item}{S-UP/DOWN$^3$}
\key{raise/lower priority of current item}{S-UP/DOWN\notetwo}
\key{run an attachment command}{C-c C-a}
\key{schedule/set deadline for this item}{C-c C-s/d}
\key{change timestamp to one day earlier/later}{S-LEFT/RIGHT$^3$}
\metax{change timestamp one day earlier/later}{S-LEFT/RIGHT\notetwo}
\key{change timestamp to today}{>}
\key{insert new entry into diary}{i}
\newcolumn
@ -713,43 +656,6 @@ \section{Exporting and Publishing}
\key{toggle fixed width for entry or region}{C-c :}
\key{toggle pretty display of scripts, entities}{C-c C-x {\tt\char`\\}}
%{\bf HTML formatting}
%\key{make words {\bf bold}}{*bold*}
%\key{make words {\it italic}}{/italic/}
%\key{make words \underbar{underlined}}{_underlined_}
%\key{sub- and superscripts}{x\^{}3, J_dust}
%\key{\TeX{}-like macros}{\\alpha, \\to}
%\key{typeset lines in fixed width font}{start with :}
%\key{tables are exported as HTML tables}{start with |}
%\key{links become HTML links}{http:... etc}
%\key{include html tags}{@<b>...@</b>}
%{\bf Export options}
%
%Include additional information for export by putting these anywhere in the
%org file. Use {\tt M-TAB} completion to make sure to get the right
%keywords. {\tt M-TAB} again just after keyword is complete inserts examples.
%
%\key{the title to be shown}{\#+TITLE:}
%\key{the author}{\#+AUTHOR:}
%\key{authors email address}{\#+EMAIL:}
%\key{language code for html}{\#+LANGUAGE:}
%\key{free text description of file}{\#+TEXT:}
%\key{... which can carry over multiple lines}{\#+TEXT:}
%\key{settings for the export process}{\#+OPTIONS:}
%\key{set number of headline levels for export}{H:2}
%\key{turn on/off section numbers}{num:t}
%\key{turn on/off table of contents}{toc:t}
%\key{turn on/off linebreak preservation}{\\n:nil}
%\key{turn on/off quoted html tags}{@:t}
%\key{turn on/off fixed width sections}{::t}
%\key{turn on/off tables}{|:t}
%\key{turn on/off \TeX\ syntax for sub/super-scripts}{\^{}:t}
%\key{turn on/off emphasised text}{*:nil}
%\key{turn on/off \TeX\ macros}{TeX:t}
{\bf Comments: Text not being exported}
Lines starting with \kbd{\#} and subtrees starting with COMMENT are
@ -763,13 +669,10 @@ \section{Dynamic Blocks}
\metax{update all dynamic blocks}{C-u C-c C-x C-u}
\section{Notes}
$^1$ This is only a suggestion for a binding of this command. Choose
[1] This is only a suggestion for a binding of this command. Choose
your own key as shown under INSTALLATION.
$^2$ After changing a \kbd{\#+KEYWORD} or \kbd{<<<target>>>} line,
press \kbd{C-c C-c} with the cursor still in the line to update.
$^3$ Keybinding affected by {\tt org-support-shift-select} and
[2] Keybinding affected by {\tt org-support-shift-select} and also
{\tt org-replace-disputed-keys}.
\copyrightnotice

681
lisp/org/ChangeLog
View file

@ -1,3 +1,684 @@
2010-12-11 Tassilo Horn <tassilo@member.fsf.org>
* org-footnote.el (org-footnote-create-definition): Place
Footnotes section before message-signature-separator also in modes
derived from message-mode.
2010-12-11 Julien Danjou <julien@danjou.info>
* org.el (org-make-tags-matcher): Remove useless cat-p value.
2010-12-11 Julien Danjou <julien@danjou.info>
* org.el (org-entry-properties): Enhance docstring.
2010-12-11 Nicolas Goaziou <n.goaziou@gmail.com>
* org-list.el (org-list-top-point-with-indent)
(org-list-bottom-point-with-indent): Pay also attention to
'original-indentation property of text, as blocks are put to
column 0 upon exporting.
2010-12-11 Dan Davison <dandavison7@gmail.com>
* ob.el (org-babel-remove-temporary-directory): Handle exception
with message informing of failure to remove directory.
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob-clojure.el (org-babel-header-arg-names:clojure): Add
`package' to the list of Clojure header arguments which will be read
from heading properties.
2010-12-11 Nicolas Goaziou <n.goaziou@gmail.com>
* org-inlinetask.el (org-inlinetask-export-templates): Add
Sébastien Vauban's suggestion for LaTeX export in docstring. This is
not default as it requires an additional LaTeX package: "todonotes".
2010-12-11 Nicolas Goaziou <n.goaziou@gmail.com>
* org-inlinetask.el (org-inlinetask-export-templates): New variable.
* org-inlinetask.el (org-inlinetask-export-handler): Make use of
templates to export inline tasks.
2010-12-11 Nicolas Goaziou <n.goaziou@gmail.com>
* org.el (org-current-level): Ignore inline tasks when getting current
level of entry.
2010-12-11 Nicolas Goaziou <n.goaziou@gmail.com>
* org.el (org-indent-line-function): Ignore drawers inside inline
tasks if the line to indent isn't inside an inline task itself.
2010-12-11 Nicolas Goaziou <n.goaziou@gmail.com>
* org-inlinetask.el (org-inlinetask-get-task-level): New function.
* org-indent.el (org-indent-add-properties): Find true level of
indentation wrt inline tasks.
2010-12-11 Nicolas Goaziou <n.goaziou@gmail.com>
* org-inlinetask.el (org-inlinetask-outline-regexp): New function.
* org-inlinetask.el (org-inlinetask-goto-beginning): New function.
* org-inlinetask.el (org-inlinetask-goto-end): New function.
* org.el (org-mark-subtree): New command.
* org.el (org-speed-commands-default, org-mode-map): Make use of
new command.
2010-12-11 Nicolas Goaziou <n.goaziou@gmail.com>
* org-inlinetask.el (org-inlinetask-export-handler): Remove protection
from @<span class...> so it can be removed during LaTeX export.
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob.el (org-babel-insert-result): More informative code block
evaluation messages.
2010-12-11 Matt Lundin <mdl@imapmail.org>
* org.el (org-make-heading-search-string): Optionally limit number
of lines stored in file link search strings.
(org-context-in-file-links) Add option to set to integer specifying
number of lines.
2010-12-11 Carsten Dominik <carsten.dominik@gmail.com>
* org-capture.el (org-capture-finalize): New prefix argument
STAY-WITH-CAPTURE.
(org-capture-refile): Improve docstring.
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob-sql.el (org-babel-execute:sql): Add msosql as optional sql
interaction engine.
2010-12-11 Carsten Dominik <carsten.dominik@gmail.com>
* org-agenda.el (org-agenda-list):
(org-agenda-goto-today): Use `org-today'.
2010-12-11 Carsten Dominik <carsten.dominik@gmail.com>
* org-latex.el (org-export-latex-make-header): Swap \begin{document}
and the title/author definitions.
2010-12-11 Carsten Dominik <carsten.dominik@gmail.com>
* org-macs.el: Better backup definition for
`with-silent-modifications'.
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob-python.el (org-babel-execute:python): Rename "prefix" to
"preamble".
(org-babel-python-evaluate): Rename "prefix" to "preamble".
(org-babel-python-evaluate-external-process): Rename "prefix" to
"preamble".
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob.el (org-babel-examplize-region): Check if `end' is a marker
or a point and handle appropriately.
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob-sql.el (org-babel-execute:sql): Explicitly set field
separator to \t when importing tabular data.
2010-12-11 Julien Danjou <julien@danjou.info>
* org-agenda.el (org-agenda-custom-commands-local-options):
Allow org-agenda-span to be a symbol.
(org-agenda-ndays): Make obsolete.
(org-agenda-span): New variable superseding org-agenda-ndays.
(org-agenda-menu): Use org-agenda-current-span.
(org-agenda-current-span): New local variable storing current
span.
(org-agenda-list): Take a span instead of ndays as argument.
This function is now responsible for computing the ndays based
on span.
(org-agenda-ndays-to-span): Return span only if number of days
really matches.
(org-agenda-span-to-ndays): New function.
(org-agenda-manipulate-query): Use org-agenda-compute-starting-span.
(org-agenda-goto-today): Use org-agenda-compute-starting-span.
(org-agenda-later): Do not give compute a new span, use the
current one.
(org-agenda-day-view, org-agenda-week-view)
(org-agenda-month-view, org-agenda-year-view): Stop touching
org-agenda-ndays.
(org-agenda-change-time-span): Only compute starting-span.
(org-agenda-compute-starting-span): New function derived from
the old org-agenda-compute-time-span.
(org-agenda-set-mode-name): Compute mode based on
org-agenda-current-span.
(org-agenda-span-name): New function.
2010-12-11 Robert Pluim <rpluim@gmail.com> (tiny change)
* org-agenda.el (org-agenda-toggle-deadlines): Fix docstring.
2010-12-11 Carsten Dominik <carsten.dominik@gmail.com>
* org-clock.el (org-quarter-to-date): Define variables.
(org-clock-special-range): Defin variables. Use org-floor*.
(org-clocktable-write-default): Define tcol.
* org-compat.el (org-floor*): New function.
* org-complete.el: New file.
2010-12-11 Carsten Dominik <carsten.dominik@gmail.com>
* org-clock.el (org-clocktable-write-default): Fix the % formula.
2010-12-11 Matt Lundin <mdl@imapmail.org>
* org-agenda.el: (org-format-agenda-item) The value of
org-category is not converted to a string unless it is defined.
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob-python.el (org-babel-execute:python): Pass the new "prefix"
header argument through to external evaluation.
(org-babel-python-evaluate): Pass the new "prefix" header argument
through to external evaluation.
(org-babel-python-evaluate-external-process): When specified prepend
"prefix" to the file used in external evaluation.
2010-12-11 Dan Davison <dandavison7@gmail.com>
* ob-python.el (org-babel-python-evaluate-session): Change python
module name from 'pp' to 'pprint'.
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob-R.el (org-babel-R-evaluate-session): Removing empty lines
from R session output, these are often the result of variable
assignments.
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob-sql.el (orgtbl-to-csv): Declaring an external function to
fix a compiler warning.
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob-eval.el (require): No longer require ob.el to allow
requiring by ob.el.
* ob.el (ob-eval): Require ob-eval.
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob.el (org-babel-confirm-evaluate): Show code block's name when
it is available during evaluation query.
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob-sql.el (org-babel-expand-body:sql): Expand the body of a sql
code block.
(org-babel-execute:sql): Use sql specific body expansion function.
(org-babel-sql-expand-vars): Insert variables into a sql code block.
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob.el (org-babel-insert-result): Using markers instead of
points for more robust buffer anchors.
2010-12-11 Julien Danjou <julien@danjou.info>
* org-capture.el: Use org-today.
2010-12-11 Julien Danjou <julien@danjou.info>
* org-habit.el: Use org-today.
2010-12-11 Julien Danjou <julien@danjou.info>
* org.el (org-auto-repeat-maybe): Use org-today.
2010-12-11 David Maus <dmaus@ictsoc.de>
* test-org.el (test-org/org-link-escape-url-with-escaped-char): Add
test for escaping and unescaping url with already escaped char.
2010-12-11 Carsten Dominik <carsten.dominik@gmail.com>
* org-clock.el (org-day-of-week): New function.
(org-quarter-to-date): New function.
(org-clock-special-range): Implement quarters.
2010-12-11 Sébastien Vauban <wxhgmqzgwmuf@spammotel.com>
* org.el (org-complete-tags-always-offer-all-agenda-tags): Fix
docstring.
2010-12-11 Julien Danjou <julien@danjou.info>
* org-agenda.el (org-format-agenda-item): Convert category to a string
if it is a symbol. This fixes the following call to
org-agenda-get-category-icon which fails if category is not a string.
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob-clojure.el: Updated requirements documentation to mention
the minimum version of Clojure.
(org-babel-expand-body:clojure): Fully qualified function name.
2010-12-11 Nicolas Goaziou <n.goaziou@gmail.com>
* org-latex.el (org-export-latex-lists): do not add an
unnecessary newline character after a list.
* org-list.el (org-list-bottom-point-with-indent): ensure bottom
point is just after a non blank line.
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob.el (org-babel-examplize-region): Remove old assertion which
no longer applies to the result insertion code.
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob-python.el (org-babel-execute:python): Use a :return header
argument for external evaluation in which the code block body need
be wrapped in a function
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob-clojure.el (org-babel-expand-body:clojure): Trapped free
variable.
2010-12-11 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-edit-special): Edit formulas when in TBLMF line
2010-12-11 Allen S. Rout <asr@ufl.edu> (tiny change)
* org-capture.el (org-capture-after-finalize-hook): New hook.
(org-capture-finalize): Run the new hook.
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob-clojure.el (org-babel-expand-body:clojure): Support for
pretty printing of Clojure code and data.
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob.el (org-babel-insert-result): No longer escape results which
will be wrapped in a block.
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob-eval.el (org-babel-eval-wipe-error-buffer): Fixed compiler
warning and added documentation string.
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob-clojure.el (org-babel-execute:clojure): Remade using slime
for all code evaluation.
2010-12-11 Carsten Dominik <carsten.dominik@gmail.com>
* org-beamer.el (org-beamer-sectioning): Allow overlay arguments for
the column as well.
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob.el (org-babel-confirm-evaluate): More descriptive message
when evaluation is aborted or disabled.
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob.el (org-babel-insert-result): Responds to new "wrap" header
argument.
(org-babel-merge-params): Includes new "wrap" header argument in
one of the results header argument exclusive groups.
2010-12-11 David Maus <dmaus@ictsoc.de>
* org-macs.el (with-silent-modifications): Fix condition for
with-silent-modification.
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob.el (org-babel-parse-header-arguments): Stripping trailing
spaces off of header arguments (even the first one).
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob-sh.el (org-babel-sh-var-to-sh): Wrap end token of heredoc in
single quotes which is the best practice.
(org-babel-sh-table-or-results): Use `org-babel-script-escape' for
more robust parsing of shell output.
2010-12-11 Dan Davison <dandavison7@gmail.com>
* org.el (org-additional-option-like-keywords): Add more keywords,
and colons to some old ones.
2010-12-11 Dan Davison <dandavison7@gmail.com>
* ob-eval.el (org-babel-error-buffer-name): Define new variable.
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob-python.el (org-babel-python-table-or-string): Using
`org-babel-script-escape' for reading string input from scripting
languages.
2010-12-11 Achim Gratz <Stromeko@nexgo.de> (tiny change)
* org-macs.el (org-called-interactively-p): Wrap function call in
with-no-warnings.
(with-silent-modifications) Declare macro for Emacs < 23.2.
2010-12-11 David Maus <dmaus@ictsoc.de>
* org-test.el (org-test-current-file): New function. Run all tests
for current file.
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob.el (org-babel-parse-header-arguments): Removed addition of
":" to singleton first header arguments as it was leading to errors.
2010-12-11 David Maus <dmaus@ictsoc.de>
* test-org.el (test-org/org-link-escape-ascii-character)
(test-org/org-link-escape-ascii-ctrl-character)
(test-org/org-link-escape-multibyte-character)
(test-org/org-link-escape-custom-table)
(test-org/org-link-escape-custom-table-merge)
(test-org/org-link-unescape-ascii-character)
(test-org/org-link-unescape-ascii-ctrl-character)
(test-org/org-link-unescape-multibyte-character)
(test-org/org-link-unescape-ascii-extended-char): New tests for
unicode aware percent escaping.
2010-12-11 Carsten Dominik <carsten.dominik@gmail.com>
* org-latex.el (org-export-latex-make-header): Run the title through
`org-export-latex-fontify-headline'.
(org-export-latex-fontify-headline): Do the protection of math
snippets also here.
2010-12-11 Richard Lawrence <richard.lawrence@berkeley.edu>
* org-latex.el (org-export-as-latex): Sent the section title
through the preprocessor.
2010-12-11 Carsten Dominik <carsten.dominik@gmail.com>
* org-html.el (org-html-level-start): Mark listified headings
with a custom id.
2010-12-11 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-open-at-point): Don't do footnote action if cursor is
on a bracket link.
2010-12-11 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-edit-special): Check also for TBLFM line.
2010-12-11 Achim Gratz <Stromeko@Stromeko.DE> (tiny change)
* org-clock.el (org-get-clocktable): previous patch incorrectly
required whitespace in front of #+BEGIN: and #+END:
2010-12-11 Dan Davison <dandavison7@gmail.com>
* org-src.el (org-edit-src-code): Allow region to be inherited by
edit buffer when mark is one character beyond end of src block.
2010-12-11 Nicolas Goaziou <n.goaziou@gmail.com>
* org-list.el (org-cycle-list-bullet): ensure point is at bol before
checking item indentation.
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob.el (org-babel-map-src-blocks): Moved to earlier in the file
and now autoloading.
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob-ref.el (org-babel-ref-at-ref-p): Use higher level function
for testing list membership.
* ob.el (org-babel-read-result): Use higher level function for
testing list membership.
(org-babel-result-end): Use higher level function for testing list
membership.
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob-sqlite.el (ob-eval): Require ob-eval for external command
execution.
(org-babel-execute:sqlite): No longer uses the init option for
passing commands to sqlite.
2010-12-11 Nicolas Goaziou <n.goaziou@gmail.com>
* org.el (org-indent-line-function): Drawers and blocks have no
influence on indentation of text below. Also fix indentation
problem with a block at column 0 and add a special case for
literal examples.
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob.el (org-babel-map-src-blocks): Ensure that the file argument
is only evaluated once.
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob-ref.el (org-babel-ref-resolve): Recognize `list' as a unique
type of data
(org-babel-ref-at-ref-p): Recognize `list' as a unique type of data
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob-tangle.el (org-babel-load-file): Can be called interactively.
2010-12-11 Carsten Dominik <carsten.dominik@gmail.com> (tiny change)
* org-table.el (orgtbl-after-send-table-hook): New hook.
(orgtbl-ctrl-c-ctrl-c): Run `orgtbl-after-send-table-hook' when a
table was sent.
(orgtbl-send-table): Return the number of sent tables, or nil if no
sending has happened.
2010-12-11 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-get-priority-function): New option.
(org-get-priority): Call `org-get-priority-function' if that
has been set.
2010-12-11 Dan Davison <dandavison7@gmail.com>
* ob-table.el (org-babel-table-truncate-at-newline): Only add
"..." if there is something after the newline.
2010-12-11 Achim Gratz <Stromeko@nexgo.de> (tiny change)
* org-clock.el (org-get-clocktable):
(org-in-clocktable-p):
(org-clocktable-shift):
(org-clocktable-steps): Fix regexp to allow for indented clock tables
2010-12-11 Puneeth Chaganti <punchagan@gmail.com>
* org-exp.el (org-export-handle-include-files): Support :minlevel
property.
(org-get-file-contents): New argument minlevel to demote included
content.
2010-12-11 Noorul Islam <noorul@noorul.com>
* org-latex.el (org-export-latex-hyperref-format): New option.
(org-export-latex-href-format): Renamed the existing variable
`org-export-latex-hyperref-format' as `org-export-latex-href-format'
(org-export-latex-links): Use `org-export-latex-hyperref-format' and
`org-export-latex-href-format'
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob-calc.el (org-babel-execute:calc): Ensure the *Calculator*
buffer exists before it is used.
2010-12-11 Nicolas Goaziou <n.goaziou@gmail.com>
* org-exp.el (org-export-preprocess-string): delaying code block
processing a bit to allow correct list parsing in the export string
2010-12-11 Christopher Allan Webber <cwebber@dustycloud.org>
* org-agenda.el (org-agenda-timegrid-use-ampm): New option.
(org-agenda-time-of-day-to-ampm): New function.
(org-agenda-time-of-day-to-ampm-maybe): New function.
(org-format-agenda-item): Call org-agenda-time-of-day-to-ampm-maybe.
2010-12-11 Carsten Dominik <carsten.dominik@gmail.com>
* org-faces.el (org-cycle-level-faces): New option.
* org.el (org-get-level-face): Honor org-cycle-level-faces.
2010-12-11 Julien Danjou <julien@danjou.info>
* org-agenda.el (org-agenda-today): New function.
(org-agenda-get-day-face): New function.
(org-timeline): Use org-agenda-today and org-agenda-get-day-face.
(org-agenda-list): Use org-agenda-today and org-agenda-get-day-face.
(org-todo-list): Use org-agenda-today.
(org-get-all-dates): Use org-agenda-today.
(org-agenda-day-face-function): New variable.
(org-agenda-get-day-face): Use org-agenda-day-face-function.
2010-12-11 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-ctrl-c-ctrl-c): Consider sending a radio table also
in Org.
2010-12-11 Carsten Dominik <carsten.dominik@gmail.com>
* org-html.el (org-export-as-html): Do not treat partially
protected lines as if they were fully protected.
2010-12-11 Dan Davison <dandavison7@gmail.com>
* org-exp.el: (org-export-format-source-code-or-example):
Remove hard-wired configuration of minted export
(org-export-latex-minted-with-line-numbers): Remove variable
2010-12-11 Bastien Guerry <bzg@altern.org>
* org-clock.el (org-dblock-write:clocktable): Fix double
reference to `link' in let construct.
(org-clock-clocktable-formatter): Fix typo in docstring.
(org-clocktable-write-default): Fix typo in docstring.
2010-12-11 David Maus <dmaus@ictsoc.de>
* org-protocol.el (org-protocol-unhex-string): Normalize percent
escape sequence to upper case letters.
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob-lob.el (org-babel-lob-get-info): including pass-through
header arguments in results variable header argument string
2010-12-11 David Maus <dmaus@ictsoc.de>
* org-exp.el (org-export-visible): Limit search for in-buffer options
beginning of first headline.
2010-12-11 David Maus <dmaus@ictsoc.de>
* org.el (org-open-at-point): Remove stale link handler for news:
links.
2010-12-11 Carsten Dominik <carsten.dominik@gmail.com>
* org-clock.el (org-clocktable-write-default): Better handling of
narrowing.
2010-12-11 Julien Danjou <julien@danjou.info>
* list/org-agenda.el (org-agenda-category-icon-alist): Fix defcustom
type.
2010-12-11 Nicolas Goaziou <n.goaziou@gmail.com>
* org.el (org-indent-line-function): simplify code and remove bug that
would insert a tab at the beginning of the line when trying to
indent the item.
2010-12-11 Julien Danjou <julien@danjou.info>
* org.el (org-diary-sexp-entry): Split sexp result strings at semicolon.
2010-12-11 Julien Danjou <julien@danjou.info>
* org-agenda.el (org-agenda-prefix-format): Insert place holder
for icon.
(org-agenda-category-icon-alist): New option.
(org-agenda-get-category-icon): New function.
(org-format-agenda-item): Support for icons.
(org-compile-prefix-format): Support for icons.
2010-12-11 Julien Danjou <julien@danjou.info>
* org-compat.el: Create defalias for `string-match-p' and
looking-at-p.
2010-12-11 Eric Schulte <schulte.eric@gmail.com>
* ob-calc.el (org-babel-execute:calc): support for variables --
converts :var variables in calc variables
2010-12-11 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-sparse-tree): Mention [r] in dispatch menu
2010-12-11 Carsten Dominik <carsten.dominik@gmail.com>
* org-list.el (org-list-parse-list): Use `org-looking-at-p'.
2010-12-11 Carsten Dominik <carsten.dominik@gmail.com>
* org-id.el (org-id-store-link): Test for org-mode before checking
for IDs.
2010-12-11 David Maus <dmaus@ictsoc.de>
* org-test.el (org-test-current-defun): `which-function' does not
return a list, but the name of the function.
2010-12-11 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-shorten-string): New function.
* org-exp.el (org-export-convert-protected-spaces): New function.
(org-export-preprocess-string): Call
`org-export-convert-protected-spaces' to handle new hard spaces.
2010-12-11 David Maus <dmaus@ictsoc.de>
* org.el (org-narrow-to-subtree): Check for heading that ends at end
of buffer.
2010-11-12 Carsten Dominik <carsten.dominik@gmail.com>
* org-capture.el (org-capture-templates): Remove autoload from

2
lisp/org/ob-C.el
View file

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.

27
lisp/org/ob-R.el
View file

@ -2,11 +2,10 @@
;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Dan Davison
;; Author: Eric Schulte, Dan Davison
;; Keywords: literate programming, reproducible research, R, statistics
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.
@ -277,16 +276,18 @@ last statement in BODY, as elisp."
(butlast
(delq nil
(mapcar
(lambda (line) ;; cleanup extra prompts left in output
(if (string-match
"^\\([ ]*[>+][ ]?\\)+\\([[0-9]+\\|[ ]\\)" line)
(substring line (match-end 1))
line))
(org-babel-comint-with-output (session org-babel-R-eoe-output)
(insert (mapconcat #'org-babel-chomp
(list body org-babel-R-eoe-indicator)
"\n"))
(inferior-ess-send-input)))) 2) "\n"))))
(lambda (line) (when (> (length line) 0) line))
(mapcar
(lambda (line) ;; cleanup extra prompts left in output
(if (string-match
"^\\([ ]*[>+][ ]?\\)+\\([[0-9]+\\|[ ]\\)" line)
(substring line (match-end 1))
line))
(org-babel-comint-with-output (session org-babel-R-eoe-output)
(insert (mapconcat #'org-babel-chomp
(list body org-babel-R-eoe-indicator)
"\n"))
(inferior-ess-send-input)))))) "\n"))))
(defun org-babel-R-process-value-result (result column-names-p)
"R-specific processing of return value.

2
lisp/org/ob-asymptote.el
View file

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.

70
lisp/org/ob-calc.el
View file

@ -1,11 +1,11 @@
;;; ob-calc.el --- org-babel functions for calc code evaluation
;; Copyright (C) 2010 Free Software Foundation, Inc.
;; Copyright (C) 2010 Free Software Foundation, Inc
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.
@ -40,25 +40,55 @@
(defun org-babel-execute:calc (body params)
"Execute a block of calc code with Babel."
(mapcar
(lambda (line)
(when (> (length line) 0)
(if (string= "'" (substring line 0 1))
(funcall (lookup-key calc-mode-map (substring line 1)) nil)
(calc-push-list
(list ((lambda (res)
(cond
((numberp res) res)
((listp res) (error "calc error \"%s\" on input \"%s\""
(cadr res) line))
(t res))
(if (numberp res) res (math-read-number res)))
(calc-eval line)))))))
(mapcar #'org-babel-trim
(split-string (org-babel-expand-body:calc body params) "[\n\r]")))
(unless (get-buffer "*Calculator*")
(save-window-excursion (calc) (calc-quit)))
(let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
(var-syms (mapcar #'car vars))
(var-names (mapcar #'symbol-name var-syms)))
(mapc
(lambda (pair)
(calc-push-list (list (cdr pair)))
(calc-store-into (car pair)))
vars)
(mapc
(lambda (line)
(when (> (length line) 0)
(cond
;; simple variable name
((member line var-names) (calc-recall (intern line)))
;; stack operation
((string= "'" (substring line 0 1))
(funcall (lookup-key calc-mode-map (substring line 1)) nil))
;; complex expression
(t
(calc-push-list
(list ((lambda (res)
(cond
((numberp res) res)
((math-read-number res) (math-read-number res))
((listp res) (error "calc error \"%s\" on input \"%s\""
(cadr res) line))
(t (calc-eval
(math-evaluate-expr
;; resolve user variables, calc built in
;; variables are handled automatically
;; upstream by calc
(mapcar (lambda (el)
(if (and (consp el) (equal 'var (car el))
(member (cadr el) var-syms))
(progn
(calc-recall (cadr el))
(prog1 (calc-top 1)
(calc-pop 1)))
el))
;; parse line into calc objects
(car (math-read-exprs line))))))))
(calc-eval line))))))))
(mapcar #'org-babel-trim
(split-string (org-babel-expand-body:calc body params) "[\n\r]"))))
(save-excursion
(set-buffer (get-buffer "*Calculator*"))
(calc-eval (calc-top 1))))
(with-current-buffer (get-buffer "*Calculator*")
(calc-eval (calc-top 1)))))
(provide 'ob-calc)

302
lisp/org/ob-clojure.el
View file

@ -2,10 +2,10 @@
;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; Author: Joel Boehland
;; Author: Joel Boehland, Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.
@ -24,14 +24,14 @@
;;; Commentary:
;;; ob support for evaluating clojure code
;;; support for evaluating clojure code, relies on slime for all eval
;;; Requirements:
;;; A working clojure install. This also implies a working java executable
;;; clojure-mode
;;; slime
;;; swank-clojure
;;; - clojure (at least 1.2.0)
;;; - clojure-mode
;;; - slime
;;; - swank-clojure
;;; By far, the best way to install these components is by following
;;; the directions as set out by Phil Hagelberg (Technomancy) on the
@ -39,277 +39,47 @@
;;; Code:
(require 'ob)
(require 'ob-eval)
(eval-when-compile (require 'cl))
(declare-function slime-eval-async "ext:slime" (sexp &optional cont package))
(declare-function slime-eval "ext:slime" (sexp &optional package))
(declare-function swank-clojure-concat-paths "ext:slime" (paths))
(declare-function slime "ext:slime" (&optional command coding-system))
(declare-function slime-output-buffer "ext:slime" (&optional noprompt))
(declare-function slime-filter-buffers "ext:slime" (predicate))
(add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj"))
(defvar org-babel-default-header-args:clojure '())
(defvar org-babel-clojure-wrapper-method
"
(defn spit
[f content]
(with-open [#^java.io.PrintWriter w
(java.io.PrintWriter.
(java.io.BufferedWriter.
(java.io.OutputStreamWriter.
(java.io.FileOutputStream.
(java.io.File. f)))))]
(.print w content)))
(defn main
[]
%s)
(spit \"%s\" (str (main)))")
;;";; <-- syntax highlighting is messed without this double quote
;;taken mostly from clojure-test-mode.el
(defun org-babel-clojure-clojure-slime-eval (string &optional handler)
"Evaluate a STRING of clojure code using `slime-eval-async'."
(slime-eval-async `(swank:eval-and-grab-output ,string)
(or handler #'identity)))
(defun org-babel-clojure-slime-eval-sync (string)
"Evaluate a STRING of clojure code using `slime-eval'."
(slime-eval `(swank:eval-and-grab-output ,string)))
;;taken from swank-clojure.el
(defvar swank-clojure-binary)
(defvar swank-clojure-classpath)
(defvar swank-clojure-java-path)
(defvar swank-clojure-extra-vm-args)
(defvar swank-clojure-library-paths)
(defvar swank-clojure-extra-classpaths)
(defun org-babel-clojure-babel-clojure-cmd ()
"Create the command to start clojure according to current settings."
(or (when swank-clojure-binary
(if (listp swank-clojure-binary)
swank-clojure-binary
(list swank-clojure-binary)))
(when swank-clojure-classpath
(delq
nil
(append
(list swank-clojure-java-path)
swank-clojure-extra-vm-args
(list
(when swank-clojure-library-paths
(concat "-Djava.library.path="
(swank-clojure-concat-paths swank-clojure-library-paths)))
"-classpath"
(swank-clojure-concat-paths
(append
swank-clojure-classpath
swank-clojure-extra-classpaths))
"clojure.main"))))
(error "%s" (concat "You must specifiy either a `swank-clojure-binary' "
"or a `swank-clojure-classpath'"))))
(defun org-babel-clojure-table-or-string (results)
"Convert RESULTS to an elisp value.
If RESULTS looks like a table, then convert to an Emacs-lisp
table, otherwise return the results as a string."
(org-babel-read
(if (string-match "^\\[.+\\]$" results)
(org-babel-read
(concat "'"
(replace-regexp-in-string
"\\[" "(" (replace-regexp-in-string
"\\]" ")" (replace-regexp-in-string
", " " " (replace-regexp-in-string
"'" "\"" results))))))
results)))
(defun org-babel-clojure-var-to-clojure (var)
"Convert an elisp value into a clojure variable.
The elisp value VAR is converted into a string of clojure source
code specifying a variable of the same value."
(if (listp var)
(format "'%s" var)
(format "%S" var)))
(defun org-babel-clojure-build-full-form (body vars)
"Construct a clojure let form with VARS as the let variables."
(let ((vars-forms
(mapconcat ;; define any variables
(lambda (pair)
(format "%s %s"
(car pair) (org-babel-clojure-var-to-clojure (cdr pair))))
vars "\n "))
(body (org-babel-trim body)))
(if (> (length vars-forms) 0)
(format "(let [%s]\n %s)" vars-forms body)
body)))
(defun org-babel-prep-session:clojure (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(require 'slime) (require 'swank-clojure)
(let* ((session-buf (org-babel-clojure-initiate-session session))
(vars (mapcar #'cdr (org-babel-get-header params :var)))
(var-lines (mapcar ;; define any top level session variables
(lambda (pair)
(format "(def %s %s)\n" (car pair)
(org-babel-clojure-var-to-clojure (cdr pair))))
vars)))
session-buf))
(defun org-babel-load-session:clojure (session body params)
"Load BODY into SESSION."
(require 'slime) (require 'swank-clojure)
(save-window-excursion
(let ((buffer (org-babel-prep-session:clojure session params)))
(with-current-buffer buffer
(goto-char (point-max))
(insert (org-babel-chomp body)))
buffer)))
(defvar org-babel-clojure-buffers '())
(defvar org-babel-clojure-pending-sessions '())
(defun org-babel-clojure-session-buffer (session)
"Return the buffer associated with SESSION."
(cdr (assoc session org-babel-clojure-buffers)))
(defun org-babel-clojure-initiate-session-by-key (&optional session)
"Initiate a clojure session in an inferior-process-buffer.
If there is not a current inferior-process-buffer in SESSION
then create one. Return the initialized session."
(save-window-excursion
(let* ((session (if session
(if (stringp session) (intern session)
session)
:default))
(clojure-buffer (org-babel-clojure-session-buffer session)))
(unless (and clojure-buffer (buffer-live-p clojure-buffer))
(setq org-babel-clojure-buffers
(assq-delete-all session org-babel-clojure-buffers))
(push session org-babel-clojure-pending-sessions)
(slime)
;; we are waiting to finish setting up which will be done in
;; org-babel-clojure-session-connected-hook below.
(let ((timeout 9))
(while (and (not (org-babel-clojure-session-buffer session))
(< 0 timeout))
(message "Waiting for clojure repl for session: %s ... %i"
session timeout)
(sit-for 1)
(decf timeout)))
(setq org-babel-clojure-pending-sessions
(remove session org-babel-clojure-pending-sessions))
(unless (org-babel-clojure-session-buffer session)
(error "Couldn't create slime clojure process"))
(setq clojure-buffer (org-babel-clojure-session-buffer session)))
session)))
(defun org-babel-clojure-initiate-session (&optional session params)
"Return the slime-clojure repl buffer bound to SESSION.
Returns nil if \"none\" is specified."
(require 'slime) (require 'swank-clojure)
(unless (and (stringp session) (string= session "none"))
(org-babel-clojure-session-buffer
(org-babel-clojure-initiate-session-by-key session))))
(defun org-babel-clojure-session-connected-hook ()
"Finish binding an org-babel session to a slime-clojure repl."
(let ((pending-session (pop org-babel-clojure-pending-sessions)))
(when pending-session
(save-excursion
(switch-to-buffer (slime-output-buffer))
(rename-buffer
(if (stringp pending-session)
pending-session (symbol-name pending-session)))
(org-babel-clojure-bind-session-to-repl-buffer
pending-session (slime-output-buffer))))))
(add-hook 'slime-connected-hook 'org-babel-clojure-session-connected-hook)
(defun org-babel-clojure-bind-session-to-repl-buffer (session repl-buffer)
"Associate SESSION with REPL-BUFFER."
(when (stringp session) (setq session (intern session)))
(setq org-babel-clojure-buffers
(cons (cons session repl-buffer)
(assq-delete-all session org-babel-clojure-buffers))))
(defun org-babel-clojure-repl-buffer-pred ()
"Test whether the current buffer is an active slime-clojure
repl buffer."
(and (buffer-live-p (current-buffer)) (eq major-mode 'slime-repl-mode)))
(defun org-babel-clojure-bind-session-to-repl (session)
"Bind SESSION to a clojure repl."
(interactive "sEnter session name: ")
(let ((repl-bufs (slime-filter-buffers 'org-babel-clojure-repl-buffer-pred)))
(unless repl-bufs (error "No existing slime-clojure repl buffers exist"))
(let ((repl-buf (read-buffer "Choose slime-clojure repl: " repl-bufs t)))
(org-babel-clojure-bind-session-to-repl-buffer session repl-buf))))
(defun org-babel-clojure-evaluate-external-process
(buffer body &optional result-type)
"Evaluate the body in an external process."
(let ((cmd (format "%s -" (mapconcat #'identity
(org-babel-clojure-babel-clojure-cmd)
" "))))
(case result-type
(output (org-babel-eval cmd body))
(value (let* ((tmp-file (org-babel-temp-file "clojure-")))
(org-babel-eval
cmd
(format
org-babel-clojure-wrapper-method
body
(org-babel-process-file-name tmp-file 'noquote)))
(org-babel-clojure-table-or-string
(org-babel-eval-read-file tmp-file)))))))
(defun org-babel-clojure-evaluate-session (buffer body &optional result-type)
"Evaluate the body in the context of a clojure session."
(require 'slime) (require 'swank-clojure)
(let ((raw nil)
(results nil))
(with-current-buffer buffer
(setq raw (org-babel-clojure-slime-eval-sync body))
(setq results (reverse (mapcar #'org-babel-trim raw)))
(cond
((equal result-type 'output)
(mapconcat #'identity (reverse (cdr results)) "\n"))
((equal result-type 'value)
(org-babel-clojure-table-or-string (car results)))))))
(defun org-babel-clojure-evaluate (buffer body &optional result-type)
"Pass BODY to the Clojure process in BUFFER.
If RESULT-TYPE equals 'output then return a list of the outputs
of the statements in BODY, if RESULT-TYPE equals 'value then
return the value of the last statement in BODY as elisp."
(if buffer
(org-babel-clojure-evaluate-session buffer body result-type)
(org-babel-clojure-evaluate-external-process buffer body result-type)))
(defvar org-babel-header-arg-names:clojure '(package))
(defun org-babel-expand-body:clojure (body params)
"Expand BODY according to PARAMS, return the expanded body."
(org-babel-clojure-build-full-form
body (mapcar #'cdr (org-babel-get-header params :var))))
(let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
(result-params (cdr (assoc :result-params params)))
(print-level nil) (print-length nil)
(body (org-babel-trim
(if (> (length vars) 0)
(concat "(let ["
(mapconcat
(lambda (var)
(format "%S (quote %S)" (car var) (cdr var)))
vars "\n ")
"]\n" body ")")
body))))
(if (or (member "code" result-params)
(member "pp" result-params))
(format (concat "(let [org-mode-print-catcher (java.io.StringWriter.)]"
"(clojure.pprint/with-pprint-dispatch %s-dispatch"
"(clojure.pprint/pprint %s org-mode-print-catcher)"
"(str org-mode-print-catcher)))")
(if (member "code" result-params) "code" "simple") body)
body)))
(defun org-babel-execute:clojure (body params)
"Execute a block of Clojure code."
"Execute a block of Clojure code with Babel."
(require 'slime) (require 'swank-clojure)
(let* ((body (org-babel-expand-body:clojure body params))
(session (org-babel-clojure-initiate-session
(cdr (assoc :session params)))))
(org-babel-reassemble-table
(org-babel-clojure-evaluate session body (cdr (assoc :result-type params)))
(org-babel-pick-name
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
(with-temp-buffer
(insert (org-babel-expand-body:clojure body params))
(read
(slime-eval
`(swank:interactive-eval-region
,(buffer-substring-no-properties (point-min) (point-max)))
(cdr (assoc :package params))))))
(provide 'ob-clojure)

2
lisp/org/ob-comint.el
View file

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, comint
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.

2
lisp/org/ob-css.el
View file

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.

2
lisp/org/ob-ditaa.el
View file

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.

2
lisp/org/ob-dot.el
View file

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.

4
lisp/org/ob-emacs-lisp.el
View file

@ -1,11 +1,11 @@
;;; ob-emacs-lisp.el --- org-babel functions for emacs-lisp code evaluation
;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 2009, 2010 Free Software Foundation, Inc
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.

22
lisp/org/ob-eval.el
View file

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, comint
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.
@ -28,12 +28,13 @@
;; shell commands.
;;; Code:
(require 'ob)
(eval-when-compile (require 'cl))
(defvar org-babel-error-buffer-name "*Org-Babel Error Output*")
(defun org-babel-eval-error-notify (exit-code stderr)
"Open a buffer to display STDERR and a message with the value of EXIT-CODE."
(let ((buf (get-buffer-create "*Org-Babel Error Output*")))
(let ((buf (get-buffer-create org-babel-error-buffer-name)))
(with-current-buffer buf
(goto-char (point-max))
(save-excursion (insert stderr)))
@ -44,7 +45,7 @@
"Run CMD on BODY.
If CMD succeeds then return its results, otherwise display
STDERR with `org-babel-eval-error-notify'."
(let ((err-buff (get-buffer-create "*Org-Babel Error*")) exit-code)
(let ((err-buff (get-buffer-create " *Org-Babel Error*")) exit-code)
(with-current-buffer err-buff (erase-buffer))
(with-temp-buffer
(insert body)
@ -138,9 +139,9 @@ specifies the value of ERROR-BUFFER."
(if error-buffer
(make-temp-file
(expand-file-name "scor"
(or (unless (featurep 'xemacs)
small-temporary-file-directory)
temporary-file-directory)))
(if (featurep 'xemacs)
(temp-directory)
temporary-file-directory)))
nil))
exit-status)
(if (or replace
@ -247,6 +248,13 @@ specifies the value of ERROR-BUFFER."
(delete-file error-file))
exit-status))
(defun org-babel-eval-wipe-error-buffer ()
"Delete the contents of the Org code block error buffer.
This buffer is named by `org-babel-error-buffer-name'."
(when (get-buffer org-babel-error-buffer-name)
(with-current-buffer org-babel-error-buffer-name
(delete-region (point-min) (point-max)))))
(provide 'ob-eval)
;; arch-tag: 5328b17f-957d-42d9-94da-a2952682d04d

6
lisp/org/ob-exp.el
View file

@ -5,7 +5,7 @@
;; Author: Eric Schulte, Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.
@ -39,8 +39,7 @@
(defvar org-babel-lob-one-liner-regexp)
(defvar org-babel-ref-split-regexp)
(declare-function org-babel-lob-get-info "ob-lob" ())
(declare-function org-babel-ref-literal "ob-ref" (ref))
(declare-function org-babel-eval-wipe-error-buffer "ob-eval" ())
(add-to-list 'org-export-interblocks '(src org-babel-exp-inline-src-blocks))
(add-to-list 'org-export-interblocks '(lob org-babel-exp-lob-one-liners))
(add-hook 'org-export-blocks-postblock-hook 'org-exp-res/src-name-cleanup)
@ -289,6 +288,7 @@ inhibit insertion of results into the buffer."
(org-babel-process-params (nth 2 info))))
;; skip code blocks which we can't evaluate
(when (fboundp (intern (concat "org-babel-execute:" lang)))
(org-babel-eval-wipe-error-buffer)
(if (equal type 'inline)
(let ((raw (org-babel-execute-src-block
nil info '((:results . "silent"))))

2
lisp/org/ob-gnuplot.el
View file

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.

13
lisp/org/ob-haskell.el
View file

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.
@ -136,16 +136,7 @@ then create one. Return the initialized session."
"Convert RESULTS to an Emacs-lisp table or string.
If RESULTS look like a table, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
(org-babel-read
(if (and (stringp results) (string-match "^\\[.+\\]$" results))
(org-babel-read
(concat "'"
(replace-regexp-in-string
"\\[" "(" (replace-regexp-in-string
"\\]" ")" (replace-regexp-in-string
"," " " (replace-regexp-in-string
"'" "\"" results))))))
results)))
(org-babel-script-escape results))
(defun org-babel-haskell-var-to-haskell (var)
"Convert an elisp value VAR into a haskell variable.

24
lisp/org/ob-js.el
View file

@ -1,26 +1,28 @@
;;; ob-js.el --- org-babel functions for Javascript
;; Copyright (C) 2010 Free Software Foundation, Inc.
;; Copyright (C) 2010 Free Software Foundation
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, js
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.
;;; License:
;; GNU Emacs is free software: you can redistribute it and/or modify
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
@ -33,7 +35,7 @@
;; - a non-browser javascript engine such as node.js http://nodejs.org/
;; or mozrepl http://wiki.github.com/bard/mozrepl/
;;
;;
;; - for session based evaluation mozrepl and moz.el are required see
;; http://wiki.github.com/bard/mozrepl/emacs-integration for
;; configuration instructions

2
lisp/org/ob-keys.el
View file

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.

2
lisp/org/ob-latex.el
View file

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.

2
lisp/org/ob-ledger.el
View file

@ -5,7 +5,7 @@
;; Author: Eric S Fraga
;; Keywords: literate programming, reproducible research, accounting
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.

37
lisp/org/ob-lisp.el
View file

@ -1,27 +1,28 @@
;;; ob-lisp.el --- org-babel functions for Common Lisp
;; Copyright (C) 2010 Free Software Foundation, Inc.
;; Copyright (C) 2010 Free Software Foundation
;; Author: David T. O'Toole <dto@gnu.org>
;; Eric Schulte
;; Author: David T. O'Toole <dto@gnu.org>, Eric Schulte
;; Keywords: literate programming, reproducible research, lisp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.
;;; License:
;; GNU Emacs is free software: you can redistribute it and/or modify
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
@ -40,16 +41,18 @@
(require 'ob-ref)
(require 'ob-comint)
(require 'ob-eval)
(declare-function slime-eval "ext:slime" (form))
(declare-function slime-eval "ext:slime" (sexp &optional package))
(declare-function slime-process "ext:slime" (&optional connection))
(declare-function slime-connected-p "ext:slime" ())
(declare-function slime-process "ext:slime" ())
(require 'slime nil 'noerror)
(defvar org-babel-default-header-args:lisp '()
"Default header arguments for lisp code blocks.")
(defcustom org-babel-lisp-cmd "sbcl --script"
"Name of command used to evaluate lisp blocks.")
"Name of command used to evaluate lisp blocks."
:group 'org-babel
:type 'string)
(defun org-babel-expand-body:lisp (body params)
"Expand BODY according to PARAMS, return the expanded body."
@ -65,6 +68,7 @@
(defun org-babel-execute:lisp (body params)
"Execute a block of Lisp code with org-babel.
This function is called by `org-babel-execute-src-block'"
(require 'slime)
(message "executing Lisp source code block")
(let* ((session (org-babel-lisp-initiate-session
(cdr (assoc :session params))))
@ -96,6 +100,7 @@ This function is called by `org-babel-execute-src-block'"
(defun org-babel-lisp-initiate-session (&optional session)
"If there is not a current inferior-process-buffer in SESSION
then create. Return the initialized session."
(require 'slime)
(unless (string= session "none")
(save-window-excursion
(or (slime-connected-p)

23
lisp/org/ob-lob.el
View file

@ -2,11 +2,10 @@
;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Dan Davison
;; Author: Eric Schulte, Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.
@ -26,7 +25,7 @@
;;; Commentary:
;; See the online documentation for more information
;;
;;
;; http://orgmode.org/worg/org-contrib/babel/
;;; Code:
@ -72,7 +71,8 @@ If you change the value of this variable then your files may
(concat
"^\\([ \t]*\\)#\\+\\(?:"
(mapconcat #'regexp-quote org-babel-lob-call-aliases "\\|")
"\\):[ \t]+\\([^\(\)\n]+\\)\(\\([^\n]*\\)\)\\(\\[.+\\]\\|\\)[ \t]*\\([^\n]*\\)")
"\\):[ \t]+\\([^\(\)\n]+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)"
"\(\\([^\n]*\\)\)\\(\\[.+\\]\\|\\)[ \t]*\\([^\n]*\\)")
"Regexp to match calls to predefined source block functions.")
;; functions for executing lob one-liners
@ -93,13 +93,16 @@ if so then run the appropriate source block from the Library."
(beginning-of-line 1)
(if (looking-at org-babel-lob-one-liner-regexp)
(append
(mapcar #'org-babel-clean-text-properties
(mapcar #'org-babel-clean-text-properties
(list
(format "%s(%s)%s"
(match-string 2) (match-string 3) (match-string 4))
(match-string 5)))
(format "%s%s(%s)%s"
(match-string 2)
(if (match-string 4)
(concat "[" (match-string 4) "]") "")
(or (match-string 6) "") (match-string 7))
(match-string 8)))
(list (length (match-string 1))))))))
(defun org-babel-lob-execute (info)
"Execute the lob call specified by INFO."
(let ((params (org-babel-process-params

2
lisp/org/ob-matlab.el
View file

@ -5,7 +5,7 @@
;; Author: Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.

2
lisp/org/ob-mscgen.el
View file

@ -5,7 +5,7 @@
;; Author: Juan Pechiar
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.

2
lisp/org/ob-ocaml.el
View file

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.

2
lisp/org/ob-octave.el
View file

@ -5,7 +5,7 @@
;; Author: Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.

2
lisp/org/ob-org.el
View file

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.

7
lisp/org/ob-perl.el
View file

@ -1,12 +1,11 @@
;;; ob-perl.el --- org-babel functions for perl evaluation
;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 2009, 2010 Free Software Foundation
;; Author: Dan Davison
;; Eric Schulte
;; Author: Dan Davison, Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.

2
lisp/org/ob-plantuml.el
View file

@ -5,7 +5,7 @@
;; Author: Zhang Weize
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.

65
lisp/org/ob-python.el
View file

@ -1,12 +1,11 @@
;;; ob-python.el --- org-babel functions for python evaluation
;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 2009, 2010 Free Software Foundation
;; Author: Eric Schulte
;; Dan Davison
;; Author: Eric Schulte, Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.
@ -57,11 +56,15 @@ This function is called by `org-babel-execute-src-block'."
(cdr (assoc :session params))))
(result-params (cdr (assoc :result-params params)))
(result-type (cdr (assoc :result-type params)))
(return-val (when (and (eq result-type 'value) (not session))
(cdr (assoc :return params))))
(preamble (cdr (assoc :preamble params)))
(full-body
(org-babel-expand-body:generic
body params (org-babel-variable-assignments:python params)))
(concat body (if return-val (format "return %s" return-val) ""))
params (org-babel-variable-assignments:python params)))
(result (org-babel-python-evaluate
session full-body result-type result-params)))
session full-body result-type result-params preamble)))
(or (cdr (assoc :file params))
(org-babel-reassemble-table
result
@ -118,20 +121,7 @@ specifying a variable of the same value."
"Convert RESULTS into an appropriate elisp value.
If the results look like a list or tuple, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
((lambda (res)
(if (listp res)
(mapcar (lambda (el) (if (equal el 'None) 'hline el)) res)
res))
(org-babel-read
(if (and (stringp results) (string-match "^[([].+[])]$" results))
(org-babel-read
(concat "'"
(replace-regexp-in-string
"\\[" "(" (replace-regexp-in-string
"\\]" ")" (replace-regexp-in-string
", " " " (replace-regexp-in-string
"'" "\"" results t))))))
results))))
(org-babel-script-escape results))
(defvar org-babel-python-buffers '((:default . nil)))
@ -192,35 +182,38 @@ def main():
open('%s', 'w').write( pprint.pformat(main()) )")
(defun org-babel-python-evaluate
(session body &optional result-type result-params)
(session body &optional result-type result-params preamble)
"Evaluate BODY as python code."
(if session
(org-babel-python-evaluate-session
session body result-type result-params)
(org-babel-python-evaluate-external-process
body result-type result-params)))
body result-type result-params preamble)))
(defun org-babel-python-evaluate-external-process
(body &optional result-type result-params)
(body &optional result-type result-params preamble)
"Evaluate BODY in external python process.
If RESULT-TYPE equals 'output then return standard output as a
string. If RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp."
(case result-type
(output (org-babel-eval org-babel-python-command body))
(output (org-babel-eval org-babel-python-command
(concat (if preamble (concat preamble "\n") "") body)))
(value (let ((tmp-file (org-babel-temp-file "python-")))
(org-babel-eval org-babel-python-command
(format
(if (member "pp" result-params)
org-babel-python-pp-wrapper-method
org-babel-python-wrapper-method)
(mapconcat
(lambda (line) (format "\t%s" line))
(split-string
(org-remove-indentation
(org-babel-trim body))
"[\r\n]") "\n")
(org-babel-process-file-name tmp-file 'noquote)))
(concat
(if preamble (concat preamble "\n") "")
(format
(if (member "pp" result-params)
org-babel-python-pp-wrapper-method
org-babel-python-wrapper-method)
(mapconcat
(lambda (line) (format "\t%s" line))
(split-string
(org-remove-indentation
(org-babel-trim body))
"[\r\n]") "\n")
(org-babel-process-file-name tmp-file 'noquote))))
((lambda (raw)
(if (or (member "code" result-params)
(member "pp" result-params))
@ -240,7 +233,7 @@ last statement in BODY, as elisp."
(lambda (statement) (insert statement) (comint-send-input))
(if pp
(list
"import pp"
"import pprint"
(format "open('%s', 'w').write(pprint.pformat(_))"
(org-babel-process-file-name tmp-file 'noquote)))
(list (format "open('%s', 'w').write(str(_))"

56
lisp/org/ob-ref.el
View file

@ -2,11 +2,10 @@
;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Dan Davison
;; Author: Eric Schulte, Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.
@ -52,11 +51,13 @@
;;; Code:
(require 'ob)
(eval-when-compile
(require 'org-list)
(require 'cl))
(declare-function org-remove-if-not "org" (predicate seq))
(declare-function org-at-table-p "org" (&optional table-type))
(declare-function org-count "org" (CL-ITEM CL-SEQ))
(declare-function org-in-item-p "org-list" ())
(defvar org-babel-ref-split-regexp
"[ \f\t\n\r\v]*\\(.+?\\)[ \f\t\n\r\v]*=[ \f\t\n\r\v]*\\(.+\\)[ \f\t\n\r\v]*")
@ -74,46 +75,39 @@ the variable."
(let ((var (match-string 1 assignment))
(ref (match-string 2 assignment)))
(cons (intern var)
((lambda (val)
(if (equal :ob-must-be-reference val)
(org-babel-ref-resolve ref) val))
(org-babel-ref-literal ref))))))
(defun org-babel-ref-literal (ref)
"Return the value of REF if it is a literal value.
Determine if the right side of a header argument variable
assignment is a literal value or is a reference to some external
resource. REF should be a string of the right hand side of the
assignment. If REF is literal then return it's value, otherwise
return nil."
(let ((out (org-babel-read ref)))
(if (equal out ref)
(if (string-match "^\".+\"$" ref)
(read ref)
:ob-must-be-reference)
out)))
(let ((out (org-babel-read ref)))
(if (equal out ref)
(if (string-match "^\".+\"$" ref)
(read ref)
(org-babel-ref-resolve ref))
out))))))
(defvar org-babel-library-of-babel)
(defun org-babel-ref-resolve (ref)
"Resolve the reference REF and return its value."
(save-excursion
(let ((case-fold-search t)
type args new-refere new-referent result lob-info split-file split-ref
index index-row index-col)
type args new-refere new-header-args new-referent result
lob-info split-file split-ref index index-row index-col)
;; if ref is indexed grab the indices -- beware nested indices
(when (and (string-match "\\[\\(.+\\)\\]" ref)
(when (and (string-match "\\[\\([^\\[]+\\)\\]$" ref)
(let ((str (substring ref 0 (match-beginning 0))))
(= (org-count ?( str) (org-count ?) str))))
(setq index (match-string 1 ref))
(setq ref (substring ref 0 (match-beginning 0))))
;; assign any arguments to pass to source block
(when (string-match "^\\(.+?\\)\(\\(.*\\)\)$" ref)
(setq new-refere (match-string 1 ref))
(setq new-referent (match-string 2 ref))
(when (string-match
"^\\(.+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)\(\\(.*\\)\)$" ref)
(setq new-refere (match-string 1 ref))
(setq new-header-args (match-string 3 ref))
(setq new-referent (match-string 5 ref))
(when (> (length new-refere) 0)
(if (> (length new-referent) 0)
(setq args (mapcar (lambda (ref) (cons :var ref))
(org-babel-ref-split-args new-referent))))
(when (> (length new-referent) 0)
(setq args (mapcar (lambda (ref) (cons :var ref))
(org-babel-ref-split-args new-referent))))
(when (> (length new-header-args) 0)
(setq args (append (org-babel-parse-header-arguments new-header-args)
args)))
(setq ref new-refere)))
(when (string-match "^\\(.+\\):\\(.+\\)$" ref)
(setq split-file (match-string 1 ref))
@ -155,6 +149,7 @@ return nil."
(case type
('results-line (org-babel-read-result))
('table (org-babel-read-table))
('list (org-babel-read-list))
('file (org-babel-read-link))
('source-block (org-babel-execute-src-block nil nil params))
('lob (org-babel-execute-src-block nil lob-info params)))))
@ -222,6 +217,7 @@ to \"0:-1\"."
Return nil if none of the supported reference types are found.
Supported reference types are tables and source blocks."
(cond ((org-at-table-p) 'table)
((org-in-item-p) 'list)
((looking-at "^[ \t]*#\\+BEGIN_SRC") 'source-block)
((looking-at org-bracket-link-regexp) 'file)
((looking-at org-babel-result-regexp) 'results-line)))

19
lisp/org/ob-ruby.el
View file

@ -1,11 +1,11 @@
;;; ob-ruby.el --- org-babel functions for ruby evaluation
;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 2009, 2010 Free Software Foundation
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.
@ -29,10 +29,10 @@
;;; Requirements:
;; - ruby and irb executables :: http://www.ruby-lang.org/
;;
;;
;; - ruby-mode :: Can be installed through ELPA, or from
;; http://github.com/eschulte/rinari/raw/master/util/ruby-mode.el
;;
;;
;; - inf-ruby mode :: Can be installed through ELPA, or from
;; http://github.com/eschulte/rinari/raw/master/util/inf-ruby.el
@ -116,16 +116,7 @@ specifying a variable of the same value."
"Convert RESULTS into an appropriate elisp value.
If RESULTS look like a table, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
(org-babel-read
(if (and (stringp results) (string-match "^\\[.+\\]$" results))
(org-babel-read
(concat "'"
(replace-regexp-in-string
"\\[" "(" (replace-regexp-in-string
"\\]" ")" (replace-regexp-in-string
", " " " (replace-regexp-in-string
"'" "\"" results))))))
results)))
(org-babel-script-escape results))
(defun org-babel-ruby-initiate-session (&optional session params)
"Initiate a ruby session.

2
lisp/org/ob-sass.el
View file

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.

24
lisp/org/ob-scheme.el
View file

@ -1,26 +1,28 @@
;;; ob-scheme.el --- org-babel functions for Scheme
;; Copyright (C) 2010 Free Software Foundation, Inc.
;; Copyright (C) 2010 Free Software Foundation
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, scheme
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.
;;; License:
;; GNU Emacs is free software: you can redistribute it and/or modify
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
@ -33,7 +35,7 @@
;; - a working scheme implementation
;; (e.g. guile http://www.gnu.org/software/guile/guile.html)
;;
;;
;; - for session based evaluation cmuscheme.el is required which is
;; included in Emacs

4
lisp/org/ob-screen.el
View file

@ -1,11 +1,11 @@
;;; ob-screen.el --- org-babel support for interactive terminal
;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 2009, 2010 Free Software Foundation
;; Author: Benjamin Andresen
;; Keywords: literate programming, interactive shell
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.

15
lisp/org/ob-sh.el
View file

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.
@ -100,7 +100,7 @@ var of the same value."
(if (listp el)
(mapcar #'deep-string el)
(org-babel-sh-var-to-sh el sep))))
(format "$(cat <<BABEL_TABLE\n%s\nBABEL_TABLE\n)"
(format "$(cat <<'BABEL_TABLE'\n%s\nBABEL_TABLE\n)"
(orgtbl-to-generic
(deep-string (if (listp (car var)) var (list var)))
(list :sep (or sep "\t")))))
@ -114,16 +114,7 @@ var of the same value."
"Convert RESULTS to an appropriate elisp value.
If the results look like a table, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
(org-babel-read
(if (string-match "^\\[.+\\]$" results)
(org-babel-read
(concat "'"
(replace-regexp-in-string
"\\[" "(" (replace-regexp-in-string
"\\]" ")" (replace-regexp-in-string
", " " " (replace-regexp-in-string
"'" "\"" results))))))
results)))
(org-babel-script-escape results))
(defun org-babel-sh-initiate-session (&optional session params)
"Initiate a session named SESSION according to PARAMS."

38
lisp/org/ob-sql.el
View file

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.
@ -47,9 +47,15 @@
(eval-when-compile (require 'cl))
(declare-function org-table-import "org-table" (file arg))
(declare-function orgtbl-to-csv "org-table" (TABLE PARAMS))
(defvar org-babel-default-header-args:sql '())
(defun org-babel-expand-body:sql (body params)
"Expand BODY according to the values of PARAMS."
(org-babel-sql-expand-vars
body (mapcar #'cdr (org-babel-get-header params :var))))
(defun org-babel-execute:sql (body params)
"Execute a block of Sql code with Babel.
This function is called by `org-babel-execute-src-block'."
@ -60,6 +66,10 @@ This function is called by `org-babel-execute-src-block'."
(out-file (or (cdr (assoc :out-file params))
(org-babel-temp-file "sql-out-")))
(command (case (intern engine)
('msosql (format "osql %s -s \"\t\" -i %s -o %s"
(or cmdline "")
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)))
('mysql (format "mysql %s -e \"source %s\" > %s"
(or cmdline "")
(org-babel-process-file-name in-file)
@ -70,11 +80,11 @@ This function is called by `org-babel-execute-src-block'."
(or cmdline "")))
(t (error "no support for the %s sql engine" engine)))))
(with-temp-file in-file
(insert (org-babel-expand-body:generic body params)))
(insert (org-babel-expand-body:sql body params)))
(message command)
(shell-command command)
(with-temp-buffer
(org-table-import out-file nil)
(org-table-import out-file '(16))
(org-babel-reassemble-table
(org-table-to-lisp)
(org-babel-pick-name (cdr (assoc :colname-names params))
@ -82,6 +92,28 @@ This function is called by `org-babel-execute-src-block'."
(org-babel-pick-name (cdr (assoc :rowname-names params))
(cdr (assoc :rownames params)))))))
(defun org-babel-sql-expand-vars (body vars)
"Expand the variables held in VARS in BODY."
(mapc
(lambda (pair)
(setq body
(replace-regexp-in-string
(format "\$%s" (car pair))
((lambda (val)
(if (listp val)
((lambda (data-file)
(with-temp-file data-file
(insert (orgtbl-to-csv
val '(:fmt (lambda (el) (if (stringp el)
el
(format "%S" el)))))))
data-file)
(org-babel-temp-file "sql-data-"))
(if (stringp val) val (format "%S" val))))
(cdr pair))
body)))
vars)
body)
(defun org-babel-prep-session:sql (session params)
"Raise an error because Sql sessions aren't implemented."

19
lisp/org/ob-sqlite.el
View file

@ -1,11 +1,11 @@
;;; ob-sqlite.el --- org-babel functions for sqlite database interaction
;; Copyright (C) 2010 Free Software Foundation, Inc.
;; Copyright (C) 2010 Free Software Foundation
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.
@ -28,6 +28,7 @@
;;; Code:
(require 'ob)
(require 'ob-eval)
(require 'ob-ref)
(declare-function org-fill-template "org" (template alist))
@ -52,7 +53,6 @@
"Execute a block of Sqlite code with Babel.
This function is called by `org-babel-execute-src-block'."
(let ((result-params (split-string (or (cdr (assoc :results params)) "")))
(vars (org-babel-get-header params :var))
(db (cdr (assoc :db params)))
(separator (cdr (assoc :separator params)))
(nullvalue (cdr (assoc :nullvalue params)))
@ -65,15 +65,10 @@ This function is called by `org-babel-execute-src-block'."
(unless db (error "ob-sqlite: can't evaluate without a database."))
(with-temp-buffer
(insert
(shell-command-to-string
(org-babel-eval
(org-fill-template
"%cmd -init %body %header %separator %nullvalue %others %csv %db "
"%cmd %header %separator %nullvalue %others %csv %db "
(list
(cons "body" ((lambda (sql-file)
(with-temp-file sql-file
(insert (org-babel-expand-body:sqlite body params)))
sql-file)
(org-babel-temp-file "sqlite-sql-")))
(cons "cmd" org-babel-sqlite3-command)
(cons "header" (if headers-p "-header" "-noheader"))
(cons "separator"
@ -90,7 +85,9 @@ This function is called by `org-babel-execute-src-block'."
(member :html others) separator)
""
"-csv"))
(cons "db " db)))))
(cons "db " db)))
;; body of the code block
(org-babel-expand-body:sqlite body params)))
(if (or (member "scalar" result-params)
(member "html" result-params)
(member "code" result-params)

8
lisp/org/ob-table.el
View file

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.
@ -57,9 +57,9 @@
"Replace newline character with ellipses.
If STRING ends in a newline character, then remove the newline
character and replace it with ellipses."
(if (and (stringp string) (string-match "[\n\r]" string))
(concat (substring string 0 (match-beginning 0)) "...")
string))
(if (and (stringp string) (string-match "[\n\r]\\(.\\)?" string))
(concat (substring string 0 (match-beginning 0))
(if (match-string 1 string) "...")) string))
(defmacro sbe (source-block &rest variables)
"Return the results of calling SOURCE-BLOCK with VARIABLES.

3
lisp/org/ob-tangle.el
View file

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.
@ -125,6 +125,7 @@ evaluating BODY."
This function exports the source code using
`org-babel-tangle' and then loads the resulting file using
`load-file'."
(interactive "fFile to load: ")
(flet ((age (file)
(float-time
(time-subtract (current-time)

356
lisp/org/ob.el
View file

@ -2,11 +2,10 @@
;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Dan Davison
;; Author: Eric Schulte, Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.
@ -31,7 +30,9 @@
;;; Code:
(eval-when-compile
(require 'org-list)
(require 'cl))
(require 'ob-eval)
(require 'org-macs)
(defvar org-babel-call-process-region-original)
@ -43,7 +44,7 @@
(declare-function tramp-file-name-host "tramp" (vec))
(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body))
(declare-function org-icompleting-read "org" (&rest args))
(declare-function org-edit-src-code "org-src"
(declare-function org-edit-src-code "org-src"
(&optional context code edit-buffer-name quietp))
(declare-function org-edit-src-exit "org-src" (&optional context))
(declare-function org-open-at-point "org" (&optional in-emacs reference-buffer))
@ -73,6 +74,10 @@
(declare-function org-babel-ref-resolve "ob-ref" (ref))
(declare-function org-babel-lob-execute-maybe "ob-lob" ())
(declare-function org-number-sequence "org-compat" (from &optional to inc))
(declare-function org-in-item-p "org-list" ())
(declare-function org-list-parse-list "org-list" (&optional delete))
(declare-function org-list-to-generic "org-list" (LIST PARAMS))
(declare-function org-list-bottom-point "org-list" ())
(defgroup org-babel nil
"Code block evaluation and management in `org-mode' documents."
@ -213,9 +218,13 @@ of potentially harmful code."
(if (or (equal eval "never") (equal eval "no")
(and query
(not (yes-or-no-p
(format "Evaluate this%scode on your system? "
(if info (format " %s " (nth 0 info)) " "))))))
(prog1 nil (message "evaluation aborted"))
(format "Evaluate this%scode block%son your system? "
(if info (format " %s " (nth 0 info)) " ")
(if (nth 4 info)
(format " (%s) " (nth 4 info)) " "))))))
(prog1 nil (message "Evaluation %s"
(if (or (equal eval "never") (equal eval "no"))
"Disabled" "Aborted")))
t)))
;;;###autoload
@ -238,7 +247,8 @@ then run `org-babel-execute-src-block'."
(interactive)
(let ((info (org-babel-get-src-block-info)))
(if info
(progn (org-babel-execute-src-block current-prefix-arg info) t) nil)))
(progn (org-babel-eval-wipe-error-buffer)
(org-babel-execute-src-block current-prefix-arg info) t) nil)))
;;;###autoload
(defun org-babel-expand-src-block-maybe ()
@ -363,10 +373,12 @@ block."
(new-hash (when cache? (org-babel-sha1-hash info)))
(old-hash (when cache? (org-babel-result-hash info)))
(body (setf (nth 1 info)
(if (and (cdr (assoc :noweb params))
(string= "yes" (cdr (assoc :noweb params))))
(org-babel-expand-noweb-references info)
(nth 1 info))))
(let ((noweb (cdr (assoc :noweb params))))
(if (and noweb
(or (string= "yes" noweb)
(string= "tangle" noweb)))
(org-babel-expand-noweb-references info)
(nth 1 info)))))
(cmd (intern (concat "org-babel-execute:" lang)))
(dir (cdr (assoc :dir params)))
(default-directory
@ -379,7 +391,7 @@ block."
result)
(unwind-protect
(flet ((call-process-region (&rest args)
(apply 'org-babel-tramp-handle-call-process-region args)))
(apply 'org-babel-tramp-handle-call-process-region args)))
(unless (fboundp cmd)
(error "No org-babel-execute function for %s!" lang))
(if (and (not arg) new-hash (equal new-hash old-hash))
@ -583,6 +595,60 @@ results already exist."
(insert (echo-res results))))))
t)))
;;;###autoload
(defmacro org-babel-map-src-blocks (file &rest body)
"Evaluate BODY forms on each source-block in FILE.
If FILE is nil evaluate BODY forms on source blocks in current
buffer. During evaluation of BODY the following local variables
are set relative to the currently matched code block.
full-block ------- string holding the entirety of the code block
beg-block -------- point at the beginning of the code block
end-block -------- point at the end of the matched code block
lang ------------- string holding the language of the code block
beg-lang --------- point at the beginning of the lang
end-lang --------- point at the end of the lang
switches --------- string holding the switches
beg-switches ----- point at the beginning of the switches
end-switches ----- point at the end of the switches
header-args ------ string holding the header-args
beg-header-args -- point at the beginning of the header-args
end-header-args -- point at the end of the header-args
body ------------- string holding the body of the code block
beg-body --------- point at the beginning of the body
end-body --------- point at the end of the body"
(declare (indent 1))
(let ((tempvar (make-symbol "file")))
`(let* ((,tempvar ,file)
(visited-p (or (null ,tempvar)
(get-file-buffer (expand-file-name ,tempvar))))
(point (point)) to-be-removed)
(save-window-excursion
(when ,tempvar (find-file ,tempvar))
(setq to-be-removed (current-buffer))
(goto-char (point-min))
(while (re-search-forward org-babel-src-block-regexp nil t)
(goto-char (match-beginning 0))
(let ((full-block (match-string 0))
(beg-block (match-beginning 0))
(end-block (match-end 0))
(lang (match-string 2))
(beg-lang (match-beginning 2))
(end-lang (match-end 2))
(switches (match-string 3))
(beg-switches (match-beginning 3))
(end-switches (match-end 3))
(header-args (match-string 4))
(beg-header-args (match-beginning 4))
(end-header-args (match-end 4))
(body (match-string 5))
(beg-body (match-beginning 5))
(end-body (match-end 5)))
,@body
(goto-char end-block))))
(unless visited-p (kill-buffer to-be-removed))
(goto-char point))))
;;;###autoload
(defun org-babel-execute-buffer (&optional arg)
"Execute source code blocks in a buffer.
@ -757,57 +823,6 @@ portions of results lines."
(lambda () (org-add-hook 'change-major-mode-hook
'org-babel-show-result-all 'append 'local)))
(defmacro org-babel-map-src-blocks (file &rest body)
"Evaluate BODY forms on each source-block in FILE.
If FILE is nil evaluate BODY forms on source blocks in current
buffer. During evaluation of BODY the following local variables
are set relative to the currently matched code block.
full-block ------- string holding the entirety of the code block
beg-block -------- point at the beginning of the code block
end-block -------- point at the end of the matched code block
lang ------------- string holding the language of the code block
beg-lang --------- point at the beginning of the lang
end-lang --------- point at the end of the lang
switches --------- string holding the switches
beg-switches ----- point at the beginning of the switches
end-switches ----- point at the end of the switches
header-args ------ string holding the header-args
beg-header-args -- point at the beginning of the header-args
end-header-args -- point at the end of the header-args
body ------------- string holding the body of the code block
beg-body --------- point at the beginning of the body
end-body --------- point at the end of the body"
(declare (indent 1))
`(let ((visited-p (or (null ,file)
(get-file-buffer (expand-file-name ,file))))
(point (point)) to-be-removed)
(save-window-excursion
(when ,file (find-file ,file))
(setq to-be-removed (current-buffer))
(goto-char (point-min))
(while (re-search-forward org-babel-src-block-regexp nil t)
(goto-char (match-beginning 0))
(let ((full-block (match-string 0))
(beg-block (match-beginning 0))
(end-block (match-end 0))
(lang (match-string 2))
(beg-lang (match-beginning 2))
(end-lang (match-end 2))
(switches (match-string 3))
(beg-switches (match-beginning 3))
(end-switches (match-end 3))
(header-args (match-string 4))
(beg-header-args (match-beginning 4))
(end-header-args (match-end 4))
(body (match-string 5))
(beg-body (match-beginning 5))
(end-body (match-end 5)))
,@body
(goto-char end-block))))
(unless visited-p (kill-buffer to-be-removed))
(goto-char point)))
(defvar org-file-properties)
(defun org-babel-params-from-properties (&optional lang)
"Retrieve parameters specified as properties.
@ -893,17 +908,31 @@ may be specified at the top of the current buffer."
(defun org-babel-parse-header-arguments (arg-string)
"Parse a string of header arguments returning an alist."
(if (> (length arg-string) 0)
(delq nil
(mapcar
(lambda (arg)
(if (string-match
"\\([^ \f\t\n\r\v]+\\)[ \f\t\n\r\v]+\\([^ \f\t\n\r\v]+.*\\)"
arg)
(cons (intern (concat ":" (match-string 1 arg)))
(org-babel-read (org-babel-chomp (match-string 2 arg))))
(cons (intern (concat ":" arg)) nil)))
(split-string (concat " " arg-string) "[ \f\t\n\r\v]+:" t)))))
(when (> (length arg-string) 0)
(delq nil
(mapcar
(lambda (arg)
(if (string-match
"\\([^ \f\t\n\r\v]+\\)[ \f\t\n\r\v]+\\([^ \f\t\n\r\v]+.*\\)"
arg)
(cons (intern (match-string 1 arg))
(org-babel-read (org-babel-chomp (match-string 2 arg))))
(cons (intern (org-babel-chomp arg)) nil)))
(let ((balance 0) (partial nil) (lst nil) (last 0))
(mapc (lambda (ch) ; split on [] balanced instances of [ \t]:
(setq balance (+ balance
(cond ((equal 91 ch) 1)
((equal 93 ch) -1)
(t 0))))
(setq partial (cons ch partial))
(when (and (= ch 58) (= balance 0)
(or (= last 32) (= last 9)))
(setq lst (cons (apply #'string (nreverse (cddr partial)))
lst))
(setq partial (list ch)))
(setq last ch))
(string-to-list arg-string))
(nreverse (cons (apply #'string (nreverse partial)) lst)))))))
(defun org-babel-process-params (params)
"Expand variables in PARAMS and add summary parameters."
@ -1291,6 +1320,7 @@ following the source block."
(let ((case-fold-search t) result-string)
(cond
((org-at-table-p) (org-babel-read-table))
((org-in-item-p) (org-babel-read-list))
((looking-at org-bracket-link-regexp) (org-babel-read-link))
((looking-at org-block-regexp) (org-babel-trim (match-string 4)))
((looking-at "^[ \t]*: ")
@ -1316,6 +1346,10 @@ following the source block."
(mapcar #'org-babel-read row)))
(org-table-to-lisp)))
(defun org-babel-read-list ()
"Read the list at `point' into emacs-lisp."
(mapcar #'org-babel-read (cdr (org-list-parse-list))))
(defvar org-link-types-re)
(defun org-babel-read-link ()
"Read the link at `point' into emacs-lisp.
@ -1349,7 +1383,9 @@ silent -- no results are inserted
file ---- the results are interpreted as a file path, and are
inserted into the buffer using the Org-mode file syntax
raw ----- results are added directly to the org-mode file. This
list ---- the results are interpreted as an Org-mode list.
raw ----- results are added directly to the Org-mode file. This
is a good option if you code block will output org-mode
formatted text.
@ -1406,16 +1442,24 @@ code ---- the results are extracted in the syntax of the source
((member "replace" result-params)
(delete-region (point) (org-babel-result-end)))
((member "append" result-params)
(goto-char (org-babel-result-end)) (setq beg (point)))
((member "prepend" result-params) ;; already there
)))
(goto-char (org-babel-result-end)) (setq beg (point-marker)))
((member "prepend" result-params)))) ; already there
(setq results-switches
(if results-switches (concat " " results-switches) ""))
;; insert results based on type
(cond
;; do nothing for an empty result
((= (length result) 0))
;; insert a list if preferred
((member "list" result-params)
(insert
(org-babel-trim
(org-list-to-generic (cons 'unordered
(if (listp result) result (list result)))
'(:splicep nil :istart "- " :iend "\n")))))
;; assume the result is a table if it's not a string
((not (stringp result))
(goto-char beg)
(insert (concat (orgtbl-to-orgtbl
(if (or (eq 'hline (car result))
(and (listp (car result))
@ -1425,24 +1469,34 @@ code ---- the results are extracted in the syntax of the source
(goto-char beg) (when (org-at-table-p) (org-table-align)))
((member "file" result-params)
(insert result))
((member "html" result-params)
(insert (format "#+BEGIN_HTML%s\n%s#+END_HTML\n"
results-switches result)))
((member "latex" result-params)
(insert (format "#+BEGIN_LaTeX%s\n%s#+END_LaTeX\n"
results-switches result)))
((member "code" result-params)
(insert (format "#+BEGIN_SRC %s%s\n%s#+END_SRC\n"
(or lang "none") results-switches result)))
((member "org" result-params)
(insert (format "#+BEGIN_SRC org\n%s#+END_SRC\n" result)))
((member "raw" result-params)
(save-excursion (insert result)) (if (org-at-table-p) (org-cycle)))
(t
(org-babel-examplize-region
(point) (progn (insert result) (point)) results-switches)))
(t (goto-char beg) (insert result)))
(when (listp result) (goto-char (org-table-end)))
(setq end (point-marker))
;; possibly wrap result
(flet ((wrap (start finish)
(goto-char beg) (insert start)
(goto-char end) (insert finish)
(setq end (point-marker))))
(cond
((member "html" result-params)
(wrap "#+BEGIN_HTML\n" "#+END_HTML"))
((member "latex" result-params)
(wrap "#+BEGIN_LaTeX\n" "#+END_LaTeX"))
((member "code" result-params)
(wrap (format "#+BEGIN_SRC %s%s\n" (or lang "none") results-switches)
"#+END_SRC"))
((member "org" result-params)
(wrap "#+BEGIN_ORG\n" "#+END_ORG"))
((member "raw" result-params)
(goto-char beg) (if (org-at-table-p) (org-cycle)))
((member "wrap" result-params)
(when (and (stringp result) (not (member "file" result-params)))
(org-babel-examplize-region beg end results-switches))
(wrap "#+BEGIN_RESULT\n" "#+END_RESULT"))
((and (stringp result) (not (member "file" result-params)))
(org-babel-examplize-region beg end results-switches)
(setq end (point)))))
;; possibly indent the results to match the #+results line
(setq end (if (listp result) (org-table-end) (point)))
(when (and indent (> indent 0)
;; in this case `table-align' does the work for us
(not (and (listp result)
@ -1450,9 +1504,9 @@ code ---- the results are extracted in the syntax of the source
(indent-rigidly beg end indent))))
(if (= (length result) 0)
(if (member "value" result-params)
(message "No result returned by source block")
(message "Source block produced no output"))
(message "finished"))))
(message "Code block returned no value.")
(message "Code block produced no output."))
(message "Code block evaluation complete."))))
(defun org-babel-remove-result (&optional info)
"Remove the result of the current source block."
@ -1466,25 +1520,18 @@ code ---- the results are extracted in the syntax of the source
(defun org-babel-result-end ()
"Return the point at the end of the current set of results"
(save-excursion
(if (org-at-table-p)
(progn (goto-char (org-table-end)) (point))
(let ((case-fold-search t))
(cond
((looking-at "[ \t]*#\\+begin_latex")
(re-search-forward "[ \t]*#\\+end_latex" nil t)
(forward-line 1))
((looking-at "[ \t]*#\\+begin_html")
(re-search-forward "[ \t]*#\\+end_html" nil t)
(forward-line 1))
((looking-at "[ \t]*#\\+begin_example")
(re-search-forward "[ \t]*#\\+end_example" nil t)
(forward-line 1))
((looking-at "[ \t]*#\\+begin_src")
(re-search-forward "[ \t]*#\\+end_src" nil t)
(forward-line 1))
(t (progn (while (looking-at "[ \t]*\\(: \\|\\[\\[\\)")
(forward-line 1))))))
(point))))
(cond
((org-at-table-p) (progn (goto-char (org-table-end)) (point)))
((org-in-item-p) (- (org-list-bottom-point) 1))
(t
(let ((case-fold-search t)
(blocks-re (regexp-opt
(list "latex" "html" "example" "src" "result"))))
(if (looking-at (concat "[ \t]*#\\+begin_" blocks-re))
(re-search-forward (concat "[ \t]*#\\+end_" blocks-re) nil t)
(while (looking-at "[ \t]*\\(: \\|\\[\\[\\)")
(forward-line 1))))
(point)))))
(defun org-babel-result-to-file (result)
"Convert RESULT into an `org-mode' link.
@ -1505,9 +1552,7 @@ file's directory then expand relative links."
(interactive "*r")
(let ((size (count-lines beg end)))
(save-excursion
(cond ((= size 0)
(error (concat "This should not be impossible:"
"a newline was appended to result if missing")))
(cond ((= size 0)) ; do nothing for an empty result
((< size org-babel-min-lines-for-block-output)
(goto-char beg)
(dotimes (n size)
@ -1517,7 +1562,7 @@ file's directory then expand relative links."
(insert (if results-switches
(format "#+begin_example%s\n" results-switches)
"#+begin_example\n"))
(forward-char (- end beg))
(if (markerp end) (goto-char end) (forward-char (- end beg)))
(insert "#+end_example\n"))))))
(defun org-babel-update-block-body (new-body)
@ -1534,8 +1579,8 @@ Later elements of PLISTS override the values of previous element.
This takes into account some special considerations for certain
parameters when merging lists."
(let ((results-exclusive-groups
'(("file" "vector" "table" "scalar" "raw" "org"
"html" "latex" "code" "pp")
'(("file" "list" "vector" "table" "scalar" "raw" "org"
"html" "latex" "code" "pp" "wrap")
("replace" "silent" "append" "prepend")
("output" "value")))
(exports-exclusive-groups
@ -1599,7 +1644,7 @@ parameters when merging lists."
(:tangle ;; take the latest -- always overwrite
(setq tangle (or (list (cdr pair)) tangle)))
(:noweb
(setq noweb (e-merge '(("yes" "no")) noweb
(setq noweb (e-merge '(("yes" "no" "tangle")) noweb
(split-string (or (cdr pair) "")))))
(:cache
(setq cache (e-merge '(("yes" "no")) cache
@ -1718,6 +1763,38 @@ block but are passed literally to the \"example-block\"."
"Strip protective commas from bodies of source blocks."
(replace-regexp-in-string "^,#" "#" body))
(defun org-babel-script-escape (str)
"Safely convert tables into elisp lists."
(let (in-single in-double out)
(org-babel-read
(if (and (stringp str) (string-match "^\\[.+\\]$" str))
(org-babel-read
(concat
"'"
(progn
(mapc
(lambda (ch)
(setq
out
(case ch
(91 (if (or in-double in-single) ; [
(cons 91 out)
(cons 40 out)))
(93 (if (or in-double in-single) ; ]
(cons 93 out)
(cons 41 out)))
(44 (if (or in-double in-single) (cons 44 out) out)) ; ,
(39 (if in-double ; '
(cons 39 out)
(setq in-single (not in-single)) (cons 34 out)))
(34 (if in-single ; "
(append (list 34 32) out)
(setq in-double (not in-double)) (cons 34 out)))
(t (cons ch out)))))
(string-to-list str))
(apply #'string (reverse out)))))
str))))
(defun org-babel-read (cell)
"Convert the string value of CELL to a number if appropriate.
Otherwise if cell looks like lisp (meaning it starts with a
@ -1851,7 +1928,7 @@ of `org-babel-temporary-directory'."
(if (file-remote-p default-directory)
(make-temp-file
(concat (file-remote-p default-directory)
(expand-file-name
(expand-file-name
prefix temporary-file-directory)
nil suffix))
(let ((temporary-file-directory
@ -1865,17 +1942,22 @@ of `org-babel-temporary-directory'."
(when (and (boundp 'org-babel-temporary-directory)
(file-exists-p org-babel-temporary-directory))
;; taken from `delete-directory' in files.el
(mapc (lambda (file)
;; This test is equivalent to
;; (and (file-directory-p fn) (not (file-symlink-p fn)))
;; but more efficient
(if (eq t (car (file-attributes file)))
(delete-directory file)
(delete-file file)))
;; We do not want to delete "." and "..".
(directory-files org-babel-temporary-directory 'full
"^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
(delete-directory org-babel-temporary-directory)))
(condition-case nil
(progn
(mapc (lambda (file)
;; This test is equivalent to
;; (and (file-directory-p fn) (not (file-symlink-p fn)))
;; but more efficient
(if (eq t (car (file-attributes file)))
(delete-directory file)
(delete-file file)))
;; We do not want to delete "." and "..".
(directory-files org-babel-temporary-directory 'full
"^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
(delete-directory org-babel-temporary-directory))
(error
(message "Failed to remove temporary Org-babel directory %s"
org-babel-temporary-directory)))))
(add-hook 'kill-emacs-hook 'org-babel-remove-temporary-directory)

561
lisp/org/org-agenda.el
View file

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;
@ -242,8 +242,12 @@ you can \"misuse\" it to also add other text to the header. However,
(const org-agenda-prefix-format :value " %-12:c%?-12t% s")
(string))
(list :tag "Number of days in agenda"
(const org-agenda-ndays)
(integer :value 1))
(const org-agenda-span)
(choice (const :tag "Day" 'day)
(const :tag "Week" 'week)
(const :tag "Month" 'month)
(const :tag "Year" 'year)
(integer :tag "Custom")))
(list :tag "Fixed starting date"
(const org-agenda-start-day)
(string :value "2007-11-01"))
@ -562,6 +566,33 @@ See also the variable `org-agenda-tags-todo-honor-ignore-options'."
:group 'org-agenda-todo-list
:type 'boolean)
(defcustom org-agenda-todo-ignore-timestamp nil
"Non-nil means don't show entries with a timestamp.
This applies when creating the global todo list.
Valid values are:
past Don't show entries for today or in the past.
future Don't show entries with a timestamp in the future.
The idea behind this is that if it has a future
timestamp, you don't want to think about it until the
date.
all Don't show any entries with a timestamp in the global todo list.
The idea behind this is that by setting a timestamp, you
have already \"taken care\" of this item.
See also `org-agenda-todo-ignore-with-date'.
See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want
to make his option also apply to the tags-todo list."
:group 'org-agenda-skip
:group 'org-agenda-todo-list
:type '(choice
(const :tag "Ignore future timestamp todos" future)
(const :tag "Ignore past or present timestamp todos" past)
(const :tag "Ignore all timestamp todos" all)
(const :tag "Show timestamp todos" nil)))
(defcustom org-agenda-todo-ignore-scheduled nil
"Non-nil means, ignore some scheduled TODO items when making TODO list.
This applies when creating the global todo list.
@ -632,7 +663,8 @@ to make his option also apply to the tags-todo list."
"Non-nil means honor todo-list ...ignore options also in tags-todo search.
The variables
`org-agenda-todo-ignore-with-date',
`org-agenda-todo-ignore-scheduled'
`org-agenda-todo-ignore-timestamp',
`org-agenda-todo-ignore-scheduled',
`org-agenda-todo-ignore-deadlines'
make the global TODO list skip entries that have time stamps of certain
kinds. If this option is set, the same options will also apply for the
@ -860,12 +892,25 @@ option will be ignored."
:group 'org-agenda-windows
:type 'boolean)
(defcustom org-agenda-ndays 7
"Number of days to include in overview display.
(defcustom org-agenda-ndays nil
"Number of days to include in overview display.
Should be 1 or 7.
Obsolete, see `org-agenda-span'."
:group 'org-agenda-daily/weekly
:type 'integer)
(make-obsolete-variable 'org-agenda-ndays 'org-agenda-span "24.1")
(defcustom org-agenda-span 'week
"Number of days to include in overview display.
Can be day, week, month, year, or any number of days.
Custom commands can set this variable in the options section."
:group 'org-agenda-daily/weekly
:type 'integer)
:type '(choice (const :tag "Day" day)
(const :tag "Week" week)
(const :tag "Month" month)
(const :tag "Year" year)
(integer :tag "Custom")))
(defcustom org-agenda-start-on-weekday 1
"Non-nil means start the overview always on the specified weekday.
@ -922,6 +967,35 @@ For example, 9:30am would become 09:30 rather than 9:30."
:group 'org-agenda-daily/weekly
:type 'boolean)
(defcustom org-agenda-timegrid-use-ampm nil
"When set, show AM/PM style timestamps on the timegrid."
:group 'org-agenda
:type 'boolean)
(defun org-agenda-time-of-day-to-ampm (time)
"Convert TIME of a string like '13:45' to an AM/PM style time string."
(let* ((hour-number (string-to-number (substring time 0 -3)))
(minute (substring time -2))
(ampm "am"))
(cond
((equal hour-number 12)
(setq ampm "pm"))
((> hour-number 12)
(setq ampm "pm")
(setq hour-number (- hour-number 12))))
(concat
(if org-agenda-time-leading-zero
(format "%02d" hour-number)
(format "%02s" (number-to-string hour-number)))
":" minute ampm)))
(defun org-agenda-time-of-day-to-ampm-maybe (time)
"Conditionally convert TIME to AM/PM format
based on `org-agenda-timegrid-use-ampm'"
(if org-agenda-timegrid-use-ampm
(org-agenda-time-of-day-to-ampm time)
time))
(defcustom org-agenda-weekend-days '(6 0)
"Which days are weekend?
These days get the special face `org-agenda-date-weekend' in the agenda
@ -1211,11 +1285,11 @@ When nil, such items are sorted as 0 minutes effort."
:group 'org-agenda)
(defcustom org-agenda-prefix-format
'((agenda . " %-12:c%?-12t% s")
'((agenda . " %i %-12:c%?-12t% s")
(timeline . " % s")
(todo . " %-12:c")
(tags . " %-12:c")
(search . " %-12:c"))
(todo . " %i %-12:c")
(tags . " %i %-12:c")
(search . " %i %-12:c"))
"Format specifications for the prefix of items in the agenda views.
An alist with four entries, for the different agenda types. The keys to the
sublists are `agenda', `timeline', `todo', and `tags'. The values
@ -1224,6 +1298,8 @@ This format works similar to a printf format, with the following meaning:
%c the category of the item, \"Diary\" for entries from the diary, or
as given by the CATEGORY keyword or derived from the file name.
%i the icon category of the item, as give in
`org-agenda-category-icon-alist'.
%T the *last* tag of the item. Last because inherited tags come
first in the list.
%t the time-of-day specification if one applies to the entry, in the
@ -1431,6 +1507,52 @@ determines if it is a foreground or a background color."
(string :tag "Color")
(sexp :tag "Face"))))))
(defcustom org-agenda-day-face-function nil
"Function called to determine what face should be used to display a day.
The only argument passed to that function is the day. It should
returns a face, or nil if does not want to specify a face and let
the normal rules apply."
:group 'org-agenda-line-format
:type 'function)
(defcustom org-agenda-category-icon-alist nil
"Alist of category icon to be displayed in agenda views.
Each entry should have the following format:
(CATEGORY-REGEXP FILE-OR-DATA TYPE DATA-P PROPS)
Where CATEGORY-REGEXP is a regexp matching the categories where
the icon should be displayed.
FILE-OR-DATA either a file path or a string containing image data.
The other fields can be ommited safely if not needed:
TYPE indicates the image type.
DATA-P is a boolean indicating whether the FILE-OR-DATA string is
image data.
PROPS are additional image attributes to assign to the image,
like, e.g. `:ascent center'.
(\"Org\" \"/path/to/icon.png\" nil nil :ascent center)
If you want to set the display properties yourself, just put a
list as second element:
(CATEGORY-REGEXP (MY PROPERTY LIST))
For example, to display a 16px horizontal space for Emacs
category, you can use:
(\"Emacs\" '(space . (:width (16))))"
:group 'org-agenda-line-format
:type '(alist :key-type (string :tag "Regexp matching category")
:value-type (choice (list :tag "Icon"
(string :tag "File or data")
(symbol :tag "Type")
(boolean :tag "Data?")
(repeat :tag "Extra image properties" :inline t symbol))
(list :tag "Display properties" sexp))))
(defgroup org-agenda-column-view nil
"Options concerning column view in the agenda."
:tag "Org Agenda Column View"
@ -1720,19 +1842,19 @@ The following commands are available:
("View"
["Day View" org-agenda-day-view
:active (org-agenda-check-type nil 'agenda)
:style radio :selected (equal org-agenda-ndays 1)
:style radio :selected (eq org-agenda-current-span 'day)
:keys "v d (or just d)"]
["Week View" org-agenda-week-view
:active (org-agenda-check-type nil 'agenda)
:style radio :selected (equal org-agenda-ndays 7)
:style radio :selected (eq org-agenda-current-span 'week)
:keys "v w (or just w)"]
["Month View" org-agenda-month-view
:active (org-agenda-check-type nil 'agenda)
:style radio :selected (member org-agenda-ndays '(28 29 30 31))
:style radio :selected (eq org-agenda-current-span 'month)
:keys "v m"]
["Year View" org-agenda-year-view
:active (org-agenda-check-type nil 'agenda)
:style radio :selected (member org-agenda-ndays '(365 366))
:style radio :selected (eq org-agenda-current-span 'year)
:keys "v y"]
"--"
["Include Diary" org-agenda-toggle-diary
@ -2778,6 +2900,7 @@ removed from the entry content. Currently only `planning' is allowed here."
(defvar org-agenda-columns-active nil)
(defvar org-agenda-name nil)
(defvar org-agenda-filter nil)
(defvar org-agenda-filter-while-redo nil)
(defvar org-agenda-filter-preset nil
"A preset of the tags filter used for secondary agenda filtering.
This must be a list of strings, each string must be a single tag preceded
@ -3065,6 +3188,16 @@ no longer in use."
(progn (delete-overlay o) t)))
(overlays-in (point-min) (point-max)))))
(defun org-agenda-get-day-face (date)
"Return the face DATE should be displayed with."
(or (and (functionp org-agenda-day-face-function)
(funcall org-agenda-day-face-function date))
(cond ((org-agenda-todayp date)
'org-agenda-date-today)
((member (calendar-day-of-week date) org-agenda-weekend-days)
'org-agenda-date-weekend)
(t 'org-agenda-date))))
;;; Agenda timeline
(defvar org-agenda-only-exact-dates nil) ; dynamically scoped
@ -3092,10 +3225,10 @@ dates."
org-timeline-show-empty-dates))
(org-deadline-warning-days 0)
(org-agenda-only-exact-dates t)
(today (time-to-days (current-time)))
(today (org-today))
(past t)
args
s e rtn d emptyp wd)
s e rtn d emptyp)
(setq org-agenda-redo-command
(list 'progn
(list 'org-switch-to-buffer-other-window (current-buffer))
@ -3129,8 +3262,7 @@ dates."
(progn
(setq past nil)
(insert (make-string 79 ?-) "\n")))
(setq date (calendar-gregorian-from-absolute d)
wd (calendar-day-of-week date))
(setq date (calendar-gregorian-from-absolute d))
(setq s (point))
(setq rtn (and (not emptyp)
(apply 'org-agenda-get-day-entries entry
@ -3144,9 +3276,7 @@ dates."
(funcall org-agenda-format-date date))
"\n")
(put-text-property s (1- (point)) 'face
(if (member wd org-agenda-weekend-days)
'org-agenda-date-weekend
'org-agenda-date))
(org-agenda-get-day-face date))
(put-text-property s (1- (point)) 'org-date-line t)
(put-text-property s (1- (point)) 'org-agenda-date-header t)
(if (equal d today)
@ -3172,7 +3302,7 @@ When EMPTY is non-nil, also include days without any entries."
(if inactive org-ts-regexp-both org-ts-regexp)))
dates dates1 date day day1 day2 ts1 ts2)
(if force-today
(setq dates (list (time-to-days (current-time)))))
(setq dates (list (org-today))))
(save-excursion
(goto-char beg)
(while (re-search-forward re end t)
@ -3210,7 +3340,8 @@ When EMPTY is non-nil, also include days without any entries."
(defvar org-agenda-last-arguments nil
"The arguments of the previous call to `org-agenda'.")
(defvar org-starting-day nil) ; local variable in the agenda buffer
(defvar org-agenda-span nil) ; local variable in the agenda buffer
(defvar org-agenda-current-span nil
"The current span used in the agenda view.") ; local variable in the agenda buffer
(defvar org-include-all-loc nil) ; local variable
(defvar org-agenda-entry-types '(:deadline :scheduled :timestamp :sexp)
@ -3247,7 +3378,7 @@ somewhat less efficient) way of determining what is included in
the daily/weekly agenda, see `org-agenda-skip-function'.")
;;;###autoload
(defun org-agenda-list (&optional include-all start-day ndays)
(defun org-agenda-list (&optional include-all start-day span)
"Produce a daily/weekly view from all files in variable `org-agenda-files'.
The view will be for the current day or week, but from the overview buffer
you will be able to go to other days/weeks.
@ -3258,37 +3389,36 @@ This feature is considered obsolete, please use the TODO list or a block
agenda instead.
With a numeric prefix argument in an interactive call, the agenda will
span INCLUDE-ALL days. Lisp programs should instead specify NDAYS to change
the number of days. NDAYS defaults to `org-agenda-ndays'.
span INCLUDE-ALL days. Lisp programs should instead specify SPAN to change
the number of days. SPAN defaults to `org-agenda-span'.
START-DAY defaults to TODAY, or to the most recent match for the weekday
given in `org-agenda-start-on-weekday'."
(interactive "P")
(if (and (integerp include-all) (> include-all 0))
(setq ndays include-all include-all nil))
(setq ndays (or ndays org-agenda-ndays)
start-day (or start-day org-agenda-start-day))
(setq span include-all include-all nil))
(setq start-day (or start-day org-agenda-start-day))
(if org-agenda-overriding-arguments
(setq include-all (car org-agenda-overriding-arguments)
start-day (nth 1 org-agenda-overriding-arguments)
ndays (nth 2 org-agenda-overriding-arguments)))
span (nth 2 org-agenda-overriding-arguments)))
(if (stringp start-day)
;; Convert to an absolute day number
(setq start-day (time-to-days (org-read-date nil t start-day))))
(setq org-agenda-last-arguments (list include-all start-day ndays))
(setq org-agenda-last-arguments (list include-all start-day span))
(org-compile-prefix-format 'agenda)
(org-set-sorting-strategy 'agenda)
(let* ((org-agenda-start-on-weekday
(if (or (equal ndays 7) (and (null ndays) (equal 7 org-agenda-ndays)))
org-agenda-start-on-weekday nil))
(let* ((span (org-agenda-ndays-to-span (or span org-agenda-ndays org-agenda-span)))
(today (org-today))
(sd (or start-day today))
(ndays (org-agenda-span-to-ndays span sd))
(org-agenda-start-on-weekday
(if (eq ndays 7)
org-agenda-start-on-weekday))
(thefiles (org-agenda-files nil 'ifmode))
(files thefiles)
(today (time-to-days
(time-subtract (current-time)
(list 0 (* 3600 org-extend-today-until) 0))))
(sd (or start-day today))
(start (if (or (null org-agenda-start-on-weekday)
(< org-agenda-ndays 7))
(< ndays 7))
sd
(let* ((nt (calendar-day-of-week
(calendar-gregorian-from-absolute sd)))
@ -3298,24 +3428,19 @@ given in `org-agenda-start-on-weekday'."
(day-numbers (list start))
(day-cnt 0)
(inhibit-redisplay (not debug-on-error))
s e rtn rtnall file date d start-pos end-pos todayp nd wd
clocktable-start clocktable-end)
s e rtn rtnall file date d start-pos end-pos todayp
clocktable-start clocktable-end filter)
(setq org-agenda-redo-command
(list 'org-agenda-list (list 'quote include-all) start-day ndays))
;; Make the list of days
(setq ndays (or ndays org-agenda-ndays)
nd ndays)
(while (> ndays 1)
(push (1+ (car day-numbers)) day-numbers)
(setq ndays (1- ndays)))
(list 'org-agenda-list (list 'quote include-all) start-day (list 'quote span)))
(dotimes (n (1- ndays))
(push (1+ (car day-numbers)) day-numbers))
(setq day-numbers (nreverse day-numbers))
(setq clocktable-start (car day-numbers)
clocktable-end (1+ (or (org-last day-numbers) 0)))
(org-prepare-agenda "Day/Week")
(org-set-local 'org-starting-day (car day-numbers))
(org-set-local 'org-include-all-loc include-all)
(org-set-local 'org-agenda-span
(org-agenda-ndays-to-span nd))
(org-set-local 'org-agenda-current-span (org-agenda-ndays-to-span span))
(when (and (or include-all org-agenda-include-all-todo)
(member today day-numbers))
(setq files thefiles
@ -3343,7 +3468,7 @@ given in `org-agenda-start-on-weekday'."
(if org-agenda-overriding-header
(insert (org-add-props (copy-sequence org-agenda-overriding-header)
nil 'face 'org-agenda-structure) "\n")
(insert (capitalize (symbol-name (org-agenda-ndays-to-span nd)))
(insert (org-agenda-span-name span)
"-agenda"
(if (< (- d2 d1) 350)
(if (= w1 w2)
@ -3356,7 +3481,6 @@ given in `org-agenda-start-on-weekday'."
(org-agenda-mark-header-line s))
(while (setq d (pop day-numbers))
(setq date (calendar-gregorian-from-absolute d)
wd (calendar-day-of-week date)
s (point))
(if (or (setq todayp (= d today))
(and (not start-pos) (= d sd)))
@ -3400,19 +3524,16 @@ given in `org-agenda-start-on-weekday'."
(funcall org-agenda-format-date date))
"\n")
(put-text-property s (1- (point)) 'face
(if (member wd org-agenda-weekend-days)
'org-agenda-date-weekend
'org-agenda-date))
(org-agenda-get-day-face date))
(put-text-property s (1- (point)) 'org-date-line t)
(put-text-property s (1- (point)) 'org-agenda-date-header t)
(put-text-property s (1- (point)) 'org-day-cnt day-cnt)
(when todayp
(put-text-property s (1- (point)) 'org-today t)
(put-text-property s (1- (point)) 'face 'org-agenda-date-today))
(put-text-property s (1- (point)) 'org-today t))
(if rtnall (insert
(org-finalize-agenda-entries
(org-agenda-add-time-grid-maybe
rtnall nd todayp))
rtnall ndays todayp))
"\n"))
(put-text-property s (1- (point)) 'day d)
(put-text-property s (1- (point)) 'org-day-cnt day-cnt))))
@ -3425,6 +3546,15 @@ given in `org-agenda-start-on-weekday'."
(setq p (plist-put p :tstart clocktable-start))
(setq p (plist-put p :tend clocktable-end))
(setq p (plist-put p :scope 'agenda))
(when (and (eq org-agenda-clockreport-mode 'with-filter)
(setq filter (or org-agenda-filter-while-redo
(get 'org-agenda-filter :preset-filter))))
(setq p (plist-put p :tags (mapconcat (lambda (x)
(if (string-match "[<>=]" x)
""
x))
filter ""))))
(message "%s" (plist-get p :tags)) (sit-for 2)
(setq tbl (apply 'org-get-clocktable p))
(insert tbl)))
(goto-char (point-min))
@ -3444,7 +3574,31 @@ given in `org-agenda-start-on-weekday'."
(message "")))
(defun org-agenda-ndays-to-span (n)
(cond ((< n 7) 'day) ((= n 7) 'week) ((< n 32) 'month) (t 'year)))
"Return a span symbol for a span of N days, or N if none matches."
(cond ((symbolp n) n)
((= n 1) 'day)
((= n 7) 'week)
(t n)))
(defun org-agenda-span-to-ndays (span start-day)
"Return ndays from SPAN starting at START-DAY."
(cond ((numberp span) span)
((eq span 'day) 1)
((eq span 'week) 7)
((eq span 'month)
(let ((date (calendar-gregorian-from-absolute start-day)))
(calendar-last-day-of-month (car date) (caddr date))))
((eq span 'year)
(let ((date (calendar-gregorian-from-absolute start-day)))
(if (calendar-leap-year-p (caddr date)) 366 365)))))
(defun org-agenda-span-name (span)
"Return a SPAN name."
(if (null span)
""
(if (symbolp span)
(capitalize (symbol-name span))
(format "%d days" span))))
;;; Agenda word search
@ -3723,7 +3877,7 @@ for a keyword. A numeric prefix directly selects the Nth keyword in
(org-set-sorting-strategy 'todo)
(org-prepare-agenda "TODO")
(if (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil))
(let* ((today (time-to-days (current-time)))
(let* ((today (org-today))
(date (calendar-gregorian-from-absolute today))
(kwds org-todo-keywords-for-agenda)
(completion-ignore-case t)
@ -4347,7 +4501,8 @@ the documentation of `org-diary'."
"Do we have a reason to ignore this TODO entry because it has a time stamp?"
(when (or org-agenda-todo-ignore-with-date
org-agenda-todo-ignore-scheduled
org-agenda-todo-ignore-deadlines)
org-agenda-todo-ignore-deadlines
org-agenda-todo-ignore-timestamp)
(setq end (or end (save-excursion (outline-next-heading) (point))))
(save-excursion
(or (and org-agenda-todo-ignore-with-date
@ -4370,7 +4525,29 @@ the documentation of `org-diary'."
(> (org-days-to-time (match-string 1)) 0))
((eq org-agenda-todo-ignore-deadlines 'past)
(<= (org-days-to-time (match-string 1)) 0))
(t (org-deadline-close (match-string 1)))))))))
(t (org-deadline-close (match-string 1)))))
(and org-agenda-todo-ignore-timestamp
(let ((buffer (current-buffer))
(regexp
(concat
org-scheduled-time-regexp "\\|" org-deadline-time-regexp))
(start (point)))
;; Copy current buffer into a temporary one
(with-temp-buffer
(insert-buffer-substring buffer start end)
(goto-char (point-min))
;; Delete SCHEDULED and DEADLINE items
(while (re-search-forward regexp end t)
(delete-region (match-beginning 0) (match-end 0)))
(goto-char (point-min))
;; No search for timestamp left
(when (re-search-forward org-ts-regexp nil t)
(cond
((eq org-agenda-todo-ignore-timestamp 'future)
(> (org-days-to-time (match-string 1)) 0))
((eq org-agenda-todo-ignore-timestamp 'past)
(<= (org-days-to-time (match-string 1)) 0))
(t))))))))))
(defconst org-agenda-no-heading-message
"No heading for this item in buffer or region.")
@ -4924,6 +5101,14 @@ The flag is set if the currently compiled format contains a `%e'.")
(defvar org-prefix-category-max-length nil
"Used by `org-compile-prefix-format' to remember the category field width.")
(defun org-agenda-get-category-icon (category)
"Return an image for CATEGORY according to `org-agenda-category-icon-alist'."
(dolist (entry org-agenda-category-icon-alist)
(when (org-string-match-p (car entry) category)
(if (listp (cadr entry))
(return (cadr entry))
(return (apply 'create-image (cdr entry)))))))
(defun org-format-agenda-item (extra txt &optional category tags dotime
noprefix remove-re habitp)
"Format TXT to be inserted into the agenda buffer.
@ -4948,11 +5133,17 @@ Any match of REMOVE-RE will be removed from TXT."
org-agenda-show-inherited-tags
org-agenda-hide-tags-regexp))
(let* ((category (or category
org-category
(if (stringp org-category)
org-category
(and org-category (symbol-name org-category)))
(if buffer-file-name
(file-name-sans-extension
(file-name-nondirectory buffer-file-name))
"")))
(category-icon (org-agenda-get-category-icon category))
(category-icon (if category-icon
(propertize " " 'display category-icon)
""))
;; time, tag, effort are needed for the eval of the prefix format
(tag (if tags (nth (1- (length tags)) tags) ""))
time effort neffort
@ -5038,8 +5229,15 @@ Any match of REMOVE-RE will be removed from TXT."
(if noprefix
(setq rtn txt)
;; Prepare the variables needed in the eval of the compiled format
(setq time (cond (s2 (concat s1 "-" s2))
(s1 (concat s1 "......"))
(setq time (cond (s2 (concat
(org-agenda-time-of-day-to-ampm-maybe s1)
"-" (org-agenda-time-of-day-to-ampm-maybe s2)
(if org-agenda-timegrid-use-ampm " ")))
(s1 (concat
(org-agenda-time-of-day-to-ampm-maybe s1)
(if org-agenda-timegrid-use-ampm
"........ "
"......")))
(t ""))
extra (or (and (not habitp) extra) "")
category (if (symbolp category) (symbol-name category) category)
@ -5163,11 +5361,11 @@ The resulting form is returned and stored in the variable
(t " %-12:c%?-12t% s")))
(start 0)
varform vars var e c f opt)
(while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([ctse]\\)"
(while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([ctsei]\\)"
s start)
(setq var (cdr (assoc (match-string 4 s)
'(("c" . category) ("t" . time) ("s" . extra)
("T" . tag) ("e" . effort))))
("i" . category-icon) ("T" . tag) ("e" . effort))))
c (or (match-string 3 s) "")
opt (match-beginning 1)
start (1+ (match-beginning 0)))
@ -5567,6 +5765,7 @@ When this is the global TODO list, a prefix argument will be interpreted."
(let* ((org-agenda-keep-modes t)
(filter org-agenda-filter)
(preset (get 'org-agenda-filter :preset-filter))
(org-agenda-filter-while-redo (or filter preset))
(cols org-agenda-columns-active)
(line (org-current-line))
(window-line (- line (org-current-line (window-start))))
@ -5839,13 +6038,10 @@ Negative selection means regexp must not match for selection of an entry."
(cond
(tdpos (goto-char tdpos))
((eq org-agenda-type 'agenda)
(let* ((sd (time-to-days
(time-subtract (current-time)
(list 0 (* 3600 org-extend-today-until) 0))))
(comp (org-agenda-compute-time-span sd org-agenda-span))
(let* ((sd (org-agenda-compute-starting-span
(org-today) (or org-agenda-ndays org-agenda-span)))
(org-agenda-overriding-arguments org-agenda-last-arguments))
(setf (nth 1 org-agenda-overriding-arguments) (car comp))
(setf (nth 2 org-agenda-overriding-arguments) (cdr comp))
(setf (nth 1 org-agenda-overriding-arguments) sd)
(org-agenda-redo)
(org-agenda-find-same-or-today-or-agenda)))
(t (error "Cannot find today")))))
@ -5862,28 +6058,28 @@ Negative selection means regexp must not match for selection of an entry."
With prefix ARG, go forward that many times the current span."
(interactive "p")
(org-agenda-check-type t 'agenda)
(let* ((span org-agenda-span)
(let* ((span org-agenda-current-span)
(sd org-starting-day)
(greg (calendar-gregorian-from-absolute sd))
(cnt (org-get-at-bol 'org-day-cnt))
greg2 nd)
greg2)
(cond
((eq span 'day)
(setq sd (+ arg sd) nd 1))
(setq sd (+ arg sd)))
((eq span 'week)
(setq sd (+ (* 7 arg) sd) nd 7))
(setq sd (+ (* 7 arg) sd)))
((eq span 'month)
(setq greg2 (list (+ (car greg) arg) (nth 1 greg) (nth 2 greg))
sd (calendar-absolute-from-gregorian greg2))
(setcar greg2 (1+ (car greg2)))
(setq nd (- (calendar-absolute-from-gregorian greg2) sd)))
(setcar greg2 (1+ (car greg2))))
((eq span 'year)
(setq greg2 (list (car greg) (nth 1 greg) (+ arg (nth 2 greg)))
sd (calendar-absolute-from-gregorian greg2))
(setcar (nthcdr 2 greg2) (1+ (nth 2 greg2)))
(setq nd (- (calendar-absolute-from-gregorian greg2) sd))))
(setcar (nthcdr 2 greg2) (1+ (nth 2 greg2))))
(t
(setq sd (+ (* span arg) sd))))
(let ((org-agenda-overriding-arguments
(list (car org-agenda-last-arguments) sd nd t)))
(list (car org-agenda-last-arguments) sd span t)))
(org-agenda-redo)
(org-agenda-find-same-or-today-or-agenda cnt))))
@ -5926,7 +6122,6 @@ With prefix ARG, go backward that many times the current span."
"Switch to daily view for agenda.
With argument DAY-OF-YEAR, switch to that day of the year."
(interactive "P")
(setq org-agenda-ndays 1)
(org-agenda-change-time-span 'day day-of-year))
(defun org-agenda-week-view (&optional iso-week)
"Switch to daily view for agenda.
@ -5936,7 +6131,6 @@ week. Any digits before this encode a year. So 200712 means
week 12 of year 2007. Years in the range 1938-2037 can also be
written as 2-digit years."
(interactive "P")
(setq org-agenda-ndays 7)
(org-agenda-change-time-span 'week iso-week))
(defun org-agenda-month-view (&optional month)
"Switch to monthly view for agenda.
@ -5961,70 +6155,61 @@ written as 2-digit years."
"Change the agenda view to SPAN.
SPAN may be `day', `week', `month', `year'."
(org-agenda-check-type t 'agenda)
(if (and (not n) (equal org-agenda-span span))
(if (and (not n) (equal org-agenda-current-span span))
(error "Viewing span is already \"%s\"" span))
(let* ((sd (or (org-get-at-bol 'day)
org-starting-day))
(computed (org-agenda-compute-time-span sd span n))
(sd (org-agenda-compute-starting-span sd span n))
(org-agenda-overriding-arguments
(list (car org-agenda-last-arguments)
(car computed) (cdr computed) t)))
(list (car org-agenda-last-arguments) sd span t)))
(org-agenda-redo)
(org-agenda-find-same-or-today-or-agenda))
(org-agenda-set-mode-name)
(message "Switched to %s view" span))
(defun org-agenda-compute-time-span (sd span &optional n)
"Compute starting date and number of days for agenda.
(defun org-agenda-compute-starting-span (sd span &optional n)
"Compute starting date for agenda.
SPAN may be `day', `week', `month', `year'. The return value
is a cons cell with the starting date and the number of days,
so that the date SD will be in that range."
(let* ((greg (calendar-gregorian-from-absolute sd))
(dg (nth 1 greg))
(mg (car greg))
(yg (nth 2 greg))
nd w1 y1 m1 thisweek)
(yg (nth 2 greg)))
(cond
((eq span 'day)
(when n
(setq sd (+ (calendar-absolute-from-gregorian
(list mg 1 yg))
n -1)))
(setq nd 1))
n -1))))
((eq span 'week)
(let* ((nt (calendar-day-of-week
(calendar-gregorian-from-absolute sd)))
(d (if org-agenda-start-on-weekday
(- nt org-agenda-start-on-weekday)
0)))
0))
y1)
(setq sd (- sd (+ (if (< d 0) 7 0) d)))
(when n
(require 'cal-iso)
(setq thisweek (car (calendar-iso-from-absolute sd)))
(when (> n 99)
(setq y1 (org-small-year-to-year (/ n 100))
n (mod n 100)))
(setq sd
(calendar-absolute-from-iso
(list n 1
(or y1 (nth 2 (calendar-iso-from-absolute sd)))))))
(setq nd 7)))
(or y1 (nth 2 (calendar-iso-from-absolute sd)))))))))
((eq span 'month)
(when (and n (> n 99))
(setq y1 (org-small-year-to-year (/ n 100))
n (mod n 100)))
(setq sd (calendar-absolute-from-gregorian
(list (or n mg) 1 (or y1 yg)))
nd (- (calendar-absolute-from-gregorian
(list (1+ (or n mg)) 1 (or y1 yg)))
sd)))
(let (y1)
(when (and n (> n 99))
(setq y1 (org-small-year-to-year (/ n 100))
n (mod n 100)))
(setq sd (calendar-absolute-from-gregorian
(list (or n mg) 1 (or y1 yg))))))
((eq span 'year)
(setq sd (calendar-absolute-from-gregorian
(list 1 1 (or n yg)))
nd (- (calendar-absolute-from-gregorian
(list 1 1 (1+ (or n yg))))
sd))))
(cons sd nd)))
(list 1 1 (or n yg))))))
sd))
(defun org-agenda-next-date-line (&optional arg)
"Jump to the next line indicating a date in agenda buffer."
@ -6094,11 +6279,15 @@ so that the date SD will be in that range."
(if org-agenda-entry-text-mode "on" "off")
(if (integerp arg) arg org-agenda-entry-text-maxlines)))
(defun org-agenda-clockreport-mode ()
"Toggle clocktable mode in an agenda buffer."
(interactive)
(defun org-agenda-clockreport-mode (&optional with-filter)
"Toggle clocktable mode in an agenda buffer.
With prefix arg WITH-FILTER, make the clocktable respect the current
agenda filter."
(interactive "P")
(org-agenda-check-type t 'agenda)
(setq org-agenda-clockreport-mode (not org-agenda-clockreport-mode))
(if with-filter
(setq org-agenda-clockreport-mode 'with-filter)
(setq org-agenda-clockreport-mode (not org-agenda-clockreport-mode)))
(org-agenda-set-mode-name)
(org-agenda-redo)
(message "Clocktable mode is %s"
@ -6151,7 +6340,7 @@ When called with a prefix argument, include all archive files as well."
(if org-agenda-include-diary "on" "off")))
(defun org-agenda-toggle-deadlines ()
"Toggle diary inclusion in an agenda buffer."
"Toggle inclusion of entries with a deadline in an agenda buffer."
(interactive)
(org-agenda-check-type t 'agenda)
(setq org-agenda-include-deadlines (not org-agenda-include-deadlines))
@ -6173,33 +6362,36 @@ When called with a prefix argument, include all archive files as well."
(defun org-agenda-set-mode-name ()
"Set the mode name to indicate all the small mode settings."
(setq mode-name
(concat "Org-Agenda"
(if (get 'org-agenda-files 'org-restrict) " []" "")
(if (equal org-agenda-ndays 1) " Day" "")
(if (equal org-agenda-ndays 7) " Week" "")
(if org-agenda-follow-mode " Follow" "")
(if org-agenda-entry-text-mode " ETxt" "")
(if org-agenda-include-diary " Diary" "")
(if org-agenda-include-deadlines " Ddl" "")
(if org-agenda-use-time-grid " Grid" "")
(if (and (boundp 'org-habit-show-habits)
org-habit-show-habits) " Habit" "")
(if (consp org-agenda-show-log) " LogAll"
(if org-agenda-show-log " Log" ""))
(if (or org-agenda-filter (get 'org-agenda-filter
:preset-filter))
(concat " {" (mapconcat
'identity
(append (get 'org-agenda-filter
:preset-filter)
org-agenda-filter) "") "}")
"")
(if org-agenda-archives-mode
(if (eq org-agenda-archives-mode t)
" Archives"
(format " :%s:" org-archive-tag))
"")
(if org-agenda-clockreport-mode " Clock" "")))
(list "Org-Agenda"
(if (get 'org-agenda-files 'org-restrict) " []" "")
" "
'(:eval (org-agenda-span-name org-agenda-current-span))
(if org-agenda-follow-mode " Follow" "")
(if org-agenda-entry-text-mode " ETxt" "")
(if org-agenda-include-diary " Diary" "")
(if org-agenda-include-deadlines " Ddl" "")
(if org-agenda-use-time-grid " Grid" "")
(if (and (boundp 'org-habit-show-habits)
org-habit-show-habits) " Habit" "")
(if (consp org-agenda-show-log) " LogAll"
(if org-agenda-show-log " Log" ""))
(if (or org-agenda-filter (get 'org-agenda-filter
:preset-filter))
(concat " {" (mapconcat
'identity
(append (get 'org-agenda-filter
:preset-filter)
org-agenda-filter) "") "}")
"")
(if org-agenda-archives-mode
(if (eq org-agenda-archives-mode t)
" Archives"
(format " :%s:" org-archive-tag))
"")
(if org-agenda-clockreport-mode
(if (eq org-agenda-clockreport-mode 'with-filter)
" Clock{}" " Clock")
"")))
(force-mode-line-update))
(defun org-agenda-post-command-hook ()
@ -6216,7 +6408,6 @@ When called with a prefix argument, include all archive files as well."
(defun org-agenda-previous-line ()
"Move cursor to the previous line, and show if follow-mode is active."
(interactive)
(call-interactively 'previous-line)
(org-agenda-do-context-action))
@ -6642,8 +6833,7 @@ the same tree node, and the headline of the tree node in the Org-mode file."
(buffer (marker-buffer marker))
(pos (marker-position marker))
(hdmarker (org-get-at-bol 'org-hd-marker))
(todayp (equal (org-get-at-bol 'day)
(time-to-days (current-time))))
(todayp (org-agenda-todayp (org-get-at-bol 'day)))
(inhibit-read-only t)
org-agenda-headline-snapshot-before-repeat newhead just-one)
(org-with-remote-undo buffer
@ -7551,25 +7741,26 @@ This is a command that has to be installed in `calendar-mode-map'."
(eq (get-char-property (point-at-bol) 'type)
'org-marked-entry-overlay))
(defun org-agenda-bulk-mark ()
(defun org-agenda-bulk-mark (&optional arg)
"Mark the entry at point for future bulk action."
(interactive)
(org-agenda-check-no-diary)
(let* ((m (org-get-at-bol 'org-hd-marker))
ov)
(unless (org-agenda-bulk-marked-p)
(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-get-todo-face "TODO")
'evaporate)
(overlay-put ov 'type 'org-marked-entry-overlay))
(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")
(dotimes (i (max arg 1))
(unless (org-get-at-bol 'org-agenda-diary-link)
(let* ((m (org-get-at-bol 'org-hd-marker))
ov)
(unless (org-agenda-bulk-marked-p)
(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-get-todo-face "TODO")
'evaporate)
(overlay-put ov 'type 'org-marked-entry-overlay))
(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))))))
(defun org-agenda-bulk-unmark ()
"Unmark the entry at point for future bulk action."
@ -7619,7 +7810,7 @@ The prefix arg is passed through to the command if possible."
(interactive "P")
(unless org-agenda-bulk-marked-entries
(error "No entries are marked"))
(message "Bulk: [r]efile [$]archive [A]rch->sib [t]odo [+/-]tag [s]chedule [d]eadline")
(message "Bulk: [r]efile [$]arch [A]rch->sib [t]odo [+/-]tag [s]chd [S]catter [d]eadline")
(let* ((action (read-char-exclusive))
(org-log-refile (if org-log-refile 'time nil))
(entries (reverse org-agenda-bulk-marked-entries))
@ -7681,6 +7872,29 @@ The prefix arg is passed through to the command if possible."
(if bound
(fset 'read-string old)
(fmakunbound 'read-string)))))))
((eq action '?S)
(let ((days (read-number
(format "Scatter tasks across how many %sdays: "
(if arg "week" "")) 7)))
(setq cmd
`(let ((distance (random ,(1+ days))))
(if arg
(let ((dist distance)
(day-of-week
(calendar-day-of-week
(calendar-gregorian-from-absolute (org-today)))))
(dotimes (i (1+ dist))
(while (member day-of-week org-agenda-weekend-days)
(incf distance)
(incf day-of-week)
(if (= day-of-week 7)
(setq day-of-week 0)))
(incf day-of-week)
(if (= day-of-week 7)
(setq day-of-week 0)))))
(org-agenda-date-later distance)))))
(t (error "Invalid bulk action")))
;; Sort the markers, to make sure that parents are handled before children
@ -7792,6 +8006,9 @@ belonging to the \"Work\" category."
(let* ((cnt 0) ; count added events
(org-agenda-new-buffers nil)
(org-deadline-warning-days 0)
;; Do not use `org-today' here because appt only takes
;; time and without date as argument, so it may pass wrong
;; information otherwise
(today (org-date-to-gregorian
(time-to-days (current-time))))
(org-agenda-restrict nil)
@ -7834,14 +8051,10 @@ belonging to the \"Work\" category."
(defun org-agenda-todayp (date)
"Does DATE mean today, when considering `org-extend-today-until'?"
(let (today h)
(if (listp date) (setq date (calendar-absolute-from-gregorian date)))
(setq today (calendar-absolute-from-gregorian (calendar-current-date)))
(setq h (nth 2 (decode-time (current-time))))
(or (and (>= h org-extend-today-until)
(= date today))
(and (< h org-extend-today-until)
(= date (1- today))))))
(let ((today (org-today))
(date (if (and date (listp date)) (calendar-absolute-from-gregorian date)
date)))
(eq date today)))
(provide 'org-agenda)

2
lisp/org/org-archive.el
View file

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;

2
lisp/org/org-ascii.el
View file

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;

2
lisp/org/org-attach.el
View file

@ -4,7 +4,7 @@
;; Author: John Wiegley <johnw@newartisans.com>
;; Keywords: org data task
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.
;;

2
lisp/org/org-bbdb.el
View file

@ -7,7 +7,7 @@
;; Thomas Baumann <thomas dot baumann at ch dot tum dot de>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;

8
lisp/org/org-beamer.el
View file

@ -2,7 +2,7 @@
;;
;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;;
;; Version: 7.3
;; Version: 7.4
;; Author: Carsten Dominik <carsten.dominik AT gmail DOT com>
;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com>
;; Keywords: org, wp, tex
@ -246,14 +246,14 @@ in org-export-latex-classes."
(if (and (string-match "\\`[0-9.]+\\'" tmp)
(or (= (string-to-number tmp) 1.0)
(= (string-to-number tmp) 0.0)))
;; column width 1 means cloase columns, go back to full width
;; column width 1 means close columns, go back to full width
(org-beamer-close-columns-maybe)
(when (setq ass (assoc "BEAMER_envargs" props))
(let (case-fold-search)
(when (string-match "C\\(\\[[^][]*\\]\\)" (cdr ass))
(while (string-match "C\\(\\[[^][]*\\]\\|<[^<>]*>\\)" (cdr ass))
(setq columns-option (match-string 1 (cdr ass)))
(setcdr ass (replace-match "" t t (cdr ass))))
(when (string-match "c\\(\\[[^][]*\\]\\)" (cdr ass))
(while (string-match "c\\(\\[[^][]*\\]\\|<[^<>]*>\\)" (cdr ass))
(setq column-option (match-string 1 (cdr ass)))
(setcdr ass (replace-match "" t t (cdr ass))))))
(org-beamer-open-columns-maybe columns-option)

2
lisp/org/org-bibtex.el
View file

@ -5,7 +5,7 @@
;; Author: Bastien Guerry <bzg at altern dot org>
;; Carsten Dominik <carsten dot dominik at gmail dot com>
;; Keywords: org, wp, remember
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;

61
lisp/org/org-capture.el
View file

@ -5,7 +5,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;
@ -133,7 +133,10 @@ target Specification of where the captured item should be placed.
File to the entry matching regexp
(file+datetree \"path/to/file\")
Will create a heading in a date tree
Will create a heading in a date tree for today's date
(file+datetree+prompt \"path/to/file\")
Will create a heading in a date tree, promts for date
(file+function \"path/to/file\" function-finding-location)
A function to find the right location in the file
@ -280,6 +283,9 @@ calendar | %:type %:date"
(list :tag "File & Date tree"
(const :format "" file+datetree)
(file :tag " File"))
(list :tag "File & Date tree, prompt for date"
(const :format "" file+datetree+prompt)
(file :tag " File"))
(list :tag "File & function"
(const :format "" file+function)
(file :tag " File ")
@ -313,6 +319,12 @@ The remember buffer is still current when this hook runs."
:group 'org-capture
:type 'hook)
(defcustom org-capture-after-finalize-hook nil
"Hook that is run right after a capture process is finalized.
Suitable for window cleanup"
:group 'org-capture
:type 'hook)
;;; The property list for keeping information about the capture process
(defvar org-capture-plist nil
@ -461,9 +473,11 @@ bypassed."
(t (setq txt "* Invalid capture template")))
(org-capture-put :template txt)))
(defun org-capture-finalize ()
"Finalize the capture process."
(interactive)
(defun org-capture-finalize (&optional stay-with-capture)
"Finalize the capture process.
With prefix argument STAY-WITH-CAPTURE, jump to the location of the
captured item after finalizing."
(interactive "P")
(unless (and org-capture-mode
(buffer-base-buffer (current-buffer)))
(error "This does not seem to be a capture buffer for Org-mode"))
@ -548,17 +562,25 @@ bypassed."
;; Restore the window configuration before capture
(set-window-configuration return-wconf))
(when abort-note
(run-hooks 'org-capture-after-finalize-hook)
;; Special cases
(cond
(abort-note
(cond
((equal abort-note 'clean)
(message "Capture process aborted and target buffer cleaned up"))
((equal abort-note 'dirty)
(error "Capture process aborted, but target buffer could not be cleaned up correctly"))))))
(error "Capture process aborted, but target buffer could not be cleaned up correctly"))))
(stay-with-capture
(org-capture-goto-last-stored)))
;; Return if we did store something
(not abort-note)))
(defun org-capture-refile ()
"Finalize the current capture and then refile the entry.
Refiling is done from the base buffer, because the indirect buffer is then
already gone."
already gone. Any prefix argument will be passed to the refile comand."
(interactive)
(unless (eq (org-capture-get :type 'local) 'entry)
(error
@ -640,19 +662,28 @@ already gone."
(setq target-entry-p (and (org-mode-p) (org-at-heading-p))))
(error "No match for target regexp in file %s" (nth 1 target))))
((eq (car target) 'file+datetree)
((memq (car target) '(file+datetree file+datetree+prompt))
(require 'org-datetree)
(set-buffer (org-capture-target-buffer (nth 1 target)))
;; Make a date tree entry, with the current date (or yesterday,
;; if we are extending dates for a couple of hours)
(org-datetree-find-date-create
(calendar-gregorian-from-absolute
(if org-overriding-default-time
(time-to-days org-overriding-default-time)
(time-to-days
(time-subtract (current-time)
(list 0 (* 3600 org-extend-today-until) 0)))))))
(cond
(org-overriding-default-time
;; use the overriding default time
(time-to-days org-overriding-default-time))
((eq (car target) 'file+datetree+prompt)
;; prompt for date
(time-to-days (org-read-date
nil t nil "Date for tree entry:"
(days-to-time (org-today)))))
(t
;; current date, possible corrected for late night workers
(org-today))))))
((eq (car target) 'file+function)
(set-buffer (org-capture-target-buffer (nth 1 target)))
(funcall (nth 2 target))
@ -1358,5 +1389,3 @@ The template may still contain \"%?\" for cursor positioning."
;; arch-tag: 986bf41b-8ada-4e28-bf20-e8388a7205a0
;;; org-capture.el ends here

843
lisp/org/org-clock.el
View file

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;
@ -34,7 +34,7 @@
(eval-when-compile
(require 'cl))
(declare-function calendar-absolute-from-iso "cal-iso" (&optional date))
(declare-function calendar-absolute-from-iso "cal-iso" (&optional date))
(declare-function notifications-notify "notifications" (&rest params))
(defvar org-time-stamp-formats)
@ -222,11 +222,48 @@ string as argument."
(string :tag "Program")
(function :tag "Function")))
(defcustom org-clock-clocktable-default-properties '(:maxlevel 2 :scope file)
"Default properties for new clocktables."
(defgroup org-clocktable nil
"Options concerning the clock table in Org-mode."
:tag "Org Clock Table"
:group 'org-clock)
(defcustom org-clocktable-defaults
(list
:maxlevel 2
:scope 'file
:block nil
:tstart nil
:tend nil
:step nil
:stepskip0 nil
:fileskip0 nil
:tags nil
:emphasize nil
:link nil
:narrow '40!
:indent t
:formula nil
:timestamp nil
:level nil
:tcolumns nil
:formatter nil)
"Default properties for clock tables."
:group 'org-clock
:type 'plist)
(defcustom org-clock-clocktable-formatter 'org-clocktable-write-default
"Function to turn clocking data into a table.
For more information, see `org-clocktable-write-default'."
:group 'org-clocktable
:type 'function)
(defcustom org-clock-clocktable-default-properties '(:maxlevel 2 :scope file)
"Default properties for new clocktables.
These will be inserted into the BEGIN line, to make it easy for users to
play with them."
:group 'org-clocktable
:type 'plist)
(defcustom org-clock-idle-time nil
"When non-nil, resolve open clocks if the user is idle more than X minutes."
:group 'org-clock
@ -1586,7 +1623,7 @@ fontified, and then returned."
(font-lock-fontify-buffer)
(forward-line 2)
(buffer-substring (point) (progn
(re-search-forward "^#\\+END" nil t)
(re-search-forward "^[ \t]*#\\+END" nil t)
(point-at-bol)))))
(defun org-clock-report (&optional arg)
@ -1611,12 +1648,68 @@ buffer and update it."
(let ((pos (point)) start)
(save-excursion
(end-of-line 1)
(and (re-search-backward "^#\\+BEGIN:[ \t]+clocktable" nil t)
(and (re-search-backward "^[ \t]*#\\+BEGIN:[ \t]+clocktable" nil t)
(setq start (match-beginning 0))
(re-search-forward "^#\\+END:.*" nil t)
(re-search-forward "^[ \t]*#\\+END:.*" nil t)
(>= (match-end 0) pos)
start))))
(defun org-day-of-week (day month year)
"Returns the day of the week as an integer."
(nth 6
(decode-time
(date-to-time
(format "%d-%02d-%02dT00:00:00" year month day)))))
(defun org-quarter-to-date (quarter year)
"Get the date (week day year) of the first day of a given quarter."
(let (startday)
(cond
((= quarter 1)
(setq startday (org-day-of-week 1 1 year))
(cond
((= startday 0)
(list 52 7 (- year 1)))
((= startday 6)
(list 52 6 (- year 1)))
((<= startday 4)
(list 1 startday year))
((> startday 4)
(list 53 startday (- year 1)))
)
)
((= quarter 2)
(setq startday (org-day-of-week 1 4 year))
(cond
((= startday 0)
(list 13 startday year))
((< startday 4)
(list 14 startday year))
((>= startday 4)
(list 13 startday year))
)
)
((= quarter 3)
(setq startday (org-day-of-week 1 7 year))
(cond
((= startday 0)
(list 26 startday year))
((< startday 4)
(list 27 startday year))
((>= startday 4)
(list 26 startday year))
)
)
((= quarter 4)
(setq startday (org-day-of-week 1 10 year))
(cond
((= startday 0)
(list 39 startday year))
((<= startday 4)
(list 40 startday year))
((> startday 4)
(list 39 startday year)))))))
(defun org-clock-special-range (key &optional time as-strings)
"Return two times bordering a special time range.
Key is a symbol specifying the range and can be one of `today', `yesterday',
@ -1633,7 +1726,12 @@ the returned times will be formatted strings."
(dow (nth 6 tm))
(skey (symbol-name key))
(shift 0)
s1 m1 h1 d1 month1 y1 diff ts te fm txt w date)
(q (cond ((>= (nth 4 tm) 10) 4)
((>= (nth 4 tm) 7) 3)
((>= (nth 4 tm) 4) 2)
((>= (nth 4 tm) 1) 1)))
s1 m1 h1 d1 month1 y1 diff ts te fm txt w date
interval tmp shiftedy shiftedm shiftedq)
(cond
((string-match "^[0-9]+$" skey)
(setq y (string-to-number skey) m 1 d 1 key 'year))
@ -1650,6 +1748,15 @@ the returned times will be formatted strings."
(setq d (nth 1 date) month (car date) y (nth 2 date)
dow 1
key 'week))
((string-match "^\\([0-9]+\\)-[qQ]\\([1-4]\\)$" skey)
(require 'cal-iso)
(setq y (string-to-number (match-string 1 skey)))
(setq q (string-to-number (match-string 2 skey)))
(setq date (calendar-gregorian-from-absolute
(calendar-absolute-from-iso (org-quarter-to-date q y))))
(setq d (nth 1 date) month (car date) y (nth 2 date)
dow 1
key 'quarter))
((string-match "^\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)-\\([0-9]\\{1,2\\}\\)$" skey)
(setq y (string-to-number (match-string 1 skey))
month (string-to-number (match-string 2 skey))
@ -1657,12 +1764,17 @@ the returned times will be formatted strings."
key 'day))
((string-match "\\([-+][0-9]+\\)$" skey)
(setq shift (string-to-number (match-string 1 skey))
key (intern (substring skey 0 (match-beginning 1))))))
key (intern (substring skey 0 (match-beginning 1))))
(if(and (memq key '(quarter thisq)) (> shift 0))
(error "Looking forward with quarters isn't implemented.")
())))
(when (= shift 0)
(cond ((eq key 'yesterday) (setq key 'today shift -1))
((eq key 'lastweek) (setq key 'week shift -1))
((eq key 'lastmonth) (setq key 'month shift -1))
((eq key 'lastyear) (setq key 'year shift -1))))
(cond ((eq key 'yesterday) (setq key 'today shift -1))
((eq key 'lastweek) (setq key 'week shift -1))
((eq key 'lastmonth) (setq key 'month shift -1))
((eq key 'lastyear) (setq key 'year shift -1))
((eq key 'lastq) (setq key 'quarter shift -1))))
(cond
((memq key '(day today))
(setq d (+ d shift) h 0 m 0 h1 24 m1 0))
@ -1671,6 +1783,28 @@ the returned times will be formatted strings."
m 0 h 0 d (- d diff) d1 (+ 7 d)))
((memq key '(month thismonth))
(setq d 1 h 0 m 0 d1 1 month (+ month shift) month1 (1+ month) h1 0 m1 0))
((memq key '(quarter thisq))
; compute if this shift remains in this year
; if not, compute how many years and quarters we have to shift (via floor*)
; and compute the shifted years, months and quarters
(cond
((< (+ (- q 1) shift) 0) ; shift not in this year
(setq interval (* -1 (+ (- q 1) shift)))
; set tmp to ((years to shift) (quarters to shift))
(setq tmp (org-floor* interval 4))
; due to the use of floor, 0 quarters actually means 4
(if (= 0 (nth 1 tmp))
(setq shiftedy (- y (nth 0 tmp))
shiftedm 1
shiftedq 1)
(setq shiftedy (- y (+ 1 (nth 0 tmp)))
shiftedm (- 13 (* 3 (nth 1 tmp)))
shiftedq (- 5 (nth 1 tmp))))
(setq d 1 h 0 m 0 d1 1 month shiftedm month1 (+ 3 shiftedm) h1 0 m1 0 y shiftedy))
((> (+ q shift) 0) ; shift is whitin this year
(setq shiftedq (+ q shift))
(setq shiftedy y)
(setq d 1 h 0 m 0 d1 1 month (+ 1 (* 3 (- (+ q shift) 1))) month1 (+ 4 (* 3 (- (+ q shift) 1))) h1 0 m1 0))))
((memq key '(year thisyear))
(setq m 0 h 0 d 1 month 1 y (+ y shift) y1 (1+ y)))
(t (error "No such time block %s" key)))
@ -1686,11 +1820,21 @@ the returned times will be formatted strings."
((memq key '(month thismonth))
(setq txt (format-time-string "%B %Y" ts)))
((memq key '(year thisyear))
(setq txt (format-time-string "the year %Y" ts))))
(setq txt (format-time-string "the year %Y" ts)))
((memq key '(quarter thisq))
(setq txt (concatenate 'string (org-count-quarter shiftedq) " quarter of " (number-to-string shiftedy))))
)
(if as-strings
(list (format-time-string fm ts) (format-time-string fm te) txt)
(list ts te txt))))
(defun org-count-quarter (n)
(cond
((= n 1) "1st")
((= n 2) "2nd")
((= n 3) "3rd")
((= n 4) "4th")))
(defun org-clocktable-shift (dir n)
"Try to shift the :block date of the clocktable at point.
Point must be in the #+BEGIN: line of a clocktable, or this function
@ -1704,7 +1848,7 @@ the currently selected interval size."
(and (memq dir '(left down)) (setq n (- n)))
(save-excursion
(goto-char (point-at-bol))
(if (not (looking-at "#\\+BEGIN: clocktable\\>.*?:block[ \t]+\\(\\S-+\\)"))
(if (not (looking-at "^[ \t]*#\\+BEGIN:[ \t]+clocktable\\>.*?:block[ \t]+\\(\\S-+\\)"))
(error "Line needs a :block definition before this command works")
(let* ((b (match-beginning 1)) (e (match-end 1))
(s (match-string 1))
@ -1713,90 +1857,95 @@ the currently selected interval size."
((equal s "yesterday") (setq s "today-1"))
((equal s "lastweek") (setq s "thisweek-1"))
((equal s "lastmonth") (setq s "thismonth-1"))
((equal s "lastyear") (setq s "thisyear-1")))
(cond
((string-match "^\\(today\\|thisweek\\|thismonth\\|thisyear\\)\\([-+][0-9]+\\)?$" s)
(setq block (match-string 1 s)
shift (if (match-end 2)
(string-to-number (match-string 2 s))
0))
(setq shift (+ shift n))
(setq ins (if (= shift 0) block (format "%s%+d" block shift))))
((string-match "\\([0-9]+\\)\\(-\\([wW]?\\)\\([0-9]\\{1,2\\}\\)\\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s)
;; 1 1 2 3 3 4 4 5 6 6 5 2
(setq y (string-to-number (match-string 1 s))
wp (and (match-end 3) (match-string 3 s))
mw (and (match-end 4) (string-to-number (match-string 4 s)))
d (and (match-end 6) (string-to-number (match-string 6 s))))
(cond
(d (setq ins (format-time-string
"%Y-%m-%d"
(encode-time 0 0 0 (+ d n) m y))))
((and wp mw (> (length wp) 0))
(require 'cal-iso)
(setq date (calendar-gregorian-from-absolute (calendar-absolute-from-iso (list (+ mw n) 1 y))))
(setq ins (format-time-string
"%G-W%V"
(encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date)))))
(mw
(setq ins (format-time-string
"%Y-%m"
(encode-time 0 0 0 1 (+ mw n) y))))
(y
(setq ins (number-to-string (+ y n))))))
(t (error "Cannot shift clocktable block")))
(when ins
(goto-char b)
(insert ins)
(delete-region (point) (+ (point) (- e b)))
(beginning-of-line 1)
(org-update-dblock)
t)))))
((equal s "lastyear") (setq s "thisyear-1"))
((equal s "lastq") (setq s "thisq-1")))
(cond
((string-match "^\\(today\\|thisweek\\|thismonth\\|thisyear\\|thisq\\)\\([-+][0-9]+\\)?$" s)
(setq block (match-string 1 s)
shift (if (match-end 2)
(string-to-number (match-string 2 s))
0))
(setq shift (+ shift n))
(setq ins (if (= shift 0) block (format "%s%+d" block shift))))
((string-match "\\([0-9]+\\)\\(-\\([wWqQ]?\\)\\([0-9]\\{1,2\\}\\)\\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s)
;; 1 1 2 3 3 4 4 5 6 6 5 2
(setq y (string-to-number (match-string 1 s))
wp (and (match-end 3) (match-string 3 s))
mw (and (match-end 4) (string-to-number (match-string 4 s)))
d (and (match-end 6) (string-to-number (match-string 6 s))))
(cond
(d (setq ins (format-time-string
"%Y-%m-%d"
(encode-time 0 0 0 (+ d n) m y))))
((and wp (string-match "w\\|W" wp) mw (> (length wp) 0))
(require 'cal-iso)
(setq date (calendar-gregorian-from-absolute (calendar-absolute-from-iso (list (+ mw n) 1 y))))
(setq ins (format-time-string
"%G-W%V"
(encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date)))))
((and wp (string-match "q\\|Q" wp) mw (> (length wp) 0))
(require 'cal-iso)
; if the 4th + 1 quarter is requested we flip to the 1st quarter of the next year
(if (> (+ mw n) 4)
(setq mw 0
y (+ 1 y))
())
; if the 1st - 1 quarter is requested we flip to the 4th quarter of the previous year
(if (= (+ mw n) 0)
(setq mw 5
y (- y 1))
())
(setq date (calendar-gregorian-from-absolute (calendar-absolute-from-iso (org-quarter-to-date (+ mw n) y))))
(setq ins (format-time-string
(concatenate 'string (number-to-string y) "-Q" (number-to-string (+ mw n)))
(encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date)))))
(mw
(setq ins (format-time-string
"%Y-%m"
(encode-time 0 0 0 1 (+ mw n) y))))
(y
(setq ins (number-to-string (+ y n))))))
(t (error "Cannot shift clocktable block")))
(when ins
(goto-char b)
(insert ins)
(delete-region (point) (+ (point) (- e b)))
(beginning-of-line 1)
(org-update-dblock)
t)))))
(defun org-dblock-write:clocktable (params)
"Write the standard clocktable."
(setq params (org-combine-plists org-clocktable-defaults params))
(catch 'exit
(let* ((hlchars '((1 . "*") (2 . "/")))
(ins (make-marker))
(total-time nil)
(scope (plist-get params :scope))
(tostring (plist-get params :tostring))
(multifile (plist-get params :multifile))
(header (plist-get params :header))
(maxlevel (or (plist-get params :maxlevel) 3))
(step (plist-get params :step))
(emph (plist-get params :emphasize))
(timestamp (plist-get params :timestamp))
(let* ((scope (plist-get params :scope))
(block (plist-get params :block))
(ts (plist-get params :tstart))
(te (plist-get params :tend))
(block (plist-get params :block))
(link (plist-get params :link))
(tags (plist-get params :tags))
(matcher (if tags (cdr (org-make-tags-matcher tags))))
ipos time p level hlc hdl tsp props content recalc formula pcol
cc beg end pos tbl tbl1 range-text rm-file-column scope-is-list st)
(setq org-clock-file-total-minutes nil)
(maxlevel (or (plist-get params :maxlevel) 3))
(step (plist-get params :step))
(timestamp (plist-get params :timestamp))
(formatter (or (plist-get params :formatter)
org-clock-clocktable-formatter
'org-clocktable-write-default))
cc range-text ipos pos one-file-with-archives
scope-is-list tbls level)
;; Check if we need to do steps
(when block
;; Get the range text for the header
(setq cc (org-clock-special-range block nil t)
ts (car cc) te (nth 1 cc) range-text (nth 2 cc)))
(when step
;; Write many tables, in steps
(unless (or block (and ts te))
(error "Clocktable `:step' can only be used with `:block' or `:tstart,:end'"))
(org-clocktable-steps params)
(throw 'exit nil))
(when block
(setq cc (org-clock-special-range block nil t)
ts (car cc) te (nth 1 cc) range-text (nth 2 cc)))
(when (integerp ts) (setq ts (calendar-gregorian-from-absolute ts)))
(when (integerp te) (setq te (calendar-gregorian-from-absolute te)))
(when (and ts (listp ts))
(setq ts (format "%4d-%02d-%02d" (nth 2 ts) (car ts) (nth 1 ts))))
(when (and te (listp te))
(setq te (format "%4d-%02d-%02d" (nth 2 te) (car te) (nth 1 te))))
;; Now the times are strings we can parse.
(if ts (setq ts (org-float-time
(apply 'encode-time (org-parse-time-string ts)))))
(if te (setq te (org-float-time
(apply 'encode-time (org-parse-time-string te)))))
(move-marker ins (point))
(setq ipos (point))
(setq ipos (point)) ; remember the insertion position
;; Get the right scope
(setq pos (point))
@ -1810,166 +1959,271 @@ the currently selected interval size."
(setq scope (org-add-archive-files scope)))
((eq scope 'file-with-archives)
(setq scope (org-add-archive-files (list (buffer-file-name)))
rm-file-column t)))
one-file-with-archives t)))
(setq scope-is-list (and scope (listp scope)))
(save-restriction
(cond
((not scope))
((eq scope 'file) (widen))
((eq scope 'subtree) (org-narrow-to-subtree))
((eq scope 'tree)
(while (org-up-heading-safe))
(org-narrow-to-subtree))
((and (symbolp scope) (string-match "^tree\\([0-9]+\\)$"
(symbol-name scope)))
(setq level (string-to-number (match-string 1 (symbol-name scope))))
(catch 'exit
(while (org-up-heading-safe)
(looking-at outline-regexp)
(if (<= (org-reduced-level (funcall outline-level)) level)
(throw 'exit nil))))
(org-narrow-to-subtree))
(scope-is-list
(if scope-is-list
;; we collect from several files
(let* ((files scope)
(scope 'agenda)
(p1 (copy-sequence params))
file)
(setq p1 (plist-put p1 :tostring t))
(setq p1 (plist-put p1 :multifile t))
(setq p1 (plist-put p1 :scope 'file))
(org-prepare-agenda-buffers files)
(while (setq file (pop files))
(with-current-buffer (find-buffer-visiting file)
(setq org-clock-file-total-minutes 0)
(setq tbl1 (org-dblock-write:clocktable p1))
(when tbl1
(push (org-clocktable-add-file
file
(concat "| |*File time*|*"
(org-minutes-to-hh:mm-string
org-clock-file-total-minutes)
"*|\n"
tbl1)) tbl)
(setq total-time (+ (or total-time 0)
org-clock-file-total-minutes))))))))
(goto-char pos)
(save-excursion
(save-restriction
(push (org-clock-get-table-data file params) tbls))))))
;; Just from the current file
(save-restriction
;; get the right range into the restriction
(org-prepare-agenda-buffers (list (buffer-file-name)))
(cond
((not scope)) ; use the restriction as it is now
((eq scope 'file) (widen))
((eq scope 'subtree) (org-narrow-to-subtree))
((eq scope 'tree)
(while (org-up-heading-safe))
(org-narrow-to-subtree))
((and (symbolp scope) (string-match "^tree\\([0-9]+\\)$"
(symbol-name scope)))
(setq level (string-to-number (match-string 1 (symbol-name scope))))
(catch 'exit
(while (org-up-heading-safe)
(looking-at outline-regexp)
(if (<= (org-reduced-level (funcall outline-level)) level)
(throw 'exit nil))))
(org-narrow-to-subtree)))
;; do the table, with no file name.
(push (org-clock-get-table-data nil params) tbls)))
(unless scope-is-list
(org-clock-sum ts te
(unless (null matcher)
(lambda ()
(let ((tags-list
(org-split-string
(or (org-entry-get (point) "ALLTAGS") "")
":")))
(eval matcher)))))
(goto-char (point-min))
(setq st t)
(while (or (and (bobp) (prog1 st (setq st nil))
(get-text-property (point) :org-clock-minutes)
(setq p (point-min)))
(setq p (next-single-property-change (point) :org-clock-minutes)))
(goto-char p)
(when (setq time (get-text-property p :org-clock-minutes))
(save-excursion
(beginning-of-line 1)
(when (and (looking-at (org-re "\\(\\*+\\)[ \t]+\\(.*?\\)\\([ \t]+:[[:alnum:]_@#%:]+:\\)?[ \t]*$"))
(setq level (org-reduced-level
(- (match-end 1) (match-beginning 1))))
(<= level maxlevel))
(setq hlc (if emph (or (cdr (assoc level hlchars)) "") "")
hdl (if (not link)
(match-string 2)
(org-make-link-string
(format "file:%s::%s"
(buffer-file-name)
(save-match-data
(org-make-org-heading-search-string
(match-string 2))))
(match-string 2)))
tsp (when timestamp
(setq props (org-entry-properties (point)))
(or (cdr (assoc "SCHEDULED" props))
(cdr (assoc "TIMESTAMP" props))
(cdr (assoc "DEADLINE" props))
(cdr (assoc "TIMESTAMP_IA" props)))))
(if (and (not multifile) (= level 1)) (push "|-" tbl))
(push (concat
"| " (int-to-string level) "|"
(if timestamp (concat tsp "|") "")
hlc hdl hlc " |"
(make-string (1- level) ?|)
hlc (org-minutes-to-hh:mm-string time) hlc
" |") tbl))))))
(setq tbl (nreverse tbl))
(if tostring
(if tbl (mapconcat 'identity tbl "\n") nil)
(goto-char ins)
(insert-before-markers
(or header
(concat
"Clock summary at ["
(substring
(format-time-string (cdr org-time-stamp-formats))
1 -1)
"]"
(if block (concat ", for " range-text ".") "")
"\n\n"))
(if scope-is-list "|File" "")
"|L|" (if timestamp "Timestamp|" "") "Headline|Time|\n")
(setq total-time (or total-time org-clock-file-total-minutes))
(insert-before-markers
"|-\n|"
(if scope-is-list "|" "")
(if timestamp "|Timestamp|" "|")
"*Total time*| *"
(org-minutes-to-hh:mm-string (or total-time 0))
"*|\n|-\n")
(setq tbl (delq nil tbl))
(if (and (stringp (car tbl)) (> (length (car tbl)) 1)
(equal (substring (car tbl) 0 2) "|-"))
(pop tbl))
(insert-before-markers (mapconcat
'identity (delq nil tbl)
(if scope-is-list "\n|-\n" "\n")))
(backward-delete-char 1)
(if (setq formula (plist-get params :formula))
(cond
((eq formula '%)
(setq pcol (+ (if scope-is-list 1 0) maxlevel 3))
(insert
(format
"\n#+TBLFM: $%d='(org-clock-time%% @%d$%d $%d..$%d);%%.1f"
pcol
2
(+ 3 (if scope-is-list 1 0))
(+ (if scope-is-list 1 0) 3)
(1- pcol)))
(setq recalc t))
((stringp formula)
(insert "\n#+TBLFM: " formula)
(setq recalc t))
(t (error "invalid formula in clocktable")))
;; Should we rescue an old formula?
(when (stringp (setq content (plist-get params :content)))
(when (string-match "^\\([ \t]*#\\+TBLFM:.*\\)" content)
(setq recalc t)
(insert "\n" (match-string 1 (plist-get params :content)))
(beginning-of-line 0))))
(goto-char ipos)
(skip-chars-forward "^|")
(org-table-align)
(when recalc
(if (eq formula '%)
(save-excursion (org-table-goto-column pcol nil 'force)
(insert "%")))
(org-table-recalculate 'all))
(when rm-file-column
(forward-char 1)
(org-table-delete-column))
total-time)))))
;; OK, at this point we tbls as a list of tables, one per file
(setq tbls (nreverse tbls))
(setq params (plist-put params :multifile scope-is-list))
(setq params (plist-put params :one-file-with-archives
one-file-with-archives))
(funcall formatter ipos tbls params))))
(defun org-clocktable-write-default (ipos tables params)
"Write out a clock table at position IPOS in the current buffer.
TABLES is a list of tables with clocking data as produced by
`org-clock-get-table-data'. PARAMS is the parameter property list obtained
from the dynamic block defintion."
;; This function looks quite complicated, mainly because there are a lot
;; of options which can add or remove columns. I have massively commented
;; function, to I hope it is understandable. If someone want to write
;; there own special formatter, this maybe much easier because there can
;; be a fixed format with a well-defined number of columns...
(let* ((hlchars '((1 . "*") (2 . "/")))
(multifile (plist-get params :multifile))
(block (plist-get params :block))
(ts (plist-get params :tstart))
(te (plist-get params :tend))
(header (plist-get params :header))
(narrow (plist-get params :narrow))
(link (plist-get params :link))
(maxlevel (or (plist-get params :maxlevel) 3))
(emph (plist-get params :emphasize))
(level-p (plist-get params :level))
(timestamp (plist-get params :timestamp))
(ntcol (max 1 (or (plist-get params :tcolumns) 100)))
(rm-file-column (plist-get params :one-file-with-archives))
(indent (plist-get params :indent))
range-text total-time tbl level hlc formula pcol
file-time entries entry headline
recalc content narrow-cut-p tcol)
;; Implement abbreviations
(when (plist-get params :compact)
(setq level nil indent t narrow (or narrow '40!) ntcol 1))
;; Some consistency test for parameters
(unless (integerp ntcol)
(setq params (plist-put params :tcolumns (setq ntcol 100))))
(when (and narrow (integerp narrow) link)
;; We cannot have both integer narrow and link
(message
"Using hard narrowing in clocktable to allow for links")
(setq narrow (intern (format "%d!" narrow))))
(when narrow
(cond
((integerp narrow))
((and (symbolp narrow)
(string-match "\\`[0-9]+!\\'" (symbol-name narrow)))
(setq narrow-cut-p t
narrow (string-to-number (substring (symbol-name narrow)
0 -1))))
(t
(error "Invalid value %s of :narrow property in clock table"
narrow))))
(when block
;; Get the range text for the header
(setq range-text (nth 2 (org-clock-special-range block nil t))))
;; Compute the total time
(setq total-time (apply '+ (mapcar 'cadr tables)))
;; Now we need to output this tsuff
(goto-char ipos)
;; Insert the text *before* the actual table
(insert-before-markers
(or header
;; Format the standard header
(concat
"Clock summary at ["
(substring
(format-time-string (cdr org-time-stamp-formats))
1 -1)
"]"
(if block (concat ", for " range-text ".") "")
"\n\n")))
;; Insert the narrowing line
(when (and narrow (integerp narrow) (not narrow-cut-p))
(insert-before-markers
"|" ; table line starter
(if multifile "|" "") ; file column, maybe
(if level-p "|" "") ; level column, maybe
(if timestamp "|" "") ; timestamp column, maybe
(format "<%d>| |\n" narrow))) ; headline and time columns
;; Insert the table header line
(insert-before-markers
"|" ; table line starter
(if multifile "File|" "") ; file column, maybe
(if level-p "L|" "") ; level column, maybe
(if timestamp "Timestamp|" "") ; timestamp column, maybe
"Headline|Time|\n") ; headline and time columns
;; Insert the total time in the table
(insert-before-markers
"|-\n" ; a hline
"|" ; table line starter
(if multifile "| ALL " "") ; file column, maybe
(if level-p "|" "") ; level column, maybe
(if timestamp "|" "") ; timestamp column, maybe
"*Total time*| " ; instead of a headline
"*"
(org-minutes-to-hh:mm-string (or total-time 0)) ; the time
"*|\n") ; close line
;; Now iterate over the tables and insert the data
;; but only if any time has been collected
(when (and total-time (> total-time 0))
(while (setq tbl (pop tables))
;; now tbl is the table resulting from one file.
(setq file-time (nth 1 tbl))
(when (or (and file-time (> file-time 0))
(not (plist-get params :fileskip0)))
(insert-before-markers "|-\n") ; a hline because a new file starts
;; First the file time, if we have multiple files
(when multifile
;; Summarize the time colleted from this file
(insert-before-markers
(format "| %s %s | %s*File time* | *%s*|\n"
(file-name-nondirectory (car tbl))
(if level-p "| " "") ; level column, maybe
(if timestamp "| " "") ; timestamp column, maybe
(org-minutes-to-hh:mm-string (nth 1 tbl))))) ; the time
;; Get the list of node entries and iterate over it
(setq entries (nth 2 tbl))
(while (setq entry (pop entries))
(setq level (car entry)
headline (nth 1 entry)
hlc (if emph (or (cdr (assoc level hlchars)) "") ""))
(when narrow-cut-p
(if (and (string-match (concat "\\`" org-bracket-link-regexp
"\\'")
headline)
(match-end 3))
(setq headline
(format "[[%s][%s]]"
(match-string 1 headline)
(org-shorten-string (match-string 3 headline)
narrow)))
(setq headline (org-shorten-string headline narrow))))
(insert-before-markers
"|" ; start the table line
(if multifile "|" "") ; free space for file name column?
(if level-p (format "%d|" (car entry)) "") ; level, maybe
(if timestamp (concat (nth 2 entry) "|") "") ; timestamp, maybe
(if indent (org-clocktable-indent-string level) "") ; indentation
hlc headline hlc "|" ; headline
(make-string (min (1- ntcol) (or (- level 1))) ?|)
; empty fields for higher levels
hlc (org-minutes-to-hh:mm-string (nth 3 entry)) hlc ; time
"|\n" ; close line
)))))
(backward-delete-char 1)
(if (setq formula (plist-get params :formula))
(cond
((eq formula '%)
;; compute the column where the % numbers need to go
(setq pcol (+ 2
(if multifile 1 0)
(if level-p 1 0)
(if timestamp 1 0)
(min maxlevel (or ntcol 100))))
;; compute the column where the total time is
(setq tcol (+ 2
(if multifile 1 0)
(if level-p 1 0)
(if timestamp 1 0)))
(insert
(format
"\n#+TBLFM: $%d='(org-clock-time%% @%d$%d $%d..$%d);%%.1f"
pcol ; the column where the % numbers should go
(if (and narrow (not narrow-cut-p)) 3 2) ; row of the total time
tcol ; column of the total time
tcol (1- pcol) ; range of columns where times can be found
))
(setq recalc t))
((stringp formula)
(insert "\n#+TBLFM: " formula)
(setq recalc t))
(t (error "invalid formula in clocktable")))
;; Should we rescue an old formula?
(when (stringp (setq content (plist-get params :content)))
(when (string-match "^\\([ \t]*#\\+TBLFM:.*\\)" content)
(setq recalc t)
(insert "\n" (match-string 1 (plist-get params :content)))
(beginning-of-line 0))))
;; Back to beginning, align the table, recalculate if necessary
(goto-char ipos)
(skip-chars-forward "^|")
(org-table-align)
(when org-hide-emphasis-markers
;; we need to align a second time
(org-table-align))
(when recalc
(if (eq formula '%)
(save-excursion
(if (and narrow (not narrow-cut-p)) (beginning-of-line 2))
(org-table-goto-column pcol nil 'force)
(insert "%")))
(org-table-recalculate 'all))
(when rm-file-column
;; The file column is actually not wanted
(forward-char 1)
(org-table-delete-column))
total-time))
(defun org-clocktable-indent-string (level)
(if (= level 1)
""
(let ((str "\\__"))
(while (> level 2)
(setq level (1- level)
str (concat str "___")))
(concat str " "))))
(defun org-clocktable-steps (params)
"Step through the range to make a number of clock tables."
(let* ((p1 (copy-sequence params))
(ts (plist-get p1 :tstart))
(te (plist-get p1 :tend))
@ -2008,29 +2262,107 @@ the currently selected interval size."
(setq p1 (plist-put p1 :tend (format-time-string
(org-time-stamp-format nil t)
(seconds-to-time (setq ts (+ ts step))))))
(insert "\n" (if (eq step0 'day) "Daily report: " "Weekly report starting on: ")
(insert "\n" (if (eq step0 'day) "Daily report: "
"Weekly report starting on: ")
(plist-get p1 :tstart) "\n")
(setq step-time (org-dblock-write:clocktable p1))
(re-search-forward "#\\+END:")
(re-search-forward "^[ \t]*#\\+END:")
(when (and (equal step-time 0) stepskip0)
;; Remove the empty table
(delete-region (point-at-bol)
(save-excursion
(re-search-backward "^\\(Daily\\|Weekly\\) report" nil t)
(re-search-backward "^\\(Daily\\|Weekly\\) report"
nil t)
(point))))
(end-of-line 0))))
(defun org-clocktable-add-file (file table)
(if table
(let ((lines (org-split-string table "\n"))
(ff (file-name-nondirectory file)))
(mapconcat 'identity
(mapcar (lambda (x)
(if (string-match org-table-dataline-regexp x)
(concat "|" ff x)
x))
lines)
"\n"))))
(defun org-clock-get-table-data (file params)
"Get the clocktable data for file FILE, with parameters PARAMS.
FILE is only for identification - this function assumes that
the correct buffer is current, and that the wanted restriction is
in place.
The return value will be a list with the file name and the total
file time (in minutes) as 1st and 2nd elements. The third element
of this list will be a list of headline entries. Each entry has the
following structure:
(LEVEL HEADLINE TIMESTAMP TIME)
LEVEL: The level of the headline, as an integer. This will be
the reduced leve, so 1,2,3,... even if only odd levels
are being used.
HEADLINE: The text of the headline. Depending on PARAMS, this may
already be formatted like a link.
TIMESTAMP: If PARAMS require it, this will be a time stamp found in the
entry, any of SCHEDULED, DEADLINE, NORMAL, or first inactive,
in this sequence.
TIME: The sum of all time spend in this tree, in minutes. This time
will of cause be restricted to the time block and tags match
specified in PARAMS."
(let* ((maxlevel (or (plist-get params :maxlevel) 3))
(timestamp (plist-get params :timestamp))
(ts (plist-get params :tstart))
(te (plist-get params :tend))
(block (plist-get params :block))
(link (plist-get params :link))
(tags (plist-get params :tags))
(matcher (if tags (cdr (org-make-tags-matcher tags))))
cc range-text st p time level hdl props tsp tbl)
(setq org-clock-file-total-minutes nil)
(when block
(setq cc (org-clock-special-range block nil t)
ts (car cc) te (nth 1 cc) range-text (nth 2 cc)))
(when (integerp ts) (setq ts (calendar-gregorian-from-absolute ts)))
(when (integerp te) (setq te (calendar-gregorian-from-absolute te)))
(when (and ts (listp ts))
(setq ts (format "%4d-%02d-%02d" (nth 2 ts) (car ts) (nth 1 ts))))
(when (and te (listp te))
(setq te (format "%4d-%02d-%02d" (nth 2 te) (car te) (nth 1 te))))
;; Now the times are strings we can parse.
(if ts (setq ts (org-float-time
(apply 'encode-time (org-parse-time-string ts)))))
(if te (setq te (org-float-time
(apply 'encode-time (org-parse-time-string te)))))
(save-excursion
(org-clock-sum ts te
(unless (null matcher)
(lambda ()
(let ((tags-list (org-get-tags-at)))
(eval matcher)))))
(goto-char (point-min))
(setq st t)
(while (or (and (bobp) (prog1 st (setq st nil))
(get-text-property (point) :org-clock-minutes)
(setq p (point-min)))
(setq p (next-single-property-change
(point) :org-clock-minutes)))
(goto-char p)
(when (setq time (get-text-property p :org-clock-minutes))
(save-excursion
(beginning-of-line 1)
(when (and (looking-at (org-re "\\(\\*+\\)[ \t]+\\(.*?\\)\\([ \t]+:[[:alnum:]_@#%:]+:\\)?[ \t]*$"))
(setq level (org-reduced-level
(- (match-end 1) (match-beginning 1))))
(<= level maxlevel))
(setq hdl (if (not link)
(match-string 2)
(org-make-link-string
(format "file:%s::%s"
(buffer-file-name)
(save-match-data
(org-make-org-heading-search-string
(match-string 2))))
(match-string 2)))
tsp (when timestamp
(setq props (org-entry-properties (point)))
(or (cdr (assoc "SCHEDULED" props))
(cdr (assoc "DEADLINE" props))
(cdr (assoc "TIMESTAMP" props))
(cdr (assoc "TIMESTAMP_IA" props)))))
(when (> time 0) (push (list level hdl tsp time) tbl))))))
(setq tbl (nreverse tbl))
(list file org-clock-file-total-minutes tbl))))
(defun org-clock-time% (total &rest strings)
"Compute a time fraction in percent.
@ -2051,7 +2383,8 @@ This function is made for clock tables."
(if (string-match "\\([0-9]+\\):\\([0-9]+\\)" s)
(throw 'exit
(/ (* 100.0 (+ (string-to-number (match-string 2 s))
(* 60 (string-to-number (match-string 1 s)))))
(* 60 (string-to-number
(match-string 1 s)))))
tot))))
0))))
@ -2081,7 +2414,8 @@ The details of what will be saved are regulated by the variable
(buffer-file-name b)
(or (not org-clock-persist-query-save)
(y-or-n-p (concat "Save current clock ("
(substring-no-properties org-clock-heading)
(substring-no-properties
org-clock-heading)
") "))))
(insert "(setq resume-clock '(\""
(buffer-file-name (org-clocking-buffer))
@ -2162,3 +2496,4 @@ The details of what will be saved are regulated by the variable
;; arch-tag: 7b42c5d4-9b36-48be-97c0-66a869daed4c
;;; org-clock.el ends here

2
lisp/org/org-colview.el
View file

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;

22
lisp/org/org-compat.el
View file

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;
@ -372,15 +372,15 @@ TIME defaults to the current time."
(time-to-seconds (or time (current-time)))
(float-time time)))
(defun org-string-match-p (&rest args)
(if (fboundp 'string-match-p)
(apply 'string-match-p args)
(if (fboundp 'string-match-p)
(defalias 'org-string-match-p 'string-match-p)
(defun org-string-match-p (regexp string &optional start)
(save-match-data
(apply 'string-match args))))
(funcall 'string-match regexp string start))))
(defun org-looking-at-p (&rest args)
(if (fboundp 'looking-at-p)
(apply 'looking-at-p args)
(if (fboundp 'looking-at-p)
(defalias 'org-looking-at-p 'looking-at-p)
(defun org-looking-at-p (&rest args)
(save-match-data
(apply 'looking-at args))))
@ -418,6 +418,12 @@ LIMIT."
(looking-at (concat "\\(?:" regexp "\\)\\'")))))
(not (null pos)))))
(defun org-floor* (x &optional y)
"Return a list of the floor of X and the fractional part of X.
With two arguments, return floor and remainder of their quotient."
(let ((q (floor x y)))
(list q (- x (if y (* y q) q)))))
(provide 'org-compat)
;; arch-tag: a0a0579f-e68c-4bdf-9e55-93768b846bbe

279
lisp/org/org-complete.el Normal file
View file

@ -0,0 +1,279 @@
;;; org-complete.el --- In-buffer completion code
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; John Wiegley <johnw at gnu dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:
;;;; Require other packages
(eval-when-compile
(require 'cl))
(require 'org-macs)
(require 'pcomplete)
(declare-function org-split-string "org" (string &optional separators))
(declare-function org-get-current-options "org-exp" ())
(declare-function org-make-org-heading-search-string "org"
(&optional string heading))
(declare-function org-get-buffer-tags "org" ())
(declare-function org-get-tags "org" ())
(declare-function org-buffer-property-keys "org"
(&optional include-specials include-defaults include-columns))
(declare-function org-entry-properties "org" (&optional pom which specific))
;;;; Customization variables
(defgroup org-complete nil
"Outline-based notes management and organizer."
:tag "Org"
:group 'org)
(defun org-thing-at-point ()
"Examine the thing at point and let the caller know what it is.
The return value is a string naming the thing at point."
(let ((beg1 (save-excursion
(skip-chars-backward (org-re "[:alnum:]_@"))
(point)))
(beg (save-excursion
(skip-chars-backward "a-zA-Z0-9_:$")
(point)))
(line-to-here (buffer-substring (point-at-bol) (point))))
(cond
((string-match "\\`[ \t]*#\\+begin: clocktable[ \t]+" line-to-here)
(cons "block-option" "clocktable"))
((string-match "\\`[ \t]*#\\+begin_src[ \t]+" line-to-here)
(cons "block-option" "src"))
((save-excursion
(re-search-backward "^[ \t]*#\\+\\([A-Z_]+\\):.*"
(line-beginning-position) t))
(cons "file-option" (match-string-no-properties 1)))
((string-match "\\`[ \t]*#\\+[a-zA-Z]*\\'" line-to-here)
(cons "file-option" nil))
((equal (char-before beg) ?\[)
(cons "link" nil))
((equal (char-before beg) ?\\)
(cons "tex" nil))
((string-match "\\`\\*+[ \t]+\\'"
(buffer-substring (point-at-bol) beg))
(cons "todo" nil))
((equal (char-before beg) ?*)
(cons "searchhead" nil))
((and (equal (char-before beg1) ?:)
(equal (char-after (point-at-bol)) ?*))
(cons "tag" nil))
((and (equal (char-before beg1) ?:)
(not (equal (char-after (point-at-bol)) ?*)))
(cons "prop" nil))
(t nil))))
(defun org-command-at-point ()
"Return the qualified name of the Org completion entity at point.
When completing for #+STARTUP, for example, this function returns
\"file-option/startup\"."
(let ((thing (org-thing-at-point)))
(cond
((string= "file-option" (car thing))
(concat (car thing) "/" (downcase (cdr thing))))
((string= "block-option" (car thing))
(concat (car thing) "/" (downcase (cdr thing))))
(t
(car thing)))))
(defun org-parse-arguments ()
"Parse whitespace separated arguments in the current region."
(let ((begin (line-beginning-position))
(end (line-end-position))
begins args)
(save-restriction
(narrow-to-region begin end)
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(skip-chars-forward " \t\n[")
(setq begins (cons (point) begins))
(skip-chars-forward "^ \t\n[")
(setq args (cons (buffer-substring-no-properties
(car begins) (point))
args)))
(cons (reverse args) (reverse begins))))))
(defun org-complete-initial ()
"Calls the right completion function for first argument completions."
(ignore
(funcall (or (pcomplete-find-completion-function
(car (org-thing-at-point)))
pcomplete-default-completion-function))))
(defvar org-additional-option-like-keywords)
(defun pcomplete/org-mode/file-option ()
"Complete against all valid file options."
(require 'org-exp)
(pcomplete-here
(org-complete-case-double
(mapcar (lambda (x)
(if (= ?: (aref x (1- (length x))))
(concat x " ")
x))
(delq nil
(pcomplete-uniqify-list
(append
(mapcar (lambda (x)
(if (string-match "^#\\+\\([A-Z_]+:?\\)" x)
(match-string 1 x)))
(org-split-string (org-get-current-options) "\n"))
org-additional-option-like-keywords)))))
(substring pcomplete-stub 2)))
(defvar org-startup-options)
(defun pcomplete/org-mode/file-option/startup ()
"Complete arguments for the #+STARTUP file option."
(while (pcomplete-here
(let ((opts (pcomplete-uniqify-list
(mapcar 'car org-startup-options))))
;; Some options are mutually exclusive, and shouldn't be completed
;; against if certain other options have already been seen.
(dolist (arg pcomplete-args)
(cond
((string= arg "hidestars")
(setq opts (delete "showstars" opts)))))
opts))))
(defun pcomplete/org-mode/file-option/bind ()
"Complete arguments for the #+BIND file option, which are variable names"
(let (vars)
(mapatoms
(lambda (a) (if (boundp a) (setq vars (cons (symbol-name a) vars)))))
(pcomplete-here vars)))
(defvar org-link-abbrev-alist-local)
(defvar org-link-abbrev-alist)
(defun pcomplete/org-mode/link ()
"Complete against defined #+LINK patterns."
(pcomplete-here
(pcomplete-uniqify-list (append (mapcar 'car org-link-abbrev-alist-local)
(mapcar 'car org-link-abbrev-alist)))))
(defvar org-entities)
(defun pcomplete/org-mode/tex ()
"Complete against TeX-style HTML entity names."
(require 'org-entities)
(while (pcomplete-here
(pcomplete-uniqify-list (remove nil (mapcar 'car-safe org-entities)))
(substring pcomplete-stub 1))))
(defvar org-todo-keywords-1)
(defun pcomplete/org-mode/todo ()
"Complete against known TODO keywords."
(pcomplete-here (pcomplete-uniqify-list org-todo-keywords-1)))
(defvar org-todo-line-regexp)
(defun pcomplete/org-mode/searchhead ()
"Complete against all headings.
This needs more work, to handle headings with lots of spaces in them."
(while
(pcomplete-here
(save-excursion
(goto-char (point-min))
(let (tbl)
(while (re-search-forward org-todo-line-regexp nil t)
(push (org-make-org-heading-search-string
(match-string-no-properties 3) t)
tbl))
(pcomplete-uniqify-list tbl)))
(substring pcomplete-stub 1))))
(defvar org-tag-alist)
(defun pcomplete/org-mode/tag ()
"Complete a tag name. Omit tags already set."
(while (pcomplete-here
(mapcar (lambda (x)
(concat x ":"))
(let ((lst (pcomplete-uniqify-list
(or (remove
nil
(mapcar (lambda (x)
(and (stringp (car x)) (car x)))
org-tag-alist))
(mapcar 'car (org-get-buffer-tags))))))
(dolist (tag (org-get-tags))
(setq lst (delete tag lst)))
lst))
(and (string-match ".*:" pcomplete-stub)
(substring pcomplete-stub (match-end 0))))))
(defun pcomplete/org-mode/prop ()
"Complete a property name. Omit properties already set."
(pcomplete-here
(mapcar (lambda (x)
(concat x ": "))
(let ((lst (pcomplete-uniqify-list
(org-buffer-property-keys nil t t))))
(dolist (prop (org-entry-properties))
(setq lst (delete (car prop) lst)))
lst))
(substring pcomplete-stub 1)))
(defun pcomplete/org-mode/block-option/src ()
"Complete the arguments of a begin_src block.
Complete a language in the first field, the header arguments and switches."
(pcomplete-here
(mapcar
(lambda(x) (symbol-name (nth 3 x)))
(cdr (car (cdr (memq :key-type (plist-get
(symbol-plist
'org-babel-load-languages)
'custom-type)))))))
(while (pcomplete-here
'("-n" "-r" "-l"
":cache" ":colnames" ":comments" ":dir" ":eval" ":exports"
":file" ":hlines" ":no-expand" ":noweb" ":results" ":rownames"
":session" ":shebang" ":tangle" ":var"))))
(defun pcomplete/org-mode/block-option/clocktable ()
"Complete keywords in a clocktable line"
(while (pcomplete-here '(":maxlevel" ":scope"
":tstart" ":tend" ":block" ":step"
":stepskip0" ":fileskip0"
":emphasize" ":link" ":narrow" ":indent"
":tcolumns" ":level" ":compact" ":timestamp"
":formula" ":formatter"))))
(defun org-complete-case-double (list)
"Return list with both upcase and downcase version of all strings in LIST."
(let (e res)
(while (setq e (pop list))
(setq res (cons (downcase e) (cons (upcase e) res))))
(nreverse res)))
;;;; Finish up
(provide 'org-complete)
;; arch-tag:
;;; org-complete.el ends here

2
lisp/org/org-crypt.el
View file

@ -4,7 +4,7 @@
;; Emacs Lisp Archive Entry
;; Filename: org-crypt.el
;; Version: 7.3
;; Version: 7.4
;; Keywords: org-mode
;; Author: John Wiegley <johnw@gnu.org>
;; Maintainer: Peter Jones <pjones@pmade.com>

4
lisp/org/org-ctags.el
View file

@ -3,10 +3,10 @@
;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Paul Sexton <eeeickythump@gmail.com>
;; Version: 7.3
;; Version: 7.4
;; Keywords: org, wp
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;

2
lisp/org/org-datetree.el
View file

@ -5,7 +5,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;

2
lisp/org/org-docbook.el
View file

@ -4,7 +4,7 @@
;;
;; Emacs Lisp Archive Entry
;; Filename: org-docbook.el
;; Version: 7.3
;; Version: 7.4
;; Author: Baoqiu Cui <cbaoqiu AT yahoo DOT com>
;; Maintainer: Baoqiu Cui <cbaoqiu AT yahoo DOT com>
;; Keywords: org, wp, docbook

2
lisp/org/org-docview.el
View file

@ -5,7 +5,7 @@
;; Author: Jan Böcker <jan.boecker at jboecker dot de>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;

2
lisp/org/org-entities.el
View file

@ -6,7 +6,7 @@
;; Ulf Stegemann <ulf at zeitform dot de>
;; Keywords: outlines, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;

5
lisp/org/org-exp-blocks.el
View file

@ -4,7 +4,7 @@
;; Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.
;;
@ -201,9 +201,6 @@ which defaults to the value of `org-export-blocks-witheld'."
(interblock start (point-max))
(run-hooks 'org-export-blocks-postblock-hook)))))
(add-hook 'org-export-preprocess-after-include-files-hook
'org-export-blocks-preprocess)
;;================================================================================
;; type specific functions

52
lisp/org/org-exp.el
View file

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;
@ -984,7 +984,7 @@ value of `org-export-run-in-background'."
(set-process-sentinel p 'org-export-process-sentinel)
(message "Background process \"%s\": started" p))
;; background processing not requested, or not possible
(if subtree-p (progn (outline-mark-subtree) (activate-mark)))
(if subtree-p (progn (org-mark-subtree) (activate-mark)))
(call-interactively (nth 1 ass))
(when (and bpos (get-buffer-window cbuf))
(let ((cw (selected-window)))
@ -1080,12 +1080,18 @@ on this string to produce the exported version."
;; Mark end of lists
(org-export-mark-list-ending backend)
;; Export code blocks
(org-export-blocks-preprocess)
;; Handle source code snippets
(org-export-replace-src-segments-and-examples backend)
;; Protect short examples marked by a leading colon
(org-export-protect-colon-examples)
;; Protected spaces
(org-export-convert-protected-spaces backend)
;; Normalize footnotes
(when (plist-get parameters :footnotes)
(org-footnote-normalize nil t))
@ -1536,6 +1542,26 @@ from the buffer."
(add-text-properties (point) (org-end-of-subtree t)
'(org-protected t)))))
(defun org-export-convert-protected-spaces (backend)
"Convert strings like \\____ to protected spaces in all backends."
(goto-char (point-min))
(while (re-search-forward "\\\\__+" nil t)
(org-if-unprotected-1
(replace-match
(org-add-props
(cond
((eq backend 'latex)
(format "\\hspace{%dex}" (- (match-end 0) (match-beginning 0))))
((eq backend 'html)
(org-add-props (match-string 0) nil
'org-whitespace (- (match-end 0) (match-beginning 0))))
;; ((eq backend 'docbook))
((eq backend 'ascii)
(org-add-props (match-string 0) '(org-whitespace t)))
(t (make-string (- (match-end 0) (match-beginning 0)) ?\ )))
'(org-protected t))
t t))))
(defun org-export-protect-verbatim ()
"Mark verbatim snippets with the protection property."
(goto-char (point-min))
@ -2100,12 +2126,13 @@ TYPE must be a string, any of:
(defun org-export-handle-include-files ()
"Include the contents of include files, with proper formatting."
(let ((case-fold-search t)
params file markup lang start end prefix prefix1 switches all)
params file markup lang start end prefix prefix1 switches all minlevel)
(goto-char (point-min))
(while (re-search-forward "^#\\+INCLUDE:?[ \t]+\\(.*\\)" nil t)
(setq params (read (concat "(" (match-string 1) ")"))
prefix (org-get-and-remove-property 'params :prefix)
prefix1 (org-get-and-remove-property 'params :prefix1)
minlevel (org-get-and-remove-property 'params :minlevel)
file (org-symname-or-string (pop params))
markup (org-symname-or-string (pop params))
lang (and (member markup '("src" "SRC"))
@ -2128,7 +2155,7 @@ TYPE must be a string, any of:
end (format "#+end_%s" markup))))
(insert (or start ""))
(insert (org-get-file-contents (expand-file-name file)
prefix prefix1 markup))
prefix prefix1 markup minlevel))
(or (bolp) (newline))
(insert (or end ""))))
all))
@ -2145,7 +2172,7 @@ TYPE must be a string, any of:
(when intersection
(error "Recursive #+INCLUDE: %S" intersection))))))
(defun org-get-file-contents (file &optional prefix prefix1 markup)
(defun org-get-file-contents (file &optional prefix prefix1 markup minlevel)
"Get the contents of FILE and return them as a string.
If PREFIX is a string, prepend it to each line. If PREFIX1
is a string, prepend it to the first line instead of PREFIX.
@ -2167,6 +2194,9 @@ take care of the block they are in."
(goto-char (match-beginning 0))
(insert ",")
(end-of-line 1)))
(when minlevel
(dotimes (lvl minlevel)
(org-map-region 'org-demote (point-min) (point-max))))
(buffer-string)))
(defun org-get-and-remove-property (listvar prop)
@ -2235,8 +2265,6 @@ in the list) and remove property and value from the list in LISTVAR."
(defvar org-export-latex-listings-langs) ;; defined in org-latex.el
(defvar org-export-latex-listings-w-names) ;; defined in org-latex.el
(defvar org-export-latex-minted-langs) ;; defined in org-latex.el
(defvar org-export-latex-minted-with-line-numbers) ;; defined in org-latex.el
(defun org-export-format-source-code-or-example
(backend lang code &optional opts indent caption)
"Format CODE from language LANG and return it formatted for export.
@ -2403,8 +2431,7 @@ INDENT was the original indentation of the block."
(format "\n%s $\\equiv$ \n"
(replace-regexp-in-string
"_" "\\\\_" caption)))
(format
"\\begin{minted}[mathescape,%s\nnumbersep=5pt,\nframe=lines,\nframesep=2mm]{%s}\n" (if org-export-latex-minted-with-line-numbers "\nlinenos," "") minted-lang)
(format "\\begin{minted}{%s}\n" minted-lang)
rtn "\\end{minted}\n"))))
(t (concat (car org-export-latex-verbatim-wrap)
rtn (cdr org-export-latex-verbatim-wrap))))
@ -2585,9 +2612,10 @@ command."
;; does do the trick.
(if (looking-at "#[^\r\n]*")
(append-to-buffer buffer (match-beginning 0) (1+ (match-end 0))))
(while (re-search-forward "[\n\r]#[^\n\r]*" nil t)
(append-to-buffer buffer (1+ (match-beginning 0))
(min (point-max) (1+ (match-end 0))))))
(when (re-search-forward "^\\*+[ \t]+" nil t)
(while (re-search-backward "[\n\r]#[^\n\r]*" nil t)
(append-to-buffer buffer (1+ (match-beginning 0))
(min (point-max) (1+ (match-end 0)))))))
(set-buffer buffer)
(let ((buffer-file-name file)
(org-inhibit-startup t))

11
lisp/org/org-faces.el
View file

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;
@ -685,6 +685,15 @@ If it is less than 8, the level-1 face gets re-used for level N+1 etc."
:type 'integer
:group 'org-faces)
(defcustom org-cycle-level-faces t
"Non-nil means level styles cycle after level `org-n-level-faces'.
Then so level org-n-level-faces+1 is styled like level 1.
If nil, then all levels >=org-n-level-faces are styled like
level org-n-level-faces"
:group 'org-appearance
:group 'org-faces
:type 'boolean)
(defface org-latex-and-export-specials
(let ((font (cond ((assq :inherit custom-face-attributes)
'(:inherit underline))

2
lisp/org/org-feed.el
View file

@ -5,7 +5,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;

4
lisp/org/org-footnote.el
View file

@ -5,7 +5,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;
@ -303,7 +303,7 @@ or new, let the user edit the definition of the footnote."
(t
(setq re (concat "^" org-footnote-tag-for-non-org-mode-files "[ \t]*$"))
(unless (re-search-forward re nil t)
(let ((max (if (and (eq major-mode 'message-mode)
(let ((max (if (and (derived-mode-p 'message-mode)
(re-search-forward message-signature-separator nil t))
(progn (beginning-of-line) (point))
(goto-char (point-max)))))

2
lisp/org/org-freemind.el
View file

@ -5,7 +5,7 @@
;; Author: Lennart Borgman (lennart O borgman A gmail O com)
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;

2
lisp/org/org-gnus.el
View file

@ -7,7 +7,7 @@
;; Tassilo Horn <tassilo at member dot fsf dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;

7
lisp/org/org-habit.el
View file

@ -5,7 +5,7 @@
;; Author: John Wiegley <johnw at gnu dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;
@ -197,10 +197,7 @@ This list represents a \"habit\" for the rest of this module."
"Determine the relative priority of a habit.
This must take into account not just urgency, but consistency as well."
(let ((pri 1000)
(now (time-to-days
(or moment
(time-subtract (current-time)
(list 0 (* 3600 org-extend-today-until) 0)))))
(now (if moment (time-to-days moment) (org-today)))
(scheduled (org-habit-scheduled habit))
(deadline (org-habit-deadline habit)))
;; add 10 for every day past the scheduled date, and subtract for every

16
lisp/org/org-html.el
View file

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;
@ -1213,7 +1213,11 @@ lang=\"%s\" xml:lang=\"%s\">
(throw 'nextline nil))
;; Protected HTML
(when (get-text-property 0 'org-protected line)
(when (and (get-text-property 0 'org-protected 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)))
(when (re-search-backward
"\\(<p>\\)\\([ \t\r\n]*\\)\\=" (- (point) 100) t)
@ -2316,10 +2320,9 @@ When TITLE is nil, just close all open levels."
(extra-class (and title (org-get-text-property-any 0 'html-container-class title)))
(preferred (and target
(cdr (assoc target org-export-preferred-target-alist))))
(remove (or preferred target))
(l org-level-max)
snumber snu href suffix)
(setq extra-targets (remove remove extra-targets))
(setq extra-targets (remove (or preferred target) extra-targets))
(setq extra-targets
(mapconcat (lambda (x)
(if (org-uuidgen-p x) (setq x (concat "ID-" x)))
@ -2358,12 +2361,13 @@ When TITLE is nil, just close all open levels."
(progn
(org-close-li)
(if target
(insert (format "<li id=\"%s\">" target) extra-targets title "<br/>\n")
(insert (format "<li id=\"%s\">" (or preferred target))
extra-targets title "<br/>\n")
(insert "<li>" title "<br/>\n")))
(aset org-levels-open (1- level) t)
(org-close-par-maybe)
(if target
(insert (format "<ul>\n<li id=\"%s\">" target)
(insert (format "<ul>\n<li id=\"%s\">" (or preferred target))
extra-targets title "<br/>\n")
(insert "<ul>\n<li>" title "<br/>\n"))))
(aset org-levels-open (1- level) t)

2
lisp/org/org-icalendar.el
View file

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;

23
lisp/org/org-id.el
View file

@ -5,7 +5,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;
@ -600,15 +600,18 @@ optional argument MARKERP, return the position as a new marker."
(defun org-id-store-link ()
"Store a link to the current entry, using its ID."
(interactive)
(let* ((link (org-make-link "id:" (org-id-get-create)))
(case-fold-search nil)
(desc (save-excursion
(org-back-to-heading t)
(or (and (looking-at org-complex-heading-regexp)
(if (match-end 4) (match-string 4) (match-string 0)))
link))))
(org-store-link-props :link link :description desc :type "id")
link))
(when (and (buffer-file-name (buffer-base-buffer)) (org-mode-p))
(let* ((link (org-make-link "id:" (org-id-get-create)))
(case-fold-search nil)
(desc (save-excursion
(org-back-to-heading t)
(or (and (looking-at org-complex-heading-regexp)
(if (match-end 4)
(match-string 4)
(match-string 0)))
link))))
(org-store-link-props :link link :description desc :type "id")
link)))
(defun org-id-open (id)
"Go to the entry with id ID."

88
lisp/org/org-indent.el
View file

@ -4,7 +4,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;
@ -38,6 +38,10 @@
(eval-when-compile
(require 'cl))
(defvar org-inlinetask-min-level)
(declare-function org-inlinetask-get-task-level "org-inlinetask" ())
(declare-function org-inlinetask-in-task-p "org-inlinetask" ())
(defgroup org-indent nil
"Options concerning dynamic virtual outline indentation."
:tag "Org Indent"
@ -219,35 +223,49 @@ useful to make it ever so slightly different."
(defun org-indent-add-properties (beg end)
"Add indentation properties between BEG and END.
Assumes that BEG is at the beginning of a line."
(when (or t org-indent-mode)
(let ((inhibit-modification-hooks t)
ov b e n level exit nstars)
(with-silent-modifications
(save-excursion
(goto-char beg)
(while (not exit)
(setq e end)
(if (not (re-search-forward org-indent-outline-re nil t))
(setq e (point-max) exit t)
(setq e (match-beginning 0))
(if (>= e end) (setq exit t))
(setq level (- (match-end 0) (match-beginning 0) 1))
(setq nstars (- (* (1- level) org-indent-indentation-per-level)
(1- level)))
(add-text-properties
(point-at-bol) (point-at-eol)
(list 'line-prefix
(aref org-indent-stars nstars)
'wrap-prefix
(aref org-indent-strings
(* level org-indent-indentation-per-level)))))
(when (and b (> e b))
(add-text-properties
b e (list 'line-prefix (aref org-indent-strings n)
'wrap-prefix (aref org-indent-strings n))))
(setq b (1+ (point-at-eol))
n (* (or level 0) org-indent-indentation-per-level))))))))
(let* ((inhibit-modification-hooks t)
(inlinetaskp (featurep 'org-inlinetask))
(get-real-level (lambda (pos lvl)
(save-excursion
(goto-char pos)
(if (and inlinetaskp (org-inlinetask-in-task-p))
(org-inlinetask-get-task-level)
lvl))))
(b beg)
(e end)
(level 0)
(n 0)
exit nstars)
(with-silent-modifications
(save-excursion
(goto-char beg)
(while (not exit)
(setq e end)
(if (not (re-search-forward org-indent-outline-re nil t))
(setq e (point-max) exit t)
(setq e (match-beginning 0))
(if (>= e end) (setq exit t))
(unless (and inlinetaskp (org-inlinetask-in-task-p))
(setq level (- (match-end 0) (match-beginning 0) 1)))
(setq nstars (* (1- (funcall get-real-level e level))
(1- org-indent-indentation-per-level)))
(add-text-properties
(point-at-bol) (point-at-eol)
(list 'line-prefix
(aref org-indent-stars nstars)
'wrap-prefix
(aref org-indent-strings
(* (funcall get-real-level e level)
org-indent-indentation-per-level)))))
(when (> e b)
(add-text-properties
b e (list 'line-prefix (aref org-indent-strings n)
'wrap-prefix (aref org-indent-strings n))))
(setq b (1+ (point-at-eol))
n (* (funcall get-real-level b level)
org-indent-indentation-per-level)))))))
(defvar org-inlinetask-min-level)
(defun org-indent-refresh-section ()
"Refresh indentation properties in the current outline section.
Point is assumed to be at the beginning of a headline."
@ -255,7 +273,11 @@ Point is assumed to be at the beginning of a headline."
(when org-indent-mode
(let (beg end)
(save-excursion
(when (ignore-errors (org-back-to-heading))
(when (ignore-errors (let ((outline-regexp (format "\\*\\{1,%s\\}[ \t]+"
(if (featurep 'org-inlinetask)
(1- org-inlinetask-min-level)
""))))
(org-back-to-heading)))
(setq beg (point))
(setq end (or (save-excursion (or (outline-next-heading) (point)))))
(org-indent-remove-properties beg end)
@ -268,7 +290,11 @@ Point is assumed to be at the beginning of a headline."
(when org-indent-mode
(let ((beg (point)) (end limit))
(save-excursion
(and (ignore-errors (org-back-to-heading t))
(and (ignore-errors (let ((outline-regexp (format "\\*\\{1,%s\\}[ \t]+"
(if (featurep 'org-inlinetask)
(1- org-inlinetask-min-level)
""))))
(org-back-to-heading)))
(setq beg (point))))
(org-indent-remove-properties beg end)
(org-indent-add-properties beg end)))

2
lisp/org/org-info.el
View file

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;

182
lisp/org/org-inlinetask.el
View file

@ -5,7 +5,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.
@ -100,6 +100,60 @@ When nil, they will not be exported."
:group 'org-inlinetask
:type 'boolean)
(defvar org-inlinetask-export-templates
'((html "<pre class=\"inlinetask\"><b>%s%s</b><br>%s</pre>"
'((unless (eq todo "")
(format "<span class=\"%s %s\">%s%s</span> "
class todo todo priority))
heading content))
(latex "\\begin\{description\}\\item[%s%s]%s\\end\{description\}"
'((unless (eq todo "") (format "\\textsc\{%s%s\} " todo priority))
heading content))
(ascii " -- %s%s%s"
'((unless (eq todo "") (format "%s%s " todo priority))
heading
(unless (eq content "")
(format "\n ¦ %s"
(mapconcat 'identity (org-split-string content "\n")
"\n ¦ ")))))
(docbook "<variablelist>
<varlistentry>
<term>%s%s</term>
<listitem><para>%s</para></listitem>
</varlistentry>
</variablelist>"
'((unless (eq todo "") (format "%s%s " todo priority))
heading content)))
"Templates for inline tasks in various exporters.
This variable is an alist in the shape of (BACKEND STRING OBJECTS).
BACKEND is the name of the backend for the template (ascii, html...).
STRING is a format control string.
OBJECTS is a list of elements to be substituted into the format
string. They can be of any type, from a string to a form
returning a value (thus allowing conditional insertion). A nil
object will be substituted as the empty string. Obviously, there
must be at least as many objects as %-sequences in the format
string.
Moreover, the following special keywords are provided: `todo',
`priority', `heading', `content', `tags'. If some of them are not
defined in an inline task, their value is the empty string.
As an example, valid associations are:
(html \"<ul><li>%s <p>%s</p></li></ul>\" (heading content))
or, with the additional package \"todonotes\" for LaTeX,
(latex \"\\todo[inline]{\\textbf{\\textsf{%s %s}}\\linebreak{} %s}\"
'((unless (eq todo \"\")
(format \"\\textsc{%s%s}\" todo priority))
heading content)))")
(defvar org-odd-levels-only)
(defvar org-keyword-time-regexp)
(defvar org-drawer-regexp)
@ -131,24 +185,56 @@ If prefix arg NO-STATE is set, ignore `org-inlinetask-default-state'."
(end-of-line -1))
(define-key org-mode-map "\C-c\C-xt" 'org-inlinetask-insert-task)
(defun org-inlinetask-outline-regexp ()
"Return string matching an inline task heading.
The number of levels is controlled by `org-inlinetask-min-level'."
(let ((nstars (if org-odd-levels-only
(1- (* org-inlinetask-min-level 2))
org-inlinetask-min-level)))
(format "^\\(\\*\\{%d,\\}\\)[ \t]+" nstars)))
(defun org-inlinetask-in-task-p ()
"Return true if point is inside an inline task."
(save-excursion
(let* ((nstars (if org-odd-levels-only
(1- (* 2 (or org-inlinetask-min-level 200)))
(or org-inlinetask-min-level 200)))
(stars-re (concat "^\\(?:\\*\\{"
(format "%d" (- nstars 1))
",\\}\\)[ \t]+"))
(let* ((stars-re (org-inlinetask-outline-regexp))
(task-beg-re (concat stars-re "\\(?:.*\\)"))
(task-end-re (concat stars-re "\\(?:END\\|end\\)")))
(task-end-re (concat stars-re "\\(?:END\\|end\\)[ \t]*$")))
(beginning-of-line)
(or (looking-at task-beg-re)
(and (re-search-forward "^\\*+[ \t]+" nil t)
(progn (beginning-of-line) (looking-at task-end-re)))))))
(defvar htmlp) ; dynamically scoped into the next function
(defvar latexp) ; dynamically scoped into the next function
(defun org-inlinetask-goto-beginning ()
"Go to the beginning of the inline task at point."
(end-of-line)
(re-search-backward (org-inlinetask-outline-regexp) nil t)
(when (org-looking-at-p (concat (org-inlinetask-outline-regexp) "END[ \t]*$"))
(re-search-backward (org-inlinetask-outline-regexp) nil t)))
(defun org-inlinetask-goto-end ()
"Go to the end of the inline task at point."
(beginning-of-line)
(cond
((org-looking-at-p (concat (org-inlinetask-outline-regexp) "END[ \t]*$"))
(forward-line 1))
((org-looking-at-p (org-inlinetask-outline-regexp))
(forward-line 1)
(when (org-inlinetask-in-task-p)
(re-search-forward (org-inlinetask-outline-regexp) nil t)
(forward-line 1)))
(t
(re-search-forward (org-inlinetask-outline-regexp) nil t)
(forward-line 1))))
(defun org-inlinetask-get-task-level ()
"Get the level of the inline task around.
This assumes the point is inside an inline task."
(save-excursion
(end-of-line)
(re-search-backward (org-inlinetask-outline-regexp) nil t)
(- (match-end 1) (match-beginning 1))))
(defvar backend) ; dynamically scoped into the next function
(defun org-inlinetask-export-handler ()
"Handle headlines with level larger or equal to `org-inlinetask-min-level'.
Either remove headline and meta data, or do special formatting."
@ -158,7 +244,7 @@ Either remove headline and meta data, or do special formatting."
(or org-inlinetask-min-level 200)))
(re1 (format "^\\(\\*\\{%d,\\}\\) .*\n" nstars))
(re2 (concat "^[ \t]*" org-keyword-time-regexp))
headline beg end stars content indent)
headline beg end stars content)
(while (re-search-forward re1 nil t)
(setq headline (match-string 0)
stars (match-string 1)
@ -179,40 +265,34 @@ Either remove headline and meta data, or do special formatting."
(delete-region beg (1+ (match-end 0))))
(goto-char beg)
(when org-inlinetask-export
(when (string-match org-complex-heading-regexp headline)
(setq headline (concat
(if (match-end 2)
(concat
(org-add-props
(format
"@<span class=\"%s %s\"> %s@</span>"
(if (member (match-string 2 headline)
org-done-keywords)
"done" "todo")
(match-string 2 headline)
(match-string 2 headline))
nil 'org-protected t)
" ") "")
(match-string 4 headline)))
(when content
;; content formatting
(when content
(if (not (string-match "\\S-" content))
(setq content nil)
(if (string-match "[ \t\n]+\\'" content)
(setq content (substring content 0 (match-beginning 0))))
(setq content (org-remove-indentation content))
(if latexp (setq content (concat "\\quad \\\\\n" content)))))
(insert (make-string (org-inlinetask-get-current-indentation) ?\ )
"- ")
(setq indent (make-string (current-column) ?\ ))
(insert headline " ::")
(if content
(insert (if htmlp " " (concat "\n" indent))
(mapconcat 'identity (org-split-string content "\n")
(concat "\n" indent)) "\n")
(insert "\n"))
(insert indent)
(backward-delete-char 2)
(insert "THISISTHEINLINELISTTEMINATOR\n"))))))
(setq content (org-remove-indentation content))))
(setq content (or content ""))
;; grab elements to export
(when (string-match org-complex-heading-regexp headline)
(let* ((todo (or (match-string 2 headline) ""))
(class (or (and (eq "" todo) "")
(if (member todo org-done-keywords) "done" "todo")))
(priority (or (match-string 3 headline) ""))
(heading (or (match-string 4 headline) ""))
(tags (or (match-string 5 headline) ""))
(backend-spec (assq backend org-inlinetask-export-templates))
(format-str (nth 1 backend-spec))
(tokens (cadr (nth 2 backend-spec)))
;; change nil arguments into empty strings
(nil-to-str (lambda (el) (or (eval el) "")))
;; build and protect export string
(export-str (org-add-props
(eval (append '(format format-str)
(mapcar nil-to-str tokens)))
nil 'org-protected t)))
;; eventually insert it
(insert export-str "\n")))))))
(defun org-inlinetask-get-current-indentation ()
"Get the indentation of the last non-while line above this one."
@ -247,31 +327,11 @@ Either remove headline and meta data, or do special formatting."
org-inlinetask-min-level))
(replace-match "")))
(defun org-inlinetask-remove-terminator ()
(let (beg end)
(save-excursion
(goto-char (point-min))
(while (re-search-forward "THISISTHEINLINELISTTEMINATOR\n" nil t)
(setq beg (match-beginning 0) end (match-end 0))
(save-excursion
(beginning-of-line 1)
(and (looking-at "<p\\(ara\\)?>THISISTHEINLINELISTTEMINATOR[ \t\n]*</p\\(ara\\)?>")
(setq beg (point) end (match-end 0))))
(delete-region beg end)))))
(eval-after-load "org-exp"
'(add-hook 'org-export-preprocess-after-tree-selection-hook
'org-inlinetask-export-handler))
(eval-after-load "org"
'(add-hook 'org-font-lock-hook 'org-inlinetask-fontify))
(eval-after-load "org-html"
'(add-hook 'org-export-html-final-hook 'org-inlinetask-remove-terminator))
(eval-after-load "org-latex"
'(add-hook 'org-export-latex-final-hook 'org-inlinetask-remove-terminator))
(eval-after-load "org-ascii"
'(add-hook 'org-export-ascii-final-hook 'org-inlinetask-remove-terminator))
(eval-after-load "org-docbook"
'(add-hook 'org-export-docbook-final-hook 'org-inlinetask-remove-terminator))
(provide 'org-inlinetask)

2
lisp/org/org-irc.el
View file

@ -4,7 +4,7 @@
;;
;; Author: Philip Jackson <emacs@shellarchive.co.uk>
;; Keywords: erc, irc, link, org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;

2
lisp/org/org-jsinfo.el
View file

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;

61
lisp/org/org-latex.el
View file

@ -4,7 +4,7 @@
;;
;; Emacs Lisp Archive Entry
;; Filename: org-latex.el
;; Version: 7.3
;; Version: 7.4
;; Author: Bastien Guerry <bzg AT altern DOT org>
;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com>
;; Keywords: org, wp, tex
@ -295,7 +295,14 @@ markup defined, the first one in the association list will be used."
:group 'org-export-latex
:type 'string)
(defcustom org-export-latex-hyperref-format "\\href{%s}{%s}"
(defcustom org-export-latex-href-format "\\href{%s}{%s}"
"A printf format string to be applied to href links.
The format must contain two %s instances. The first will be filled with
the link, the second with the link description."
:group 'org-export-latex
:type 'string)
(defcustom org-export-latex-hyperref-format "\\hyperref[%s]{%s}"
"A printf format string to be applied to hyperref links.
The format must contain two %s instances. The first will be filled with
the link, the second with the link description."
@ -453,12 +460,6 @@ pygmentize -L lexers
(symbol :tag "Major mode ")
(string :tag "Listings language"))))
(defcustom org-export-latex-minted-with-line-numbers nil
"Should source code line numbers be included when exporting
with the latex minted package?"
:group 'org-export-latex
:type 'boolean)
(defcustom org-export-latex-remove-from-headlines
'(:todo nil :priority nil :tags nil)
"A plist of keywords to remove from headlines. OBSOLETE.
@ -1280,12 +1281,13 @@ OPT-PLIST is the options plist for current buffer."
(org-export-apply-macros-in-string org-export-latex-append-header)
;; define alert if not yet defined
"\n\\providecommand{\\alert}[1]{\\textbf{#1}}"
;; beginning of the document
"\n\\begin{document}\n\n"
;; insert the title
(format
"\n\n\\title{%s}\n"
;; convert the title
(org-export-latex-content
title '(lists tables fixed-width keywords)))
(org-export-latex-fontify-headline title))
;; insert author info
(if (plist-get opt-plist :author-info)
(format "\\author{%s}\n"
@ -1297,8 +1299,6 @@ OPT-PLIST is the options plist for current buffer."
(format-time-string
(or (plist-get opt-plist :date)
org-export-latex-date-format)))
;; beginning of the document
"\n\\begin{document}\n\n"
;; insert the title command
(when (string-match "\\S-" title)
(if (string-match "%s" org-export-latex-title-command)
@ -1325,7 +1325,7 @@ If END is non-nil, it is the end of the region."
(save-excursion
(goto-char (or beg (point-min)))
(let* ((pt (point))
(end (if (re-search-forward "^\\*+ " end t)
(end (if (re-search-forward (org-get-limited-outline-regexp) end t)
(goto-char (match-beginning 0))
(goto-char (or end (point-max))))))
(prog1
@ -1452,6 +1452,33 @@ links, keywords, lists, tables, fixed-width"
;; FIXME: org-inside-LaTeX-fragment-p doesn't work when the $...$ is at
;; the beginning of the buffer - inserting "\n" is safe here though.
(insert "\n" string)
;; Preserve math snippets
(let* ((matchers (plist-get org-format-latex-options :matchers))
(re-list org-latex-regexps)
beg end re e m n block off)
;; Check the different regular expressions
(while (setq e (pop re-list))
(setq m (car e) re (nth 1 e) n (nth 2 e)
block (if (nth 3 e) "\n\n" ""))
(setq off (if (member m '("$" "$1")) 1 0))
(when (and (member m matchers) (not (equal m "begin")))
(goto-char (point-min))
(while (re-search-forward re nil t)
(setq beg (+ (match-beginning 0) off) end (- (match-end 0) 0))
(add-text-properties beg end
'(org-protected t org-latex-math t))))))
;; Convert LaTeX to \LaTeX{} and TeX to \TeX{}
(goto-char (point-min))
(let ((case-fold-search nil))
(while (re-search-forward "\\<\\(\\(La\\)?TeX\\)\\>" nil t)
(unless (eq (char-before (match-beginning 1)) ?\\)
(org-if-unprotected-1
(replace-match (org-export-latex-protect-string
(concat "\\" (match-string 1)
"{}")) t t)))))
(goto-char (point-min))
(let ((re (concat "\\\\\\([a-zA-Z]+\\)"
"\\(?:<[^<>\n]*>\\)*"
@ -2016,10 +2043,10 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(insert (format
(org-export-get-coderef-format path desc)
(cdr (assoc path org-export-code-refs)))))
(radiop (insert (format "\\hyperref[%s]{%s}"
(radiop (insert (format org-export-latex-hyperref-format
(org-solidify-link-text raw-path) desc)))
((not type)
(insert (format "\\hyperref[%s]{%s}"
(insert (format org-export-latex-hyperref-format
(org-remove-initial-hash
(org-solidify-link-text raw-path))
desc)))
@ -2030,7 +2057,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
;; a LaTeX issue, but we here implement a work-around anyway.
(setq path (org-export-latex-protect-amp path)
desc (org-export-latex-protect-amp desc)))
(insert (format org-export-latex-hyperref-format path desc)))
(insert (format org-export-latex-href-format path desc)))
((functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
;; The link protocol has a function for formatting the link
@ -2356,7 +2383,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
"\n"
(match-string 1 res))
t t res)))
(insert res "\n"))))
(insert res))))
(defconst org-latex-entities
'("\\!"

85
lisp/org/org-list.el
View file

@ -7,7 +7,7 @@
;; Bastien Guerry <bzg AT altern DOT org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;
@ -462,7 +462,8 @@ List ending is determined by indentation of text. See
(forward-line -1)
(catch 'exit
(while t
(let ((ind (org-get-indentation)))
(let ((ind (+ (or (get-text-property (point) 'original-indentation) 0)
(org-get-indentation))))
(cond
((looking-at "^[ \t]*:END:")
(throw 'exit item-ref))
@ -502,7 +503,8 @@ List ending is determined by the indentation of text. See
(catch 'exit
(while t
(skip-chars-forward " \t")
(let ((ind (org-get-indentation)))
(let ((ind (+ (or (get-text-property (point) 'original-indentation) 0)
(org-get-indentation))))
(cond
((or (>= (point) limit)
(looking-at ":END:"))
@ -518,7 +520,11 @@ List ending is determined by the indentation of text. See
(setq ind-ref ind)
(forward-line 1))
((<= ind ind-ref)
(throw 'exit (point-at-bol)))
(throw 'exit (progn
;; Again, ensure bottom is just after a
;; non-blank line.
(skip-chars-backward " \r\t\n")
(min (point-max) (1+ (point-at-eol))))))
((looking-at "#\\+begin_")
(re-search-forward "[ \t]*#\\+end_")
(forward-line 1))
@ -636,7 +642,7 @@ function ends."
;; insert bullet above item in order to avoid bothering
;; with possible blank lines ending last item.
(goto-char (org-get-item-beginning))
(indent-to-column ind)
(org-indent-to-column ind)
(insert (concat bullet (when checkbox "[ ] ") after-bullet))
;; Stay between after-bullet and before text.
(save-excursion
@ -1060,7 +1066,7 @@ so this really moves item trees."
(org-list-exchange-items actual-item next-item bottom)
(org-list-repair nil nil bottom)
(goto-char (org-get-next-item (point) bottom))
(move-to-column col)))))
(org-move-to-column col)))))
(defun org-move-item-up ()
"Move the plain list item at point up, i.e. swap with previous item.
@ -1081,7 +1087,7 @@ so this really moves item trees."
(error "Cannot move this item further up"))
(org-list-exchange-items prev-item actual-item bottom)
(org-list-repair nil top bottom)
(move-to-column col)))))
(org-move-to-column col)))))
(defun org-insert-item (&optional checkbox)
"Insert a new item at the current level.
@ -1481,7 +1487,7 @@ BOTTOM is position at list ending."
;; this is not an empty line
(let ((i (org-get-indentation)))
(when (and (> i 0) (> (+ i delta) 0))
(indent-line-to (+ i delta)))))
(org-indent-line-to (+ i delta)))))
(beginning-of-line 0)))))
(defun org-outdent-item ()
@ -1543,7 +1549,7 @@ Return t at each successful move."
(ignore-errors
(org-list-indent-item-generic 1 t top bottom))))
(t (back-to-indentation)
(indent-to-column (car org-tab-ind-state))
(org-indent-to-column (car org-tab-ind-state))
(end-of-line)
(org-list-repair (cdr org-tab-ind-state))
;; Break cycle
@ -1629,35 +1635,36 @@ If WHICH is a valid string, use that as the new bullet. If WHICH
is an integer, 0 means `-', 1 means `+' etc. If WHICH is
'previous, cycle backwards."
(interactive "P")
(let* ((top (org-list-top-point))
(bullet (save-excursion
(goto-char (org-get-beginning-of-list top))
(org-get-bullet)))
(current (cond
((string-match "\\." bullet) "1.")
((string-match ")" bullet) "1)")
(t bullet)))
(bullet-rule-p (cdr (assq 'bullet org-list-automatic-rules)))
(bullet-list (append '("-" "+" )
;; *-bullets are not allowed at column 0
(unless (and bullet-rule-p
(looking-at "\\S-")) '("*"))
;; Description items cannot be numbered
(unless (and bullet-rule-p
(or (eq org-plain-list-ordered-item-terminator ?\))
(org-at-item-description-p))) '("1."))
(unless (and bullet-rule-p
(or (eq org-plain-list-ordered-item-terminator ?.)
(org-at-item-description-p))) '("1)"))))
(len (length bullet-list))
(item-index (- len (length (member current bullet-list))))
(get-value (lambda (index) (nth (mod index len) bullet-list)))
(new (cond
((member which bullet-list) which)
((numberp which) (funcall get-value which))
((eq 'previous which) (funcall get-value (1- item-index)))
(t (funcall get-value (1+ item-index))))))
(org-list-repair new top)))
(save-excursion
(let* ((top (org-list-top-point))
(bullet (progn
(goto-char (org-get-beginning-of-list top))
(org-get-bullet)))
(current (cond
((string-match "\\." bullet) "1.")
((string-match ")" bullet) "1)")
(t bullet)))
(bullet-rule-p (cdr (assq 'bullet org-list-automatic-rules)))
(bullet-list (append '("-" "+" )
;; *-bullets are not allowed at column 0
(unless (and bullet-rule-p
(looking-at "\\S-")) '("*"))
;; Description items cannot be numbered
(unless (and bullet-rule-p
(or (eq org-plain-list-ordered-item-terminator ?\))
(org-at-item-description-p))) '("1."))
(unless (and bullet-rule-p
(or (eq org-plain-list-ordered-item-terminator ?.)
(org-at-item-description-p))) '("1)"))))
(len (length bullet-list))
(item-index (- len (length (member current bullet-list))))
(get-value (lambda (index) (nth (mod index len) bullet-list)))
(new (cond
((member which bullet-list) which)
((numberp which) (funcall get-value which))
((eq 'previous which) (funcall get-value (1- item-index)))
(t (funcall get-value (1+ item-index))))))
(org-list-repair new top))))
;;; Checkboxes
@ -2029,7 +2036,7 @@ sublevels as a list of strings."
(while (org-search-forward-unenclosed org-item-beginning-re end t)
(save-excursion
(beginning-of-line)
(setq ltype (cond ((looking-at-p "^[ \t]*[0-9]") 'ordered)
(setq ltype (cond ((org-looking-at-p "^[ \t]*[0-9]") 'ordered)
((org-at-item-description-p) 'descriptive)
(t 'unordered))))
(let* ((indent1 (org-get-indentation))

2
lisp/org/org-mac-message.el
View file

@ -5,7 +5,7 @@
;; Author: John Wiegley <johnw@gnu.org>
;; Christopher Suckling <suckling at gmail dot com>
;; Version: 7.3
;; Version: 7.4
;; Keywords: outlines, hypermedia, calendar, wp
;; This file is part of GNU Emacs.

11
lisp/org/org-macs.el
View file

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;
@ -46,9 +46,16 @@
(if (or (> emacs-major-version 23)
(and (>= emacs-major-version 23)
(>= emacs-minor-version 2)))
(called-interactively-p ,kind)
(with-no-warnings (called-interactively-p ,kind)) ;; defined with no argument in <=23.1
(interactive-p))))
(if (and (not (fboundp 'with-silent-modifications))
(or (< emacs-major-version 23)
(and (= emacs-major-version 23)
(< emacs-minor-version 2))))
(defmacro with-silent-modifications (&rest body)
`(org-unmodified ,@body)))
(defmacro org-bound-and-true-p (var)
"Return the value of symbol VAR if it is bound, else nil."
`(and (boundp (quote ,var)) ,var))

2
lisp/org/org-mew.el
View file

@ -5,7 +5,7 @@
;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.

2
lisp/org/org-mhe.el
View file

@ -6,7 +6,7 @@
;; Author: Thomas Baumann <thomas dot baumann at ch dot tum dot de>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;

2
lisp/org/org-mks.el
View file

@ -5,7 +5,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;

2
lisp/org/org-mobile.el
View file

@ -4,7 +4,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;

9
lisp/org/org-mouse.el
View file

@ -1,11 +1,10 @@
;;; org-mouse.el --- Better mouse support for org-mode
;; Copyright (C) 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Copyright (C) 2006, 2007, 2008, 2009, 2010 Free Software Foundation
;;
;; Author: Piotr Zielinski <piotr dot zielinski at gmail dot com>
;; Maintainer: Carsten Dominik <carsten at orgmode dot org>
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;
@ -1101,10 +1100,10 @@ This means, between the beginning of line and the point."
"--"
["Day View" org-agenda-day-view
:active (org-agenda-check-type nil 'agenda)
:style radio :selected (equal org-agenda-ndays 1)]
:style radio :selected (eq org-agenda-current-span 'day)]
["Week View" org-agenda-week-view
:active (org-agenda-check-type nil 'agenda)
:style radio :selected (equal org-agenda-ndays 7)]
:style radio :selected (eq org-agenda-current-span 'week)]
"--"
["Show Logbook entries" org-agenda-log-mode
:style toggle :selected org-agenda-show-log

2
lisp/org/org-plot.el
View file

@ -5,7 +5,7 @@
;; Author: Eric Schulte <schulte dot eric at gmail dot com>
;; Keywords: tables, plotting
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;

4
lisp/org/org-protocol.el
View file

@ -9,7 +9,7 @@
;; Author: Ross Patterson <me AT rpatterson DOT net>
;; Maintainer: Sebastian Rose <sebastian_rose AT gmx DOT de>
;; Keywords: org, emacsclient, wp
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.
;;
@ -313,7 +313,7 @@ encodeURIComponent. E.g. `%C3%B6' is the german Umlaut `ü'."
(let* ((start (match-beginning 0))
(end (match-end 0))
(hex (match-string 0 str))
(replacement (org-protocol-unhex-compound hex)))
(replacement (org-protocol-unhex-compound (upcase hex))))
(setq tmp (concat tmp (substring str 0 start) replacement))
(setq str (substring str end))))
(setq tmp (concat tmp str))

2
lisp/org/org-publish.el
View file

@ -5,7 +5,7 @@
;; Author: David O'Toole <dto@gnu.org>
;; Maintainer: Carsten Dominik <carsten DOT dominik AT gmail DOT com>
;; Keywords: hypermedia, outlines, wp
;; Version: 7.3
;; Version: 7.4
;; This file is part of GNU Emacs.
;;

2
lisp/org/org-remember.el
View file

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;

2
lisp/org/org-rmail.el
View file

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;

6
lisp/org/org-src.el
View file

@ -8,7 +8,7 @@
;; Dan Davison <davison at stats dot ox dot ac dot uk>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;
@ -240,8 +240,8 @@ buffer."
block-nindent (nth 5 info)
lang-f (intern (concat lang "-mode"))
begline (save-excursion (goto-char beg) (org-current-line)))
(if (and mark (>= mark beg) (<= mark end))
(save-excursion (goto-char mark)
(if (and mark (>= mark beg) (<= mark (1+ end)))
(save-excursion (goto-char (min mark end))
(setq markline (org-current-line)
markcol (current-column))))
(if (equal lang-f 'table.el-mode)

16
lisp/org/org-table.el
View file

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;
@ -48,6 +48,12 @@
(defvar org-export-html-table-tag) ; defined in org-exp.el
(defvar constants-unit-system)
(defvar orgtbl-after-send-table-hook nil
"Hook for functions attaching to `C-c C-c', if the table is sent.
This can be used to add additional functionality after the table is sent
to the receiver position, othewise, if table is not sent, the functions
are not run.")
(defcustom orgtbl-optimized (eq org-enable-table-editor 'optimized)
"Non-nil means use the optimized table editor version for `orgtbl-mode'.
In the optimized version, the table editor takes over all simple keys that
@ -3729,7 +3735,8 @@ With prefix arg, also recompute table."
(call-interactively 'org-table-recalculate)
(org-table-maybe-recalculate-line))
(call-interactively 'org-table-align)
(orgtbl-send-table 'maybe))
(when (orgtbl-send-table 'maybe)
(run-hooks 'orgtbl-after-send-table-hook)))
((eq action 'recalc)
(save-excursion
(beginning-of-line 1)
@ -3943,7 +3950,10 @@ this table."
(orgtbl-send-replace-tbl name txt))
(setq ntbl (1+ ntbl)))
(message "Table converted and installed at %d receiver location%s"
ntbl (if (> ntbl 1) "s" "")))))
ntbl (if (> ntbl 1) "s" ""))
(if (> ntbl 0)
ntbl
nil))))
(defun org-remove-by-index (list indices &optional i0)
"Remove the elements in LIST with indices in INDICES.

2
lisp/org/org-taskjuggler.el
View file

@ -4,7 +4,7 @@
;;
;; Emacs Lisp Archive Entry
;; Filename: org-taskjuggler.el
;; Version: 7.3
;; Version: 7.4
;; Author: Christian Egli
;; Maintainer: Christian Egli
;; Keywords: org, taskjuggler, project planning

2
lisp/org/org-timer.el
View file

@ -5,7 +5,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;

2
lisp/org/org-vm.el
View file

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;

2
lisp/org/org-w3m.el
View file

@ -5,7 +5,7 @@
;; Author: Andy Stewart <lazycat dot manatee at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;

2
lisp/org/org-wl.el
View file

@ -7,7 +7,7 @@
;; David Maus <dmaus at ictsoc dot de>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;

2
lisp/org/org-xoxo.el
View file

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.3
;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;

Some files were not shown because too many files have changed in this diff Show more