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

Merge from trunk.

Browse source
This commit is contained in:
Paul Eggert 2011-07-28 09:27:30 -07:00
commit 70c2e72ae5
162 changed files with 19457 additions and 7877 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
ChangeLog
View file

@ -1,4 +1,4 @@
2011-07-25 Paul Eggert <eggert@cs.ucla.edu>
2011-07-28 Paul Eggert <eggert@cs.ucla.edu>
Merge from gnulib, using build-aux to remove clutter (Bug#9169).
* m4/largefile.m4: New file, so that Emacs does not mess up when
@ -30,6 +30,27 @@
'configure'.
* make-dist: Adjust to new build-aux and build-aux/snippit dirs.
2011-07-28 Paul Eggert <eggert@cs.ucla.edu>
Assume freestanding C89 headers, string.h, stdlib.h.
Again, this simplifies the code, and all current platforms have these.
* configure.in (AC_CHECK_HEADERS): Don't check for limits.h.
(AC_HEADER_STDC): Remove.
(AC_CHECK_FUNCS): No need to check for strchr, strrchr.
(strchr, strrchr): Remove fallback macros.
Assume support for memcmp, memcpy, memmove, memset.
This simplifies the code a bit. All current platforms have these,
as they are required for C89. If this turns into a problem we
can add the gnulib modules for these (a 1-line change to Makefile.in).
* configure.in: Don't check for memcmp, memcpy, memmove, memset.
2011-07-27 Paul Eggert <eggert@cs.ucla.edu>
* GNUmakefile: New file.
This is for convenience, so that one can run GNU make in an
unconfigured source tree, and get a default build.
2011-07-13 Jan Djärv <jan.h.d@swipnet.se>
* configure.in (GSETTINGS): Check for gio-2.0 >= 2.26.

77
GNUmakefile Normal file
View file

@ -0,0 +1,77 @@
# Build Emacs from a fresh tarball or version-control checkout.
# Copyright 2011 Free Software Foundation, Inc.
#
# 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/>.
#
# written by Paul Eggert
# This GNUmakefile is for GNU Make. It is for convenience, so that
# one can run 'make' in an unconfigured source tree. In such a tree,
# this file causes GNU Make to first create a standard configuration
# with the default options, and then reinvokes itself on the
# newly-built Makefile. If the source tree is already configured,
# this file defers to the existing Makefile.
# If you are using a non-GNU 'make', or if you want non-default build
# options, or if you want to build in an out-of-source tree, please
# run "configure" by hand. But run autogen.sh first, if the source
# was checked out directly from the repository.
# If a Makefile already exists, just use it.
ifeq ($(wildcard Makefile),Makefile)
include Makefile
else
# If cleaning and Makefile does not exist, don't bother creating it.
# The source tree is already clean, or is in a weird state that
# requires expert attention.
ifeq ($(filter-out %clean,$(or $(MAKECMDGOALS),default)),)
$(MAKECMDGOALS):
@echo >&2 'No Makefile; skipping $@.'
else
# No Makefile, and not cleaning.
# If 'configure' does not exist, Emacs must have been checked
# out directly from the repository; run ./autogen.sh.
# Once 'configure' exists, run it.
# Finally, run the actual 'make'.
default $(filter-out configure Makefile,$(MAKECMDGOALS)): Makefile
$(MAKE) -f Makefile $(MAKECMDGOALS)
# Execute in sequence, so that multiple user goals don't conflict.
.NOTPARALLEL:
configure:
@echo >&2 'There seems to be no "configure" file in this directory.'
@echo >&2 'Running ./autogen.sh || autogen/copy_autogen ...'
./autogen.sh || autogen/copy_autogen
@echo >&2 '"configure" file built.'
Makefile: configure
@echo >&2 'There seems to be no Makefile in this directory.'
@echo >&2 'Running ./configure ...'
./configure
@echo >&2 'Makefile built.'
endif
endif

29
autogen/config.in
View file

@ -474,9 +474,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if you have the `Xmu' library (-lXmu). */
#undef HAVE_LIBXMU
/* Define to 1 if you have the <limits.h> header file. */
#undef HAVE_LIMITS_H
/* Define to 1 if you have the <linux/version.h> header file. */
#undef HAVE_LINUX_VERSION_H
@ -531,24 +528,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if <wchar.h> declares mbstate_t. */
#undef HAVE_MBSTATE_T
/* Define to 1 if you have the `memcmp' function. */
#undef HAVE_MEMCMP
/* Define to 1 if you have the `memcpy' function. */
#undef HAVE_MEMCPY
/* Define to 1 if you have the `memmove' function. */
#undef HAVE_MEMMOVE
/* Define to 1 if you have the <memory.h> header file. */
#undef HAVE_MEMORY_H
/* Define to 1 if you have the `mempcpy' function. */
#undef HAVE_MEMPCPY
/* Define to 1 if you have the `memset' function. */
#undef HAVE_MEMSET
/* Define to 1 if you have mouse menus. (This is automatic if you use X, but
the option to specify it remains.) It is also defined with other window
systems that support xmenu.c. */
@ -693,9 +678,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if you have the <stdlib.h> header file. */
#undef HAVE_STDLIB_H
/* Define to 1 if you have the `strchr' function. */
#undef HAVE_STRCHR
/* Define to 1 if you have the `strerror' function. */
#undef HAVE_STRERROR
@ -705,9 +687,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if you have the <string.h> header file. */
#undef HAVE_STRING_H
/* Define to 1 if you have the `strrchr' function. */
#undef HAVE_STRRCHR
/* Define to 1 if you have the `strsignal' function. */
#undef HAVE_STRSIGNAL
@ -1396,14 +1375,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <string.h>
#include <stdlib.h>
#ifndef HAVE_STRCHR
#define strchr(a, b) index (a, b)
#endif
#ifndef HAVE_STRRCHR
#define strrchr(a, b) rindex (a, b)
#endif
#if defined __GNUC__ && (__GNUC__ > 2 \
|| (__GNUC__ == 2 && __GNUC_MINOR__ >= 5))
#define NO_RETURN __attribute__ ((__noreturn__))

121
autogen/configure vendored
View file

@ -8046,7 +8046,7 @@ $as_echo "#define HAVE_SOUND 1" >>confdefs.h
fi
for ac_header in sys/select.h sys/time.h unistd.h utime.h \
linux/version.h sys/systeminfo.h limits.h \
linux/version.h sys/systeminfo.h \
stdio_ext.h fcntl.h coff.h pty.h sys/mman.h \
sys/vlimit.h sys/resource.h locale.h sys/_mbstate_t.h \
sys/utsname.h pwd.h utmp.h dirent.h util.h
@ -8104,118 +8104,6 @@ fi
done
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5
$as_echo_n "checking for ANSI C header files... " >&6; }
if test "${ac_cv_header_stdc+set}" = set; then :
$as_echo_n "(cached) " >&6
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <stdlib.h>
#include <stdarg.h>
#include <string.h>
#include <float.h>
int
main ()
{
;
return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
ac_cv_header_stdc=yes
else
ac_cv_header_stdc=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
if test $ac_cv_header_stdc = yes; then
# SunOS 4.x string.h does not declare mem*, contrary to ANSI.
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <string.h>
_ACEOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
$EGREP "memchr" >/dev/null 2>&1; then :
else
ac_cv_header_stdc=no
fi
rm -f conftest*
fi
if test $ac_cv_header_stdc = yes; then
# ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <stdlib.h>
_ACEOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
$EGREP "free" >/dev/null 2>&1; then :
else
ac_cv_header_stdc=no
fi
rm -f conftest*
fi
if test $ac_cv_header_stdc = yes; then
# /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
if test "$cross_compiling" = yes; then :
:
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <ctype.h>
#include <stdlib.h>
#if ((' ' & 0x0FF) == 0x020)
# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
#else
# define ISLOWER(c) \
(('a' <= (c) && (c) <= 'i') \
|| ('j' <= (c) && (c) <= 'r') \
|| ('s' <= (c) && (c) <= 'z'))
# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c))
#endif
#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
int
main ()
{
int i;
for (i = 0; i < 256; i++)
if (XOR (islower (i), ISLOWER (i))
|| toupper (i) != TOUPPER (i))
return 2;
return 0;
}
_ACEOF
if ac_fn_c_try_run "$LINENO"; then :
else
ac_cv_header_stdc=no
fi
rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5
$as_echo "$ac_cv_header_stdc" >&6; }
if test $ac_cv_header_stdc = yes; then
$as_echo "#define STDC_HEADERS 1" >>confdefs.h
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether time.h and sys/time.h may both be included" >&5
$as_echo_n "checking whether time.h and sys/time.h may both be included... " >&6; }
if test "${ac_cv_header_time+set}" = set; then :
@ -13777,10 +13665,10 @@ rename closedir mkdir rmdir sysinfo getrusage get_current_dir_name \
random lrand48 logb frexp fmod rint cbrt ftime setsid \
strerror fpathconf select euidaccess getpagesize tzset setlocale \
utimes getrlimit setrlimit setpgid getcwd getwd shutdown getaddrinfo \
__fpending mblen mbrlen mbsinit strsignal setitimer ualarm strchr strrchr \
__fpending mblen mbrlen mbsinit strsignal setitimer ualarm \
sendto recvfrom getsockopt setsockopt getsockname getpeername \
gai_strerror mkstemp getline getdelim mremap memmove fsync sync \
memset memcmp difftime memcpy mempcpy mblen mbrlen posix_memalign \
gai_strerror mkstemp getline getdelim mremap fsync sync \
difftime mempcpy mblen mbrlen posix_memalign \
cfmakeraw cfsetspeed isnan copysign __executable_start
do :
as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
@ -15460,7 +15348,6 @@ $as_echo "#define __restrict_arr __restrict" >>confdefs.h
fi
# Set up the CFLAGS for real compilation, so we can substitute it.
CFLAGS="$REAL_CFLAGS"
CPPFLAGS="$REAL_CPPFLAGS"

21
configure.in
View file

@ -1094,7 +1094,7 @@ if test "x$crt_files" != x; then
dnl first there is no point asking gcc.
crt_gcc=no
test -e $CRT_DIR/$file || crt_missing="$crt_missing $file"
test -e $CRT_DIR/$file || crt_missing="$crt_missing $file"
done # $crt_files
test "x$crt_missing" = x || \
@ -1214,7 +1214,7 @@ fi
dnl checks for header files
AC_CHECK_HEADERS(sys/select.h sys/time.h unistd.h utime.h \
linux/version.h sys/systeminfo.h limits.h \
linux/version.h sys/systeminfo.h \
stdio_ext.h fcntl.h coff.h pty.h sys/mman.h \
sys/vlimit.h sys/resource.h locale.h sys/_mbstate_t.h \
sys/utsname.h pwd.h utmp.h dirent.h util.h)
@ -1233,7 +1233,6 @@ fi
dnl On Solaris 8 there's a compilation warning for term.h because
dnl it doesn't define `bool'.
AC_CHECK_HEADERS(term.h, , , -)
AC_HEADER_STDC
AC_HEADER_TIME
AC_CHECK_DECLS([sys_siglist])
if test $ac_cv_have_decl_sys_siglist != yes; then
@ -2705,10 +2704,10 @@ rename closedir mkdir rmdir sysinfo getrusage get_current_dir_name \
random lrand48 logb frexp fmod rint cbrt ftime setsid \
strerror fpathconf select euidaccess getpagesize tzset setlocale \
utimes getrlimit setrlimit setpgid getcwd getwd shutdown getaddrinfo \
__fpending mblen mbrlen mbsinit strsignal setitimer ualarm strchr strrchr \
__fpending mblen mbrlen mbsinit strsignal setitimer ualarm \
sendto recvfrom getsockopt setsockopt getsockname getpeername \
gai_strerror mkstemp getline getdelim mremap memmove fsync sync \
memset memcmp difftime memcpy mempcpy mblen mbrlen posix_memalign \
gai_strerror mkstemp getline getdelim mremap fsync sync \
difftime mempcpy mblen mbrlen posix_memalign \
cfmakeraw cfsetspeed isnan copysign __executable_start)
dnl Cannot use AC_CHECK_FUNCS
@ -3107,8 +3106,6 @@ dnl and macros for terminal control.])
dnl AC_DEFINE(HAVE_TCATTR, 1, [Define to 1 if you have tcgetattr and tcsetattr.])
dnl fi
dnl Fixme: Use AC_FUNC_MEMCMP since memcmp is used. (Needs libobj replacement.)
# Set up the CFLAGS for real compilation, so we can substitute it.
CFLAGS="$REAL_CFLAGS"
CPPFLAGS="$REAL_CPPFLAGS"
@ -3586,14 +3583,6 @@ AH_BOTTOM([
#include <string.h>
#include <stdlib.h>
#ifndef HAVE_STRCHR
#define strchr(a, b) index (a, b)
#endif
#ifndef HAVE_STRRCHR
#define strrchr(a, b) rindex (a, b)
#endif
#if defined __GNUC__ && (__GNUC__ > 2 \
|| (__GNUC__ == 2 && __GNUC_MINOR__ >= 5))
#define NO_RETURN __attribute__ ((__noreturn__))

265
doc/misc/ChangeLog
View file

@ -1,3 +1,268 @@
2011-07-28 Bastien Guerry <bzg@gnu.org>
* org.texi (Using the mapping API): mention 'region as a possible
scope for `org-map-entries'.
2011-07-28 Carsten Dominik <carsten.dominik@gmail.com>
* org.texi (Visibility cycling): Document `org-copy-visible'.
2011-07-28 Bastien Guerry <bzg@gnu.org>
* org.texi (Template expansion): order template sequences in the
proper order.
2011-07-28 Eric Schulte <schulte.eric@gmail.com>
* org.texi (eval): Expand discussion of the :eval header argument.
2011-07-28 Bastien Guerry <bzg@gnu.org>
* org.texi (Languages): Add Lilypond and Awk as supported
languages.
2011-07-28 Achim Gratz <stromeko@nexgo.de>
* org.texi: document that both CLOCK_INTO_DRAWER and
LOG_INTO_DRAWER can be used to override the contents of variable
org-clock-into-drawer (or if unset, org-log-into-drawer).
* org.texi: replace @xref->@pxref.
2011-07-28 Eric Schulte <schulte.eric@gmail.com>
* org.texi (Evaluating code blocks): Documenting the new option
for inline call lines.
2011-07-28 Eric Schulte <schulte.eric@gmail.com>
* org.texi (Results of evaluation): More explicit about the
mechanism through which interactive evaluation of code is
performed.
2011-07-28 Eric Schulte <schulte.eric@gmail.com>
* org.texi (noweb-ref): New header argument documentation.
2011-07-28 Eric Schulte <schulte.eric@gmail.com>
* org.texi (Extracting source code): Documentation of the new
org-babel-tangle-named-block-combination variable.
2011-07-28 Eric Schulte <schulte.eric@gmail.com>
* org.texi (Structure of code blocks): explicitly state that the
behavior of multiple blocks of the same name is undefined
2011-07-28 Christian Egli <christian.egli@sbszh.ch>
* org.texi (TaskJuggler export): Modify the example to reflect the
new effort durations.
2011-07-28 David Maus <dmaus@ictsoc.de>
* org.texi (Images in LaTeX export): Escape curly brackets in
LaTeX example.
2011-07-28 Carsten Dominik <carsten.dominik@gmail.com>
* org.texi (The clock table): Document the :properties and
:inherit-props arguments for the clocktable.
2011-07-28 Carsten Dominik <carsten.dominik@gmail.com>
* org.texi (Tables in LaTeX export): Document specifying placement
options for tables.
2011-07-28 Eric Schulte <schulte.eric@gmail.com>
* org.texi (Evaluating code blocks): More specific documentation
about the different types of header arguments.
2011-07-28 Manuel Giraud <manuel.giraud@univ-nantes.fr>
* org.texi (Sitemap): Document `:sitemap-sans-extension' property.
2011-07-28 Carsten Dominik <carsten.dominik@gmail.com>
* org.texi (Built-in table editor): Document the table field
follow mode.
2011-07-28 Robert P. Goldman <rpgoldman@real-time.com>
* org.texi (Easy Templates): Document new template.
2011-07-28 Robert P. Goldman <rpgoldman@real-time.com>
* org.texi (Literal examples): Add a cross-reference from "Literal
Examples" to "Easy Templates."
2011-07-28 Carsten Dominik <carsten.dominik@gmail.com>
* org.texi (The clock table): Add link to match syntax.
2011-07-28 Carsten Dominik <carsten.dominik@gmail.com>
* org.texi (Agenda commands): Document clock consistency checks.
2011-07-28 Carsten Dominik <carsten.dominik@gmail.com>
* org.texi (Built-in table editor): Document that \vert represents
a vertical bar in a table field.
2011-07-28 Eric Schulte <schulte.eric@gmail.com>
* org.texi (Literal examples): Link from "Markup" > "Literate
Examples" to "Working with Source Code".
2011-07-28 Puneeth Chaganti <punchagan@gmail.com>
* org.texi (Agenda commands): Doc for function option to bulk
action.
2011-07-28 Carsten Dominik <carsten.dominik@gmail.com>
* org.texi (Template expansion): Document new %<...> template
escape.
2011-07-28 Carsten Dominik <carsten.dominik@gmail.com>
* org.texi (Selective export): Document exclusion of any tasks
from export.
2011-07-28 Carsten Dominik <carsten.dominik@gmail.com>
* org.texi (Selective export): Document how to exclude DONE tasks
from export.
(Publishing options): Document the properties to be used to turn off
export of DONE tasks.
2011-07-28 Carsten Dominik <carsten.dominik@gmail.com>
* org.texi (The date/time prompt): Document date range protection.
2011-07-28 Eric Schulte <schulte.eric@gmail.com>
* org.texi (padline): Documentation of the new padline header
argument.
2011-07-28 Eric Schulte <schulte.eric@gmail.com>
* org.texi (var): Adding "[" to list of characters triggering
elisp evaluation.
2011-07-28 Eric Schulte <schulte.eric@gmail.com>
* org.texi (var): Documentation of Emacs Lisp evaluation during
variable assignment.
2011-07-28 Eric Schulte <schulte.eric@gmail.com>
* org.texi (colnames): Reference indexing into variables, and note
that colnames are *not* removed before indexing occurs.
(rownames): Reference indexing into variables, and note that
rownames are *not* removed before indexing occurs.
2011-07-28 Eric Schulte <schulte.eric@gmail.com>
* org.texi (var): Clarification of indexing into tabular
variables.
2011-07-28 Eric Schulte <schulte.eric@gmail.com>
* org.texi (results): Documentation of the `:results wrap' header
argument.
2011-07-28 Bastien Guerry <bzg@gnu.org>
* org.texi (LaTeX and PDF export): add a note about a limitation
of the LaTeX export: the org file has to be properly structured.
2011-07-28 Bastien Guerry <bzg@gnu.org>
* org.texi (Dynamic blocks, Structure editing): Mention
the function `org-narrow-to-block'.
2011-07-28 Eric Schulte <schulte.eric@gmail.com>
* org.texi (Languages): Updating list of code block supported
languages.
2011-07-28 Carsten Dominik <carsten.dominik@gmail.com>
* org.texi (Special properties): CATEGORY is a special property,
but it may also used in the drawer.
2011-07-28 Eric Schulte <schulte.eric@gmail.com>
* org.texi (mkdirp): Documentation of the :mkdirp header argument.
2011-07-28 Puneeth Chaganti <punchagan@gmail.com>
* org.texi (Include files): Document :lines.
2011-07-28 Eric Schulte <schulte.eric@gmail.com>
* org.texi (comments): Documentation of the ":comments noweb" code
block header argument.
2011-07-28 Eric Schulte <schulte.eric@gmail.com>
* org.texi (Conflicts): Changed "yasnippets" to "yasnippet" and
added extra whitespace around functions to be consistent with the
rest of the section.
2011-07-28 Eric Schulte <schulte.eric@gmail.com>
* org.texi (Evaluating code blocks): Expanded discussion of
#+call: line syntax.
(Header arguments in function calls): Expanded discussion of
#+call: line syntax.
2011-07-28 Eric Schulte <schulte.eric@gmail.com>
* org.texi (Evaluating code blocks): More explicit about how to
pass variables to #+call lines.
2011-07-28 Eric Schulte <schulte.eric@gmail.com>
* org.texi (Results of evaluation): Link to the :results header
argument list from the "Results of evaluation" section.
2011-07-28 Eric Schulte <schulte.eric@gmail.com>
* org.texi (Conflicts): Adding additional information about
resolving org/yasnippet conflicts.
2011-07-28 David Maus <dmaus@ictsoc.de>
* org.texi (Publishing options): Document style-include-scripts
publishing project property.
2011-07-28 Carsten Dominik <carsten.dominik@gmail.com>
* org.texi (Sparse trees): Document the next-error /
previous-error functionality.
2011-07-28 Tom Dye <tsd@tsdye.com>
* org.texi (cache): Improved documentation of code block caches.
2011-07-28 Tom Dye <tsd@tsdye.com>
* org.texi (Code block specific header arguments): Documentation
of multi-line header arguments.
2011-07-28 Eric Schulte <schulte.eric@gmail.com>
* org.texi (Code evaluation security): Add example for using a
function.
2011-07-28 Eric Schulte <schulte.eric@gmail.com>
* org.texi (Tables in LaTeX export): Documentation of new
attr_latex options for tables.
2011-07-15 Lars Magne Ingebrigtsen <larsi@gnus.org>
* flymake.texi (Example -- Configuring a tool called via make):

16
etc/ChangeLog
View file

@ -1,3 +1,19 @@
2011-07-28 Carsten Dominik <carsten.dominik@gmail.com>
* refcards/orgcard.tex: Document `org-copy-visible'.
2011-07-28 Eric Schulte <schulte.eric@gmail.com>
* refcards/orgcard.tex: Documentation of new Babel function.
2011-07-28 Eric Schulte <schulte.eric@gmail.com>
* refcards/orgcard.tex: Adding line for org-babel-check-src-block.
2011-07-28 Carsten Dominik <carsten.dominik@gmail.com>
* refcards/orgcard.tex: Document key for clock consistency check.
2011-07-18 Andreas Schwab <schwab@linux-m68k.org>
* charsets/GB180302.map: Update to 2005 edition.

15
lib-src/ChangeLog
View file

@ -1,8 +1,21 @@
2011-07-25 Paul Eggert <eggert@cs.ucla.edu>
2011-07-28 Paul Eggert <eggert@cs.ucla.edu>
* Makefile.in ($(DESTDIR)${archlibdir}): install-sh moved
to build-aux (Bug#9169).
2011-07-28 Paul Eggert <eggert@cs.ucla.edu>
Assume freestanding C89 headers, string.h, stdlib.h.
* ebrowse.c: Include stdlib.h unconditionally.
* etags.c, update-game-score.c:
Include string.h and stdlib.h unconditionally.
* makefile.w32-in (LOCAL_CFLAGS): Don't define STDC_HEADERS.
* movemail.c, pop.c: Include string.h unconditionally.
* update-game-score.c: No need to include stdarg.h; not used.
Assume support for memcmp, memcpy, memmove, memset.
* etags.c (absolute_filename): Assume memmove exists.
2011-07-09 Andreas Schwab <schwab@linux-m68k.org>
* update-game-score.c (usage): Update usage line.

4
lib-src/ebrowse.c
View file

@ -20,11 +20,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
#ifdef HAVE_STDLIB_H
#include <stdlib.h>
#endif
#include <string.h>
#include <ctype.h>
#include <assert.h>

34
lib-src/etags.c
View file

@ -138,9 +138,7 @@ char pot_etags_version[] = "@(#) pot revision number is 17.38.1.4";
#endif /* MSDOS */
#ifdef WINDOWSNT
# include <stdlib.h>
# include <fcntl.h>
# include <string.h>
# include <direct.h>
# include <io.h>
# define MAXPATHLEN _MAX_PATH
@ -151,27 +149,6 @@ char pot_etags_version[] = "@(#) pot revision number is 17.38.1.4";
# define HAVE_GETCWD
# endif /* undef HAVE_GETCWD */
#else /* not WINDOWSNT */
# ifdef STDC_HEADERS
# include <stdlib.h>
# include <string.h>
# else /* no standard C headers */
extern char *getenv (const char *);
extern char *strcpy (char *, const char *);
extern char *strncpy (char *, const char *, unsigned long);
extern char *strcat (char *, const char *);
extern char *strncat (char *, const char *, unsigned long);
extern int strcmp (const char *, const char *);
extern int strncmp (const char *, const char *, unsigned long);
extern int system (const char *);
extern unsigned long strlen (const char *);
extern void *malloc (unsigned long);
extern void *realloc (void *, unsigned long);
extern void exit (int);
extern void free (void *);
extern void *memmove (void *, const void *, unsigned long);
# define EXIT_SUCCESS 0
# define EXIT_FAILURE 1
# endif
#endif /* !WINDOWSNT */
#include <unistd.h>
@ -181,6 +158,8 @@ char pot_etags_version[] = "@(#) pot revision number is 17.38.1.4";
# endif
#endif /* HAVE_UNISTD_H */
#include <stdlib.h>
#include <string.h>
#include <stdio.h>
#include <ctype.h>
#include <errno.h>
@ -6567,22 +6546,13 @@ absolute_filename (char *file, char *dir)
else if (cp[0] != '/')
cp = slashp;
#endif
#ifdef HAVE_MEMMOVE
memmove (cp, slashp + 3, strlen (slashp + 2));
#else
/* Overlapping copy isn't really okay */
strcpy (cp, slashp + 3);
#endif
slashp = cp;
continue;
}
else if (slashp[2] == '/' || slashp[2] == '\0')
{
#ifdef HAVE_MEMMOVE
memmove (slashp, slashp + 2, strlen (slashp + 1));
#else
strcpy (slashp, slashp + 2);
#endif
continue;
}
}

2
lib-src/makefile.w32-in
View file

@ -21,7 +21,7 @@ ALL = make-docfile hexl ctags etags movemail ebrowse emacsclient
.PHONY: $(ALL)
LOCAL_FLAGS = -DWINDOWSNT -DDOS_NT -DSTDC_HEADERS=1 -DNO_LDAV=1 \
LOCAL_FLAGS = -DWINDOWSNT -DDOS_NT -DNO_LDAV=1 \
-DNO_ARCHIVES=1 -DHAVE_CONFIG_H=1 -I../lib \
-I../nt/inc -I../src

2
lib-src/movemail.c
View file

@ -68,9 +68,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifdef HAVE_FCNTL_H
#include <fcntl.h>
#endif
#ifdef HAVE_STRING_H
#include <string.h>
#endif
#include "syswait.h"
#ifdef MAIL_USE_POP
#include "pop.h"

2
lib-src/pop.c
View file

@ -65,9 +65,7 @@ extern struct servent *hes_getservbyname (/* char *, char * */);
#include <netdb.h>
#include <errno.h>
#include <stdio.h>
#ifdef STDC_HEADERS
#include <string.h>
#endif
#include <unistd.h>
#ifdef KERBEROS

7
lib-src/update-game-score.c
View file

@ -35,12 +35,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <unistd.h>
#include <errno.h>
#ifdef HAVE_STRING_H
#include <string.h>
#endif
#ifdef HAVE_STDLIB_H
#include <stdlib.h>
#endif
#include <stdio.h>
#include <time.h>
#include <pwd.h>
@ -48,9 +44,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifdef HAVE_FCNTL_H
#include <fcntl.h>
#endif
#ifdef STDC_HEADERS
#include <stdarg.h>
#endif
#include <sys/stat.h>
/* Needed for SunOS4, for instance. */

42
lisp/ChangeLog
View file

@ -1,3 +1,45 @@
2011-07-28 Jose E. Marchesi <jemarch@gnu.org>
* simple.el (goto-line): Use string-to-number to provide a
numeric argument to read-number.
2011-07-27 Michael Albinus <michael.albinus@gmx.de>
* net/tramp-sh.el (tramp-maybe-send-script): Don't let-bind the
connection process, it could be nil.
2011-07-27 Leo Liu <sdl.web@gmail.com>
Simplify url handling in rcirc-mode.
* net/rcirc.el (rcirc-browse-url-map, rcirc-browse-url-at-point)
(rcirc-browse-url-at-mouse): Remove.
* net/rcirc.el (rcirc-markup-urls): Use `make-button'.
2011-07-26 Alan Mackenzie <acm@muc.de>
Fontify bitfield declarations properly.
* progmodes/cc-langs.el (c-has-bitfields): New lang variable.
(c-symbol-chars): Now exported as a lang variable.
(c-not-primitive-type-keywords): New lang variable.
* progmodes/cc-fonts.el (c-font-lock-declarations): Jump over the
QT keyword "more" to prevent "more slots: ...." being spuriously
parsed as a bitfield declaraion.
* progmodes/cc-engine.el (c-beginning-of-statement-1): Refactor
and enhance to handle bitfield declarations.
(c-punctuation-in): New function.
(c-forward-decl-or-cast-1): Enhance CASE 3 to handle bitfield
declarations properly.
2011-07-26 Ulf Jasper <ulf.jasper@web.de>
* calendar/icalendar.el (icalendar--all-events): Take care of
multiple vcalendars in a single file.
(icalendar--convert-float-to-ical): checkdoc fixes.
2011-07-25 Deniz Dogan <deniz@dogan.se>
* image.el (insert-image): Clarifying docstring.

15
lisp/calendar/icalendar.el
View file

@ -412,10 +412,15 @@ children."
(setq result subresult)))))
result))
; private
;; private
(defun icalendar--all-events (icalendar)
"Return the list of all existing events in the given ICALENDAR."
(icalendar--get-children (car icalendar) 'VEVENT))
(let ((result '()))
(mapc (lambda (elt)
(setq result (append (icalendar--get-children elt 'VEVENT)
result)))
(nreverse icalendar))
result))
(defun icalendar--split-value (value-string)
"Split VALUE-STRING at ';='."
@ -1571,8 +1576,8 @@ entries. ENTRY-MAIN is the first line of the diary entry."
(n (nth 3 sexp))
(day (nth 4 sexp))
(summary
(replace-regexp-in-string
"\\(^\s+\\|\s+$\\)" ""
(replace-regexp-in-string
"\\(^\s+\\|\s+$\\)" ""
(buffer-substring (point) (point-max)))))
(when day
@ -1590,7 +1595,7 @@ entries. ENTRY-MAIN is the first line of the diary entry."
(null (let ((date (calendar-current-date))
(entry entry-main))
(diary-float month dayname n)))
(concat
(concat
"\nEXDATE;VALUE=DATE:"
(format-time-string "%Y%m%d" (current-time))))
"\nRRULE:"

37
lisp/net/rcirc.el
View file

@ -935,14 +935,6 @@ IRC command completion is performed only if '/' is the first input char."
map)
"Keymap for rcirc mode.")
(defvar rcirc-browse-url-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "RET") 'rcirc-browse-url-at-point)
(define-key map (kbd "<mouse-2>") 'rcirc-browse-url-at-mouse)
(define-key map [follow-link] 'mouse-face)
map)
"Keymap used for browsing URLs in `rcirc-mode'.")
(defvar rcirc-short-buffer-name nil
"Generated abbreviation to use to indicate buffer activity.")
@ -2351,21 +2343,6 @@ keywords when no KEYWORD is given."
(browse-url (completing-read "rcirc browse-url: "
completions nil nil initial-input 'history)
arg)))
(defun rcirc-browse-url-at-point (point)
"Send URL at point to `browse-url'."
(interactive "d")
(let ((beg (previous-single-property-change (1+ point) 'mouse-face))
(end (next-single-property-change point 'mouse-face)))
(browse-url (buffer-substring-no-properties beg end))))
(defun rcirc-browse-url-at-mouse (event)
"Send URL at mouse click to `browse-url'."
(interactive "e")
(let ((position (event-end event)))
(with-current-buffer (window-buffer (posn-window position))
(rcirc-browse-url-at-point (posn-point position)))))
(defun rcirc-markup-timestamp (sender response)
(goto-char (point-min))
@ -2406,12 +2383,16 @@ keywords when no KEYWORD is given."
(while (and rcirc-url-regexp ;; nil means disable URL catching
(re-search-forward rcirc-url-regexp nil t))
(let ((start (match-beginning 0))
(end (match-end 0)))
(rcirc-add-face start end 'rcirc-url)
(add-text-properties start end (list 'mouse-face 'highlight
'keymap rcirc-browse-url-map))
(end (match-end 0))
(url (match-string-no-properties 0)))
(make-button start end
'face 'rcirc-url
'follow-link t
'rcirc-url url
'action (lambda (button)
(browse-url (button-get button 'rcirc-url))))
;; record the url
(push (buffer-substring-no-properties start end) rcirc-urls))))
(push url rcirc-urls))))
(defun rcirc-markup-keywords (sender response)
(when (and (string= response "PRIVMSG")

9
lisp/net/tramp-sh.el
View file

@ -3457,8 +3457,10 @@ Fall back to normal file name handler if no Tramp handler exists."
(defun tramp-maybe-send-script (vec script name)
"Define in remote shell function NAME implemented as SCRIPT.
Only send the definition if it has not already been done."
(let* ((p (tramp-get-connection-process vec))
(scripts (tramp-get-connection-property p "scripts" nil)))
;; We cannot let-bind (tramp-get-connection-process vec) because it
;; might be nil.
(let ((scripts (tramp-get-connection-property
(tramp-get-connection-process vec) "scripts" nil)))
(unless (member name scripts)
(tramp-with-progress-reporter vec 5 (format "Sending script `%s'" name)
;; The script could contain a call of Perl. This is masked with `%s'.
@ -3467,7 +3469,8 @@ Only send the definition if it has not already been done."
(format "%s () {\n%s\n}" name
(format script (tramp-get-remote-perl vec)))
"Script %s sending failed" name)
(tramp-set-connection-property p "scripts" (cons name scripts))))))
(tramp-set-connection-property
(tramp-get-connection-process vec) "scripts" (cons name scripts))))))
(defun tramp-set-auto-save ()
(when (and ;; ange-ftp has its own auto-save mechanism

5186
lisp/org/ChangeLog
View file

File diff suppressed because it is too large Load diff

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

@ -1,11 +1,11 @@
;;; ob-C.el --- org-babel functions for C and similar languages
;; Copyright (C) 2010-2011 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.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -38,7 +38,9 @@
(declare-function org-entry-get "org"
(pom property &optional inherit literal-nil))
(add-to-list 'org-babel-tangle-lang-exts '("c++" . "cpp"))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("C++" . "cpp"))
(defvar org-babel-default-header-args:C '())
@ -46,8 +48,8 @@
"Command used to compile a C source code file into an
executable.")
(defvar org-babel-c++-compiler "g++"
"Command used to compile a c++ source code file into an
(defvar org-babel-C++-compiler "g++"
"Command used to compile a C++ source code file into an
executable.")
(defvar org-babel-c-variant nil
@ -56,15 +58,15 @@ is currently being evaluated.")
(defun org-babel-execute:cpp (body params)
"Execute BODY according to PARAMS. This function calls
`org-babel-execute:C'."
(org-babel-execute:C body params))
`org-babel-execute:C++'."
(org-babel-execute:C++ body params))
(defun org-babel-execute:c++ (body params)
(defun org-babel-execute:C++ (body params)
"Execute a block of C++ code with org-babel. This function is
called by `org-babel-execute-src-block'."
(let ((org-babel-c-variant 'cpp)) (org-babel-C-execute body params)))
(defun org-babel-expand-body:c++ (body params)
(defun org-babel-expand-body:C++ (body params)
"Expand a block of C++ code with org-babel according to it's
header arguments (calls `org-babel-C-expand')."
(let ((org-babel-c-variant 'cpp)) (org-babel-C-expand body params)))
@ -81,7 +83,7 @@ header arguments (calls `org-babel-C-expand')."
(defun org-babel-C-execute (body params)
"This function should only be called by `org-babel-execute:C'
or `org-babel-execute:c++'."
or `org-babel-execute:C++'."
(let* ((tmp-src-file (org-babel-temp-file
"C-src-"
(cond
@ -98,7 +100,7 @@ or `org-babel-execute:c++'."
(format "%s -o %s %s %s"
(cond
((equal org-babel-c-variant 'c) org-babel-C-compiler)
((equal org-babel-c-variant 'cpp) org-babel-c++-compiler))
((equal org-babel-c-variant 'cpp) org-babel-C++-compiler))
(org-babel-process-file-name tmp-bin-file)
(mapconcat 'identity
(if (listp flags) flags (list flags)) " ")
@ -189,5 +191,6 @@ of the same value."
(provide 'ob-C)
;; arch-tag: 8f49e462-54e3-417b-9a8d-423864893b37
;;; ob-C.el ends here

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

@ -1,11 +1,11 @@
;;; ob-R.el --- org-babel functions for R code evaluation
;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; Author: Eric Schulte, Dan Davison
;; Keywords: literate programming, reproducible research, R, statistics
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -51,15 +51,24 @@
(defvar org-babel-R-command "R --slave --no-save"
"Name of command to use for executing R code.")
(defun org-babel-expand-body:R (body params)
(defvar ess-local-process-name)
(defun org-babel-edit-prep:R (info)
(let ((session (cdr (assoc :session (nth 2 info)))))
(when (and session (string-match "^\\*\\(.+?\\)\\*$" session))
(save-match-data (org-babel-R-initiate-session session nil))
(setq ess-local-process-name (match-string 1 session)))))
(defun org-babel-expand-body:R (body params &optional graphics-file)
"Expand BODY according to PARAMS, return the expanded body."
(let ((out-file (cdr (assoc :file params))))
(let ((graphics-file
(or graphics-file (org-babel-R-graphical-output-file params))))
(mapconcat
#'identity
((lambda (inside)
(if out-file
(if graphics-file
(append
(list (org-babel-R-construct-graphics-device-call out-file params))
(list (org-babel-R-construct-graphics-device-call
graphics-file params))
inside
(list "dev.off()"))
inside))
@ -75,8 +84,8 @@ This function is called by `org-babel-execute-src-block'."
(cdr (assoc :session params)) params))
(colnames-p (cdr (assoc :colnames params)))
(rownames-p (cdr (assoc :rownames params)))
(out-file (cdr (assoc :file params)))
(full-body (org-babel-expand-body:R body params))
(graphics-file (org-babel-R-graphical-output-file params))
(full-body (org-babel-expand-body:R body params graphics-file))
(result
(org-babel-R-evaluate
session full-body result-type
@ -86,8 +95,7 @@ This function is called by `org-babel-execute-src-block'."
(or (equal "yes" rownames-p)
(org-babel-pick-name
(cdr (assoc :rowname-names params)) rownames-p)))))
(message "result is %S" result)
(or out-file result))))
(if graphics-file nil result))))
(defun org-babel-prep-session:R (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
@ -177,6 +185,11 @@ current code buffer."
(process-name (get-buffer-process session)))
(ess-make-buffer-current))
(defun org-babel-R-graphical-output-file (params)
"Name of file to which R should send graphical output."
(and (member "graphics" (cdr (assq :result-params params)))
(cdr (assq :file params))))
(defun org-babel-R-construct-graphics-device-call (out-file params)
"Construct the call to the graphics device."
(let ((devices
@ -214,7 +227,8 @@ current code buffer."
(defvar org-babel-R-eoe-indicator "'org_babel_R_eoe'")
(defvar org-babel-R-eoe-output "[1] \"org_babel_R_eoe\"")
(defvar org-babel-R-write-object-command "{function(object, transfer.file) {invisible(if(inherits(try(write.table(object, file=transfer.file, sep=\"\\t\", na=\"nil\",row.names=%s, col.names=%s, quote=FALSE), silent=TRUE),\"try-error\")) {if(!file.exists(transfer.file)) file.create(transfer.file)})}}(object=%s, transfer.file=\"%s\")")
(defvar org-babel-R-write-object-command "{function(object,transfer.file){object;invisible(if(inherits(try({tfile<-tempfile();write.table(object,file=tfile,sep=\"\\t\",na=\"nil\",row.names=%s,col.names=%s,quote=FALSE);file.rename(tfile,transfer.file)},silent=TRUE),\"try-error\")){if(!file.exists(transfer.file))file.create(transfer.file)})}}(object=%s,transfer.file=\"%s\")")
(defun org-babel-R-evaluate
(session body result-type column-names-p row-names-p)
@ -298,5 +312,6 @@ Insert hline if column names in output have been requested."
(provide 'ob-R)
;; arch-tag: cd4c7298-503b-450f-a3c2-f3e74b630237
;;; ob-R.el ends here

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

@ -1,11 +1,11 @@
;;; ob-asymptote.el --- org-babel functions for asymptote evaluation
;; Copyright (C) 2009-2011 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.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -49,6 +49,7 @@
(declare-function orgtbl-to-generic "org-table" (table params))
(declare-function org-combine-plists "org" (&rest plists))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("asymptote" . "asy"))
(defvar org-babel-default-header-args:asymptote
@ -80,7 +81,7 @@ This function is called by `org-babel-execute-src-block'."
body params
(org-babel-variable-assignments:asymptote params))))
(message cmd) (shell-command cmd)
out-file))
nil)) ;; signal that output has already been written to file
(defun org-babel-prep-session:asymptote (session params)
"Return an error if the :session header argument is set.
@ -159,5 +160,6 @@ of int, where every cell must be of int type."
(provide 'ob-asymptote)
;; arch-tag: f2f5bd0d-78e8-412b-8e6c-6dadc94cc06b
;;; ob-asymptote.el ends here

119
lisp/org/ob-awk.el Normal file
View file

@ -0,0 +1,119 @@
;;; ob-awk.el --- org-babel functions for awk evaluation
;; Copyright (C) 2011 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.7
;; 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/>.
;;; Commentary:
;;; Commentary:
;; Babel's awk can use special header argument:
;;
;; - :in-file takes a path to a file of data to be processed by awk
;;
;; - :stdin takes an Org-mode data or code block reference, the value
;; of which will be passed to the awk process through STDIN
;;; Code:
(require 'ob)
(require 'ob-eval)
(eval-when-compile (require 'cl))
(declare-function org-babel-ref-resolve "ob-ref" (ref))
(declare-function orgtbl-to-generic "org-table" (table params))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("awk" . "awk"))
(defvar org-babel-awk-command "awk"
"Name of the awk executable command.")
(defun org-babel-expand-body:awk (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body."
(dolist (pair (mapcar #'cdr (org-babel-get-header params :var)))
(setf body (replace-regexp-in-string
(regexp-quote (concat "$" (car pair))) (cdr pair) body)))
body)
(defun org-babel-execute:awk (body params)
"Execute a block of Awk code with org-babel. This function is
called by `org-babel-execute-src-block'"
(message "executing Awk source code block")
(let* ((result-params (cdr (assoc :result-params params)))
(cmd-line (cdr (assoc :cmd-line params)))
(in-file (cdr (assoc :in-file params)))
(full-body (org-babel-expand-body:awk body params))
(code-file ((lambda (file) (with-temp-file file (insert full-body)) file)
(org-babel-temp-file "awk-")))
(stdin ((lambda (stdin)
(when stdin
(let ((tmp (org-babel-temp-file "awk-stdin-"))
(res (org-babel-ref-resolve stdin)))
(with-temp-file tmp
(insert (org-babel-awk-var-to-awk res)))
tmp)))
(cdr (assoc :stdin params))))
(cmd (mapconcat #'identity (remove nil (list org-babel-awk-command
"-f" code-file
cmd-line
in-file))
" ")))
(org-babel-reassemble-table
((lambda (results)
(when results
(if (or (member "scalar" result-params)
(member "verbatim" result-params)
(member "output" result-params))
results
(let ((tmp (org-babel-temp-file "awk-results-")))
(with-temp-file tmp (insert results))
(org-babel-import-elisp-from-file tmp)))))
(cond
(stdin (with-temp-buffer
(call-process-shell-command cmd stdin (current-buffer))
(buffer-string)))
(t (org-babel-eval cmd ""))))
(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))))))
(defun org-babel-awk-var-to-awk (var &optional sep)
"Return a printed value of VAR suitable for parsing with awk."
(flet ((echo-var (v) (if (stringp v) v (format "%S" v))))
(cond
((and (listp var) (listp (car var)))
(orgtbl-to-generic var (list :sep (or sep "\t") :fmt #'echo-var)))
((listp var)
(mapconcat #'echo-var var "\n"))
(t (echo-var var)))))
(defun org-babel-awk-table-or-string (results)
"If the results look like a table, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
(org-babel-script-escape results))
(provide 'ob-awk)
;; arch-tag: 844e2c88-6aad-4018-868d-a2df6bcdf68f
;;; ob-awk.el ends here

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

@ -1,11 +1,11 @@
;;; ob-calc.el --- org-babel functions for calc code evaluation
;; Copyright (C) 2010-2011 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.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -29,7 +29,8 @@
;;; Code:
(require 'ob)
(require 'calc)
(require 'calc-trail)
(require 'calc-store)
(unless (featurep 'xemacs) (require 'calc-trail))
(eval-when-compile (require 'ob-comint))
(defvar org-babel-default-header-args:calc nil
@ -68,21 +69,16 @@
((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))))))))
(t (replace-regexp-in-string
"'\\[" "["
(calc-eval
(math-evaluate-expr
;; resolve user variables, calc built in
;; variables are handled automatically
;; upstream by calc
(mapcar #'ob-calc-maybe-resolve-var
;; 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]"))))
@ -90,7 +86,19 @@
(with-current-buffer (get-buffer "*Calculator*")
(calc-eval (calc-top 1)))))
(defvar var-syms) ; Dynamically scoped from org-babel-execute:calc
(defun ob-calc-maybe-resolve-var (el)
(if (consp el)
(if (and (equal 'var (car el)) (member (cadr el) var-syms))
(progn
(calc-recall (cadr el))
(prog1 (calc-top 1)
(calc-pop 1)))
(mapcar #'ob-calc-maybe-resolve-var el))
el))
(provide 'ob-calc)
;; arch-tag: 5c57a3b7-5818-4c6c-acda-7a94831a6449
;;; ob-calc.el ends here

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

@ -1,11 +1,11 @@
;;; ob-clojure.el --- org-babel functions for clojure evaluation
;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; Author: Joel Boehland, Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -42,6 +42,7 @@
(declare-function slime-eval "ext:slime" (sexp &optional package))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj"))
(defvar org-babel-default-header-args:clojure '())
@ -61,27 +62,36 @@
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)))
(cond ((or (member "code" result-params) (member "pp" result-params))
(format (concat "(let [org-mode-print-catcher (java.io.StringWriter.)] "
"(clojure.pprint/with-pprint-dispatch clojure.pprint/%s-dispatch "
"(clojure.pprint/pprint (do %s) org-mode-print-catcher) "
"(str org-mode-print-catcher)))")
(if (member "code" result-params) "code" "simple") body))
;; if (:results output), collect printed output
((member "output" result-params)
(format "(clojure.core/with-out-str %s)" body))
(t body))))
(defun org-babel-execute:clojure (body params)
"Execute a block of Clojure code with Babel."
(require 'slime) (require 'swank-clojure)
(with-temp-buffer
(insert (org-babel-expand-body:clojure body params))
(read
((lambda (result)
(let ((result-params (cdr (assoc :result-params params))))
(if (or (member "scalar" result-params)
(member "verbatim" result-params))
result
(condition-case nil (org-babel-script-escape result)
(error result)))))
(slime-eval
`(swank:interactive-eval-region
,(buffer-substring-no-properties (point-min) (point-max)))
,(buffer-substring-no-properties (point-min) (point-max)))
(cdr (assoc :package params))))))
(provide 'ob-clojure)
;; arch-tag: a43b33f2-653e-46b1-ac56-2805cf05b7d1
;;; ob-clojure.el ends here

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

@ -1,11 +1,11 @@
;;; ob-comint.el --- org-babel functions for interaction with comint buffers
;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, comint
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -93,9 +93,9 @@ or user `keyboard-quit' during execution of body."
(goto-char comint-last-input-end)
(not (save-excursion
(and (re-search-forward
comint-prompt-regexp nil t)
(regexp-quote ,eoe-indicator) nil t)
(re-search-forward
(regexp-quote ,eoe-indicator) nil t)))))
comint-prompt-regexp nil t)))))
(accept-process-output (get-buffer-process (current-buffer)))
;; thought the following this would allow async
;; background running, but I was wrong...
@ -158,5 +158,6 @@ FILE exists at end of evaluation."
(provide 'ob-comint)
;; arch-tag: 9adddce6-0864-4be3-b0b5-6c5157dc7889
;;; ob-comint.el ends here

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

@ -1,11 +1,11 @@
;;; ob-css.el --- org-babel functions for css evaluation
;; Copyright (C) 2009-2011 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.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -44,5 +44,6 @@ CSS does not support sessions."
(provide 'ob-css)
;; arch-tag: f4447e8c-50ab-41f9-b322-b7b9574d9fbe
;;; ob-css.el ends here

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

@ -1,11 +1,11 @@
;;; ob-ditaa.el --- org-babel functions for ditaa evaluation
;; Copyright (C) 2009-2011 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.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -40,7 +40,7 @@
(require 'ob)
(defvar org-babel-default-header-args:ditaa
'((:results . "file") (:exports . "results"))
'((:results . "file") (:exports . "results") (:java . "-Dfile.encoding=UTF-8"))
"Default arguments for evaluating a ditaa source block.")
(defvar org-ditaa-jar-path)
@ -48,10 +48,15 @@
"Execute a block of Ditaa code with org-babel.
This function is called by `org-babel-execute-src-block'."
(let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
(out-file (cdr (assoc :file params)))
(out-file ((lambda (el)
(or el
(error
"ditaa code block requires :file header argument")))
(cdr (assoc :file params))))
(cmdline (cdr (assoc :cmdline params)))
(java (cdr (assoc :java params)))
(in-file (org-babel-temp-file "ditaa-"))
(cmd (concat "java -jar "
(cmd (concat "java " java " -jar "
(shell-quote-argument
(expand-file-name org-ditaa-jar-path))
" " cmdline
@ -61,7 +66,7 @@ This function is called by `org-babel-execute-src-block'."
(error "Could not find ditaa.jar at %s" org-ditaa-jar-path))
(with-temp-file in-file (insert body))
(message cmd) (shell-command cmd)
out-file))
nil)) ;; signal that output has already been written to file
(defun org-babel-prep-session:ditaa (session params)
"Return an error because ditaa does not support sessions."
@ -69,5 +74,6 @@ This function is called by `org-babel-execute-src-block'."
(provide 'ob-ditaa)
;; arch-tag: 492cd006-07d9-4fac-bef6-5bb60b48842e
;;; ob-ditaa.el ends here

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

@ -1,11 +1,11 @@
;;; ob-dot.el --- org-babel functions for dot evaluation
;; Copyright (C) 2009-2011 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.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -77,7 +77,7 @@ This function is called by `org-babel-execute-src-block'."
" " (org-babel-process-file-name in-file)
" " cmdline
" -o " (org-babel-process-file-name out-file)) "")
out-file))
nil)) ;; signal that output has already been written to file
(defun org-babel-prep-session:dot (session params)
"Return an error because Dot does not support sessions."
@ -85,5 +85,6 @@ This function is called by `org-babel-execute-src-block'."
(provide 'ob-dot)
;; arch-tag: 817d0516-7b47-4f77-a8b2-2aadd8e4d0e2
;;; ob-dot.el ends here

29
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-2011 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.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -56,15 +56,26 @@
(defun org-babel-execute:emacs-lisp (body params)
"Execute a block of emacs-lisp code with Babel."
(save-window-excursion
(org-babel-reassemble-table
(eval (read (format "(progn %s)"
(org-babel-expand-body:emacs-lisp body 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))))))
((lambda (result)
(if (or (member "scalar" (cdr (assoc :result-params params)))
(member "verbatim" (cdr (assoc :result-params params))))
(let ((print-level nil)
(print-length nil))
(format "%S" result))
(org-babel-reassemble-table
result
(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))))))
(eval (read (format (if (member "output"
(cdr (assoc :result-params params)))
"(with-output-to-string %s)"
"(progn %s)")
(org-babel-expand-body:emacs-lisp body params)))))))
(provide 'ob-emacs-lisp)
;; arch-tag: e9a3acca-dc84-472a-9f5a-23c35befbcd6
;;; ob-emacs-lisp.el ends here

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

@ -1,11 +1,11 @@
;;; ob-eval.el --- org-babel functions for external code evaluation
;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, comint
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -257,5 +257,6 @@ This buffer is named by `org-babel-error-buffer-name'."
(provide 'ob-eval)
;; arch-tag: 5328b17f-957d-42d9-94da-a2952682d04d
;;; ob-eval.el ends here

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

@ -1,11 +1,11 @@
;;; ob-exp.el --- Exportation of org-babel source blocks
;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; Author: Eric Schulte, Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -22,12 +22,6 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; See the online documentation for more information
;;
;; http://orgmode.org/worg/org-contrib/babel/
;;; Code:
(require 'ob)
(require 'org-exp-blocks)
@ -44,7 +38,7 @@
(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)
(org-export-blocks-add-block '(src org-babel-exp-src-blocks nil))
(org-export-blocks-add-block '(src org-babel-exp-src-block nil))
(defcustom org-export-babel-evaluate t
"Switch controlling code evaluation during export.
@ -54,30 +48,9 @@ process."
:type 'boolean)
(put 'org-export-babel-evaluate 'safe-local-variable (lambda (x) (eq x nil)))
(defvar org-babel-function-def-export-keyword "function"
"The keyword to substitute for the source name line on export.
When exporting a source block function, this keyword will
appear in the exported version in the place of source name
line. A source block is considered to be a source block function
if the source name is present and is followed by a parenthesized
argument list. The parentheses may be empty or contain
whitespace. An example is the following which generates n random
\(uniform) numbers.
#+source: rand(n)
#+begin_src R
runif(n)
#+end_src")
(defvar org-babel-function-def-export-indent 4
"Number of characters to indent a source block on export.
When exporting a source block function, the block contents will
be indented by this many characters. See
`org-babel-function-def-export-name' for the definition of a
source block function.")
(defmacro org-babel-exp-in-export-file (&rest body)
`(let* ((lang-headers (intern (concat "org-babel-default-header-args:" lang)))
(defmacro org-babel-exp-in-export-file (lang &rest body)
(declare (indent 1))
`(let* ((lang-headers (intern (concat "org-babel-default-header-args:" ,lang)))
(heading (nth 4 (ignore-errors (org-heading-components))))
(link (when org-current-export-file
(org-make-link-string
@ -92,7 +65,8 @@ source block function.")
(set-buffer (get-file-buffer org-current-export-file))
(save-restriction
(condition-case nil
(org-open-link-from-string link)
(let ((org-link-search-inhibit-query t))
(org-open-link-from-string link))
(error (when heading
(goto-char (point-min))
(re-search-forward (regexp-quote heading) nil t))))
@ -100,7 +74,7 @@ source block function.")
(set-buffer export-buffer)
results)))
(defun org-babel-exp-src-blocks (body &rest headers)
(defun org-babel-exp-src-block (body &rest headers)
"Process source block for export.
Depending on the 'export' headers argument in replace the source
code block with...
@ -115,22 +89,26 @@ results - just like none only the block is run on export ensuring
none ----- do not display either code or results upon export"
(interactive)
(message "org-babel-exp processing...")
(unless noninteractive (message "org-babel-exp processing..."))
(save-excursion
(goto-char (match-beginning 0))
(let* ((info (org-babel-get-src-block-info 'light))
(lang (nth 0 info))
(raw-params (nth 2 info)))
(raw-params (nth 2 info)) hash)
;; bail if we couldn't get any info from the block
(when info
(org-babel-exp-in-export-file
(setf (nth 2 info)
(org-babel-merge-params
org-babel-default-header-args
(org-babel-params-from-buffer)
(org-babel-params-from-properties lang)
(if (boundp lang-headers) (eval lang-headers) nil)
raw-params)))
;; if we're actually going to need the parameters
(when (member (cdr (assoc :exports (nth 2 info))) '("both" "results"))
(org-babel-exp-in-export-file lang
(setf (nth 2 info)
(org-babel-process-params
(org-babel-merge-params
org-babel-default-header-args
(org-babel-params-from-buffer)
(org-babel-params-from-properties lang)
(if (boundp lang-headers) (eval lang-headers) nil)
raw-params))))
(setf hash (org-babel-sha1-hash info)))
;; expand noweb references in the original file
(setf (nth 1 info)
(if (and (cdr (assoc :noweb (nth 2 info)))
@ -138,11 +116,11 @@ none ----- do not display either code or results upon export"
(org-babel-expand-noweb-references
info (get-file-buffer org-current-export-file))
(nth 1 info)))
(org-babel-exp-do-export info 'block)))))
(org-babel-exp-do-export info 'block hash)))))
(defun org-babel-exp-inline-src-blocks (start end)
"Process inline source blocks between START and END for export.
See `org-babel-exp-src-blocks' for export options, currently the
See `org-babel-exp-src-block' for export options, currently the
options and are taken from `org-babel-default-inline-header-args'."
(interactive)
(save-excursion
@ -150,21 +128,22 @@ options and are taken from `org-babel-default-inline-header-args'."
(while (and (< (point) end)
(re-search-forward org-babel-inline-src-block-regexp end t))
(let* ((info (save-match-data (org-babel-parse-inline-src-block-match)))
(params (nth 2 info))
(replacement
(save-match-data
(if (org-babel-in-example-or-verbatim)
(buffer-substring (match-beginning 0) (match-end 0))
;; expand noweb references in the original file
(setf (nth 1 info)
(if (and (cdr (assoc :noweb params))
(string= "yes" (cdr (assoc :noweb params))))
(org-babel-expand-noweb-references
info (get-file-buffer org-current-export-file))
(nth 1 info)))
(org-babel-exp-do-export info 'inline)))))
(setq end (+ end (- (length replacement) (length (match-string 1)))))
(replace-match replacement t t nil 1)))))
(params (nth 2 info)) code-replacement)
(save-match-data
(goto-char (match-beginning 2))
(when (not (org-babel-in-example-or-verbatim))
;; expand noweb references in the original file
(setf (nth 1 info)
(if (and (cdr (assoc :noweb params))
(string= "yes" (cdr (assoc :noweb params))))
(org-babel-expand-noweb-references
info (get-file-buffer org-current-export-file))
(nth 1 info)))
(setq code-replacement (org-babel-exp-do-export info 'inline))))
(if code-replacement
(replace-match code-replacement nil nil nil 1)
(org-babel-examplize-region (match-beginning 1) (match-end 1))
(forward-char 2))))))
(defun org-exp-res/src-name-cleanup ()
"Clean up #+results and #+srcname lines for export.
@ -187,141 +166,106 @@ Example and verbatim code include escaped portions of
an org-mode buffer code that should be treated as normal
org-mode text."
(or (org-in-indented-comment-line)
(save-excursion
(save-match-data
(save-match-data
(save-excursion
(goto-char (point-at-bol))
(looking-at "[ \t]*:[ \t]")))
(org-in-verbatim-emphasis)
(org-in-regexps-block-p "^[ \t]*#\\+begin_src" "^[ \t]*#\\+end_src")))
(defvar org-babel-default-lob-header-args)
(defun org-babel-exp-lob-one-liners (start end)
"Process Library of Babel calls between START and END for export.
See `org-babel-exp-src-blocks' for export options. Currently the
See `org-babel-exp-src-block' for export options. Currently the
options are taken from `org-babel-default-header-args'."
(interactive)
(let (replacement)
(save-excursion
(goto-char start)
(while (and (< (point) end)
(re-search-forward org-babel-lob-one-liner-regexp nil t))
(setq replacement
(let ((lob-info (org-babel-lob-get-info)))
(save-match-data
(org-babel-exp-do-export
(list "emacs-lisp" "results"
(org-babel-merge-params
org-babel-default-header-args
(org-babel-params-from-buffer)
(org-babel-params-from-properties)
(org-babel-parse-header-arguments
(org-babel-clean-text-properties
(concat ":var results="
(mapconcat #'identity
(butlast lob-info) " ")))))
(car (last lob-info)))
'lob))))
(setq end (+ end (- (length replacement) (length (match-string 0)))))
(replace-match replacement t t)))))
(save-excursion
(goto-char start)
(while (and (< (point) end)
(re-search-forward org-babel-lob-one-liner-regexp nil t))
(unless (and (match-string 12) (org-babel-in-example-or-verbatim))
(let* ((lob-info (org-babel-lob-get-info))
(inlinep (match-string 11))
(inline-start (match-end 11))
(inline-end (match-end 0))
(rep (let ((lob-info (org-babel-lob-get-info)))
(save-match-data
(org-babel-exp-do-export
(list "emacs-lisp" "results"
(org-babel-merge-params
org-babel-default-header-args
org-babel-default-lob-header-args
(org-babel-params-from-buffer)
(org-babel-params-from-properties)
(org-babel-parse-header-arguments
(org-babel-clean-text-properties
(concat ":var results="
(mapconcat #'identity
(butlast lob-info) " ")))))
"" nil (car (last lob-info)))
'lob)))))
(setq end (+ end (- (length rep)
(- (length (match-string 0))
(length (or (match-string 11) ""))))))
(if inlinep
(save-excursion
(goto-char inline-start)
(delete-region inline-start inline-end)
(insert rep))
(replace-match rep t t)))))))
(defun org-babel-exp-do-export (info type)
(defun org-babel-exp-do-export (info type &optional hash)
"Return a string with the exported content of a code block.
The function respects the value of the :exports header argument."
(flet ((silently () (let ((session (cdr (assoc :session (nth 2 info)))))
(when (and session
(not (equal "none" session)))
(when (not (and session (equal "none" session)))
(org-babel-exp-results info type 'silent))))
(clean () (org-babel-remove-result info)))
(clean () (unless (eq type 'inline) (org-babel-remove-result info))))
(case (intern (or (cdr (assoc :exports (nth 2 info))) "code"))
(none (silently) (clean) "")
(code (silently) (clean) (org-babel-exp-code info type))
(results (org-babel-exp-results info type))
(both (concat (org-babel-exp-code info type)
"\n\n"
(org-babel-exp-results info type))))))
('none (silently) (clean) "")
('code (silently) (clean) (org-babel-exp-code info))
('results (org-babel-exp-results info type nil hash) "")
('both (org-babel-exp-results info type nil hash)
(org-babel-exp-code info)))))
(defvar backend)
(defun org-babel-exp-code (info type)
"Prepare and return code in the current code block for export.
Code is prepared in a manner suitable for export by
org-mode. This function is called by `org-babel-exp-do-export'.
The code block is not evaluated."
(let ((lang (nth 0 info))
(body (nth 1 info))
(switches (nth 3 info))
(name (nth 4 info))
(args (mapcar #'cdr (org-babel-get-header (nth 2 info) :var))))
(case type
(inline (format "=%s=" body))
(block
(let ((str
(format "#+BEGIN_SRC %s %s\n%s%s#+END_SRC\n" lang switches body
(if (and body (string-match "\n$" body))
"" "\n"))))
(when name
(add-text-properties
0 (length str)
(list 'org-caption
(format "%s(%s)"
name
(mapconcat #'identity args ", ")))
str))
str))
(lob
(let ((call-line (and (string-match "results=" (car args))
(substring (car args) (match-end 0)))))
(cond
((eq backend 'html)
(format "\n#+HTML: <label class=\"org-src-name\">%s</label>\n"
call-line))
((format ": %s\n" call-line))))))))
(defun org-babel-exp-code (info)
"Return the original code block formatted for export."
(org-fill-template
"#+BEGIN_SRC %lang%flags\n%body\n#+END_SRC\n"
`(("lang" . ,(nth 0 info))
("flags" . ,((lambda (f) (when f (concat " " f))) (nth 3 info)))
("body" . ,(nth 1 info)))))
(defun org-babel-exp-results (info type &optional silent)
(defun org-babel-exp-results (info type &optional silent hash)
"Evaluate and return the results of the current code block for export.
Results are prepared in a manner suitable for export by org-mode.
This function is called by `org-babel-exp-do-export'. The code
block will be evaluated. Optional argument SILENT can be used to
inhibit insertion of results into the buffer."
(or
(when org-export-babel-evaluate
(let ((lang (nth 0 info))
(body (nth 1 info)))
(setf (nth 2 info) (org-babel-exp-in-export-file
(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"))))
(result-params (split-string
(cdr (assoc :results (nth 2 info))))))
(unless silent
(cond ;; respect the value of the :results header argument
((member "file" result-params)
(org-babel-result-to-file raw))
((or (member "raw" result-params)
(member "org" result-params))
(format "%s" raw))
((member "code" result-params)
(format "src_%s{%s}" lang raw))
(t
(if (stringp raw)
(if (= 0 (length raw)) "=(no results)="
(format "%s" raw))
(format "%S" raw))))))
(prog1 nil
(setf (nth 2 info)
(when (and org-export-babel-evaluate
(not (and hash (equal hash (org-babel-current-result-hash)))))
(let ((lang (nth 0 info))
(body (nth 1 info)))
;; skip code blocks which we can't evaluate
(when (fboundp (intern (concat "org-babel-execute:" lang)))
(org-babel-eval-wipe-error-buffer)
(prog1 nil
(setf (nth 2 info)
(org-babel-exp-in-export-file lang
(org-babel-process-params
(org-babel-merge-params
(nth 2 info)
`((:results . ,(if silent "silent" "replace")))))
(cond
((equal type 'block) (org-babel-execute-src-block nil info))
((equal type 'lob)
(save-excursion
(re-search-backward org-babel-lob-one-liner-regexp nil t)
(org-babel-execute-src-block nil info)))))))))
""))
`((:results . ,(if silent "silent" "replace")))))))
(cond
((or (equal type 'block) (equal type 'inline))
(org-babel-execute-src-block nil info))
((equal type 'lob)
(save-excursion
(re-search-backward org-babel-lob-one-liner-regexp nil t)
(org-babel-execute-src-block nil info)))))))))
(provide 'ob-exp)
;; arch-tag: 523abf4c-76d1-44ed-9f27-e3bddf34bf0f
;;; ob-exp.el ends here

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

@ -1,11 +1,11 @@
;;; ob-gnuplot.el --- org-babel functions for gnuplot evaluation
;; Copyright (C) 2009-2011 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.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -157,7 +157,7 @@ This function is called by `org-babel-execute-src-block'."
(gnuplot-send-buffer-to-gnuplot)))
(if (member "output" (split-string result-type))
output
out-file))))
nil)))) ;; signal that output has already been written to file
(defun org-babel-prep-session:gnuplot (session params)
"Prepare SESSION according to the header arguments in PARAMS."
@ -230,5 +230,6 @@ Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE."
(provide 'ob-gnuplot)
;; arch-tag: 50490ace-a9e1-4b29-a6e5-0db9f16c610b
;;; ob-gnuplot.el ends here

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

@ -1,11 +1,11 @@
;;; ob-haskell.el --- org-babel functions for haskell evaluation
;; Copyright (C) 2009-2011 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.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -51,6 +51,7 @@
(declare-function inferior-haskell-load-file
"ext:inf-haskell" (&optional reload))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("haskell" . "hs"))
(defvar org-babel-default-header-args:haskell '())
@ -191,7 +192,7 @@ constructs (header arguments, no-web syntax etc...) are ignored."
(save-excursion
;; export to latex w/org and save as .lhs
(find-file tmp-org-file) (funcall 'org-export-as-latex nil)
(kill-buffer)
(kill-buffer nil)
(delete-file tmp-org-file)
(find-file tmp-tex-file)
(goto-char (point-min)) (forward-line 2)
@ -201,7 +202,7 @@ constructs (header arguments, no-web syntax etc...) are ignored."
(replace-match (save-match-data (org-remove-indentation (match-string 0)))
t t))
(setq contents (buffer-string))
(save-buffer) (kill-buffer))
(save-buffer) (kill-buffer nil))
(delete-file tmp-tex-file)
;; save org exported latex to a .lhs file
(with-temp-file lhs-file (insert contents))
@ -212,5 +213,6 @@ constructs (header arguments, no-web syntax etc...) are ignored."
(provide 'ob-haskell)
;; arch-tag: b53f75f3-ba1a-4b05-82d9-a2a0d4e70804
;;; ob-haskell.el ends here

74
lisp/org/ob-java.el Normal file
View file

@ -0,0 +1,74 @@
;;; ob-java.el --- org-babel functions for java evaluation
;; Copyright (C) 2011 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.7
;; 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/>.
;;; Commentary:
;; Currently this only supports the external compilation and execution
;; of java code blocks (i.e., no session support).
;;; Code:
(require 'ob)
(require 'ob-eval)
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("java" . "java"))
(defvar org-babel-java-command "java"
"Name of the java command.")
(defvar org-babel-java-compiler "javac"
"Name of the java compiler.")
(defun org-babel-execute:java (body params)
(let* ((classname (or (cdr (assoc :classname params))
(error
"Can't compile a java block without a classname")))
(packagename (file-name-directory classname))
(src-file (concat classname ".java"))
(full-body (org-babel-expand-body:generic body params))
(compile
(progn (with-temp-file src-file (insert full-body))
(org-babel-eval
(concat org-babel-java-compiler " " src-file) ""))))
;; created package-name directories if missing
(unless (or (not packagename) (file-exists-p packagename))
(make-directory packagename 'parents))
((lambda (results)
(org-babel-reassemble-table
(if (member "vector" (cdr (assoc :result-params params)))
(let ((tmp-file (org-babel-temp-file "c-")))
(with-temp-file tmp-file (insert results))
(org-babel-import-elisp-from-file tmp-file))
(org-babel-read results))
(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)))))
(org-babel-eval (concat org-babel-java-command " " classname) ""))))
(provide 'ob-java)
;; arch-tag: dd1cfb00-7f76-4ecf-922c-f7031b68b85e
;;; ob-java.el ends here

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

@ -1,11 +1,11 @@
;;; ob-js.el --- org-babel functions for Javascript
;; Copyright (C) 2010-2011 Free Software Foundation
;; Copyright (C) 2010 Free Software Foundation
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, js
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;; License:
@ -160,5 +160,6 @@ then create. Return the initialized session."
(provide 'ob-js)
;; arch-tag: 84401fb3-b8d9-4bb6-9a90-cbe2d103d494
;;; ob-js.el ends here

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

@ -1,11 +1,11 @@
;;; ob-keys.el --- key bindings for org-babel
;; Copyright (C) 2009-2011 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.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -73,10 +73,14 @@ functions which are assigned key bindings, and see
("t" . org-babel-tangle)
("\C-f" . org-babel-tangle-file)
("f" . org-babel-tangle-file)
("\C-c" . org-babel-check-src-block)
("c" . org-babel-check-src-block)
("\C-l" . org-babel-load-in-session)
("l" . org-babel-load-in-session)
("\C-i" . org-babel-lob-ingest)
("i" . org-babel-lob-ingest)
("\C-I" . org-babel-view-src-block-info)
("I" . org-babel-view-src-block-info)
("\C-z" . org-babel-switch-to-session)
("z" . org-babel-switch-to-session-with-code)
("\C-a" . org-babel-sha1-hash)
@ -93,5 +97,6 @@ a-list placed behind the generic `org-babel-key-prefix'.")
(provide 'ob-keys)
;; arch-tag: 01e348ee-4906-46fa-839a-6b7b6f989048
;;; ob-keys.el ends here

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

@ -1,11 +1,11 @@
;;; ob-latex.el --- org-babel functions for latex "evaluation"
;; Copyright (C) 2009-2011 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.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -37,6 +37,7 @@
(declare-function org-splice-latex-header "org"
(tpl def-pkg pkg snippets-p &optional extra))
(declare-function org-export-latex-fix-inputenc "org-latex" ())
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("latex" . "tex"))
(defvar org-format-latex-header)
@ -122,7 +123,7 @@ This function is called by `org-babel-execute-src-block'."
((string-match "\\.\\([^\\.]+\\)$" out-file)
(error "can not create %s files, please specify a .png or .pdf file"
(match-string 1 out-file))))
out-file)
nil) ;; signal that output has already been written to file
body))
(defun org-babel-latex-tex-to-pdf (file)
@ -175,5 +176,6 @@ Extracted from `org-export-as-pdf' in org-latex.el."
(provide 'ob-latex)
;; arch-tag: 1f13f7e2-26de-4c24-9274-9f331d4c6ff3
;;; ob-latex.el ends here

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

@ -1,11 +1,11 @@
;;; ob-ledger.el --- org-babel functions for ledger evaluation
;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
;; Copyright (C) 2010 Free Software Foundation, Inc.
;; Author: Eric S Fraga
;; Keywords: literate programming, reproducible research, accounting
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -52,7 +52,7 @@ called by `org-babel-execute-src-block'."
(in-file (org-babel-temp-file "ledger-"))
(out-file (org-babel-temp-file "ledger-output-")))
(with-temp-file in-file (insert body))
(message (concat "ledger"
(message "%s" (concat "ledger"
" -f " (org-babel-process-file-name in-file)
" " cmdline))
(with-output-to-string
@ -67,5 +67,6 @@ called by `org-babel-execute-src-block'."
(provide 'ob-ledger)
;; arch-tag: 7bbb529e-95a1-4236-9d29-b0000b918c7c
;;; ob-ledger.el ends here

447
lisp/org/ob-lilypond.el Normal file
View file

@ -0,0 +1,447 @@
;;; ob-lilypond.el --- org-babel functions for lilypond evaluation
;; Copyright (C) 2010 Free Software Foundation, Inc.
;; Author: Martyn Jago
;; Keywords: babel language, literate programming
;; Homepage: https://github.com/mjago/ob-lilypond
;; Version: 7.7
;; 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/>.
;;; Commentary:
;; Installation / usage info, and examples are available at
;; https://github.com/mjago/ob-lilypond
;;; Code:
(require 'ob)
(require 'ob-eval)
(require 'ob-tangle)
(defalias 'lilypond-mode 'LilyPond-mode)
(declare-function show-all "outline" ())
(add-to-list 'org-babel-tangle-lang-exts '("LilyPond" . "ly"))
(defvar org-babel-default-header-args:lilypond '()
"Default header arguments for js code blocks.")
(defconst ly-version "0.3"
"The version number of the file ob-lilypond.el.")
(defvar ly-compile-post-tangle t
"Following the org-babel-tangle (C-c C-v t) command,
ly-compile-post-tangle determines whether ob-lilypond should
automatically attempt to compile the resultant tangled file.
If the value is nil, no automated compilation takes place.
Default value is t")
(defvar ly-display-pdf-post-tangle t
"Following a successful LilyPond compilation
ly-display-pdf-post-tangle determines whether to automate the
drawing / redrawing of the resultant pdf. If the value is nil,
the pdf is not automatically redrawn. Default value is t")
(defvar ly-play-midi-post-tangle t
"Following a successful LilyPond compilation
ly-play-midi-post-tangle determines whether to automate the
playing of the resultant midi file. If the value is nil,
the midi file is not automatically played. Default value is t")
(defvar ly-OSX-ly-path
"/Applications/lilypond.app/Contents/Resources/bin/lilypond")
(defvar ly-OSX-pdf-path "open")
(defvar ly-OSX-midi-path "open")
(defvar ly-nix-ly-path "/usr/bin/lilypond")
(defvar ly-nix-pdf-path "evince")
(defvar ly-nix-midi-path "timidity")
(defvar ly-win32-ly-path "lilypond")
(defvar ly-win32-pdf-path "")
(defvar ly-win32-midi-path "")
(defvar ly-gen-png nil
"Image generation (png) can be turned on by default by setting
LY-GEN-PNG to t")
(defvar ly-gen-svg nil
"Image generation (SVG) can be turned on by default by setting
LY-GEN-SVG to t")
(defvar ly-gen-html nil
"HTML generation can be turned on by default by setting
LY-GEN-HTML to t")
(defvar ly-use-eps nil
"You can force the compiler to use the EPS backend by setting
LY-USE-EPS to t")
(defvar ly-arrange-mode nil
"Arrange mode is turned on by setting LY-ARRANGE-MODE
to t. In Arrange mode the following settings are altered
from default...
:tangle yes, :noweb yes
:results silent :comments yes.
In addition lilypond block execution causes tangling of all lilypond
blocks")
(defun org-babel-expand-body:lilypond (body params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
(mapc
(lambda (pair)
(let ((name (symbol-name (car pair)))
(value (cdr pair)))
(setq body
(replace-regexp-in-string
(concat "\$" (regexp-quote name))
(if (stringp value) value (format "%S" value))
body))))
vars)
body))
(defun org-babel-execute:lilypond (body params)
"This function is called by `org-babel-execute-src-block'.
Depending on whether we are in arrange mode either:
1. Attempt to execute lilypond block according to header settings
(This is the default basic mode)
2. Tangle all lilypond blocks and process the result (arrange mode)"
(ly-set-header-args ly-arrange-mode)
(if ly-arrange-mode
(ly-tangle)
(ly-process-basic body params)))
(defun ly-tangle ()
"ob-lilypond specific tangle, attempts to invoke
=ly-execute-tangled-ly= if tangle is successful. Also passes
specific arguments to =org-babel-tangle="
(interactive)
(if (org-babel-tangle nil "yes" "lilypond")
(ly-execute-tangled-ly) nil))
(defun ly-process-basic (body params)
"Execute a lilypond block in basic mode"
(let* ((result-params (cdr (assoc :result-params params)))
(out-file (cdr (assoc :file params)))
(cmdline (or (cdr (assoc :cmdline params))
""))
(in-file (org-babel-temp-file "lilypond-")))
(with-temp-file in-file
(insert (org-babel-expand-body:generic body params)))
(org-babel-eval
(concat
(ly-determine-ly-path)
" -dbackend=eps "
"-dno-gs-load-fonts "
"-dinclude-eps-fonts "
"--png "
"--output="
(file-name-sans-extension out-file)
" "
cmdline
in-file) "")
) nil)
(defun org-babel-prep-session:lilypond (session params)
"Return an error because LilyPond exporter does not support sessions."
(error "Sorry, LilyPond does not currently support sessions!"))
(defun ly-execute-tangled-ly ()
"Compile result of block tangle with lilypond.
If error in compilation, attempt to mark the error in lilypond org file"
(when ly-compile-post-tangle
(let ((ly-tangled-file (ly-switch-extension
(buffer-file-name) ".lilypond"))
(ly-temp-file (ly-switch-extension
(buffer-file-name) ".ly")))
(if (file-exists-p ly-tangled-file)
(progn
(when (file-exists-p ly-temp-file)
(delete-file ly-temp-file))
(rename-file ly-tangled-file
ly-temp-file))
(error "Error: Tangle Failed!") t)
(switch-to-buffer-other-window "*lilypond*")
(erase-buffer)
(ly-compile-lilyfile ly-temp-file)
(goto-char (point-min))
(if (not (ly-check-for-compile-error ly-temp-file))
(progn
(other-window -1)
(ly-attempt-to-open-pdf ly-temp-file)
(ly-attempt-to-play-midi ly-temp-file))
(error "Error in Compilation!")))) nil)
(defun ly-compile-lilyfile (file-name &optional test)
"Compile lilypond file and check for compile errors
FILE-NAME is full path to lilypond (.ly) file"
(message "Compiling LilyPond...")
(let ((arg-1 (ly-determine-ly-path)) ;program
(arg-2 nil) ;infile
(arg-3 "*lilypond*") ;buffer
(arg-4 t) ;display
(arg-5 (if ly-gen-png "--png" "")) ;&rest...
(arg-6 (if ly-gen-html "--html" ""))
(arg-7 (if ly-use-eps "-dbackend=eps" ""))
(arg-8 (if ly-gen-svg "-dbackend=svg" ""))
(arg-9 (concat "--output=" (file-name-sans-extension file-name)))
(arg-10 file-name))
(if test
`(,arg-1 ,arg-2 ,arg-3 ,arg-4 ,arg-5
,arg-6 ,arg-7 ,arg-8 ,arg-9 ,arg-10)
(call-process
arg-1 arg-2 arg-3 arg-4 arg-5
arg-6 arg-7 arg-8 arg-9 arg-10))))
(defun ly-check-for-compile-error (file-name &optional test)
"Check for compile error.
This is performed by parsing the *lilypond* buffer
containing the output message from the compilation.
FILE-NAME is full path to lilypond file.
If TEST is t just return nil if no error found, and pass
nil as file-name since it is unused in this context"
(let ((is-error (search-forward "error:" nil t)))
(if (not test)
(if (not is-error)
nil
(ly-process-compile-error file-name))
is-error)))
(defun ly-process-compile-error (file-name)
"Process the compilation error that has occurred.
FILE-NAME is full path to lilypond file"
(let ((line-num (ly-parse-line-num)))
(let ((error-lines (ly-parse-error-line file-name line-num)))
(ly-mark-error-line file-name error-lines)
(error "Error: Compilation Failed!"))))
(defun ly-mark-error-line (file-name line)
"Mark the erroneous lines in the lilypond org buffer.
FILE-NAME is full path to lilypond file.
LINE is the erroneous line"
(switch-to-buffer-other-window
(concat (file-name-nondirectory
(ly-switch-extension file-name ".org"))))
(let ((temp (point)))
(goto-char (point-min))
(setq case-fold-search nil)
(if (search-forward line nil t)
(progn
(show-all)
(set-mark (point))
(goto-char (- (point) (length line))))
(goto-char temp))))
(defun ly-parse-line-num (&optional buffer)
"Extract error line number."
(when buffer
(set-buffer buffer))
(let ((start
(and (search-backward ":" nil t)
(search-backward ":" nil t)
(search-backward ":" nil t)
(search-backward ":" nil t)))
(num nil))
(if start
(progn
(forward-char)
(let ((num (buffer-substring
(+ 1 start)
(- (search-forward ":" nil t) 1))))
(setq num (string-to-number num))
(if (numberp num)
num
nil)))
nil)))
(defun ly-parse-error-line (file-name lineNo)
"Extract the erroneous line from the tangled .ly file
FILE-NAME is full path to lilypond file.
LINENO is the number of the erroneous line"
(with-temp-buffer
(insert-file-contents (ly-switch-extension file-name ".ly")
nil nil nil t)
(if (> lineNo 0)
(progn
(goto-char (point-min))
(forward-line (- lineNo 1))
(buffer-substring (point) (point-at-eol)))
nil)))
(defun ly-attempt-to-open-pdf (file-name &optional test)
"Attempt to display the generated pdf file
FILE-NAME is full path to lilypond file
If TEST is non-nil, the shell command is returned and is not run"
(when ly-display-pdf-post-tangle
(let ((pdf-file (ly-switch-extension file-name ".pdf")))
(if (file-exists-p pdf-file)
(let ((cmd-string
(concat (ly-determine-pdf-path) " " pdf-file)))
(if test
cmd-string
(shell-command cmd-string)))
(message "No pdf file generated so can't display!")))))
(defun ly-attempt-to-play-midi (file-name &optional test)
"Attempt to play the generated MIDI file
FILE-NAME is full path to lilypond file
If TEST is non-nil, the shell command is returned and is not run"
(when ly-play-midi-post-tangle
(let ((midi-file (ly-switch-extension file-name ".midi")))
(if (file-exists-p midi-file)
(let ((cmd-string
(concat (ly-determine-midi-path) " " midi-file)))
(if test
cmd-string
(shell-command cmd-string)))
(message "No midi file generated so can't play!")))))
(defun ly-determine-ly-path (&optional test)
"Return correct path to ly binary depending on OS
If TEST is non-nil, it contains a simulation of the OS for test purposes"
(let ((sys-type
(or test system-type)))
(cond ((string= sys-type "darwin")
ly-OSX-ly-path)
((string= sys-type "win32")
ly-win32-ly-path)
(t ly-nix-ly-path))))
(defun ly-determine-pdf-path (&optional test)
"Return correct path to pdf viewer depending on OS
If TEST is non-nil, it contains a simulation of the OS for test purposes"
(let ((sys-type
(or test system-type)))
(cond ((string= sys-type "darwin")
ly-OSX-pdf-path)
((string= sys-type "win32")
ly-win32-pdf-path)
(t ly-nix-pdf-path))))
(defun ly-determine-midi-path (&optional test)
"Return correct path to midi player depending on OS
If TEST is non-nil, it contains a simulation of the OS for test purposes"
(let ((sys-type
(or test test system-type)))
(cond ((string= sys-type "darwin")
ly-OSX-midi-path)
((string= sys-type "win32")
ly-win32-midi-path)
(t ly-nix-midi-path))))
(defun ly-toggle-midi-play ()
"Toggle whether midi will be played following a successful compilation"
(interactive)
(setq ly-play-midi-post-tangle
(not ly-play-midi-post-tangle))
(message (concat "Post-Tangle MIDI play has been "
(if ly-play-midi-post-tangle
"ENABLED." "DISABLED."))))
(defun ly-toggle-pdf-display ()
"Toggle whether pdf will be displayed following a successful compilation"
(interactive)
(setq ly-display-pdf-post-tangle
(not ly-display-pdf-post-tangle))
(message (concat "Post-Tangle PDF display has been "
(if ly-display-pdf-post-tangle
"ENABLED." "DISABLED."))))
(defun ly-toggle-png-generation ()
"Toggle whether png image will be generated by compilation"
(interactive)
(setq ly-gen-png
(not ly-gen-png))
(message (concat "PNG image generation has been "
(if ly-gen-png "ENABLED." "DISABLED."))))
(defun ly-toggle-html-generation ()
"Toggle whether html will be generated by compilation"
(interactive)
(setq ly-gen-html
(not ly-gen-html))
(message (concat "HTML generation has been "
(if ly-gen-html "ENABLED." "DISABLED."))))
(defun ly-toggle-arrange-mode ()
"Toggle whether in Arrange mode or Basic mode"
(interactive)
(setq ly-arrange-mode
(not ly-arrange-mode))
(message (concat "Arrange mode has been "
(if ly-arrange-mode "ENABLED." "DISABLED."))))
(defun ly-version (&optional insert-at-point)
(interactive)
(let ((version (format "ob-lilypond version %s" ly-version)))
(when insert-at-point (insert version))
(message version)))
(defun ly-switch-extension (file-name ext)
"Utility command to swap current FILE-NAME extension with EXT"
(concat (file-name-sans-extension
file-name) ext))
(defun ly-get-header-args (mode)
"Default arguments to use when evaluating a lilypond
source block. These depend upon whether we are in arrange
mode i.e. ARRANGE-MODE is t"
(cond (mode
'((:tangle . "yes")
(:noweb . "yes")
(:results . "silent")
(:comments . "yes")))
(t
'((:results . "file")
(:exports . "results")))))
(defun ly-set-header-args (mode)
"Set org-babel-default-header-args:lilypond
dependent on LY-ARRANGE-MODE"
(setq org-babel-default-header-args:lilypond
(ly-get-header-args mode)))
(provide 'ob-lilypond)
;; arch-tag: ac449eea-2cf2-4dc5-ae33-426f57ba4894
;;; ob-lilypond.el ends here

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

@ -1,35 +1,30 @@
;;; ob-lisp.el --- org-babel functions for Common Lisp
;;; ob-lisp.el --- org-babel functions for common lisp evaluation
;; Copyright (C) 2010-2011 Free Software Foundation
;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc.
;; Author: David T. O'Toole <dto@gnu.org>, Eric Schulte
;; Keywords: literate programming, reproducible research, lisp
;; Author: Joel Boehland, Eric Schulte, David T. O'Toole <dto@gnu.org>
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;; License:
;; This file is part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify
;; 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, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; 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; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Now working with SBCL for both session and external evaluation.
;;
;; This certainly isn't optimally robust, but it seems to be working
;; for the basic use cases.
;;; support for evaluating common lisp code, relies on slime for all eval
;;; Requirements:
@ -38,75 +33,74 @@
;;; Code:
(require 'ob)
(require 'ob-ref)
(require 'ob-comint)
(require 'ob-eval)
(declare-function slime-eval "ext:slime" (sexp &optional package))
(declare-function slime-process "ext:slime" (&optional connection))
(declare-function slime-connected-p "ext:slime" ())
(defvar org-babel-default-header-args:lisp '()
"Default header arguments for lisp code blocks.")
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("lisp" . "lisp"))
(defcustom org-babel-lisp-cmd "sbcl --script"
"Name of command used to evaluate lisp blocks."
(defvar org-babel-default-header-args:lisp '())
(defvar org-babel-header-arg-names:lisp '(package))
(defcustom org-babel-lisp-dir-fmt
"(let ((*default-pathname-defaults* #P%S)) %%s)"
"Format string used to wrap code bodies to set the current directory.
For example a value of \"(progn ;; %s\\n %%s)\" would ignore the
current directory string."
:group 'org-babel
:type 'string)
(defun org-babel-expand-body:lisp (body params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
(if (> (length vars) 0)
(concat "(let ("
(mapconcat
(lambda (var) (format "%S" (print `(,(car var) ',(cdr var)))))
vars "\n ")
")\n" body ")")
(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 "(pprint %s)" body)
body)))
(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'"
"Execute a block of Common Lisp code with Babel."
(require 'slime)
(message "executing Lisp source code block")
(let* ((session (org-babel-lisp-initiate-session
(cdr (assoc :session params))))
(result-type (cdr (assoc :result-type params)))
(full-body (org-babel-expand-body:lisp body params)))
(read
(if session
;; session evaluation
(save-window-excursion
(cadr (slime-eval `(swank:eval-and-grab-output ,full-body))))
;; external evaluation
(let ((script-file (org-babel-temp-file "lisp-script-")))
(with-temp-file script-file
(insert
;; return the value or the output
(if (string= result-type "value")
(format "(print %s)" full-body)
full-body)))
(org-babel-eval
(format "%s %s" org-babel-lisp-cmd
(org-babel-process-file-name script-file)) ""))))))
(org-babel-reassemble-table
((lambda (result)
(if (member "output" (cdr (assoc :result-params params)))
(car result)
(condition-case nil
(read (org-bable-lisp-vector-to-list (cadr result)))
(error (cadr result)))))
(with-temp-buffer
(insert (org-babel-expand-body:lisp body params))
(slime-eval `(swank:eval-and-grab-output
,(let ((dir (if (assoc :dir params)
(cdr (assoc :dir params))
default-directory)))
(format
(if dir (format org-babel-lisp-dir-fmt dir) "(progn %s)")
(buffer-substring-no-properties
(point-min) (point-max)))))
(cdr (assoc :package 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)))))
;; This function should be used to assign any variables in params in
;; the context of the session environment.
(defun org-babel-prep-session:lisp (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(error "not yet implemented"))
(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)
(slime-process)))))
(defun org-bable-lisp-vector-to-list (results)
;; TODO: better would be to replace #(...) with [...]
(replace-regexp-in-string "#(" "(" results))
(provide 'ob-lisp)
;; arch-tag: 18086168-009f-4947-bbb5-3532375d851d
;;; ob-lisp.el ends here

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

@ -1,11 +1,11 @@
;;; ob-lob.el --- functions supporting the Library of Babel
;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; Author: Eric Schulte, Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -22,13 +22,9 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; See the online documentation for more information
;;
;; http://orgmode.org/worg/org-contrib/babel/
;;; Code:
(eval-when-compile
(require 'cl))
(require 'ob)
(require 'ob-table)
@ -43,11 +39,14 @@ To add files to this list use the `org-babel-lob-ingest' command."
:group 'org-babel
:type 'list)
(defvar org-babel-default-lob-header-args '((:exports . "results"))
"Default header arguments to use when exporting #+lob/call lines.")
;;;###autoload
(defun org-babel-lob-ingest (&optional file)
"Add all named source-blocks defined in FILE to
`org-babel-library-of-babel'."
(interactive "f")
(interactive "fFile: ")
(let ((lob-ingest-count 0))
(org-babel-map-src-blocks file
(let* ((info (org-babel-get-src-block-info 'light))
@ -67,12 +66,25 @@ To add files to this list use the `org-babel-lob-ingest' command."
If you change the value of this variable then your files may
become unusable by other org-babel users, and vice versa.")
(defconst org-babel-lob-one-liner-regexp
(defconst org-babel-block-lob-one-liner-regexp
(concat
"^\\([ \t]*\\)#\\+\\(?:"
(mapconcat #'regexp-quote org-babel-lob-call-aliases "\\|")
"\\):[ \t]+\\([^\(\)\n]+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)"
"\(\\([^\n]*\\)\)\\(\\[.+\\]\\|\\)[ \t]*\\([^\n]*\\)")
"\(\\([^\n]*\\)\)\\(\\[.+\\]\\|\\)[ \t]*\\(\\([^\n]*\\)\\)?")
"Regexp to match non-inline calls to predefined source block functions.")
(defconst org-babel-inline-lob-one-liner-regexp
(concat
"\\([^\n]*\\)\\(?:"
(mapconcat #'regexp-quote org-babel-lob-call-aliases "\\|")
"\\)_\\([^\(\)\n]+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)"
"\(\\([^\n]*\\)\)\\(\\[\\(.*?\\)\\]\\)?")
"Regexp to match inline calls to predefined source block functions.")
(defconst org-babel-lob-one-liner-regexp
(concat "\\(" org-babel-block-lob-one-liner-regexp
"\\|" org-babel-inline-lob-one-liner-regexp "\\)")
"Regexp to match calls to predefined source block functions.")
;; functions for executing lob one-liners
@ -88,20 +100,25 @@ if so then run the appropriate source block from the Library."
;;;###autoload
(defun org-babel-lob-get-info ()
"Return a Library of Babel function call as a string."
(let ((case-fold-search t))
(save-excursion
(beginning-of-line 1)
(if (looking-at org-babel-lob-one-liner-regexp)
(append
(flet ((nonempty (a b)
(let ((it (match-string a)))
(if (= (length it) 0) (match-string b) it))))
(let ((case-fold-search t))
(save-excursion
(beginning-of-line 1)
(when (looking-at org-babel-lob-one-liner-regexp)
(append
(mapcar #'org-babel-clean-text-properties
(list
(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))))))))
(nonempty 3 12)
(if (not (= 0 (length (nonempty 5 13))))
(concat "[" (nonempty 5 13) "]") "")
(or (nonempty 7 16) "")
(or (nonempty 8 19) ""))
(nonempty 9 18)))
(list (length (if (= (length (match-string 12)) 0)
(match-string 2) (match-string 11))))))))))
(defun org-babel-lob-execute (info)
"Execute the lob call specified by INFO."
@ -119,5 +136,6 @@ if so then run the appropriate source block from the Library."
(provide 'ob-lob)
;; arch-tag: ce0712c9-2147-4019-ba3f-42341b8b474b
;;; ob-lob.el ends here

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

@ -1,11 +1,11 @@
;;; ob-matlab.el --- org-babel support for matlab evaluation
;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
;; Copyright (C) 2010 Free Software Foundation, Inc.
;; Author: Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -43,5 +43,6 @@
(provide 'ob-matlab)
;; arch-tag: 6b234299-c1f7-4eb1-ace8-7b93344065ac
;;; ob-matlab.el ends here

80
lisp/org/ob-maxima.el Normal file
View file

@ -0,0 +1,80 @@
;;; ob-maxima.el --- org-babel functions for maxima evaluation
;; Copyright (c) 2009, 2010, 2011 Eric S Fraga, Eric Schulte
;; Author: Eric S Fraga, Eric Schulte
;; Keywords: literate programming, reproducible research, maxima
;; Homepage: http://orgmode.org
;; Version: 7.7
;;; License:
;; 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, 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; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Org-Babel support for evaluating maxima entries.
;;
;; This differs from most standard languages in that
;;
;; 1) there is no such thing as a "session" in maxima
;;
;; 2) we are generally only going to return output from maxima
;;
;; 3) we are adding the "cmdline" header argument
;;
;; 4) there are no variables
;;; Code:
(require 'ob)
(defvar org-babel-default-header-args:maxima '())
(defun org-babel-maxima-expand (body params)
"Expand a block of Maxima code according to its header arguments."
body)
(defun org-babel-execute:maxima (body params)
"Execute a block of Maxima entries with org-babel. This function is
called by `org-babel-execute-src-block'."
(message "executing Maxima source code block")
(let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
(cmdline (cdr (assoc :cmdline params)))
(in-file (org-babel-temp-file "maxima-"))
(cmd (format "maxima --very-quiet -r 'batchload(%S)$' %s"
in-file cmdline)))
(with-temp-file in-file (insert body))
(message cmd)
((lambda (raw) ;; " | grep -v batch | grep -v 'replaced' | sed '/^$/d' "
(mapconcat
#'identity
(delq nil
(mapcar (lambda (line)
(unless (or (string-match "batch" line)
(string-match "^rat: replaced .*$" line)
(= 0 (length line)))
line))
(split-string raw "[\r\n]"))) "\n"))
(org-babel-eval cmd ""))))
(defun org-babel-prep-session:maxima (session params)
(error "Maxima does not support sessions"))
(provide 'ob-maxima)
;; arch-tag: d86c97ac-7eab-4349-8d8b-302dd09779a8
;;; ob-maxima.el ends here

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

@ -1,11 +1,11 @@
;;; ob-msc.el --- org-babel functions for mscgen evaluation
;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
;; Copyright (C) 2010 Free Software Foundation, Inc.
;; Author: Juan Pechiar
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -73,7 +73,7 @@ mscgen supported formats."
(error "
ERROR: no output file specified. Add \":file name.png\" to the src header"))
(org-babel-eval (concat "mscgen -T " filetype " -o " out-file) body)
out-file))
nil)) ;; signal that output has already been written to file
(defun org-babel-prep-session:mscgen (session params)
"Raise an error because Mscgen doesn't support sessions."
@ -81,5 +81,6 @@ ERROR: no output file specified. Add \":file name.png\" to the src header"))
(provide 'ob-mscgen)
;; arch-tag: 74695b1e-715f-4b5a-a3a9-d78ee39ba5c8
;;; ob-msc.el ends here

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

@ -1,11 +1,11 @@
;;; ob-ocaml.el --- org-babel functions for ocaml evaluation
;; Copyright (C) 2009-2011 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.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -44,6 +44,7 @@
(declare-function tuareg-run-caml "ext:tuareg" ())
(declare-function tuareg-interactive-send-input "ext:tuareg" ())
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("ocaml" . "ml"))
(defvar org-babel-default-header-args:ocaml '())
@ -125,32 +126,20 @@ OUTPUT is string output from an ocaml process."
"Convert RESULTS into an elisp table or string.
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 (and (stringp results) (string-match "^\\[.+\\]$" results))
(org-babel-read
(replace-regexp-in-string
"\\[" "(" (replace-regexp-in-string
"\\]" ")" (replace-regexp-in-string
"; " " " (replace-regexp-in-string
"'" "\"" results)))))
results)))
(org-babel-script-escape (replace-regexp-in-string ";" "," results)))
(defun org-babel-ocaml-read-array (results)
"Convert RESULTS into an elisp table or string.
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 (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
(replace-regexp-in-string
"\\[|" "[" (replace-regexp-in-string
"|\\]" "]" (replace-regexp-in-string
"; " "," results)))))
(provide 'ob-ocaml)
;; arch-tag: 2e815f4d-365e-4d69-b1df-dd17fdd7b7b7
;;; ob-ocaml.el ends here

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

@ -1,11 +1,11 @@
;;; ob-octave.el --- org-babel functions for octave and matlab evaluation
;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
;; Copyright (C) 2010 Free Software Foundation, Inc.
;; Author: Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -88,13 +88,12 @@ end")
body params (org-babel-variable-assignments:octave params)))
(result (org-babel-octave-evaluate
session full-body result-type matlabp)))
(or out-file
(org-babel-reassemble-table
result
(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)))))))
(org-babel-reassemble-table
result
(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))))))
(defun org-babel-prep-session:matlab (session params)
"Prepare SESSION according to PARAMS."
@ -104,7 +103,7 @@ end")
"Return list of octave statements assigning the block's variables"
(mapcar
(lambda (pair)
(format "%s=%s"
(format "%s=%s;"
(car pair)
(org-babel-octave-var-to-octave (cdr pair))))
(mapcar #'cdr (org-babel-get-header params :var))))
@ -259,5 +258,6 @@ This removes initial blank and comment lines and then calls
(provide 'ob-octave)
;; arch-tag: d8e5f68b-ba13-440a-a495-b653e989e704
;;; ob-octave.el ends here

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

@ -1,11 +1,11 @@
;;; ob-org.el --- org-babel functions for org code block evaluation
;; Copyright (C) 2010-2011 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.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -40,13 +40,22 @@
"#+TITLE: default empty header\n"
"Default header inserted during export of org blocks.")
(defun org-babel-expand-body:org (body params)
(dolist (var (mapcar #'cdr (org-babel-get-header params :var)))
(setq body (replace-regexp-in-string
(regexp-quote (format "$%s" (car var))) (cdr var) body
nil 'literal)))
body)
(defun org-babel-execute:org (body params)
"Execute a block of Org code with.
This function is called by `org-babel-execute-src-block'."
(let ((result-params (split-string (or (cdr (assoc :results params)) "")))
(body (replace-regexp-in-string "^," "" body)))
(body (org-babel-expand-body:org
(replace-regexp-in-string "^," "" body) params)))
(cond
((member "latex" result-params) (org-export-string body "latex"))
((member "latex" result-params) (org-export-string
(concat "#+Title: \n" body) "latex"))
((member "html" result-params) (org-export-string body "html"))
((member "ascii" result-params) (org-export-string body "ascii"))
(t body))))
@ -57,5 +66,6 @@ This function is called by `org-babel-execute-src-block'."
(provide 'ob-org)
;; arch-tag: 130af5fe-cc56-46bd-9508-fa0ebd94cb1f
;;; ob-org.el ends here

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

@ -1,11 +1,11 @@
;;; ob-perl.el --- org-babel functions for perl evaluation
;; Copyright (C) 2009-2011 Free Software Foundation
;; Copyright (C) 2009, 2010 Free Software Foundation
;; Author: Dan Davison, Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -31,6 +31,7 @@
(require 'ob-eval)
(eval-when-compile (require 'cl))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("perl" . "pl"))
(defvar org-babel-default-header-args:perl '())
@ -112,5 +113,6 @@ return the value of the last statement in BODY, as elisp."
(provide 'ob-perl)
;; arch-tag: 88ef9396-d857-4dc3-8946-5a72bdfa2337
;;; ob-perl.el ends here

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

@ -1,11 +1,11 @@
;;; ob-plantuml.el --- org-babel functions for plantuml evaluation
;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
;; Copyright (C) 2010 Free Software Foundation, Inc.
;; Author: Zhang Weize
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -62,6 +62,8 @@ This function is called by `org-babel-execute-src-block'."
(expand-file-name org-plantuml-jar-path))
(if (string= (file-name-extension out-file) "svg")
" -tsvg" "")
(if (string= (file-name-extension out-file) "eps")
" -teps" "")
" -p " cmdline " < "
(org-babel-process-file-name in-file)
" > "
@ -70,7 +72,7 @@ This function is called by `org-babel-execute-src-block'."
(error "Could not find plantuml.jar at %s" org-plantuml-jar-path))
(with-temp-file in-file (insert (concat "@startuml\n" body "\n@enduml")))
(message "%s" cmd) (org-babel-eval cmd "")
out-file))
nil)) ;; signal that output has already been written to file
(defun org-babel-prep-session:plantuml (session params)
"Return an error because plantuml does not support sessions."
@ -78,5 +80,6 @@ This function is called by `org-babel-execute-src-block'."
(provide 'ob-plantuml)
;; arch-tag: 451f50c5-e779-407e-ad64-70e0e8f161d1
;;; ob-plantuml.el ends here

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

@ -1,11 +1,11 @@
;;; ob-python.el --- org-babel functions for python evaluation
;; Copyright (C) 2009-2011 Free Software Foundation
;; Copyright (C) 2009, 2010 Free Software Foundation
;; Author: Eric Schulte, Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -35,8 +35,10 @@
(declare-function org-remove-indentation "org" )
(declare-function py-shell "ext:python-mode" (&optional argprompt))
(declare-function py-toggle-shells "ext:python-mode" (arg))
(declare-function run-python "ext:python" (&optional cmd noshow new))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("python" . "py"))
(defvar org-babel-default-header-args:python '())
@ -45,7 +47,8 @@
"Name of command for executing python code.")
(defvar org-babel-python-mode (if (featurep 'xemacs) 'python-mode 'python)
"Preferred python mode for use in running python interactively.")
"Preferred python mode for use in running python interactively.
This will typically be either 'python or 'python-mode.")
(defvar org-src-preserve-indentation)
@ -65,13 +68,12 @@ This function is called by `org-babel-execute-src-block'."
params (org-babel-variable-assignments:python params)))
(result (org-babel-python-evaluate
session full-body result-type result-params preamble)))
(or (cdr (assoc :file params))
(org-babel-reassemble-table
result
(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)))))))
(org-babel-reassemble-table
result
(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))))))
(defun org-babel-prep-session:python (session params)
"Prepare SESSION according to the header arguments in PARAMS.
@ -129,6 +131,7 @@ Emacs-lisp table, otherwise return the results as a string."
"Return the buffer associated with SESSION."
(cdr (assoc session org-babel-python-buffers)))
(defvar py-default-interpreter)
(defun org-babel-python-initiate-session-by-key (&optional session)
"Initiate a python session.
If there is not a current inferior-process-buffer in SESSION
@ -143,9 +146,13 @@ then create. Return the initialized session."
(run-python))
((and (eq 'python-mode org-babel-python-mode)
(fboundp 'py-shell)) ; python-mode.el
;; Make sure that py-which-bufname is initialized, as otherwise
;; it will be overwritten the first time a Python buffer is
;; created.
(py-toggle-shells py-default-interpreter)
;; `py-shell' creates a buffer whose name is the value of
;; `py-which-bufname' with '*'s at the beginning and end
(let* ((bufname (if python-buffer
(let* ((bufname (if (and python-buffer (buffer-live-p python-buffer))
(replace-regexp-in-string ;; zap surrounding *
"^\\*\\([^*]+\\)\\*$" "\\1" python-buffer)
(concat "Python-" (symbol-name session))))
@ -196,29 +203,33 @@ open('%s', 'w').write( pprint.pformat(main()) )")
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
(concat (if preamble (concat preamble "\n") "") body)))
(value (let ((tmp-file (org-babel-temp-file "python-")))
(org-babel-eval org-babel-python-command
(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))
raw
(org-babel-python-table-or-string raw)))
((lambda (raw)
(if (or (member "code" result-params)
(member "pp" result-params)
(and (member "output" result-params)
(not (member "table" result-params))))
raw
(org-babel-python-table-or-string (org-babel-trim raw))))
(case result-type
(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
(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))))
(org-babel-eval-read-file tmp-file))))))
(defun org-babel-python-evaluate-session
@ -227,10 +238,11 @@ last statement in BODY, as elisp."
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."
(flet ((dump-last-value
(flet ((send-wait () (comint-send-input nil t) (sleep-for 0 5))
(dump-last-value
(tmp-file pp)
(mapc
(lambda (statement) (insert statement) (comint-send-input))
(lambda (statement) (insert statement) (send-wait))
(if pp
(list
"import pprint"
@ -239,34 +251,39 @@ last statement in BODY, as elisp."
(list (format "open('%s', 'w').write(str(_))"
(org-babel-process-file-name tmp-file 'noquote))))))
(input-body (body)
(mapc (lambda (statement) (insert statement) (comint-send-input))
(split-string (org-babel-trim body) "[\r\n]+"))
(comint-send-input) (comint-send-input)))
(case result-type
(output
(mapconcat
#'org-babel-trim
(butlast
(org-babel-comint-with-output
(session org-babel-python-eoe-indicator t body)
(let ((comint-process-echoes nil))
(input-body body)
(insert org-babel-python-eoe-indicator)
(comint-send-input))) 2) "\n"))
(value
((lambda (results)
(if (or (member "code" result-params) (member "pp" result-params))
results
(org-babel-python-table-or-string results)))
(let ((tmp-file (org-babel-temp-file "python-")))
(mapc (lambda (line) (insert line) (send-wait))
(split-string body "[\r\n]"))
(send-wait)))
((lambda (results)
(unless (string= (substring org-babel-python-eoe-indicator 1 -1) results)
(if (or (member "code" result-params)
(member "pp" result-params)
(and (member "output" result-params)
(not (member "table" result-params))))
results
(org-babel-python-table-or-string results))))
(case result-type
(output
(mapconcat
#'org-babel-trim
(butlast
(org-babel-comint-with-output
(session org-babel-python-eoe-indicator t body)
(input-body body)
(send-wait) (send-wait)
(insert org-babel-python-eoe-indicator)
(send-wait))
2) "\n"))
(value
(let ((tmp-file (org-babel-temp-file "python-")))
(org-babel-comint-with-output
(session org-babel-python-eoe-indicator nil body)
(let ((comint-process-echoes nil))
(input-body body)
(dump-last-value tmp-file (member "pp" result-params))
(comint-send-input) (comint-send-input)
(send-wait) (send-wait)
(insert org-babel-python-eoe-indicator)
(comint-send-input)))
(send-wait)))
(org-babel-eval-read-file tmp-file)))))))
(defun org-babel-python-read-string (string)
@ -277,5 +294,6 @@ last statement in BODY, as elisp."
(provide 'ob-python)
;; arch-tag: f19b6c3d-dfcb-4a1a-9ce0-45ade1ebc212
;;; ob-python.el ends here

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

@ -1,11 +1,11 @@
;;; ob-ref.el --- org-babel functions for referencing external data
;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; Author: Eric Schulte, Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -51,13 +51,17 @@
;;; 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" ())
(declare-function org-at-item-p "org-list" ())
(declare-function org-narrow-to-subtree "org" ())
(declare-function org-id-find-id-in-file "org-id" (id file &optional markerp))
(declare-function org-show-context "org" (&optional key))
(declare-function org-pop-to-buffer-same-window
"org-compat" (&optional buffer-or-name norecord label))
(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]*")
@ -77,18 +81,46 @@ the variable."
(cons (intern var)
(let ((out (org-babel-read ref)))
(if (equal out ref)
(if (string-match "^\".+\"$" ref)
(if (string-match "^\".*\"$" ref)
(read ref)
(org-babel-ref-resolve ref))
out))))))
(defun org-babel-ref-goto-headline-id (id)
(goto-char (point-min))
(let ((rx (regexp-quote id)))
(or (re-search-forward
(concat "^[ \t]*:CUSTOM_ID:[ \t]+" rx "[ \t]*$") nil t)
(let* ((file (org-id-find-id-file id))
(m (when file (org-id-find-id-in-file id file 'marker))))
(when (and file m)
(message "file:%S" file)
(org-pop-to-buffer-same-window (marker-buffer m))
(goto-char m)
(move-marker m nil)
(org-show-context)
t)))))
(defun org-babel-ref-headline-body ()
(save-restriction
(org-narrow-to-subtree)
(buffer-substring
(save-excursion (goto-char (point-min))
(forward-line 1)
(when (looking-at "[ \t]*:PROPERTIES:")
(re-search-forward ":END:" nil)
(forward-char))
(point))
(point-max))))
(defvar org-babel-library-of-babel)
(defun org-babel-ref-resolve (ref)
"Resolve the reference REF and return its value."
(save-window-excursion
(save-excursion
(let ((case-fold-search t)
type args new-refere new-header-args new-referent result
lob-info split-file split-ref index index-row index-col)
lob-info split-file split-ref index index-row index-col id)
;; if ref is indexed grab the indices -- beware nested indices
(when (and (string-match "\\[\\([^\\[]+\\)\\]$" ref)
(let ((str (substring ref 0 (match-beginning 0))))
@ -106,8 +138,8 @@ the variable."
(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 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))
@ -116,48 +148,52 @@ the variable."
(save-restriction
(widen)
(goto-char (point-min))
(if (let ((result_regexp (concat "^[ \t]*#\\+\\(TBLNAME\\|RESNAME"
"\\|RESULTS\\):[ \t]*"
(regexp-quote ref) "[ \t]*$"))
(regexp (concat org-babel-src-name-regexp
(regexp-quote ref) "\\(\(.*\)\\)?" "[ \t]*$")))
(if (let* ((rx (regexp-quote ref))
(res-rx (concat org-babel-result-regexp rx "[ \t]*$"))
(src-rx (concat org-babel-src-name-regexp
rx "\\(\(.*\)\\)?" "[ \t]*$")))
;; goto ref in the current buffer
(or (and (not args)
(or (re-search-forward result_regexp nil t)
(re-search-backward result_regexp nil t)))
(re-search-forward regexp nil t)
(re-search-backward regexp nil t)
(or (re-search-forward res-rx nil t)
(re-search-backward res-rx nil t)))
(re-search-forward src-rx nil t)
(re-search-backward src-rx nil t)
;; check for local or global headlines by id
(setq id (org-babel-ref-goto-headline-id ref))
;; check the Library of Babel
(setq lob-info (cdr (assoc (intern ref)
org-babel-library-of-babel)))))
(unless lob-info (goto-char (match-beginning 0)))
(unless (or lob-info id) (goto-char (match-beginning 0)))
;; ;; TODO: allow searching for names in other buffers
;; (setq id-loc (org-id-find ref 'marker)
;; buffer (marker-buffer id-loc)
;; loc (marker-position id-loc))
;; (move-marker id-loc nil)
(error "reference '%s' not found in this buffer" ref))
(if lob-info
(setq type 'lob)
(while (not (setq type (org-babel-ref-at-ref-p)))
(forward-line 1)
(beginning-of-line)
(if (or (= (point) (point-min)) (= (point) (point-max)))
(error "reference not found"))))
(cond
(lob-info (setq type 'lob))
(id (setq type 'id))
(t (while (not (setq type (org-babel-ref-at-ref-p)))
(forward-line 1)
(beginning-of-line)
(if (or (= (point) (point-min)) (= (point) (point-max)))
(error "reference not found")))))
(let ((params (append args '((:results . "silent")))))
(setq result
(case type
(results-line (org-babel-read-result))
(table (org-babel-read-table))
(list (org-babel-read-list))
(file (org-babel-read-link))
(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)))))
(lob (org-babel-execute-src-block
nil lob-info params))
(id (org-babel-ref-headline-body)))))
(if (symbolp result)
(format "%S" result)
(if (and index (listp result))
(org-babel-ref-index-list index result)
result))))))
result)))))))
(defun org-babel-ref-index-list (index lis)
"Return the subset of LIS indexed by INDEX.
@ -181,7 +217,10 @@ to \"0:-1\"."
(open (ls) (if (and (listp ls) (= (length ls) 1)) (car ls) ls)))
(open
(mapcar
(lambda (sub-lis) (org-babel-ref-index-list remainder sub-lis))
(lambda (sub-lis)
(if (listp sub-lis)
(org-babel-ref-index-list remainder sub-lis)
sub-lis))
(if (or (= 0 (length portion)) (string-match ind-re portion))
(mapcar
(lambda (n) (nth n lis))
@ -205,7 +244,7 @@ to \"0:-1\"."
(cond
((string= holder ",")
(when (= depth 0)
(setq return (reverse (cons (substring buffer 0 -1) return)))
(setq return (cons (substring buffer 0 -1) return))
(setq buffer "")))
((or (string= holder "(") (string= holder "[")) (setq depth (+ depth 1)))
((or (string= holder ")") (string= holder "]")) (setq depth (- depth 1)))))
@ -217,12 +256,13 @@ 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)
((org-at-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)))
(provide 'ob-ref)
;; arch-tag: ace4a4f4-ea38-4dac-8fe6-6f52fcc43b6d
;;; ob-ref.el ends here

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

@ -1,11 +1,11 @@
;;; ob-ruby.el --- org-babel functions for ruby evaluation
;; Copyright (C) 2009-2011 Free Software Foundation
;; Copyright (C) 2009, 2010 Free Software Foundation
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -44,7 +44,9 @@
(eval-when-compile (require 'cl))
(declare-function run-ruby "ext:inf-ruby" (&optional command name))
(declare-function xmp "ext:rcodetools" (&optional option))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("ruby" . "rb"))
(defvar org-babel-default-header-args:ruby '())
@ -61,15 +63,20 @@ This function is called by `org-babel-execute-src-block'."
(result-type (cdr (assoc :result-type params)))
(full-body (org-babel-expand-body:generic
body params (org-babel-variable-assignments:ruby params)))
(result (org-babel-ruby-evaluate
session full-body result-type result-params)))
(or (cdr (assoc :file params))
(org-babel-reassemble-table
result
(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)))))))
(result (if (member "xmp" result-params)
(with-temp-buffer
(require 'rcodetools)
(insert full-body)
(xmp (cdr (assoc :xmp-option params)))
(buffer-string))
(org-babel-ruby-evaluate
session full-body result-type result-params))))
(org-babel-reassemble-table
result
(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))))))
(defun org-babel-prep-session:ruby (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
@ -234,5 +241,6 @@ return the value of the last statement in BODY, as elisp."
(provide 'ob-ruby)
;; arch-tag: 3e9726db-4520-49e2-b263-e8f571ac88f5
;;; ob-ruby.el ends here

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

@ -1,11 +1,11 @@
;;; ob-sass.el --- org-babel functions for the sass css generation language
;; Copyright (C) 2009-2011 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.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -40,6 +40,7 @@
;;; Code:
(require 'ob)
(require 'ob-eval)
(defvar org-babel-default-header-args:sass '())
@ -55,8 +56,11 @@ This function is called by `org-babel-execute-src-block'."
" " (org-babel-process-file-name in-file)
" " (org-babel-process-file-name out-file))))
(with-temp-file in-file
(insert (org-babel-expand-body:generic body params))) (shell-command cmd)
(or file (with-temp-buffer (insert-file-contents out-file) (buffer-string)))))
(insert (org-babel-expand-body:generic body params)))
(org-babel-eval cmd "")
(if file
nil ;; signal that output has already been written to file
(with-temp-buffer (insert-file-contents out-file) (buffer-string)))))
(defun org-babel-prep-session:sass (session params)
"Raise an error because sass does not support sessions."
@ -64,5 +68,6 @@ This function is called by `org-babel-execute-src-block'."
(provide 'ob-sass)
;; arch-tag: 2954b169-eef4-45ce-a8e5-3e619f0f07ac
;;; ob-sass.el ends here

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

@ -1,11 +1,11 @@
;;; ob-scheme.el --- org-babel functions for Scheme
;; Copyright (C) 2010-2011 Free Software Foundation
;; Copyright (C) 2010 Free Software Foundation
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, scheme
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;; License:
@ -134,5 +134,6 @@ then create. Return the initialized session."
(provide 'ob-scheme)
;; arch-tag: 6b2fe76f-4b25-4e87-ad1c-225b2f282a71
;;; ob-scheme.el ends here

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

@ -1,11 +1,11 @@
;;; ob-screen.el --- org-babel support for interactive terminal
;; Copyright (C) 2009-2011 Free Software Foundation
;; Copyright (C) 2009, 2010 Free Software Foundation
;; Author: Benjamin Andresen
;; Keywords: literate programming, interactive shell
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -142,5 +142,6 @@ The terminal should shortly flicker."
(provide 'ob-screen)
;; arch-tag: 908e5afe-89a0-4f27-b982-23f1f2e3bac9
;;; ob-screen.el ends here

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

@ -1,11 +1,11 @@
;;; ob-sh.el --- org-babel functions for shell evaluation
;; Copyright (C) 2009-2011 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.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -28,6 +28,7 @@
;;; Code:
(require 'ob)
(require 'ob-ref)
(require 'ob-comint)
(require 'ob-eval)
(require 'shell)
@ -45,16 +46,25 @@
"Command used to invoke a shell.
This will be passed to `shell-command-on-region'")
(defcustom org-babel-sh-var-quote-fmt
"$(cat <<'BABEL_TABLE'\n%s\nBABEL_TABLE\n)"
"Format string used to escape variables when passed to shell scripts."
:group 'org-babel
:type 'string)
(defun org-babel-execute:sh (body params)
"Execute a block of Shell commands with Babel.
This function is called by `org-babel-execute-src-block'."
(let* ((session (org-babel-sh-initiate-session
(cdr (assoc :session params))))
(result-params (cdr (assoc :result-params params)))
(result-params (cdr (assoc :result-params params)))
(stdin ((lambda (stdin) (when stdin (org-babel-sh-var-to-string
(org-babel-ref-resolve stdin))))
(cdr (assoc :stdin params))))
(full-body (org-babel-expand-body:generic
body params (org-babel-variable-assignments:sh params))))
(org-babel-reassemble-table
(org-babel-sh-evaluate session full-body result-params)
(org-babel-sh-evaluate session full-body result-params stdin)
(org-babel-pick-name
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
@ -95,20 +105,17 @@ This function is called by `org-babel-execute-src-block'."
"Convert an elisp value to a shell variable.
Convert an elisp var into a string of shell commands specifying a
var of the same value."
(if (listp var)
(flet ((deep-string (el)
(if (listp el)
(mapcar #'deep-string el)
(org-babel-sh-var-to-sh el sep))))
(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")))))
(if (stringp var)
(if (string-match "[\n\r]" var)
(format "$(cat <<BABEL_STRING\n%s\nBABEL_STRING\n)" var)
(format "%s" var))
(format "%S" var))))
(format org-babel-sh-var-quote-fmt (org-babel-sh-var-to-string var sep)))
(defun org-babel-sh-var-to-string (var &optional sep)
"Convert an elisp value to a string."
(flet ((echo-var (v) (if (stringp v) v (format "%S" v))))
(cond
((and (listp var) (listp (car var)))
(orgtbl-to-generic var (list :sep (or sep "\t") :fmt #'echo-var)))
((listp var)
(mapconcat #'echo-var var "\n"))
(t (echo-var var)))))
(defun org-babel-sh-table-or-results (results)
"Convert RESULTS to an appropriate elisp value.
@ -128,7 +135,7 @@ Emacs-lisp table, otherwise return the results as a string."
(defvar org-babel-sh-eoe-output "org_babel_sh_eoe"
"String to indicate that evaluation has completed.")
(defun org-babel-sh-evaluate (session body &optional result-params)
(defun org-babel-sh-evaluate (session body &optional result-params stdin)
"Pass BODY to the Shell 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
@ -136,13 +143,25 @@ return the value of the last statement in BODY."
((lambda (results)
(when results
(if (or (member "scalar" result-params)
(member "verbatim" result-params)
(member "output" result-params))
results
(let ((tmp-file (org-babel-temp-file "sh-")))
(with-temp-file tmp-file (insert results))
(org-babel-import-elisp-from-file tmp-file)))))
(if (not session)
(org-babel-eval org-babel-sh-command (org-babel-trim body))
(cond
(stdin ; external shell script w/STDIN
(let ((script-file (org-babel-temp-file "sh-script-"))
(stdin-file (org-babel-temp-file "sh-stdin-")))
(with-temp-file script-file (insert body))
(with-temp-file stdin-file (insert stdin))
(with-temp-buffer
(call-process-shell-command
(format "%s %s" org-babel-sh-command script-file)
stdin-file
(current-buffer))
(buffer-string))))
(session ; session evaluation
(mapconcat
#'org-babel-sh-strip-weird-long-prompt
(mapcar
@ -152,11 +171,19 @@ return the value of the last statement in BODY."
(session org-babel-sh-eoe-output t body)
(mapc
(lambda (line)
(insert line) (comint-send-input nil t) (sleep-for 0.25))
(insert line)
(comint-send-input nil t)
(while (save-excursion
(goto-char comint-last-input-end)
(not (re-search-forward
comint-prompt-regexp nil t)))
(accept-process-output (get-buffer-process (current-buffer)))))
(append
(split-string (org-babel-trim body) "\n")
(list org-babel-sh-eoe-indicator))))
2)) "\n"))))
2)) "\n"))
('otherwise ; external shell script
(org-babel-eval org-babel-sh-command (org-babel-trim body))))))
(defun org-babel-sh-strip-weird-long-prompt (string)
"Remove prompt cruft from a string of shell output."
@ -166,5 +193,6 @@ return the value of the last statement in BODY."
(provide 'ob-sh)
;; arch-tag: 416dd531-c230-4b0a-a5bf-8d948f990f2d
;;; ob-sh.el ends here

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

@ -1,11 +1,11 @@
;;; ob-sql.el --- org-babel functions for sql evaluation
;; Copyright (C) 2009-2011 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.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -65,28 +65,47 @@ This function is called by `org-babel-execute-src-block'."
(in-file (org-babel-temp-file "sql-in-"))
(out-file (or (cdr (assoc :out-file params))
(org-babel-temp-file "sql-out-")))
(header-delim "")
(command (case (intern engine)
(msosql (format "osql %s -s \"\t\" -i %s -o %s"
('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 < %s > %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)
(org-babel-process-file-name out-file)))
(postgresql (format "psql -A -P footer=off -F \"\t\" -f %s -o %s %s"
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)
(or cmdline "")))
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)))
('postgresql (format
"psql -A -P footer=off -F \"\t\" -f %s -o %s %s"
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)
(or cmdline "")))
(t (error "no support for the %s sql engine" engine)))))
(with-temp-file in-file
(insert (org-babel-expand-body:sql body params)))
(message command)
(shell-command command)
(with-temp-buffer
;; need to figure out what the delimiter is for the header row
(with-temp-buffer
(insert-file-contents out-file)
(goto-char (point-min))
(when (re-search-forward "^\\(-+\\)[^-]" nil t)
(setq header-delim (match-string-no-properties 1)))
(goto-char (point-max))
(forward-char -1)
(while (looking-at "\n")
(delete-char 1)
(goto-char (point-max))
(forward-char -1))
(write-file out-file))
(org-table-import out-file '(16))
(org-babel-reassemble-table
(org-table-to-lisp)
(mapcar (lambda (x)
(if (string= (car x) header-delim)
'hline
x))
(org-table-to-lisp))
(org-babel-pick-name (cdr (assoc :colname-names params))
(cdr (assoc :colnames params)))
(org-babel-pick-name (cdr (assoc :rowname-names params))
@ -121,5 +140,6 @@ This function is called by `org-babel-execute-src-block'."
(provide 'ob-sql)
;; arch-tag: a43ff944-6de1-4566-a83c-626814e3dad2
;;; ob-sql.el ends here

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

@ -1,11 +1,11 @@
;;; ob-sqlite.el --- org-babel functions for sqlite database interaction
;; Copyright (C) 2010-2011 Free Software Foundation
;; Copyright (C) 2010 Free Software Foundation
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -89,6 +89,7 @@ This function is called by `org-babel-execute-src-block'."
;; body of the code block
(org-babel-expand-body:sqlite body params)))
(if (or (member "scalar" result-params)
(member "verbatim" result-params)
(member "html" result-params)
(member "code" result-params)
(equal (point-min) (point-max)))
@ -144,5 +145,6 @@ Prepare SESSION according to the header arguments specified in PARAMS."
(provide 'ob-sqlite)
;; arch-tag: 5c03d7f2-0f72-48b8-bbd1-35aafea248ac
;;; ob-sqlite.el ends here

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

@ -1,11 +1,11 @@
;;; ob-table.el --- support for calling org-babel functions from tables
;; Copyright (C) 2009-2011 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.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -97,7 +97,8 @@ example above."
variables)))
(unless (stringp source-block)
(setq source-block (symbol-name source-block)))
(org-babel-table-truncate-at-newline ;; org-table cells can't be multi-line
((lambda (result)
(org-babel-trim (if (stringp result) result (format "%S" result))))
(if (and source-block (> (length source-block) 0))
(let ((params
(eval `(org-babel-parse-header-arguments
@ -120,5 +121,6 @@ example above."
(provide 'ob-table)
;; arch-tag: 4234cc7c-4fc8-4e92-abb0-2892de1a493b
;;; ob-table.el ends here

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

@ -1,11 +1,11 @@
;;; ob-tangle.el --- extract source code from org-mode files
;; Copyright (C) 2009-2011 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.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -37,6 +37,7 @@
(declare-function org-back-to-heading "org" (invisible-ok))
(declare-function org-fill-template "org" (template alist))
(declare-function org-babel-update-block-body "org" (new-body))
(declare-function make-directory "files" (dir &optional parents))
;;;###autoload
(defcustom org-babel-tangle-lang-exts
@ -62,10 +63,10 @@ then the name of the language is used."
:group 'org-babel
:type 'hook)
(defcustom org-babel-tangle-pad-newline t
"Switch indicating whether to pad tangled code with newlines."
(defcustom org-babel-tangle-body-hook nil
"Hook run over the contents of each code block body."
:group 'org-babel
:type 'boolean)
:type 'hook)
(defcustom org-babel-tangle-comment-format-beg "[[%link][%source-name]]"
"Format of inserted comments in tangled code files.
@ -153,7 +154,7 @@ used to limit the exported source code blocks by language."
(save-window-excursion
(find-file file)
(setq to-be-removed (current-buffer))
(org-babel-tangle target-file lang))
(org-babel-tangle nil target-file lang))
(unless visited-p
(kill-buffer to-be-removed))))
@ -162,15 +163,24 @@ used to limit the exported source code blocks by language."
(mapc (lambda (el) (copy-file el pub-dir t)) (org-babel-tangle-file filename)))
;;;###autoload
(defun org-babel-tangle (&optional target-file lang)
(defun org-babel-tangle (&optional only-this-block target-file lang)
"Write code blocks to source-specific files.
Extract the bodies of all source code blocks from the current
file into their own source-specific files. Optional argument
TARGET-FILE can be used to specify a default export file for all
source blocks. Optional argument LANG can be used to limit the
exported source code blocks by language."
(interactive)
(interactive "P")
(run-hooks 'org-babel-pre-tangle-hook)
;; possibly restrict the buffer to the current code block
(save-restriction
(when only-this-block
(unless (org-babel-where-is-src-block-head)
(error "Point is not currently inside of a code block"))
(unless target-file
(setq target-file
(read-from-minibuffer "Tangle to: " (buffer-file-name))))
(narrow-to-region (match-beginning 0) (match-end 0)))
(save-excursion
(let ((block-counter 0)
(org-babel-default-header-args
@ -210,13 +220,17 @@ exported source code blocks by language."
(if (and ext (string= "yes" tangle))
(concat base-name "." ext) base-name))))
(when file-name
;; possibly create the parent directories for file
(when ((lambda (m) (and m (not (string= m "no"))))
(get-spec :mkdirp))
(make-directory (file-name-directory file-name) 'parents))
;; delete any old versions of file
(when (and (file-exists-p file-name)
(not (member file-name path-collector)))
(delete-file file-name))
;; drop source-block to file
(with-temp-buffer
(when (fboundp lang-f) (funcall lang-f))
(when (fboundp lang-f) (ignore-errors (funcall lang-f)))
(when (and she-bang (not (member file-name she-banged)))
(insert (concat she-bang "\n"))
(setq she-banged (cons file-name she-banged)))
@ -238,7 +252,8 @@ exported source code blocks by language."
(org-babel-tangle-collect-blocks lang))
(message "tangled %d code block%s from %s" block-counter
(if (= block-counter 1) "" "s")
(file-name-nondirectory (buffer-file-name (current-buffer))))
(file-name-nondirectory
(buffer-file-name (or (buffer-base-buffer) (current-buffer)))))
;; run `org-babel-post-tangle-hook' in all tangled files
(when org-babel-post-tangle-hook
(mapc
@ -246,7 +261,7 @@ exported source code blocks by language."
(org-babel-with-temp-filebuffer file
(run-hooks 'org-babel-post-tangle-hook)))
path-collector))
path-collector)))
path-collector))))
(defun org-babel-tangle-clean ()
"Remove comments inserted by `org-babel-tangle'.
@ -263,6 +278,7 @@ references."
(save-excursion (end-of-line 1) (forward-char 1) (point)))))
(defvar org-stored-links)
(defvar org-bracket-link-regexp)
(defun org-babel-tangle-collect-blocks (&optional language)
"Collect source blocks in the current Org-mode file.
Return an association list of source-code block specifications of
@ -290,9 +306,11 @@ code blocks by language."
(unless (and language (not (string= language src-lang)))
(let* ((info (org-babel-get-src-block-info))
(params (nth 2 info))
(link (progn (call-interactively 'org-store-link)
(org-babel-clean-text-properties
(car (pop org-stored-links)))))
(link ((lambda (link)
(and (string-match org-bracket-link-regexp link)
(match-string 1 link)))
(org-babel-clean-text-properties
(org-store-link nil))))
(source-name
(intern (or (nth 4 info)
(format "%s:%d"
@ -302,22 +320,27 @@ code blocks by language."
(assignments-cmd
(intern (concat "org-babel-variable-assignments:" src-lang)))
(body
((lambda (body)
(if (assoc :no-expand params)
body
(if (fboundp expand-cmd)
(funcall expand-cmd body params)
(org-babel-expand-body:generic
body params
(and (fboundp assignments-cmd)
(funcall assignments-cmd params))))))
(if (and (cdr (assoc :noweb params))
(let ((nowebs (split-string
(cdr (assoc :noweb params)))))
(or (member "yes" nowebs)
(member "tangle" nowebs))))
(org-babel-expand-noweb-references info)
(nth 1 info))))
((lambda (body) ;; run the tangle-body-hook
(with-temp-buffer
(insert body)
(run-hooks 'org-babel-tangle-body-hook)
(buffer-string)))
((lambda (body) ;; expand the body in language specific manner
(if (assoc :no-expand params)
body
(if (fboundp expand-cmd)
(funcall expand-cmd body params)
(org-babel-expand-body:generic
body params
(and (fboundp assignments-cmd)
(funcall assignments-cmd params))))))
(if (and (cdr (assoc :noweb params)) ;; expand noweb refs
(let ((nowebs (split-string
(cdr (assoc :noweb params)))))
(or (member "yes" nowebs)
(member "tangle" nowebs))))
(org-babel-expand-noweb-references info)
(nth 1 info)))))
(comment
(when (or (string= "both" (cdr (assoc :comments params)))
(string= "org" (cdr (assoc :comments params))))
@ -363,8 +386,9 @@ form
(body (nth 5 spec))
(comment (nth 6 spec))
(comments (cdr (assoc :comments (nth 4 spec))))
(padline (not (string= "no" (cdr (assoc :padline (nth 4 spec))))))
(link-p (or (string= comments "both") (string= comments "link")
(string= comments "yes")))
(string= comments "yes") (string= comments "noweb")))
(link-data (mapcar (lambda (el)
(cons (symbol-name el)
((lambda (le)
@ -375,14 +399,14 @@ form
(let ((text (org-babel-trim text)))
(when (and comments (not (string= comments "no"))
(> (length text) 0))
(when org-babel-tangle-pad-newline (insert "\n"))
(when padline (insert "\n"))
(comment-region (point) (progn (insert text) (point)))
(end-of-line nil) (insert "\n")))))
(when comment (insert-comment comment))
(when link-p
(insert-comment
(org-fill-template org-babel-tangle-comment-format-beg link-data)))
(when org-babel-tangle-pad-newline (insert "\n"))
(when padline (insert "\n"))
(insert
(format
"%s\n"
@ -393,7 +417,24 @@ form
(insert-comment
(org-fill-template org-babel-tangle-comment-format-end link-data))))))
;; detangling functions
(defun org-babel-tangle-comment-links ( &optional info)
"Return a list of begin and end link comments for the code block at point."
(let* ((start-line (org-babel-where-is-src-block-head))
(file (buffer-file-name))
(link (org-link-escape (progn (call-interactively 'org-store-link)
(org-babel-clean-text-properties
(car (pop org-stored-links))))))
(source-name (nth 4 (or info (org-babel-get-src-block-info 'light))))
(link-data (mapcar (lambda (el)
(cons (symbol-name el)
((lambda (le)
(if (stringp le) le (format "%S" le)))
(eval el))))
'(start-line file link source-name))))
(list (org-fill-template org-babel-tangle-comment-format-beg link-data)
(org-fill-template org-babel-tangle-comment-format-end link-data))))
;; de-tangling functions
(defvar org-bracket-link-analytic-regexp)
(defun org-babel-detangle (&optional source-code-file)
"Propagate changes in source file back original to Org-mode file.
@ -420,20 +461,24 @@ which enable the original code blocks to be found."
"Jump from a tangled code file to the related Org-mode file."
(interactive)
(let ((mid (point))
target-buffer target-char
start end link path block-name body)
start end done
target-buffer target-char link path block-name body)
(save-window-excursion
(save-excursion
(unless (and (re-search-backward org-bracket-link-analytic-regexp nil t)
(setq start (point-at-eol))
(setq link (match-string 0))
(setq path (match-string 3))
(setq block-name (match-string 5))
(re-search-forward
(concat " " (regexp-quote block-name) " ends here") nil t)
(setq end (point-at-bol))
(< start mid) (< mid end))
(error "not in tangled code"))
(while (and (re-search-backward org-bracket-link-analytic-regexp nil t)
(not ; ever wider searches until matching block comments
(and (setq start (point-at-eol))
(setq link (match-string 0))
(setq path (match-string 3))
(setq block-name (match-string 5))
(save-excursion
(save-match-data
(re-search-forward
(concat " " (regexp-quote block-name)
" ends here") nil t)
(setq end (point-at-bol))))))))
(unless (and start (< start mid) (< mid end))
(error "not in tangled code"))
(setq body (org-babel-trim (buffer-substring start end))))
(when (string-match "::" path)
(setq path (substring path 0 (match-beginning 0))))
@ -449,5 +494,6 @@ which enable the original code blocks to be found."
(provide 'ob-tangle)
;; arch-tag: 413ced93-48f5-4216-86e4-3fc5df8c8f24
;;; ob-tangle.el ends here

708
lisp/org/ob.el
View file

File diff suppressed because it is too large Load diff

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

File diff suppressed because it is too large Load diff

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

@ -1,11 +1,12 @@
;;; org-archive.el --- Archiving for Org-mode
;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -70,6 +71,14 @@ This variable is obsolete and has no effect anymore, instead add or remove
:group 'org-archive
:type 'boolean)
(defcustom org-archive-subtree-add-inherited-tags 'infile
"Non-nil means append inherited tags when archiving a subtree."
:group 'org-archive
:type '(choice
(const :tag "Never" nil)
(const :tag "When archiving a subtree to the same file" infile)
(const :tag "Always" t)))
(defcustom org-archive-save-context-info '(time file olpath category todo itags)
"Parts of context info that should be stored as properties when archiving.
When a subtree is moved to an archive file, it loses information given by
@ -87,7 +96,7 @@ olpath The outline path to the item. These are all headlines above
the current item, separated by /, like a file path.
For each symbol present in the list, a property will be created in
the archived entry, with a prefix \"PRE_ARCHIVE_\", to remember this
the archived entry, with a prefix \"ARCHIVE_\", to remember this
information."
:group 'org-archive
:type '(set :greedy t
@ -156,10 +165,11 @@ if LOCATION is not given, the value of `org-archive-location' is used."
(setq location (or location org-archive-location))
(if (string-match "\\(.*\\)::\\(.*\\)" location)
(if (= (match-beginning 1) (match-end 1))
(buffer-file-name)
(buffer-file-name (buffer-base-buffer))
(expand-file-name
(format (match-string 1 location)
(file-name-nondirectory buffer-file-name))))))
(file-name-nondirectory
(buffer-file-name (buffer-base-buffer))))))))
(defun org-extract-archive-heading (&optional location)
"Extract the heading from archive LOCATION.
@ -167,7 +177,8 @@ if LOCATION is not given, the value of `org-archive-location' is used."
(setq location (or location org-archive-location))
(if (string-match "\\(.*\\)::\\(.*\\)" location)
(format (match-string 2 location)
(file-name-nondirectory buffer-file-name))))
(file-name-nondirectory
(buffer-file-name (buffer-base-buffer))))))
(defun org-archive-subtree (&optional find-done)
"Move the current subtree to the archive.
@ -193,21 +204,24 @@ this heading."
(tr-org-todo-line-regexp org-todo-line-regexp)
(tr-org-odd-levels-only org-odd-levels-only)
(this-buffer (current-buffer))
;; start of variables that will be used for saving context
;; start of variables that will be used for saving context
;; The compiler complains about them - keep them anyway!
(file (abbreviate-file-name (buffer-file-name)))
(file (abbreviate-file-name
(or (buffer-file-name (buffer-base-buffer))
(error "No file associated to buffer"))))
(olpath (mapconcat 'identity (org-get-outline-path) "/"))
(time (format-time-string
(substring (cdr org-time-stamp-formats) 1 -1)
(current-time)))
category todo priority ltags itags
;; end of variables that will be used for saving context
location afile heading buffer level newfile-p visiting)
category todo priority ltags itags atags
;; end of variables that will be used for saving context
location afile heading buffer level newfile-p infile-p visiting)
;; Find the local archive location
(setq location (org-get-local-archive-location)
afile (org-extract-archive-file location)
heading (org-extract-archive-heading location))
heading (org-extract-archive-heading location)
infile-p (equal file (abbreviate-file-name afile)))
(unless afile
(error "Invalid `org-archive-location'"))
@ -225,14 +239,14 @@ this heading."
(save-excursion
(org-back-to-heading t)
;; Get context information that will be lost by moving the tree
(org-refresh-category-properties)
(setq category (org-get-category)
(setq category (org-get-category nil 'force-refresh)
todo (and (looking-at org-todo-line-regexp)
(match-string 2))
priority (org-get-priority
(if (match-end 3) (match-string 3) ""))
ltags (org-get-tags)
itags (org-delete-all ltags (org-get-tags-at)))
itags (org-delete-all ltags (org-get-tags-at))
atags (org-get-tags-at))
(setq ltags (mapconcat 'identity ltags " ")
itags (mapconcat 'identity itags " "))
;; We first only copy, in case something goes wrong
@ -289,7 +303,12 @@ this heading."
(goto-char (point-max)) (insert "\n"))
;; Paste
(org-paste-subtree (org-get-valid-level level (and heading 1)))
;; Shall we append inherited tags?
(and itags
(or (and (eq org-archive-subtree-add-inherited-tags 'infile)
infile-p)
(eq org-archive-subtree-add-inherited-tags t))
(org-set-tags-to atags))
;; Mark the entry as done
(when (and org-archive-mark-done
(looking-at org-todo-line-regexp)
@ -311,8 +330,7 @@ this heading."
;; Save and kill the buffer, if it is not the same buffer.
(when (not (eq this-buffer buffer))
(save-buffer))
))
(save-buffer))))
;; Here we are back in the original buffer. Everything seems to have
;; worked. So now cut the tree and finish up.
(let (this-command) (org-cut-subtree))
@ -388,7 +406,7 @@ sibling does not exist, it will be created at the end of the subtree."
If the cursor is not on a headline, try all level 1 trees. If
it is on a headline, try all direct children.
When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag."
(let ((re (concat "^\\*+ +" org-not-done-regexp)) re1
(let ((re (concat org-outline-regexp-bol "+" org-not-done-regexp)) re1
(rea (concat ".*:" org-archive-tag ":"))
(begm (make-marker))
(endm (make-marker))
@ -465,5 +483,6 @@ This command is set with the variable `org-archive-default-command'."
(provide 'org-archive)
;; arch-tag: 0837f601-9699-43c3-8b90-631572ae6c85
;;; org-archive.el ends here

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

@ -1,11 +1,12 @@
;;; org-ascii.el --- ASCII export for Org-mode
;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -37,7 +38,7 @@
:tag "Org Export ASCII"
:group 'org-export)
(defcustom org-export-ascii-underline '(?\$ ?\# ?^ ?\~ ?\= ?\-)
(defcustom org-export-ascii-underline '(?\- ?\= ?\~ ?^ ?\# ?\$)
"Characters for underlining headings in ASCII export.
In the given sequence, these characters will be used for level 1, 2, ..."
:group 'org-export-ascii
@ -95,29 +96,30 @@ utf8 Use all UTF-8 characters")
(defun org-export-as-latin1 (&rest args)
"Like `org-export-as-ascii', use latin1 encoding for special symbols."
(interactive)
(org-export-as-encoding 'org-export-as-ascii (interactive-p)
(org-export-as-encoding 'org-export-as-ascii (org-called-interactively-p 'any)
'latin1 args))
;;;###autoload
(defun org-export-as-latin1-to-buffer (&rest args)
"Like `org-export-as-ascii-to-buffer', use latin1 encoding for symbols."
(interactive)
(org-export-as-encoding 'org-export-as-ascii-to-buffer (interactive-p)
'latin1 args))
(org-export-as-encoding 'org-export-as-ascii-to-buffer
(org-called-interactively-p 'any) 'latin1 args))
;;;###autoload
(defun org-export-as-utf8 (&rest args)
"Like `org-export-as-ascii', use use encoding for special symbols."
"Like `org-export-as-ascii', use encoding for special symbols."
(interactive)
(org-export-as-encoding 'org-export-as-ascii (interactive-p)
(org-export-as-encoding 'org-export-as-ascii
(org-called-interactively-p 'any)
'utf8 args))
;;;###autoload
(defun org-export-as-utf8-to-buffer (&rest args)
"Like `org-export-as-ascii-to-buffer', use utf8 encoding for symbols."
(interactive)
(org-export-as-encoding 'org-export-as-ascii-to-buffer (interactive-p)
'utf8 args))
(org-export-as-encoding 'org-export-as-ascii-to-buffer
(org-called-interactively-p 'any) 'utf8 args))
(defun org-export-as-encoding (command interactivep encoding &rest args)
(let ((org-export-ascii-entities encoding))
@ -175,7 +177,7 @@ a Lisp program could call this function in the following way:
When called interactively, the output buffer is selected, and shown
in a window. A non-interactive call will only return the buffer."
(interactive "r\nP")
(when (interactive-p)
(when (org-called-interactively-p 'any)
(setq buffer "*Org ASCII Export*"))
(let ((transient-mark-mode t) (zmacs-regions t)
ext-plist rtn)
@ -187,7 +189,7 @@ in a window. A non-interactive call will only return the buffer."
nil nil ext-plist
buffer body-only))
(if (fboundp 'deactivate-mark) (deactivate-mark))
(if (and (interactive-p) (bufferp rtn))
(if (and (org-called-interactively-p 'any) (bufferp rtn))
(switch-to-buffer-other-window rtn)
rtn)))
@ -290,10 +292,12 @@ publishing directory."
(buffer-substring
(if (org-region-active-p) (region-beginning) (point-min))
(if (org-region-active-p) (region-end) (point-max))))
(org-export-footnotes-seen nil)
(org-export-footnotes-data (org-footnote-all-labels 'with-defs))
(lines (org-split-string
(org-export-preprocess-string
region
:for-ascii t
:for-backend 'ascii
:skip-before-1st-heading
(plist-get opt-plist :skip-before-1st-heading)
:drawers (plist-get opt-plist :drawers)
@ -302,6 +306,7 @@ publishing directory."
:footnotes (plist-get opt-plist :footnotes)
:timestamps (plist-get opt-plist :timestamps)
:todo-keywords (plist-get opt-plist :todo-keywords)
:tasks (plist-get opt-plist :tasks)
:verbatim-multiline t
:select-tags (plist-get opt-plist :select-tags)
:exclude-tags (plist-get opt-plist :exclude-tags)
@ -369,61 +374,61 @@ publishing directory."
(push (concat (nth 3 lang-words) "\n") thetoc)
(push (concat (make-string (string-width (nth 3 lang-words)) ?=)
"\n") thetoc)
(mapc (lambda (line)
(if (string-match org-todo-line-regexp
line)
;; This is a headline
(progn
(setq have-headings t)
(setq level (- (match-end 1) (match-beginning 1)
level-offset)
level (org-tr-level level)
txt (match-string 3 line)
todo
(or (and org-export-mark-todo-in-toc
(match-beginning 2)
(not (member (match-string 2 line)
org-done-keywords)))
(mapc #'(lambda (line)
(if (string-match org-todo-line-regexp
line)
;; This is a headline
(progn
(setq have-headings t)
(setq level (- (match-end 1) (match-beginning 1)
level-offset)
level (org-tr-level level)
txt (match-string 3 line)
todo
(or (and org-export-mark-todo-in-toc
(match-beginning 2)
(not (member (match-string 2 line)
org-done-keywords)))
; TODO, not DONE
(and org-export-mark-todo-in-toc
(= level umax-toc)
(org-search-todo-below
line lines level))))
(setq txt (org-html-expand-for-ascii txt))
(and org-export-mark-todo-in-toc
(= level umax-toc)
(org-search-todo-below
line lines level))))
(setq txt (org-html-expand-for-ascii txt))
(while (string-match org-bracket-link-regexp txt)
(setq txt
(replace-match
(match-string (if (match-end 2) 3 1) txt)
t t txt)))
(while (string-match org-bracket-link-regexp txt)
(setq txt
(replace-match
(match-string (if (match-end 2) 3 1) txt)
t t txt)))
(if (and (memq org-export-with-tags '(not-in-toc nil))
(string-match
(org-re "[ \t]+:[[:alnum:]_@#%:]+:[ \t]*$")
txt))
(setq txt (replace-match "" t t txt)))
(if (string-match quote-re0 txt)
(setq txt (replace-match "" t t txt)))
(if (and (memq org-export-with-tags '(not-in-toc nil))
(string-match
(org-re "[ \t]+:[[:alnum:]_@#%:]+:[ \t]*$")
txt))
(setq txt (replace-match "" t t txt)))
(if (string-match quote-re0 txt)
(setq txt (replace-match "" t t txt)))
(if org-export-with-section-numbers
(setq txt (concat (org-section-number level)
" " txt)))
(if (<= level umax-toc)
(progn
(push
(concat
(make-string
(* (max 0 (- level org-min-level)) 4) ?\ )
(format (if todo "%s (*)\n" "%s\n") txt))
thetoc)
(setq org-last-level level))
))))
(if org-export-with-section-numbers
(setq txt (concat (org-section-number level)
" " txt)))
(if (<= level umax-toc)
(progn
(push
(concat
(make-string
(* (max 0 (- level org-min-level)) 4) ?\ )
(format (if todo "%s (*)\n" "%s\n") txt))
thetoc)
(setq org-last-level level))
))))
lines)
(setq thetoc (if have-headings (nreverse thetoc) nil))))
(org-init-section-numbers)
(while (setq line (pop lines))
(when (and link-buffer (string-match "^\\*+ " line))
(when (and link-buffer (string-match org-outline-regexp-bol line))
(org-export-ascii-push-links (nreverse link-buffer))
(setq link-buffer nil))
(setq wrap nil)
@ -576,8 +581,8 @@ publishing directory."
(replace-match "\\1\\2")))
;; Remove list start counters
(goto-char (point-min))
(while (org-search-forward-unenclosed
"\\[@\\(?:start:\\)?[0-9]+\\][ \t]*" nil t)
(while (org-list-search-forward
"\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*" nil t)
(replace-match ""))
(remove-text-properties
(point-min) (point-max)
@ -624,7 +629,9 @@ publishing directory."
(save-match-data
(if (save-excursion
(re-search-backward
"^\\(\\([ \t]*\\)\\|\\(\\*+ \\)\\)[^ \t\n]" nil t))
(concat "^\\(\\([ \t]*\\)\\|\\("
org-outline-regexp
"\\)\\)[^ \t\n]") nil t))
(setq ind (or (match-string 2)
(make-string (length (match-string 3)) ?\ )))))
(mapc (lambda (x) (insert ind "[" (car x) "]: " (cdr x) "\n"))
@ -651,7 +658,8 @@ publishing directory."
(if (or (not (equal (char-before) ?\n))
(not (equal (char-before (1- (point))) ?\n)))
(insert "\n"))
(setq char (nth (- umax level) (reverse org-export-ascii-underline)))
(setq char (or (nth (1- level) org-export-ascii-underline)
(car (last org-export-ascii-underline))))
(unless org-export-with-tags
(if (string-match (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title)
(setq title (replace-match "" t t title))))
@ -718,4 +726,5 @@ publishing directory."
(provide 'org-ascii)
;; arch-tag: aa96f882-f477-4e13-86f5-70d43e7adf3c
;;; org-ascii.el ends here

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

@ -1,10 +1,10 @@
;;; org-attach.el --- Manage file attachments to org-mode tasks
;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@newartisans.com>
;; Keywords: org data task
;; Version: 7.4
;; Version: 7.7
;; This file is part of GNU Emacs.
;;
@ -96,10 +96,17 @@ ln create a hard link. Note that this is not supported
:group 'org-attach
:type 'boolean)
(defvar org-attach-inherited nil
"Indicates if the last access to the attachment directory was inherited.")
(defcustom org-attach-store-link-p nil
"Non-nil means store a link to a file when attaching it."
:group 'org-attach
:type '(choice
(const :tag "Don't store link" nil)
(const :tag "Link to origin location" t)
(const :tag "Link to the attach-dir location" 'attached)))
;;;###autoload
(defun org-attach ()
"The dispatcher for attachment commands.
@ -246,10 +253,10 @@ This checks for the existence of a \".git\" directory in that directory."
(cd dir)
(shell-command "git add .")
(shell-command "git ls-files --deleted" t)
(mapc (lambda (file)
(unless (string= file "")
(shell-command
(concat "git rm \"" file "\""))))
(mapc #'(lambda (file)
(unless (string= file "")
(shell-command
(concat "git rm \"" file "\""))))
(split-string (buffer-string) "\n"))
(shell-command "git commit -m 'Synchronized attachments'")))))
@ -264,6 +271,14 @@ This checks for the existence of a \".git\" directory in that directory."
"Turn the autotag off."
(org-attach-tag 'off))
(defun org-attach-store-link (file)
"Add a link to `org-stored-link' when attaching a file.
Only do this when `org-attach-store-link-p' is non-nil."
(setq org-stored-links
(cons (list (org-attach-expand-link file)
(file-name-nondirectory file))
org-stored-links)))
(defun org-attach-attach (file &optional visit-dir method)
"Move/copy/link FILE into the attachment directory of the current task.
If VISIT-DIR is non-nil, visit the directory with dired.
@ -282,6 +297,10 @@ METHOD may be `cp', `mv', or `ln', default taken from `org-attach-method'."
((eq method 'ln) (add-name-to-file file fname)))
(org-attach-commit)
(org-attach-tag)
(cond ((eq org-attach-store-link-p 'attached)
(org-attach-store-link fname))
((eq org-attach-store-link-p t)
(org-attach-store-link file)))
(if visit-dir
(dired attach-dir)
(message "File \"%s\" is now a task attachment." basename)))))
@ -418,4 +437,5 @@ prefix."
(provide 'org-attach)
;; arch-tag: fce93c2e-fe07-4fa3-a905-e10dcc7a6248
;;; org-attach.el ends here

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

@ -1,12 +1,13 @@
;;; org-bbdb.el --- Support for links to BBDB entries from within Org-mode
;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>,
;; Thomas Baumann <thomas dot baumann at ch dot tum dot de>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -135,12 +136,12 @@
'(("birthday" lambda
(name years suffix)
(concat "Birthday: [[bbdb:" name "][" name " ("
(number-to-string years)
(format "%s" years) ; handles numbers as well as strings
suffix ")]]"))
("wedding" lambda
(name years suffix)
(concat "[[bbdb:" name "][" name "'s "
(number-to-string years)
(format "%s" years)
suffix " wedding anniversary]]")))
"How different types of anniversaries should be formatted.
An alist of elements (STRING . FORMAT) where STRING is the name of an
@ -207,10 +208,12 @@ date year)."
"Create the export version of a BBDB link specified by PATH or DESC.
If exporting to either HTML or LaTeX FORMAT the link will be
italicized, in all other cases it is left unchanged."
(when (string= desc (format "bbdb:%s" path))
(setq desc path))
(cond
((eq format 'html) (format "<i>%s</i>" (or desc path)))
((eq format 'latex) (format "\\textit{%s}" (or desc path)))
(t (or desc path))))
((eq format 'html) (format "<i>%s</i>" desc))
((eq format 'latex) (format "\\textit{%s}" desc))
(t desc)))
(defun org-bbdb-open (name)
"Follow a BBDB link to NAME."
@ -238,11 +241,16 @@ italicized, in all other cases it is left unchanged."
(defun org-bbdb-anniv-extract-date (time-str)
"Convert YYYY-MM-DD to (month date year).
Argument TIME-STR is the value retrieved from BBDB."
(multiple-value-bind (y m d) (values-list (bbdb-split time-str "-"))
(list (string-to-number m)
(string-to-number d)
(string-to-number y))))
Argument TIME-STR is the value retrieved from BBDB. If YYYY- is omitted
it will be considered unknown."
(multiple-value-bind (a b c) (values-list (bbdb-split time-str "-"))
(if (eq c nil)
(list (string-to-number a)
(string-to-number b)
nil)
(list (string-to-number b)
(string-to-number c)
(string-to-number a)))))
(defun org-bbdb-anniv-split (str)
"Split multiple entries in the BBDB anniversary field.
@ -325,8 +333,12 @@ This is used by Org to re-create the anniversary hash table."
class org-bbdb-anniversary-format-alist t))
class)) ; (as format string)
(name (nth 1 rec))
(years (- y (car rec)))
(suffix (diary-ordinal-suffix years))
(years (if (eq (car rec) nil)
"unknown"
(- y (car rec))))
(suffix (if (eq (car rec) nil)
""
(diary-ordinal-suffix years)))
(tmp (cond
((functionp form)
(funcall form name years suffix))
@ -380,5 +392,6 @@ END:VEVENT\n"
(provide 'org-bbdb)
;; arch-tag: 9e4f275d-d080-48c1-b040-62247f66b5c2
;;; org-bbdb.el ends here

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

@ -1,8 +1,8 @@
;;; org-beamer.el --- Beamer-specific LaTeX export for org-mode
;;
;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;;
;; Version: 7.4
;; Version: 7.7
;; Author: Carsten Dominik <carsten.dominik AT gmail DOT com>
;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com>
;; Keywords: org, wp, tex
@ -139,6 +139,7 @@ open The opening template for the environment, with the following escapes
%h the headline text
%H if there is headline text, that text in {} braces
%U if there is headline text, that text in [] brackets
%x the content of the BEAMER_extra property
close The closing string of the environment."
:group 'org-beamer
@ -399,7 +400,7 @@ the value will be inserted right after the documentclass statement."
(insert org-beamer-header-extra)
(or (bolp) (insert "\n"))))))
(defcustom org-beamer-fragile-re "^[ \t]*\\\\begin{\\(verbatim\\|lstlisting\\)}"
(defcustom org-beamer-fragile-re "^[ \t]*\\\\begin{\\(verbatim\\|lstlisting\\|minted\\)}"
"If this regexp matches in a frame, the frame is marked as fragile."
:group 'org-beamer
:type 'regexp)
@ -631,5 +632,6 @@ include square brackets."
(provide 'org-beamer)
;; arch-tag: 68bac91a-a946-43a3-8173-a9269306f67c
;;; org-beamer.el ends here

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

@ -1,11 +1,12 @@
;;; org-bibtex.el --- Org links to BibTeX entries
;;
;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
;; Copyright (C) 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
;;
;; Author: Bastien Guerry <bzg at altern dot org>
;; Carsten Dominik <carsten dot dominik at gmail dot com>
;; Eric Schulte <schulte dot eric at gmail dot com>
;; Keywords: org, wp, remember
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -66,12 +67,30 @@
;; =====================================================================
;; * READ <== [point here]
;;
;; [[file:/file.bib::dolev83][Dolev & Yao 1983: security of public key protocols]]
;; [[file:file.bib::dolev83][Dolev & Yao 1983: security of public key protocols]]
;;
;; Danny Dolev and Andrew C. Yao (1983): On the security of public-key protocols
;; In IEEE Transaction on Information Theory, 198--208.
;; =====================================================================
;;
;; Additionally, the following functions are now available for storing
;; bibtex entries within Org-mode documents.
;;
;; - Run `org-bibtex' to export the current file to a .bib.
;;
;; - Run `org-bibtex-check' or `org-bibtex-check-all' to check and
;; fill in missing field of either the current, or all headlines
;;
;; - Run `org-bibtex-create' to add a bibtex entry
;;
;; - Use `org-bibtex-read' to read a bibtex entry after `point' or in
;; the active region, then call `org-bibtex-write' in a .org file to
;; insert a heading for the read bibtex entry
;;
;; - All Bibtex information is taken from the document compiled by
;; Andrew Roberts from the Bibtex manual, available at
;; http://www.andy-roberts.net/misc/latex/sessions/bibtex/bibentries.pdf
;;
;;; History:
;;
;; The link creation part has been part of Org-mode for a long time.
@ -80,34 +99,321 @@
;; of Austin Frank: http://article.gmane.org/gmane.emacs.orgmode/4112
;; and then implemented by Bastien Guerry.
;;
;; Eric Schulte eventually added the functions for translating between
;; Org-mode headlines and Bibtex entries, and for fleshing out the Bibtex
;; fields of existing Org-mode headlines.
;;
;; Org-mode loads this module by default - if this is not what you want,
;; configure the variable `org-modules'.
;;; Code:
(require 'org)
(require 'bibtex)
(eval-when-compile
(require 'cl))
(defvar description nil) ; dynamically scoped from org.el
(defvar org-id-locations)
(declare-function bibtex-beginning-of-entry "bibtex" ())
(declare-function bibtex-generate-autokey "bibtex" ())
(declare-function bibtex-parse-entry "bibtex" (&optional content))
(declare-function bibtex-url "bibtex" (&optional pos no-browse))
(declare-function longlines-mode "longlines" (&optional arg))
(declare-function org-babel-trim "ob" (string &optional regexp))
;;; Bibtex data
(defvar org-bibtex-types
'((:article
(:description . "An article from a journal or magazine")
(:required :author :title :journal :year)
(:optional :volume :number :pages :month :note))
(:book
(:description . "A book with an explicit publisher")
(:required (:editor :author) :title :publisher :year)
(:optional (:volume :number) :series :address :edition :month :note))
(:booklet
(:description . "A work that is printed and bound, but without a named publisher or sponsoring institution.")
(:required :title)
(:optional :author :howpublished :address :month :year :note))
(:conference
(:description . "")
(:required :author :title :booktitle :year)
(:optional :editor :pages :organization :publisher :address :month :note))
(:inbook
(:description . "A part of a book, which may be a chapter (or section or whatever) and/or a range of pages.")
(:required (:author :editor) :title (:chapter :pages) :publisher :year)
(:optional :crossref (:volume :number) :series :type :address :edition :month :note))
(:incollection
(:description . "A part of a book having its own title.")
(:required :author :title :booktitle :publisher :year)
(:optional :crossref :editor (:volume :number) :series :type :chapter :pages :address :edition :month :note))
(:inproceedings
(:description . "An article in a conference proceedings")
(:required :author :title :booktitle :year)
(:optional :crossref :editor (:volume :number) :series :pages :address :month :organization :publisher :note))
(:manual
(:description . "Technical documentation.")
(:required :title)
(:optional :author :organization :address :edition :month :year :note))
(:mastersthesis
(:description . "A Master’s thesis.")
(:required :author :title :school :year)
(:optional :type :address :month :note))
(:misc
(:description . "Use this type when nothing else fits.")
(:required)
(:optional :author :title :howpublished :month :year :note))
(:phdthesis
(:description . "A PhD thesis.")
(:required :author :title :school :year)
(:optional :type :address :month :note))
(:proceedings
(:description . "The proceedings of a conference.")
(:required :title :year)
(:optional :editor (:volume :number) :series :address :month :organization :publisher :note))
(:techreport
(:description . "A report published by a school or other institution.")
(:required :author :title :institution :year)
(:optional :type :address :month :note))
(:unpublished
(:description . "A document having an author and title, but not formally published.")
(:required :author :title :note)
(:optional :month :year)))
"Bibtex entry types with required and optional parameters.")
(defvar org-bibtex-fields
'((:address . "Usually the address of the publisher or other type of institution. For major publishing houses, van Leunen recommends omitting the information entirely. For small publishers, on the other hand, you can help the reader by giving the complete address.")
(:annote . "An annotation. It is not used by the standard bibliography styles, but may be used by others that produce an annotated bibliography.")
(:author . "The name(s) of the author(s), in the format described in the LaTeX book. Remember, all names are separated with the and keyword, and not commas.")
(:booktitle . "Title of a book, part of which is being cited. See the LaTeX book for how to type titles. For book entries, use the title field instead.")
(:chapter . "A chapter (or section or whatever) number.")
(:crossref . "The database key of the entry being cross referenced.")
(:edition . "The edition of a book for example, 'Second'. This should be an ordinal, and should have the first letter capitalized, as shown here; the standard styles convert to lower case when necessary.")
(:editor . "Name(s) of editor(s), typed as indicated in the LaTeX book. If there is also an author field, then the editor field gives the editor of the book or collection in which the reference appears.")
(:howpublished . "How something strange has been published. The first word should be capitalized.")
(:institution . "The sponsoring institution of a technical report.")
(:journal . "A journal name.")
(:key . "Used for alphabetizing, cross-referencing, and creating a label when the author information is missing. This field should not be confused with the key that appears in the \cite command and at the beginning of the database entry.")
(:month . "The month in which the work was published or, for an unpublished work, in which it was written. You should use the standard three-letter abbreviation,")
(:note . "Any additional information that can help the reader. The first word should be capitalized.")
(:number . "Any additional information that can help the reader. The first word should be capitalized.")
(:organization . "The organization that sponsors a conference or that publishes a manual.")
(:pages . "One or more page numbers or range of numbers, such as 42-111 or 7,41,73-97 or 43+ (the ‘+’ in this last example indicates pages following that don’t form simple range). BibTEX requires double dashes for page ranges (--).")
(:publisher . "The publisher’s name.")
(:school . "The name of the school where a thesis was written.")
(:series . "The name of a series or set of books. When citing an entire book, the the title field gives its title and an optional series field gives the name of a series or multi-volume set in which the book is published.")
(:title . "The work’s title, typed as explained in the LaTeX book.")
(:type . "The type of a technical report for example, 'Research Note'.")
(:volume . "The volume of a journal or multi-volume book.")
(:year . "The year of publication or, for an unpublished work, the year it was written. Generally it should consist of four numerals, such as 1984, although the standard styles can handle any year whose last four nonpunctuation characters are numerals, such as '(about 1984)'"))
"Bibtex fields with descriptions.")
(defvar *org-bibtex-entries* nil
"List to hold parsed bibtex entries.")
(defcustom org-bibtex-autogen-keys nil
"Set to a truthy value to use `bibtex-generate-autokey' to generate keys."
:group 'org-bibtex
:type 'boolean)
(defcustom org-bibtex-prefix nil
"Optional prefix for all bibtex property names.
For example setting to 'BIB_' would allow interoperability with fireforg."
:group 'org-bibtex
:type 'string)
(defcustom org-bibtex-treat-headline-as-title t
"Treat headline text as title if title property is absent.
If an entry is missing a title property, use the headline text as
the property. If this value is t, `org-bibtex-check' will ignore
a missing title field."
:group 'org-bibtex
:type 'boolean)
(defcustom org-bibtex-export-arbitrary-fields nil
"When converting to bibtex allow fields not defined in `org-bibtex-fields'.
This only has effect if `org-bibtex-prefix' is defined, so as to
ensure that other org-properties, such as CATEGORY or LOGGING are
not placed in the exported bibtex entry."
:group 'org-bibtex
:type 'boolean)
(defcustom org-bibtex-key-property "CUSTOM_ID"
"Property that holds the bibtex key.
By default, this is CUSTOM_ID, which enables easy linking to
bibtex headlines from within an org file. This can be set to ID
to enable global links, but only with great caution, as global
IDs must be unique."
:group 'org-bibtex
:type 'string)
(defcustom org-bibtex-tags nil
"List of tag(s) that should be added to new bib entries."
:group 'org-bibtex
:type '(repeat :tag "Tag" (string)))
(defcustom org-bibtex-tags-are-keywords nil
"Convert the value of the keywords field to tags and vice versa.
If set to t, comma-separated entries in a bibtex entry's keywords
field will be converted to org tags. Note: spaces will be escaped
with underscores, and characters that are not permitted in org
tags will be removed.
If t, local tags in an org entry will be exported as a
comma-separated string of keywords when exported to bibtex. Tags
defined in `org-bibtex-tags' or `org-bibtex-no-export-tags' will
not be exported."
:group 'org-bibtex
:type 'boolean)
(defcustom org-bibtex-no-export-tags nil
"List of tag(s) that should not be converted to keywords.
This variable is relevant only if `org-bibtex-export-tags-as-keywords` is t."
:group 'org-bibtex
:type '(repeat :tag "Tag" (string)))
;;; Utility functions
(defun org-bibtex-get (property)
((lambda (it) (when it (org-babel-trim it)))
(or (org-entry-get (point) (upcase property))
(org-entry-get (point) (concat org-bibtex-prefix (upcase property))))))
(defun org-bibtex-put (property value)
(let ((prop (upcase (if (keywordp property)
(substring (symbol-name property) 1)
property))))
(org-set-property
(concat (unless (string= org-bibtex-key-property prop) org-bibtex-prefix)
prop)
value)))
(defun org-bibtex-headline ()
"Return a bibtex entry of the given headline as a string."
(flet ((val (key lst) (cdr (assoc key lst)))
(to (string) (intern (concat ":" string)))
(from (key) (substring (symbol-name key) 1))
(flatten (&rest lsts)
(apply #'append (mapcar
(lambda (e)
(if (listp e) (apply #'flatten e) (list e)))
lsts))))
(let ((notes (buffer-string))
(id (org-bibtex-get org-bibtex-key-property))
(type (org-bibtex-get "type"))
(tags (when org-bibtex-tags-are-keywords
(delq nil
(mapcar
(lambda (tag)
(unless (member tag
(append org-bibtex-tags
org-bibtex-no-export-tags))
tag))
(org-get-local-tags-at))))))
(when type
(let ((entry (format
"@%s{%s,\n%s\n}\n" type id
(mapconcat
(lambda (pair) (format " %s={%s}" (car pair) (cdr pair)))
(remove nil
(if (and org-bibtex-export-arbitrary-fields
org-bibtex-prefix)
(mapcar
(lambda (kv)
(let ((key (car kv)) (val (cdr kv)))
(when (and (string-match org-bibtex-prefix key)
(not (string=
(downcase (concat org-bibtex-prefix "TYPE")) (downcase key))))
(cons (downcase (replace-regexp-in-string
org-bibtex-prefix "" key))
val))))
(org-entry-properties nil 'standard))
(mapcar
(lambda (field)
(let ((value (or (org-bibtex-get (from field))
(and (equal :title field)
(nth 4 (org-heading-components))))))
(when value (cons (from field) value))))
(flatten
(val :required (val (to type) org-bibtex-types))
(val :optional (val (to type) org-bibtex-types))))))
",\n"))))
(with-temp-buffer
(insert entry)
(when tags
(bibtex-beginning-of-entry)
(if (re-search-forward "keywords.*=.*{\\(.*\\)}" nil t)
(progn (goto-char (match-end 1)) (insert ", "))
(bibtex-make-field "keywords" t t))
(insert (mapconcat #'identity tags ", ")))
(bibtex-reformat) (buffer-string)))))))
(defun org-bibtex-ask (field)
(unless (assoc field org-bibtex-fields)
(error "field:%s is not known" field))
(save-window-excursion
(let* ((name (substring (symbol-name field) 1))
(buf-name (format "*Bibtex Help %s*" name)))
(with-output-to-temp-buffer buf-name
(princ (cdr (assoc field org-bibtex-fields))))
(with-current-buffer buf-name (longlines-mode t))
(org-fit-window-to-buffer (get-buffer-window buf-name))
((lambda (result) (when (> (length result) 0) result))
(read-from-minibuffer (format "%s: " name))))))
(defun org-bibtex-autokey ()
"Generate an autokey for the current headline"
(org-bibtex-put org-bibtex-key-property
(if org-bibtex-autogen-keys
(let* ((entry (org-bibtex-headline))
(key
(with-temp-buffer
(insert entry)
(bibtex-generate-autokey))))
;; test for duplicate IDs if using global ID
(when (and
(equal org-bibtex-key-property "ID")
(featurep 'org-id)
(hash-table-p org-id-locations)
(gethash key org-id-locations))
(warn "Another entry has the same ID"))
key)
(read-from-minibuffer "id: "))))
(defun org-bibtex-fleshout (type &optional optional)
"Fleshout the current heading, ensuring that all required fields are present.
With optional argument OPTIONAL, also prompt for optional fields."
(flet ((val (key lst) (cdr (assoc key lst)))
(keyword (name) (intern (concat ":" (downcase name))))
(name (keyword) (substring (symbol-name keyword) 1)))
(dolist (field (append
(if org-bibtex-treat-headline-as-title
(remove :title (val :required (val type org-bibtex-types)))
(val :required (val type org-bibtex-types)))
(when optional (val :optional (val type org-bibtex-types)))))
(when (consp field) ; or'd pair of fields e.g., (:editor :author)
(let ((present (first (remove nil
(mapcar
(lambda (f) (when (org-bibtex-get (name f)) f))
field)))))
(setf field (or present (keyword (org-icompleting-read
"Field: " (mapcar #'name field)))))))
(let ((name (name field)))
(unless (org-bibtex-get name)
(let ((prop (org-bibtex-ask field)))
(when prop (org-bibtex-put name prop)))))))
(when (and type (assoc type org-bibtex-types)
(not (org-bibtex-get org-bibtex-key-property)))
(org-bibtex-autokey)))
;;; Bibtex link functions
(org-add-link-type "bibtex" 'org-bibtex-open)
(add-hook 'org-store-link-functions 'org-bibtex-store-link)
;; (defun org-bibtex-publish (path)
;; "Build the description of the BibTeX entry for publishing."
;; (let* ((search (when (string-match "::\\(.+\\)\\'" path)
;; (match-string 1 path)))
;; (path (substring path 0 (match-beginning 0)))
;; key)
;; (with-temp-buffer
;; (org-open-file path t nil search)
;; (setq key (org-create-file-search-functions)))
;; (or description key)))
(defun org-bibtex-open (path)
"Visit the bibliography entry on PATH."
(let* ((search (when (string-match "::\\(.+\\)\\'" path)
@ -192,13 +498,150 @@
(goto-char p)
(bibtex-url)))
(recenter 0)) ; Move entry start to beginning of window
;; return t to indicate that the search is done.
;; return t to indicate that the search is done.
t))
;; Finally add the link search function to the right hook.
(add-hook 'org-execute-file-search-functions 'org-execute-file-search-in-bibtex)
;;; Bibtex <-> Org-mode headline translation functions
(defun org-bibtex (&optional filename)
"Export each headline in the current file to a bibtex entry.
Headlines are exported using `org-bibtex-export-headline'."
(interactive
(list (read-file-name
"Bibtex file: " nil nil nil
(file-name-nondirectory
(concat (file-name-sans-extension (buffer-file-name)) ".bib")))))
(let ((bibtex-entries (remove nil (org-map-entries #'org-bibtex-headline))))
(with-temp-file filename
(insert (mapconcat #'identity bibtex-entries "\n")))))
(defun org-bibtex-check (&optional optional)
"Check the current headline for required fields.
With prefix argument OPTIONAL also prompt for optional fields."
(interactive "P")
(save-restriction
(org-narrow-to-subtree)
(let ((type ((lambda (name) (when name (intern (concat ":" name))))
(org-bibtex-get "TYPE"))))
(when type (org-bibtex-fleshout type optional)))))
(defun org-bibtex-check-all (&optional optional)
"Check all headlines in the current file.
With prefix argument OPTIONAL also prompt for optional fields."
(interactive) (org-map-entries (lambda () (org-bibtex-check optional))))
(defun org-bibtex-create (&optional arg nonew)
"Create a new entry at the given level.
With a prefix arg, query for optional fields as well.
If nonew is t, add data to the headline of the entry at point."
(interactive "P")
(let* ((type (org-icompleting-read
"Type: " (mapcar (lambda (type)
(substring (symbol-name (car type)) 1))
org-bibtex-types)
nil nil (when nonew (org-bibtex-get "TYPE"))))
(type (if (keywordp type) type (intern (concat ":" type))))
(org-bibtex-treat-headline-as-title (if nonew nil t)))
(unless (assoc type org-bibtex-types)
(error "type:%s is not known" type))
(if nonew
(org-back-to-heading)
(org-insert-heading)
(let ((title (org-bibtex-ask :title)))
(insert title)
(org-bibtex-put "TITLE" title)))
(org-bibtex-put "TYPE" (substring (symbol-name type) 1))
(org-bibtex-fleshout type arg)
(mapc (lambda (tag) (org-toggle-tag tag 'on)) org-bibtex-tags)))
(defun org-bibtex-create-in-current-entry (&optional arg)
"Add bibliographical data to the current entry.
With a prefix arg, query for optional fields."
(interactive "P")
(org-bibtex-create arg t))
(defun org-bibtex-read ()
"Read a bibtex entry and save to `*org-bibtex-entries*'.
This uses `bibtex-parse-entry'."
(interactive)
(flet ((keyword (str) (intern (concat ":" (downcase str))))
(clean-space (str) (replace-regexp-in-string
"[[:space:]\n\r]+" " " str))
(strip-delim (str) ; strip enclosing "..." and {...}
(dolist (pair '((34 . 34) (123 . 125) (123 . 125)))
(when (and (= (aref str 0) (car pair))
(= (aref str (1- (length str))) (cdr pair)))
(setf str (substring str 1 (1- (length str)))))) str))
(push (mapcar
(lambda (pair)
(cons (let ((field (keyword (car pair))))
(case field
(:=type= :type)
(:=key= :key)
(otherwise field)))
(clean-space (strip-delim (cdr pair)))))
(save-excursion (bibtex-beginning-of-entry) (bibtex-parse-entry)))
*org-bibtex-entries*)))
(defun org-bibtex-write ()
"Insert a heading built from the first element of `*org-bibtex-entries*'."
(interactive)
(when (= (length *org-bibtex-entries*) 0)
(error "No entries in `*org-bibtex-entries*'."))
(let ((entry (pop *org-bibtex-entries*))
(org-special-properties nil)) ; avoids errors with `org-entry-put'
(flet ((val (field) (cdr (assoc field entry)))
(togtag (tag) (org-toggle-tag tag 'on)))
(org-insert-heading)
(insert (val :title))
(org-bibtex-put "TITLE" (val :title))
(org-bibtex-put "TYPE" (downcase (val :type)))
(dolist (pair entry)
(case (car pair)
(:title nil)
(:type nil)
(:key (org-bibtex-put org-bibtex-key-property (cdr pair)))
(:keywords (if org-bibtex-tags-are-keywords
(mapc
(lambda (kw)
(togtag
(replace-regexp-in-string
"[^[:alnum:]_@#%]" ""
(replace-regexp-in-string "[ \t]+" "_" kw))))
(split-string (cdr pair) ", *"))
(org-bibtex-put (car pair) (cdr pair))))
(otherwise (org-bibtex-put (car pair) (cdr pair)))))
(mapc #'togtag org-bibtex-tags))))
(defun org-bibtex-yank ()
"If kill ring holds a bibtex entry yank it as an Org-mode headline."
(interactive)
(let (entry)
(with-temp-buffer (yank 1) (setf entry (org-bibtex-read)))
(if entry
(org-bibtex-write)
(error "yanked text does not appear to contain a bibtex entry"))))
(defun org-bibtex-export-to-kill-ring ()
"Export current headline to kill ring as bibtex entry."
(interactive)
(kill-new (org-bibtex-headline)))
(defun org-bibtex-search (string)
"Search for bibliographical entries in agenda files.
This function relies `org-search-view' to locate results."
(interactive "sSearch string: ")
(let ((org-agenda-overriding-header "Bib search results:")
(org-agenda-search-view-always-boolean t))
(org-search-view nil
(format "%s +{:%sTYPE:}"
string org-bibtex-prefix))))
(provide 'org-bibtex)
;; arch-tag: 83987d5a-01b8-41c7-85bc-77700f1285f5
;;; org-bibtex.el ends here

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

@ -1,11 +1,11 @@
;;; org-capture.el --- Fast note taking in Org-mode
;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
;; Copyright (C) 2010 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -54,12 +54,16 @@
(require 'org-mks)
(declare-function org-datetree-find-date-create "org-datetree"
(DATE &optional KEEP-RESTRICTION))
(date &optional keep-restriction))
(declare-function org-table-get-specials "org-table" ())
(declare-function org-table-goto-line "org-table" (N))
(declare-function org-pop-to-buffer-same-window "org-compat"
(&optional buffer-or-name norecord label))
(defvar org-remember-default-headline)
(defvar org-remember-templates)
(defvar org-table-hlines)
(defvar dired-buffers)
(defvar org-capture-clock-was-started nil
"Internal flag, noting if the clock was started.")
@ -115,6 +119,11 @@ target Specification of where the captured item should be placed.
become children of this node, other types will be added to the
table or list in the body of this node.
Most target specifications contain a file name. If that file
name is the empty string, it defaults to `org-default-notes-file'.
A file can also be given as a variable, function, or Emacs Lisp
form.
Valid values are:
(file \"path/to/file\")
@ -136,7 +145,7 @@ target Specification of where the captured item should be placed.
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
Will create a heading in a date tree, prompts for date
(file+function \"path/to/file\" function-finding-location)
A function to find the right location in the file
@ -177,51 +186,60 @@ properties are:
:clock-in Start the clock in this item.
:clock-keep Keep the clock running when filing the captured entry.
:clock-resume Start the interrupted clock when finishing the capture.
Note that :clock-keep has precedence over :clock-resume.
When setting both to `t', the current clock will run and
the previous one will not be resumed.
:unnarrowed Do not narrow the target buffer, simply show the
full buffer. Default is to narrow it so that you
only see the new stuff.
:table-line-pos Specification of the location in the table where the
new line should be inserted. It looks like \"II-3\"
which means that the new line should become the third
line before the second horizontal separator line.
new line should be inserted. It should be a string like
\"II-3\", meaning that the new line should become the
third line before the second horizontal separator line.
:kill-buffer If the target file was not yet visited by a buffer when
capture was invoked, kill the buffer again after capture
is finalized.
The template defines the text to be inserted. Often this is an org-mode
entry (so the first line should start with a star) that will be filed as a
child of the target headline. It can also be freely formatted text.
Furthermore, the following %-escapes will be replaced with content:
The template defines the text to be inserted. Often this is an
org-mode entry (so the first line should start with a star) that
will be filed as a child of the target headline. It can also be
freely formatted text. Furthermore, the following %-escapes will
be replaced with content and expanded in this order:
%^{prompt} prompt the user for a string and replace this sequence with it.
A default value and a completion table ca be specified like this:
%^{prompt|default|completion2|completion3|...}
%t time stamp, date only
%T time stamp with date and time
%u, %U like the above, but inactive time stamps
%^t like %t, but prompt for date. Similarly %^T, %^u, %^U.
You may define a prompt like %^{Please specify birthday
%n user name (taken from `user-full-name')
%a annotation, normally the link created with `org-store-link'
%[pathname] insert the contents of the file given by `pathname'.
%(sexp) evaluate elisp `(sexp)' and replace with the result.
%<...> the result of format-time-string on the ... format specification.
%t time stamp, date only.
%T time stamp with date and time.
%u, %U like the above, but inactive time stamps.
%a annotation, normally the link created with `org-store-link'.
%i initial content, copied from the active region. If %i is
indented, the entire inserted text will be indented as well.
%c current kill ring head
%x content of the X clipboard
%^C interactive selection of which kill or clip to use
%^L like %^C, but insert as link
%k title of currently clocked task
%K link to currently clocked task
%^g prompt for tags, with completion on tags in target file
%^G prompt for tags, with completion on all tags in all agenda files
%^{prop}p prompt the user for a value for property `prop'
%:keyword specific information for certain link types, see below
%[pathname] insert the contents of the file given by `pathname'
%(sexp) evaluate elisp `(sexp)' and replace with the result
%A like %a, but prompt for the description part.
%c current kill ring head.
%x content of the X clipboard.
%k title of currently clocked task.
%K link to currently clocked task.
%n user name (taken from `user-full-name').
%f file visited by current buffer when org-capture was called.
%F full path of the file or directory visited by current buffer.
%:keyword specific information for certain link types, see below.
%^g prompt for tags, with completion on tags in target file.
%^G prompt for tags, with completion on all tags in all agenda files.
%^t like %t, but prompt for date. Similarly %^T, %^u, %^U.
You may define a prompt like %^{Please specify birthday.
%^C interactive selection of which kill or clip to use.
%^L like %^C, but insert as link.
%^{prop}p prompt the user for a value for property `prop'.
%^{prompt} prompt the user for a string and replace this sequence with it.
A default value and a completion table ca be specified like this:
%^{prompt|default|completion2|completion3|...}.
%? After completing the template, position cursor here.
Apart from these general escapes, you can access information specific to the
@ -309,13 +327,14 @@ calendar | %:type %:date"
((const :format "%v " :immediate-finish) (const t))
((const :format "%v " :empty-lines) (const 1))
((const :format "%v " :clock-in) (const t))
((const :format "%v " :clock-keep) (const t))
((const :format "%v " :clock-resume) (const t))
((const :format "%v " :unnarrowed) (const t))
((const :format "%v " :kill-buffer) (const t))))))))
(defcustom org-capture-before-finalize-hook nil
"Hook that is run right before a remember process is finalized.
The remember buffer is still current when this hook runs."
"Hook that is run right before a capture process is finalized.
The capture buffer is still current when this hook runs."
:group 'org-capture
:type 'hook)
@ -329,37 +348,55 @@ The remember buffer is still current when this hook runs."
(defvar org-capture-plist nil
"Plist for the current capture process, global, to avoid having to pass it.")
(defvar org-capture-current-plist nil
"Local variable holding the plist in a capture buffer.
This is used to store the plist for use when finishing a capture process.
Another such process might have changed the global variable by then.")
This is used to store the plist for use when finishing a capture process
because another such process might have changed the global variable by then.
Each time a new capture buffer has been set up, the global `org-capture-plist'
is copied to this variable, which is local in the indirect buffer.")
(defvar org-capture-clock-keep nil
"Local variable to store the value of the :clock-keep parameter.
This is needed in case org-capture-finalize is called interactively.")
(defun org-capture-put (&rest stuff)
"Add properties to the capture property list `org-capture-plist'."
(while stuff
(setq org-capture-plist (plist-put org-capture-plist
(pop stuff) (pop stuff)))))
(defun org-capture-get (prop &optional local)
"Get properties from the capture property list `org-capture-plist'.
When LOCAL is set, use the local variable `org-capture-current-plist',
this is necessary after initialization of the capture process,
to avoid conflicts with other active capture processes."
(plist-get (if local org-capture-current-plist org-capture-plist) prop))
(defun org-capture-member (prop)
(plist-get org-capture-plist prop))
(defun org-capture-member (prop &optional local)
"Is PROP a preperty in `org-capture-plist'.
When LOCAL is set, use the local variable `org-capture-current-plist',
this is necessary after initialization of the capture process,
to avoid conflicts with other active capture processes."
(plist-get (if local org-capture-current-plist org-capture-plist) prop))
;;; The minor mode
(defvar org-capture-mode-map (make-sparse-keymap)
"Keymap for `org-capture-mode', a minor mode.
Use this map to set additional keybindings for when Org-mode is used
for a Remember buffer.")
for a capture buffer.")
(defvar org-capture-mode-hook nil
"Hook for the minor `org-capture-mode'.")
(define-minor-mode org-capture-mode
"Minor mode for special key bindings in a remember buffer."
"Minor mode for special key bindings in a capture buffer."
nil " Rem" org-capture-mode-map
(org-set-local
'header-line-format
"Capture buffer. Finish `C-c C-c', refile `C-c C-w', abort `C-c C-k'."))
"Capture buffer. Finish `C-c C-c', refile `C-c C-w', abort `C-c C-k'.")
(run-hooks 'org-capture-mode-hook))
(define-key org-capture-mode-map "\C-c\C-c" 'org-capture-finalize)
(define-key org-capture-mode-map "\C-c\C-k" 'org-capture-kill)
(define-key org-capture-mode-map "\C-c\C-w" 'org-capture-refile)
@ -397,7 +434,7 @@ bypassed."
(annotation (if (and (boundp 'org-capture-link-is-already-stored)
org-capture-link-is-already-stored)
(plist-get org-store-link-plist :annotation)
(org-store-link nil)))
(ignore-errors (org-store-link nil))))
(initial (and (org-region-active-p)
(buffer-substring (point) (mark))))
(entry (org-capture-select-template keys)))
@ -414,7 +451,16 @@ bypassed."
(t
(org-capture-set-plist entry)
(org-capture-get-template)
(org-capture-put :original-buffer orig-buf :annotation annotation
(org-capture-put :original-buffer orig-buf
:original-file (or (buffer-file-name orig-buf)
(and (featurep 'dired)
(car (rassq orig-buf
dired-buffers))))
:original-file-nondirectory
(and (buffer-file-name orig-buf)
(file-name-nondirectory
(buffer-file-name orig-buf)))
:annotation annotation
:initial initial)
(org-capture-put :default-time
(or org-overriding-default-time
@ -426,6 +472,7 @@ bypassed."
(if (get-buffer "*Capture*") (kill-buffer "*Capture*"))
(error "Capture abort: %s" error)))
(setq org-capture-clock-keep (org-capture-get :clock-keep))
(if (equal goto 0)
;;insert at point
(org-capture-insert-template-here)
@ -439,20 +486,19 @@ bypassed."
(error "Capture template `%s': %s"
(org-capture-get :key)
(nth 1 error))))
(if (and (org-mode-p)
(org-capture-get :clock-in))
(condition-case nil
(progn
(if (org-clock-is-active)
(org-capture-put :interrupted-clock
(copy-marker org-clock-marker)))
(org-clock-in)
(org-set-local 'org-capture-clock-was-started t))
(error
"Could not start the clock in this capture buffer")))
(if (org-capture-get :immediate-finish)
(org-capture-finalize)
(if (and (org-mode-p)
(org-capture-get :clock-in))
(condition-case nil
(progn
(if (org-clock-is-active)
(org-capture-put :interrupted-clock
(copy-marker org-clock-marker)))
(org-clock-in)
(org-set-local 'org-capture-clock-was-started t))
(error
"Could not start the clock in this capture buffer")))))))))))
(org-capture-finalize nil)))))))))
(defun org-capture-get-template ()
"Get the template from a file or a function if necessary."
@ -488,8 +534,9 @@ captured item after finalizing."
(> org-clock-marker (point-min))
(< org-clock-marker (point-max)))
;; Looks like the clock we started is still running. Clock out.
(let (org-log-note-clock-out) (org-clock-out))
(when (and (org-capture-get :clock-resume 'local)
(when (not org-capture-clock-keep) (let (org-log-note-clock-out) (org-clock-out)))
(when (and (not org-capture-clock-keep)
(org-capture-get :clock-resume 'local)
(markerp (org-capture-get :interrupted-clock 'local))
(buffer-live-p (marker-buffer
(org-capture-get :interrupted-clock 'local))))
@ -501,13 +548,20 @@ captured item after finalizing."
(let ((beg (point-min))
(end (point-max))
(abort-note nil))
;; Store the size of the capture buffer
(org-capture-put :captured-entry-size (- (point-max) (point-min)))
(widen)
;; Store the insertion point in the target buffer
(org-capture-put :insertion-point (point))
(if org-note-abort
(let ((m1 (org-capture-get :begin-marker 'local))
(m2 (org-capture-get :end-marker 'local)))
(if (and m1 m2 (= m1 beg) (= m2 end))
(progn
(setq m2 (if (cdr (assoc 'heading org-blank-before-new-entry))
m2 (1+ m2))
m2 (if (< (point-max) m2) (point-max) m2))
(setq abort-note 'clean)
(kill-region m1 m2))
(setq abort-note 'dirty)))
@ -533,16 +587,14 @@ captured item after finalizing."
(org-at-table-p))
(if (org-table-get-stored-formulas)
(org-table-recalculate 'all) ;; FIXME: Should we iterate???
(org-table-align)))
)
(org-table-align))))
;; Store this place as the last one where we stored something
;; Do the marking in the base buffer, so that it makes sense after
;; the indirect buffer has been killed.
(org-capture-bookmark-last-stored-position)
;; Run the hook
(run-hooks 'org-capture-before-finalize-hook)
)
(run-hooks 'org-capture-before-finalize-hook))
;; Kill the indirect buffer
(save-buffer)
@ -551,9 +603,30 @@ captured item after finalizing."
(kill-buffer (org-capture-get :kill-buffer 'local))
(base-buffer (buffer-base-buffer (current-buffer))))
;; Kill the indiret buffer
;; Kill the indirect buffer
(kill-buffer (current-buffer))
;; Narrow back the target buffer to its previous state
(with-current-buffer (org-capture-get :buffer)
(let ((reg (org-capture-get :initial-target-region))
(pos (org-capture-get :initial-target-position))
(ipt (org-capture-get :insertion-point))
(size (org-capture-get :captured-entry-size)))
(when reg
(cond ((< ipt (car reg))
;; insertion point is before the narrowed region
(narrow-to-region (+ size (car reg)) (+ size (cdr reg))))
((> ipt (cdr reg))
;; insertion point is after the narrowed region
(narrow-to-region (car reg) (cdr reg)))
(t
;; insertion point is within the narrowed region
(narrow-to-region (car reg) (+ size (cdr reg)))))
;; now place back the point at its original position
(if (< ipt (car reg))
(goto-char (+ size pos))
(goto-char (if (< ipt pos) (+ size pos) pos))))))
;; Kill the target buffer if that is desired
(when (and base-buffer new-buffer kill-buffer)
(with-current-buffer base-buffer (save-buffer))
@ -579,7 +652,7 @@ captured item after finalizing."
(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. Any prefix argument will be passed to the refile comand."
already gone. Any prefix argument will be passed to the refile command."
(interactive)
(unless (eq (org-capture-get :type 'local) 'entry)
(error
@ -601,11 +674,12 @@ already gone. Any prefix argument will be passed to the refile comand."
(interactive)
;; FIXME: This does not do the right thing, we need to remove the new stuff
;; By hand it is easy: undo, then kill the buffer
(let ((org-note-abort t) (org-capture-before-finalize-hook nil))
(let ((org-note-abort t)
(org-capture-before-finalize-hook nil))
(org-capture-finalize)))
(defun org-capture-goto-last-stored ()
"Go to the location where the last remember note was stored."
"Go to the location where the last capture note was stored."
(interactive)
(org-goto-marker-or-bmk org-capture-last-stored-marker
"org-capture-last-stored")
@ -613,6 +687,16 @@ already gone. Any prefix argument will be passed to the refile comand."
;;; Supporting functions for handling the process
(defun org-capture-put-target-region-and-position ()
"Store the initial region with `org-capture-put'."
(org-capture-put
:initial-target-region
;; Check if the buffer is currently narrowed
(when (/= (buffer-size) (- (point-max) (point-min)))
(cons (point-min) (point-max))))
;; store the current point
(org-capture-put :initial-target-position (point)))
(defun org-capture-set-target-location (&optional target)
"Find target buffer and position and store then in the property list."
(let ((target-entry-p t))
@ -621,6 +705,8 @@ already gone. Any prefix argument will be passed to the refile comand."
(cond
((eq (car target) 'file)
(set-buffer (org-capture-target-buffer (nth 1 target)))
(org-capture-put-target-region-and-position)
(widen)
(setq target-entry-p nil))
((eq (car target) 'id)
@ -628,14 +714,20 @@ already gone. Any prefix argument will be passed to the refile comand."
(if (not loc)
(error "Cannot find target ID \"%s\"" (nth 1 target))
(set-buffer (org-capture-target-buffer (car loc)))
(widen)
(org-capture-put-target-region-and-position)
(goto-char (cdr loc)))))
((eq (car target) 'file+headline)
(set-buffer (org-capture-target-buffer (nth 1 target)))
(org-capture-put-target-region-and-position)
(widen)
(let ((hd (nth 2 target)))
(goto-char (point-min))
(unless (org-mode-p)
(error "Target buffer for file+headline should be in Org mode"))
(error
"Target buffer \"%s\" for file+headline should be in Org mode"
(current-buffer)))
(if (re-search-forward
(format org-complex-heading-regexp-format (regexp-quote hd))
nil t)
@ -646,12 +738,18 @@ already gone. Any prefix argument will be passed to the refile comand."
(beginning-of-line 0))))
((eq (car target) 'file+olp)
(let ((m (org-find-olp (cdr target))))
(let ((m (org-find-olp
(cons (org-capture-expand-file (nth 1 target))
(cddr target)))))
(set-buffer (marker-buffer m))
(org-capture-put-target-region-and-position)
(widen)
(goto-char m)))
((eq (car target) 'file+regexp)
(set-buffer (org-capture-target-buffer (nth 1 target)))
(org-capture-put-target-region-and-position)
(widen)
(goto-char (point-min))
(if (re-search-forward (nth 2 target) nil t)
(progn
@ -664,27 +762,32 @@ already gone. Any prefix argument will be passed to the refile comand."
((memq (car target) '(file+datetree file+datetree+prompt))
(require 'org-datetree)
(set-buffer (org-capture-target-buffer (nth 1 target)))
(org-capture-put-target-region-and-position)
(widen)
;; 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
(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)))))
(let ((prompt-time (org-read-date
nil t nil "Date for tree entry:"
(current-time))))
(org-capture-put :prompt-time prompt-time)
(time-to-days prompt-time)))
(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)))
(org-capture-put-target-region-and-position)
(widen)
(funcall (nth 2 target))
(org-capture-put :exact-position (point))
(setq target-entry-p (and (org-mode-p) (org-at-heading-p))))
@ -698,6 +801,8 @@ already gone. Any prefix argument will be passed to the refile comand."
(if (and (markerp org-clock-hd-marker)
(marker-buffer org-clock-hd-marker))
(progn (set-buffer (marker-buffer org-clock-hd-marker))
(org-capture-put-target-region-and-position)
(widen)
(goto-char org-clock-hd-marker))
(error "No running clock that could be used as capture target")))
@ -706,8 +811,20 @@ already gone. Any prefix argument will be passed to the refile comand."
(org-capture-put :buffer (current-buffer) :pos (point)
:target-entry-p target-entry-p))))
(defun org-capture-expand-file (file)
"Expand functions and symbols for FILE.
When FILE is a function, call it. When it is a form, evaluate
it. When it is a variable, retrieve the value. Return whatever we get."
(cond
((org-string-nw-p file) file)
((functionp file) (funcall file))
((and (symbolp file) (boundp file)) (symbol-value file))
((and file (consp file)) (eval file))
(t file)))
(defun org-capture-target-buffer (file)
"Get a buffer for FILE."
(setq file (org-capture-expand-file file))
(setq file (or (org-string-nw-p file)
org-default-notes-file
(error "No notes file specified, and no default available")))
@ -775,6 +892,7 @@ already gone. Any prefix argument will be passed to the refile comand."
(or (bolp) (insert "\n")))))
(org-capture-empty-lines-before)
(setq beg (point))
(org-capture-verify-tree txt)
(org-paste-subtree level txt 'for-yank)
(org-capture-empty-lines-after 1)
(org-capture-position-for-last-stored beg)
@ -803,14 +921,14 @@ already gone. Any prefix argument will be passed to the refile comand."
(if (org-capture-get :prepend)
(progn
(goto-char beg)
(if (org-search-forward-unenclosed org-item-beginning-re end t)
(if (org-list-search-forward (org-item-beginning-re) end t)
(progn
(goto-char (match-beginning 0))
(setq ind (org-get-indentation)))
(goto-char end)
(setq ind 0)))
(goto-char end)
(if (org-search-backward-unenclosed org-item-beginning-re beg t)
(if (org-list-search-backward (org-item-beginning-re) beg t)
(progn
(setq ind (org-get-indentation))
(org-end-of-item))
@ -921,13 +1039,28 @@ already gone. Any prefix argument will be passed to the refile comand."
(org-table-align)))
(defun org-capture-place-plain-text ()
"Place the template plainly."
"Place the template plainly.
If the target locator points at an Org node, place the template into
the text of the entry, before the first child. If not, place the
template at the beginning or end of the file.
Of course, if exact position has been required, just put it there."
(let* ((txt (org-capture-get :template))
beg end)
(goto-char (cond
((org-capture-get :exact-position))
((org-capture-get :prepend) (point-min))
(t (point-max))))
(cond
((org-capture-get :exact-position)
(goto-char (org-capture-get :exact-position)))
((and (org-capture-get :target-entry-p)
(bolp)
(looking-at org-outline-regexp))
;; we should place the text into this entry
(if (org-capture-get :prepend)
;; Skip meta data and drawers
(org-end-of-meta-data-and-drawers)
;; go to ent of the entry text, before the next headline
(outline-next-heading)))
(t
;; beginning or end of file
(goto-char (if (org-capture-get :prepend) (point-min) (point-max)))))
(or (bolp) (newline))
(org-capture-empty-lines-before)
(setq beg (point))
@ -1016,6 +1149,7 @@ Point will remain at the first line after the inserted text."
(setq beg (point))
(cond
((and (eq type 'entry) (org-mode-p))
(org-capture-verify-tree (org-capture-get :template))
(org-paste-subtree nil template t))
((and (memq type '(item checkitem))
(org-mode-p)
@ -1067,7 +1201,7 @@ The user is queried for the template."
(error "No capture template selected"))
(org-capture-set-plist entry)
(org-capture-set-target-location)
(switch-to-buffer (org-capture-get :buffer))
(org-pop-to-buffer-same-window (org-capture-get :buffer))
(goto-char (org-capture-get :pos))))
(defun org-capture-get-indirect-buffer (&optional buffer prefix)
@ -1083,24 +1217,28 @@ Use PREFIX as a prefix for the name of the indirect buffer."
(error (make-indirect-buffer buffer bname)))))
(defun org-capture-verify-tree (tree)
"Throw error if TREE is not a valid tree"
(unless (org-kill-is-subtree-p tree)
(error "Template is not a valid Org entry or tree")))
;;; The template code
(defun org-capture-select-template (&optional keys)
"Select a capture template.
Lisp programs can force the template by setting KEYS to a string."
(if org-capture-templates
(if keys
(or (assoc keys org-capture-templates)
(error "No capture template referred to by \"%s\" keys" keys))
(if (= 1 (length org-capture-templates))
(car org-capture-templates)
(org-mks org-capture-templates
"Select a capture template\n========================="
"Template key: "
'(("C" "Customize org-capture-templates")
("q" "Abort")))))
;; Use an arbitrary default template
'("t" "Task" entry (file+headline "" "Tasks") "* TODO %?\n %u\n %a")))
(let ((org-capture-templates
(or org-capture-templates
'(("t" "Task" entry (file+headline "" "Tasks")
"* TODO %?\n %u\n %a")))))
(if keys
(or (assoc keys org-capture-templates)
(error "No capture template referred to by \"%s\" keys" keys))
(org-mks org-capture-templates
"Select a capture template\n========================="
"Template key: "
'(("C" "Customize org-capture-templates")
("q" "Abort"))))))
(defun org-capture-fill-template (&optional template initial annotation)
"Fill a template and return the filled template as a string.
@ -1155,6 +1293,8 @@ The template may still contain \"%?\" for cursor positioning."
(org-make-link-string
(buffer-file-name (marker-buffer org-clock-marker))
org-clock-heading)))
(v-f (or (org-capture-get :original-file-nondirectory) ""))
(v-F (or (org-capture-get :original-file) ""))
v-I
(org-startup-folded nil)
(org-inhibit-startup t)
@ -1171,7 +1311,7 @@ The template may still contain \"%?\" for cursor positioning."
(sit-for 1))
(save-window-excursion
(delete-other-windows)
(switch-to-buffer (get-buffer-create "*Capture*"))
(org-pop-to-buffer-same-window (get-buffer-create "*Capture*"))
(erase-buffer)
(insert template)
(goto-char (point-min))
@ -1198,16 +1338,18 @@ The template may still contain \"%?\" for cursor positioning."
(goto-char (match-beginning 0))
(let ((template-start (point)))
(forward-char 1)
(let ((result
(condition-case error
(eval (read (current-buffer)))
(error (format "%%![Error: %s]" error)))))
(let ((result (org-eval (read (current-buffer)))))
(delete-region template-start (point))
(insert result)))))
;; The current time
(goto-char (point-min))
(while (re-search-forward "%<\\([^>\n]+\\)>" nil t)
(replace-match (format-time-string (match-string 1)) t t))
;; Simple %-escapes
(goto-char (point-min))
(while (re-search-forward "%\\([tTuUaiAcxkKI]\\)" nil t)
(while (re-search-forward "%\\([tTuUaiAcxkKInfF]\\)" nil t)
(unless (org-capture-escaped-%)
(when (and initial (equal (match-string 0) "%i"))
(save-match-data
@ -1237,8 +1379,8 @@ The template may still contain \"%?\" for cursor positioning."
(while (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?"
nil t)
(unless (org-capture-escaped-%)
(setq char (if (match-end 3) (match-string 3))
prompt (if (match-end 2) (match-string 2)))
(setq char (if (match-end 3) (match-string-no-properties 3))
prompt (if (match-end 2) (match-string-no-properties 2)))
(goto-char (match-beginning 0))
(replace-match "")
(setq completions nil default nil)
@ -1287,29 +1429,7 @@ The template may still contain \"%?\" for cursor positioning."
'(clipboards . 1)
(car clipboards))))))
((equal char "p")
(let*
((prop (org-substring-no-properties prompt))
(pall (concat prop "_ALL"))
(allowed
(with-current-buffer
(get-buffer (file-name-nondirectory file))
(or (cdr (assoc pall org-file-properties))
(cdr (assoc pall org-global-properties))
(cdr (assoc pall org-global-properties-fixed)))))
(existing (with-current-buffer
(get-buffer (file-name-nondirectory file))
(mapcar 'list (org-property-values prop))))
(propprompt (concat "Value for " prop ": "))
(val (if allowed
(org-completing-read
propprompt
(mapcar 'list (org-split-string allowed
"[ \t]+"))
nil 'req-match)
(org-completing-read-no-i propprompt
existing nil nil
"" nil ""))))
(org-set-property prop val)))
(org-set-property (org-substring-no-properties prompt) nil))
(char
;; These are the date/time related ones
(setq org-time-was-given (equal (upcase char) char))
@ -1385,5 +1505,6 @@ The template may still contain \"%?\" for cursor positioning."
(provide 'org-capture)
;; arch-tag: 986bf41b-8ada-4e28-bf20-e8388a7205a0
;;; org-capture.el ends here

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

@ -1,11 +1,12 @@
;;; org-clock.el --- The time clocking code for Org-mode
;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -28,6 +29,7 @@
;; This file contains the time clocking code for Org-mode
(require 'org)
(require 'org-exp)
;;; Code:
(eval-when-compile
@ -35,7 +37,9 @@
(declare-function calendar-absolute-from-iso "cal-iso" (&optional date))
(declare-function notifications-notify "notifications" (&rest params))
(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label))
(defvar org-time-stamp-formats)
(defvar org-ts-what)
(defgroup org-clock nil
"Options concerning clocking working time in Org-mode."
@ -62,6 +66,22 @@ which see."
(const :tag "Into LOGBOOK drawer" "LOGBOOK")
(string :tag "Into Drawer named...")))
(defun org-clock-into-drawer ()
"Return the value of `org-clock-into-drawer', but let properties overrule.
If the current entry has or inherits a CLOCK_INTO_DRAWER
property, it will be used instead of the default value; otherwise
if the current entry has or inherits a LOG_INTO_DRAWER property,
it will be used instead of the default value.
The default is the value of the customizable variable `org-clock-into-drawer',
which see."
(let ((p (org-entry-get nil "CLOCK_INTO_DRAWER" 'inherit))
(q (org-entry-get nil "LOG_INTO_DRAWER" 'inherit)))
(cond
((or (not (or p q)) (equal p "nil") (equal q "nil")) org-clock-into-drawer)
((or (equal p "t") (equal q "t")) "LOGBOOK")
((not p) q)
(t p))))
(defcustom org-clock-out-when-done t
"When non-nil, clock will be stopped when the clocked entry is marked DONE.
DONE here means any DONE-like state.
@ -227,25 +247,26 @@ string as argument."
: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)
`(list
:maxlevel 2
:lang ,org-export-default-language
: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)
@ -256,6 +277,16 @@ For more information, see `org-clocktable-write-default'."
:group 'org-clocktable
:type 'function)
;; FIXME: translate es and nl last string "Clock summary at"
(defcustom org-clock-clocktable-language-setup
'(("en" "File" "L" "Timestamp" "Headline" "Time" "ALL" "Total time" "File time" "Clock summary at")
("es" "Archivo" "N" "Fecha y hora" "Tarea" "Tiempo" "TODO" "Tiempo total" "Tiempo archivo" "Clock summary at")
("fr" "Fichier" "N" "Horodatage" "En-tête" "Durée" "TOUT" "Durée totale" "Durée fichier" "Horodatage sommaire à")
("nl" "Bestand" "N" "Tijdstip" "Hoofding" "Duur" "ALLES" "Totale duur" "Bestandstijd" "Clock summary at"))
"Terms used in clocktable, translated to different languages."
:group 'org-clocktable
:type 'alist)
(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
@ -387,6 +418,9 @@ of a different task.")
"Return t when clocking a task."
(not (equal (org-clocking-buffer) nil)))
(defvar org-clock-before-select-task-hook nil
"Hook called in task selection just before prompting the user.")
(defun org-clock-select-task (&optional prompt)
"Select a task that recently was associated with clocking."
(interactive)
@ -419,6 +453,7 @@ of a different task.")
(if (fboundp 'int-to-char) (setf (car s) (int-to-char (car s))))
(push s sel-list)))
org-clock-history)
(run-hooks 'org-clock-before-select-task-hook)
(org-fit-window-to-buffer)
(message (or prompt "Select task for clocking:"))
(setq rpl (read-char-exclusive))
@ -441,13 +476,11 @@ pointing to it."
(ignore-errors
(goto-char marker)
(setq file (buffer-file-name (marker-buffer marker))
cat (or (org-get-category)
(progn (org-refresh-category-properties)
(org-get-category)))
cat (org-get-category)
heading (org-get-heading 'notags)
prefix (save-excursion
(org-back-to-heading t)
(looking-at "\\*+ ")
(looking-at org-outline-regexp)
(match-string 0))
task (substring
(org-fontify-like-in-org-mode
@ -473,7 +506,7 @@ If not, show simply the clocked time like 01:50."
(m (- clocked-time (* 60 h))))
(if org-clock-effort
(let* ((effort-in-minutes
(org-hh:mm-string-to-minutes org-clock-effort))
(org-duration-string-to-minutes org-clock-effort))
(effort-h (floor effort-in-minutes 60))
(effort-m (- effort-in-minutes (* effort-h 60)))
(work-done-str
@ -547,10 +580,10 @@ the mode line."
;; A string. See if it is a delta
(setq sign (string-to-char value))
(if (member sign '(?- ?+))
(setq current (org-hh:mm-string-to-minutes current)
(setq current (org-duration-string-to-minutes current)
value (substring value 1))
(setq current 0))
(setq value (org-hh:mm-string-to-minutes value))
(setq value (org-duration-string-to-minutes value))
(if (equal ?- sign)
(setq value (- current value))
(if (equal ?+ sign) (setq value (+ current value)))))
@ -567,7 +600,7 @@ the mode line."
"Show notification if we spent more time than we estimated before.
Notification is shown only once."
(when (org-clocking-p)
(let ((effort-in-minutes (org-hh:mm-string-to-minutes org-clock-effort))
(let ((effort-in-minutes (org-duration-string-to-minutes org-clock-effort))
(clocked-time (org-clock-get-clocked-time)))
(if (setq org-task-overrun
(if (or (null effort-in-minutes) (zerop effort-in-minutes))
@ -746,7 +779,8 @@ If necessary, clock-out of the currently active clock."
(defun org-clock-jump-to-current-clock (&optional effective-clock)
(interactive)
(let ((clock (or effective-clock (cons org-clock-marker
(let ((org-clock-into-drawer (org-clock-into-drawer))
(clock (or effective-clock (cons org-clock-marker
org-clock-start-time))))
(unless (marker-buffer (car clock))
(error "No clock is currently running"))
@ -961,6 +995,16 @@ so long."
60.0))))
org-clock-user-idle-start)))))
(defvar org-clock-current-task nil
"Task currently clocked in.")
(defun org-clock-set-current ()
"Set `org-clock-current-task' to the task currently clocked in."
(setq org-clock-current-task (nth 4 (org-heading-components))))
(defun org-clock-delete-current ()
"Reset `org-clock-current-task' to nil."
(setq org-clock-current-task nil))
(defun org-clock-in (&optional select start-time)
"Start the clock on the current item.
If necessary, clock-out of the currently active clock.
@ -978,6 +1022,7 @@ the clocking selection, associated with the letter `d'."
ts selected-task target-pos (msg-extra "")
(leftover (and (not org-clock-resolving-clocks)
org-clock-leftover-time)))
(when (and org-clock-auto-clock-resolution
(or (not interrupting)
(eq t org-clock-auto-clock-resolution))
@ -986,11 +1031,17 @@ the clocking selection, associated with the letter `d'."
(setq org-clock-leftover-time nil)
(let ((org-clock-clocking-in t))
(org-resolve-clocks))) ; check if any clocks are dangling
(when (equal select '(4))
(setq selected-task (org-clock-select-task "Clock-in on task: "))
(if selected-task
(setq selected-task (copy-marker selected-task))
(error "Abort")))
(when (equal select '(16))
;; Mark as default clocking task
(org-clock-mark-default-task))
(when interrupting
;; We are interrupting the clocking of a different task.
;; Save a marker to this task, so that we can go back.
@ -1005,7 +1056,8 @@ the clocking selection, associated with the letter `d'."
(= (marker-position org-clock-hd-marker)
(if selected-task
(marker-position selected-task)
(point)))))
(point)))
(equal org-clock-current-task (nth 4 (org-heading-components)))))
(message "Clock continues in \"%s\"" org-clock-heading)
(throw 'abort nil))
(move-marker org-clock-interrupted-task
@ -1014,10 +1066,6 @@ the clocking selection, associated with the letter `d'."
(let ((org-clock-clocking-in t))
(org-clock-out t)))
(when (equal select '(16))
;; Mark as default clocking task
(org-clock-mark-default-task))
;; Clock in at which position?
(setq target-pos
(if (and (eobp) (not (org-on-heading-p)))
@ -1045,7 +1093,7 @@ the clocking selection, associated with the letter `d'."
(match-string 2))))
(if newstate (org-todo newstate))))
((and org-clock-in-switch-to-state
(not (looking-at (concat outline-regexp "[ \t]*"
(not (looking-at (concat org-outline-regexp "[ \t]*"
org-clock-in-switch-to-state
"\\>"))))
(org-todo org-clock-in-switch-to-state)))
@ -1138,16 +1186,6 @@ the clocking selection, associated with the letter `d'."
(message "Clock starts at %s - %s" ts msg-extra)
(run-hooks 'org-clock-in-hook)))))))
(defvar org-clock-current-task nil
"Task currently clocked in.")
(defun org-clock-set-current ()
"Set `org-clock-current-task' to the task currently clocked in."
(setq org-clock-current-task (nth 4 (org-heading-components))))
(defun org-clock-delete-current ()
"Reset `org-clock-current-task' to nil."
(setq org-clock-current-task nil))
(defun org-clock-mark-default-task ()
"Mark current task as default task."
(interactive)
@ -1197,16 +1235,17 @@ When FIND-UNCLOSED is non-nil, first check if there is an unclosed clock
line and position cursor in that line."
(org-back-to-heading t)
(catch 'exit
(let ((beg (save-excursion
(beginning-of-line 2)
(or (bolp) (newline))
(point)))
(end (progn (outline-next-heading) (point)))
(re (concat "^[ \t]*" org-clock-string))
(cnt 0)
(drawer (if (stringp org-clock-into-drawer)
org-clock-into-drawer "LOGBOOK"))
first last ind-last)
(let* ((org-clock-into-drawer (org-clock-into-drawer))
(beg (save-excursion
(beginning-of-line 2)
(or (bolp) (newline))
(point)))
(end (progn (outline-next-heading) (point)))
(re (concat "^[ \t]*" org-clock-string))
(cnt 0)
(drawer (if (stringp org-clock-into-drawer)
org-clock-into-drawer "LOGBOOK"))
first last ind-last)
(goto-char beg)
(when (and find-unclosed
(re-search-forward
@ -1239,7 +1278,10 @@ line and position cursor in that line."
(beginning-of-line 2)
(if (and (>= (org-get-indentation) ind-last)
(org-at-item-p))
(org-end-of-item))
(when (and (>= (org-get-indentation) ind-last)
(org-at-item-p))
(let ((struct (org-list-struct)))
(goto-char (org-list-get-bottom-point struct)))))
(insert ":END:\n")
(beginning-of-line 0)
(org-indent-line-to ind-last)
@ -1339,7 +1381,7 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set."
(match-string 2))))
(if newstate (org-todo newstate))))
((and org-clock-out-switch-to-state
(not (looking-at (concat outline-regexp "[ \t]*"
(not (looking-at (concat org-outline-regexp "[ \t]*"
org-clock-out-switch-to-state
"\\>"))))
(org-todo org-clock-out-switch-to-state))))))
@ -1349,6 +1391,76 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set."
(run-hooks 'org-clock-out-hook)
(org-clock-delete-current))))))
(add-hook 'org-clock-out-hook 'org-clock-remove-empty-clock-drawer)
(defun org-clock-remove-empty-clock-drawer nil
"Remove empty clock drawer in the current subtree."
(let* ((olid (or (org-entry-get (point) "LOG_INTO_DRAWER")
org-log-into-drawer))
(clock-drawer (if (eq t olid) "LOGBOOK" olid))
(end (save-excursion (org-end-of-subtree t t))))
(when clock-drawer
(save-excursion
(org-back-to-heading t)
(while (search-forward clock-drawer end t)
(goto-char (match-beginning 0))
(org-remove-empty-drawer-at clock-drawer (point))
(forward-line 1))))))
(defun org-at-clock-log-p nil
"Is the cursor on the clock log line?"
(save-excursion
(move-beginning-of-line 1)
(looking-at "^[ \t]*CLOCK:")))
(defun org-clock-timestamps-up nil
"Increase CLOCK timestamps at cursor."
(interactive)
(org-clock-timestamps-change 'up))
(defun org-clock-timestamps-down nil
"Increase CLOCK timestamps at cursor."
(interactive)
(org-clock-timestamps-change 'down))
(defun org-clock-timestamps-change (updown)
"Change CLOCK timestamps synchronously at cursor.
UPDOWN tells whether to change 'up or 'down."
(setq org-ts-what nil)
(when (org-at-timestamp-p t)
(let ((tschange (if (eq updown 'up) 'org-timestamp-up
'org-timestamp-down))
ts1 begts1 ts2 begts2 updatets1 tdiff)
(save-excursion
(move-beginning-of-line 1)
(re-search-forward org-ts-regexp3 nil t)
(setq ts1 (match-string 0) begts1 (match-beginning 0))
(when (re-search-forward org-ts-regexp3 nil t)
(setq ts2 (match-string 0) begts2 (match-beginning 0))))
;; Are we on the second timestamp?
(if (<= begts2 (point)) (setq updatets1 t))
(if (not ts2)
;; fall back on org-timestamp-up if there is only one
(funcall tschange)
;; setq this so that (boundp 'org-ts-what is non-nil)
(funcall tschange)
(let ((ts (if updatets1 ts2 ts1))
(begts (if updatets1 begts1 begts2)))
(setq tdiff
(subtract-time
(org-time-string-to-time org-last-changed-timestamp)
(org-time-string-to-time ts)))
(save-excursion
(goto-char begts)
(org-timestamp-change
(round (/ (org-float-time tdiff)
(cond ((eq org-ts-what 'minute) 60)
((eq org-ts-what 'hour) 3600)
((eq org-ts-what 'day) (* 24 3600))
((eq org-ts-what 'month) (* 24 3600 31))
((eq org-ts-what 'year) (* 24 3600 365.2)))))
org-ts-what 'updown)))))))
(defun org-clock-cancel ()
"Cancel the running clock by removing the start timestamp."
(interactive)
@ -1387,7 +1499,7 @@ With prefix arg SELECT, offer recently clocked tasks for selection."
(setq recent t)
(car org-clock-history))
(t (error "No active or recent clock task")))))
(switch-to-buffer (marker-buffer m))
(org-pop-to-buffer-same-window (marker-buffer m))
(if (or (< m (point-min)) (> m (point-max))) (widen))
(goto-char m)
(org-show-entry)
@ -1502,7 +1614,9 @@ nil are excluded from the clock summation."
(defun org-clock-display (&optional total-only)
"Show subtree times in the entire buffer.
If TOTAL-ONLY is non-nil, only show the total time for the entire file
in the echo area."
in the echo area.
Use \\[org-clock-remove-overlays] to remove the subtree times."
(interactive)
(org-clock-remove-overlays)
(let (time h m p)
@ -1628,7 +1742,10 @@ fontified, and then returned."
(defun org-clock-report (&optional arg)
"Create a table containing a report about clocked time.
If the cursor is inside an existing clocktable block, then the table
will be updated. If not, a new clocktable will be inserted.
will be updated. If not, a new clocktable will be inserted. The scope
of the new clock will be subtree when called from within a subtree, and
file elsewhere.
When called with a prefix argument, move to the first clock table in the
buffer and update it."
(interactive "P")
@ -1638,8 +1755,12 @@ buffer and update it."
(org-show-entry))
(if (org-in-clocktable-p)
(goto-char (org-in-clocktable-p))
(org-create-dblock (append (list :name "clocktable")
org-clock-clocktable-default-properties)))
(let ((props (if (ignore-errors
(save-excursion (org-back-to-heading)))
(list :name "clocktable" :scope 'subtree)
(list :name "clocktable"))))
(org-create-dblock
(org-combine-plists org-clock-clocktable-default-properties props))))
(org-update-dblock))
(defun org-in-clocktable-p ()
@ -1986,7 +2107,7 @@ the currently selected interval size."
(setq level (string-to-number (match-string 1 (symbol-name scope))))
(catch 'exit
(while (org-up-heading-safe)
(looking-at outline-regexp)
(looking-at org-outline-regexp)
(if (<= (org-reduced-level (funcall outline-level)) level)
(throw 'exit nil))))
(org-narrow-to-subtree)))
@ -2007,12 +2128,16 @@ the currently selected interval size."
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...
;; This function looks quite complicated, mainly because there are a
;; lot of options which can add or remove columns. I have massively
;; commented this function, the I hope it is understandable. If
;; someone wants to write their 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 . "/")))
(lwords (assoc (or (plist-get params :lang)
org-export-default-language)
org-clock-clocktable-language-setup))
(multifile (plist-get params :multifile))
(block (plist-get params :block))
(ts (plist-get params :tstart))
@ -2024,6 +2149,7 @@ from the dynamic block defintion."
(emph (plist-get params :emphasize))
(level-p (plist-get params :level))
(timestamp (plist-get params :timestamp))
(properties (plist-get params :properties))
(ntcol (max 1 (or (plist-get params :tcolumns) 100)))
(rm-file-column (plist-get params :one-file-with-archives))
(indent (plist-get params :indent))
@ -2072,7 +2198,7 @@ from the dynamic block defintion."
(or header
;; Format the standard header
(concat
"Clock summary at ["
(nth 9 lwords) " ["
(substring
(format-time-string (cdr org-time-stamp-formats))
1 -1)
@ -2087,24 +2213,29 @@ from the dynamic block defintion."
(if multifile "|" "") ; file column, maybe
(if level-p "|" "") ; level column, maybe
(if timestamp "|" "") ; timestamp column, maybe
(if properties (make-string (length properties) ?|) "") ;properties columns, 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
(if multifile (concat (nth 1 lwords) "|") "") ; file column, maybe
(if level-p (concat (nth 2 lwords) "|") "") ; level column, maybe
(if timestamp (concat (nth 3 lwords) "|") "") ; timestamp column, maybe
(if properties (concat (mapconcat 'identity properties "|") "|") "") ;properties columns, maybe
(concat (nth 4 lwords) "|"
(nth 5 lwords) "|\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
"|-\n" ; a hline
"|" ; table line starter
(if multifile (concat "| " (nth 6 lwords) " ") "")
; file column, maybe
(if level-p "|" "") ; level column, maybe
(if timestamp "|" "") ; timestamp column, maybe
(if properties (make-string (length properties) ?|) "") ;properties columns, maybe
(concat "*" (nth 7 lwords) "*| ") ; instead of a headline
"*"
(org-minutes-to-hh:mm-string (or total-time 0)) ; the time
"*|\n") ; close line
@ -2121,12 +2252,13 @@ from the dynamic block defintion."
(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
;; Summarize the time collected from this file
(insert-before-markers
(format "| %s %s | %s*File time* | *%s*|\n"
(format (concat "| %s %s | %s%s*" (nth 8 lwords) "* | *%s*|\n")
(file-name-nondirectory (car tbl))
(if level-p "| " "") ; level column, maybe
(if timestamp "| " "") ; timestamp column, maybe
(if properties (make-string (length properties) ?|) "") ;properties columns, maybe
(org-minutes-to-hh:mm-string (nth 1 tbl))))) ; the time
;; Get the list of node entries and iterate over it
@ -2151,6 +2283,11 @@ from the dynamic block defintion."
(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 properties
(concat
(mapconcat
(lambda (p) (or (cdr (assoc p (nth 4 entry))) ""))
properties "|") "|") "") ;properties columns, maybe
(if indent (org-clocktable-indent-string level) "") ; indentation
hlc headline hlc "|" ; headline
(make-string (min (1- ntcol) (or (- level 1))) ?|)
@ -2305,6 +2442,8 @@ TIME: The sum of all time spend in this tree, in minutes. This time
(block (plist-get params :block))
(link (plist-get params :link))
(tags (plist-get params :tags))
(properties (plist-get params :properties))
(inherit-property-p (plist-get params :inherit-props))
(matcher (if tags (cdr (org-make-tags-matcher tags))))
cc range-text st p time level hdl props tsp tbl)
@ -2358,8 +2497,15 @@ TIME: The sum of all time spend in this tree, in minutes. This time
(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))))))
(cdr (assoc "TIMESTAMP_IA" props))))
props (when properties
(remove nil
(mapcar
(lambda (p)
(when (org-entry-get (point) p inherit-property-p)
(cons p (org-entry-get (point) p inherit-property-p))))
properties))))
(when (> time 0) (push (list level hdl tsp time props) tbl))))))
(setq tbl (nreverse tbl))
(list file org-clock-file-total-minutes tbl))))
@ -2387,6 +2533,8 @@ This function is made for clock tables."
tot))))
0))))
;; Saving and loading the clock
(defvar org-clock-loaded nil
"Was the clock file loaded?")
@ -2478,7 +2626,7 @@ The details of what will be saved are regulated by the variable
(goto-char (cdr resume-clock))
(let ((org-clock-auto-clock-resolution nil))
(org-clock-in)
(if (org-invisible-p)
(if (outline-invisible-p)
(org-show-context))))))))))
;;;###autoload
@ -2492,6 +2640,7 @@ The details of what will be saved are regulated by the variable
(provide 'org-clock)
;; arch-tag: 7b42c5d4-9b36-48be-97c0-66a869daed4c
;;; org-clock.el ends here

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

@ -1,11 +1,12 @@
;;; org-colview.el --- Column View in Org-mode
;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -170,7 +171,6 @@ This is the compiled version of the format.")
(color (list :foreground (face-attribute ref-face :foreground)))
(face (list color 'org-column ref-face))
(face1 (list color 'org-agenda-column-dateline ref-face))
(pl (or (get-text-property (point-at-bol) 'prefix-length) 0))
(cphr (get-text-property (point-at-bol) 'org-complex-heading-regexp))
pom property ass width f string ov column val modval s2 title calc)
;; Check if the entry is in another buffer.
@ -186,11 +186,17 @@ This is the compiled version of the format.")
title (nth 1 column)
ass (if (equal property "ITEM")
(cons "ITEM"
(save-match-data
;; When in a buffer, get the whole line,
;; we'll clean it later…
(if (org-mode-p)
(save-match-data
(org-no-properties
(org-remove-tabs
(buffer-substring-no-properties
(point-at-bol) (point-at-eol)))))
;; In agenda, just get the `txt' property
(org-no-properties
(org-remove-tabs
(buffer-substring-no-properties
(point-at-bol) (point-at-eol))))))
(org-get-at-bol 'txt))))
(assoc property props))
width (or (cdr (assoc property org-columns-current-maxwidths))
(nth 2 column)
@ -206,9 +212,7 @@ This is the compiled version of the format.")
((equal property "ITEM")
(if (org-mode-p)
(org-columns-cleanup-item
val org-columns-current-fmt-compiled)
(org-agenda-columns-cleanup-item
val pl cphr org-columns-current-fmt-compiled)))
val org-columns-current-fmt-compiled)))
((and calc (functionp calc)
(not (string= val ""))
(not (get-text-property 0 'org-computed val)))
@ -365,20 +369,6 @@ for the duration of the command.")
t t s)))
s)
(defvar org-agenda-columns-remove-prefix-from-item)
(defun org-agenda-columns-cleanup-item (item pl cphr fmt)
"Cleanup the time property for agenda column view.
See also the variable `org-agenda-columns-remove-prefix-from-item'."
(let* ((org-complex-heading-regexp cphr)
(prefix (substring item 0 pl))
(rest (substring item pl))
(fake (concat "* " rest))
(cleaned (org-trim (substring (org-columns-cleanup-item fake fmt) 1))))
(if org-agenda-columns-remove-prefix-from-item
cleaned
(concat prefix cleaned))))
(defun org-columns-show-value ()
"Show the full value of the property."
(interactive)
@ -706,7 +696,7 @@ around it."
(save-restriction
(narrow-to-region beg end)
(org-clock-sum))))
(while (re-search-forward (concat "^" outline-regexp) end t)
(while (re-search-forward org-outline-regexp-bol end t)
(if (and org-columns-skip-archived-trees
(looking-at (concat ".*:" org-archive-tag ":")))
(org-end-of-subtree t)
@ -939,7 +929,7 @@ Don't set this, this is meant for dynamic scoping.")
(defun org-columns-compute (property)
"Sum the values of property PROPERTY hierarchically, for the entire buffer."
(interactive)
(let* ((re (concat "^" outline-regexp))
(let* ((re org-outline-regexp-bol)
(lmax 30) ; Does anyone use deeper levels???
(lvals (make-vector lmax nil))
(lflag (make-vector lmax nil))
@ -1536,5 +1526,6 @@ The string should be two numbers joined with a \"-\"."
(provide 'org-colview)
;; arch-tag: 61f5128d-747c-4983-9479-e3871fa3d73c
;;; org-colview.el ends here

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

@ -1,11 +1,12 @@
;;; org-compat.el --- Compatibility code for Org-mode
;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -246,6 +247,15 @@ Works on both Emacs and XEmacs."
(> (point) (region-beginning)))
(exchange-point-and-mark)))
;; Emacs 22 misses `activate-mark'
(if (fboundp 'activate-mark)
(defalias 'org-activate-mark 'activate-mark)
(defun org-activate-mark ()
(when (mark t)
(setq mark-active t)
(unless transient-mark-mode
(setq transient-mark-mode 'lambda)))))
;; Invisibility compatibility
(defun org-remove-from-invisibility-spec (arg)
@ -423,7 +433,17 @@ With two arguments, return floor and remainder of their quotient."
(let ((q (floor x y)))
(list q (- x (if y (* y q) q)))))
;; `pop-to-buffer-same-window' has been introduced with Emacs 24.1.
(defun org-pop-to-buffer-same-window
(&optional buffer-or-name norecord label)
"Pop to buffer specified by BUFFER-OR-NAME in the selected window."
(if (fboundp 'pop-to-buffer-same-window)
(funcall
'pop-to-buffer-same-window buffer-or-name norecord label)
(funcall 'switch-to-buffer buffer-or-name norecord)))
(provide 'org-compat)
;; arch-tag: a0a0579f-e68c-4bdf-9e55-93768b846bbe
;;; org-compat.el ends here

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

@ -1,10 +1,10 @@
;;; org-crypt.el --- Public key encryption for org-mode entries
;; Copyright (C) 2007, 2009-2011 Free Software Foundation, Inc.
;; Copyright (C) 2007, 2009, 2010 Free Software Foundation, Inc.
;; Emacs Lisp Archive Entry
;; Filename: org-crypt.el
;; Version: 7.4
;; Version: 7.7
;; Keywords: org-mode
;; Author: John Wiegley <johnw@gnu.org>
;; Maintainer: Peter Jones <pjones@pmade.com>
@ -56,9 +56,6 @@
;; 4. To automatically encrypt all necessary entries when saving a
;; file, call `org-crypt-use-before-save-magic' after loading
;; org-crypt.el.
;;
;; TODO:
;; - Allow symmetric encryption as well
;;; Thanks:
@ -80,19 +77,45 @@
(defgroup org-crypt nil
"Org Crypt"
:tag "Org Crypt" :group 'org)
:tag "Org Crypt"
:group 'org)
(defcustom org-crypt-tag-matcher "crypt"
"The tag matcher used to find headings whose contents should be encrypted.
See the \"Match syntax\" section of the org manual for more details."
:type 'string :group 'org-crypt)
:type 'string
:group 'org-crypt)
(defcustom org-crypt-key nil
(defcustom org-crypt-key ""
"The default key to use when encrypting the contents of a heading.
This setting can also be overridden in the CRYPTKEY property."
:type 'string :group 'org-crypt)
:type 'string
:group 'org-crypt)
(defcustom org-crypt-disable-auto-save 'ask
"What org-decrypt should do if `auto-save-mode' is enabled.
t : Disable auto-save-mode for the current buffer
prior to decrypting an entry.
nil : Leave auto-save-mode enabled.
This may cause data to be written to disk unencrypted!
'ask : Ask user whether or not to disable auto-save-mode
for the current buffer.
'encrypt : Leave auto-save-mode enabled for the current buffer,
but automatically re-encrypt all decrypted entries
*before* auto-saving.
NOTE: This only works for entries which have a tag
that matches `org-crypt-tag-matcher'."
:group 'org-crypt
:type '(choice (const :tag "Always" t)
(const :tag "Never" nil)
(const :tag "Ask" ask)
(const :tag "Encrypt" encrypt)))
(defun org-crypt-key-for-heading ()
"Return the encryption key for the current heading."
@ -103,6 +126,15 @@ This setting can also be overridden in the CRYPTKEY property."
(and (boundp 'epa-file-encrypt-to) epa-file-encrypt-to)
(message "No crypt key set, using symmetric encryption."))))
(defun org-encrypt-string (str crypt-key)
"Return STR encrypted with CRYPT-KEY."
;; Text and key have to be identical, otherwise we re-crypt.
(if (and (string= crypt-key (get-text-property 0 'org-crypt-key str))
(string= (sha1 str) (get-text-property 0 'org-crypt-checksum str)))
(get-text-property 0 'org-crypt-text str)
(let ((epg-context (epg-make-context nil t t)))
(epg-encrypt-string epg-context str (epg-list-keys epg-context crypt-key)))))
(defun org-encrypt-entry ()
"Encrypt the content of the current headline."
(interactive)
@ -112,7 +144,7 @@ This setting can also be overridden in the CRYPTKEY property."
(let ((start-heading (point)))
(forward-line)
(when (not (looking-at "-----BEGIN PGP MESSAGE-----"))
(let ((folded (org-invisible-p))
(let ((folded (outline-invisible-p))
(epg-context (epg-make-context nil t t))
(crypt-key (org-crypt-key-for-heading))
(beg (point))
@ -122,10 +154,7 @@ This setting can also be overridden in the CRYPTKEY property."
(org-back-over-empty-lines)
(setq end (point)
encrypted-text
(epg-encrypt-string
epg-context
(buffer-substring-no-properties beg end)
(epg-list-keys epg-context crypt-key)))
(org-encrypt-string (buffer-substring beg end) crypt-key))
(delete-region beg end)
(insert encrypted-text)
(when folded
@ -136,27 +165,68 @@ This setting can also be overridden in the CRYPTKEY property."
(defun org-decrypt-entry ()
"Decrypt the content of the current headline."
(interactive)
; auto-save-mode may cause leakage, so check whether it's enabled.
(when buffer-auto-save-file-name
(cond
((or
(eq org-crypt-disable-auto-save t)
(and
(eq org-crypt-disable-auto-save 'ask)
(y-or-n-p "org-decrypt: auto-save-mode may cause leakage. Disable it for current buffer? ")))
(message (concat "org-decrypt: Disabling auto-save-mode for " (or (buffer-file-name) (current-buffer))))
; The argument to auto-save-mode has to be "-1", since
; giving a "nil" argument toggles instead of disabling.
(auto-save-mode -1))
((eq org-crypt-disable-auto-save nil)
(message "org-decrypt: Decrypting entry with auto-save-mode enabled. This may cause leakage."))
((eq org-crypt-disable-auto-save 'encrypt)
(message "org-decrypt: Enabling re-encryption on auto-save.")
(add-hook 'auto-save-hook
(lambda ()
(message "org-crypt: Re-encrypting all decrypted entries due to auto-save.")
(org-encrypt-entries))
nil t))
(t nil)))
(require 'epg)
(unless (org-before-first-heading-p)
(save-excursion
(org-back-to-heading t)
(forward-line)
(when (looking-at "-----BEGIN PGP MESSAGE-----")
(let* ((beg (point))
(end (save-excursion
(search-forward "-----END PGP MESSAGE-----")
(forward-line)
(point)))
(epg-context (epg-make-context nil t t))
(decrypted-text
(decode-coding-string
(epg-decrypt-string
epg-context
(buffer-substring-no-properties beg end))
'utf-8)))
(delete-region beg end)
(insert decrypted-text)
nil)))))
(let ((heading-point (point))
(heading-was-invisible-p
(save-excursion
(outline-end-of-heading)
(outline-invisible-p))))
(forward-line)
(when (looking-at "-----BEGIN PGP MESSAGE-----")
(let* ((end (save-excursion
(search-forward "-----END PGP MESSAGE-----")
(forward-line)
(point)))
(epg-context (epg-make-context nil t t))
(encrypted-text (buffer-substring-no-properties (point) end))
(decrypted-text
(decode-coding-string
(epg-decrypt-string
epg-context
encrypted-text)
'utf-8)))
;; Delete region starting just before point, because the
;; outline property starts at the \n of the heading.
(delete-region (1- (point)) end)
;; Store a checksum of the decrypted and the encrypted
;; text value. This allow to reuse the same encrypted text
;; if the text does not change, and therefore avoid a
;; re-encryption process.
(insert "\n" (propertize decrypted-text
'org-crypt-checksum (sha1 decrypted-text)
'org-crypt-key (org-crypt-key-for-heading)
'org-crypt-text encrypted-text))
(when heading-was-invisible-p
(goto-char heading-point)
(org-flag-subtree t))
nil))))))
(defun org-encrypt-entries ()
"Encrypt all top-level entries in the current buffer."
@ -182,5 +252,6 @@ This setting can also be overridden in the CRYPTKEY property."
(provide 'org-crypt)
;; arch-tag: 8202ed2c-221e-4001-9e4b-54674a7e846e
;;; org-crypt.el ends here

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

@ -1,12 +1,12 @@
;;; org-ctags.el - Integrate Emacs "tags" facility with org mode.
;;
;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Paul Sexton <eeeickythump@gmail.com>
;; Version: 7.4
;; Version: 7.7
;; Keywords: org, wp
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -140,6 +140,8 @@
(require 'org)
(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label))
(defgroup org-ctags nil
"Options concerning use of ctags within org mode."
:tag "Org-Ctags"
@ -385,7 +387,7 @@ the new file."
(cond
((get-buffer (concat name ".org"))
;; Buffer is already open
(switch-to-buffer (get-buffer (concat name ".org"))))
(org-pop-to-buffer-same-window (get-buffer (concat name ".org"))))
((file-exists-p filename)
;; File exists but is not open --> open it
(message "Opening existing org file `%S'..."
@ -537,4 +539,5 @@ a new topic."
(provide 'org-ctags)
;; arch-tag: 4b1ddd5a-8529-4b17-bcde-96a922d26343
;;; org-ctags.el ends here

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

@ -1,11 +1,11 @@
;;; org-datetree.el --- Create date entries in a tree
;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -64,7 +64,7 @@ tree can be found."
(goto-char (prog1 (point) (widen))))))
(defun org-datetree-find-year-create (year)
(let ((re "^\\*+[ \t]+\\([12][0-9][0-9][0-9]\\)[ \t\n]")
(let ((re "^\\*+[ \t]+\\([12][0-9][0-9][0-9]\\)$")
match)
(goto-char (point-min))
(while (and (setq match (re-search-forward re nil t))
@ -83,7 +83,7 @@ tree can be found."
(defun org-datetree-find-month-create (year month)
(org-narrow-to-subtree)
(let ((re (format "^\\*+[ \t]+%d-\\([01][0-9]\\)[ \t\n]" year))
(let ((re (format "^\\*+[ \t]+%d-\\([01][0-9]\\) \\w+$" year))
match)
(goto-char (point-min))
(while (and (setq match (re-search-forward re nil t))
@ -102,7 +102,7 @@ tree can be found."
(defun org-datetree-find-day-create (year month day)
(org-narrow-to-subtree)
(let ((re (format "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\)[ \t\n]" year month))
(let ((re (format "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$" year month))
match)
(goto-char (point-min))
(while (and (setq match (re-search-forward re nil t))
@ -195,5 +195,6 @@ before running this command, even though the command tries to be smart."
(provide 'org-datetree)
;; arch-tag: 1daea962-fd08-448b-9f98-6e8b511b3601
;;; org-datetree.el ends here

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

@ -1,10 +1,10 @@
;;; org-docbook.el --- DocBook exporter for org-mode
;;
;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;;
;; Emacs Lisp Archive Entry
;; Filename: org-docbook.el
;; Version: 7.4
;; Version: 7.7
;; Author: Baoqiu Cui <cbaoqiu AT yahoo DOT com>
;; Maintainer: Baoqiu Cui <cbaoqiu AT yahoo DOT com>
;; Keywords: org, wp, docbook
@ -148,6 +148,11 @@ avoid same set of footnote IDs being used multiple times."
:group 'org-export-docbook
:type 'string)
(defcustom org-export-docbook-footnote-separator "<superscript>, </superscript>"
"Text used to separate footnotes."
:group 'org-export-docbook
:type 'string)
(defcustom org-export-docbook-emphasis-alist
`(("*" "<emphasis role=\"bold\">" "</emphasis>")
("/" "<emphasis>" "</emphasis>")
@ -320,7 +325,7 @@ could call this function in the following way:
When called interactively, the output buffer is selected, and shown
in a window. A non-interactive call will only return the buffer."
(interactive "r\nP")
(when (interactive-p)
(when (org-called-interactively-p 'any)
(setq buffer "*Org DocBook Export*"))
(let ((transient-mark-mode t)
(zmacs-regions t)
@ -332,7 +337,7 @@ in a window. A non-interactive call will only return the buffer."
nil nil
buffer body-only))
(if (fboundp 'deactivate-mark) (deactivate-mark))
(if (and (interactive-p) (bufferp rtn))
(if (and (org-called-interactively-p 'any) (bufferp rtn))
(switch-to-buffer-other-window rtn)
rtn)))
@ -499,9 +504,6 @@ publishing directory."
(inquote nil)
(infixed nil)
(inverse nil)
(in-local-list nil)
(local-list-type nil)
(local-list-indent nil)
(llt org-plain-list-ordered-item-terminator)
(email (plist-get opt-plist :email))
(language (plist-get opt-plist :language))
@ -522,16 +524,19 @@ publishing directory."
(buffer-substring
(if region-p (region-beginning) (point-min))
(if region-p (region-end) (point-max))))
(org-export-footnotes-seen nil)
(org-export-footnotes-data (org-footnote-all-labels 'with-defs))
(lines
(org-split-string
(org-export-preprocess-string
region
:emph-multiline t
:for-docbook t
:for-backend 'docbook
:skip-before-1st-heading
(plist-get opt-plist :skip-before-1st-heading)
:drawers (plist-get opt-plist :drawers)
:todo-keywords (plist-get opt-plist :todo-keywords)
:tasks (plist-get opt-plist :tasks)
:tags (plist-get opt-plist :tags)
:priority (plist-get opt-plist :priority)
:footnotes (plist-get opt-plist :footnotes)
@ -646,7 +651,7 @@ publishing directory."
(catch 'nextline
;; End of quote section?
(when (and inquote (string-match "^\\*+ " line))
(when (and inquote (string-match org-outline-regexp-bol line))
(insert "]]></programlisting>\n")
(org-export-docbook-open-para)
(setq inquote nil))
@ -671,22 +676,6 @@ publishing directory."
(org-export-docbook-open-para))
(throw 'nextline nil))
;; List ender: close every open list.
(when (equal "ORG-LIST-END" line)
(while local-list-type
(let ((listtype (car local-list-type)))
(org-export-docbook-close-li listtype)
(insert (cond
((equal listtype "o") "</orderedlist>\n")
((equal listtype "u") "</itemizedlist>\n")
((equal listtype "d") "</variablelist>\n"))))
(pop local-list-type))
;; We did close a list, normal text follows: need <para>
(org-export-docbook-open-para)
(setq local-list-indent nil
in-local-list nil)
(throw 'nextline nil))
;; Protected HTML
(when (get-text-property 0 'org-protected line)
(let (par (ind (get-text-property 0 'original-indentation line)))
@ -947,7 +936,10 @@ publishing directory."
(when org-export-with-footnotes
(setq start 0)
(while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line start)
(if (get-text-property (match-beginning 2) 'org-protected line)
;; Discard protected matches not clearly identified as
;; footnote markers.
(if (or (get-text-property (match-beginning 2) 'org-protected line)
(not (get-text-property (match-beginning 2) 'org-footnote line)))
(setq start (match-end 2))
(let* ((num (match-string 2 line))
(footnote-def (assoc num footnote-list)))
@ -958,14 +950,22 @@ publishing directory."
org-export-docbook-footnote-id-prefix num)
t t line))
(setq line (replace-match
(format "%s<footnote xml:id=\"%s%s\"><para>%s</para></footnote>"
(match-string 1 line)
org-export-docbook-footnote-id-prefix
num
(if footnote-def
(save-match-data
(org-docbook-expand (cdr footnote-def)))
(format "FOOTNOTE DEFINITION NOT FOUND: %s" num)))
(concat
(format "%s<footnote xml:id=\"%s%s\"><para>%s</para></footnote>"
(match-string 1 line)
org-export-docbook-footnote-id-prefix
num
(if footnote-def
(save-match-data
(org-docbook-expand (cdr footnote-def)))
(format "FOOTNOTE DEFINITION NOT FOUND: %s" num)))
;; If another footnote is following the
;; current one, add a separator.
(if (save-match-data
(string-match "\\`\\[[0-9]+\\]"
(substring line (match-end 0))))
org-export-docbook-footnote-separator
""))
t t line))
(push (cons num 1) footref-seen))))))
@ -1008,93 +1008,15 @@ publishing directory."
(org-format-table-html table-buffer table-orig-buffer
'no-css)))))
;; Normal lines
(t
;; Normal lines
(when (string-match
(cond
((eq llt t) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+[.)]\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
((= llt ?.) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+\\.\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
((= llt ?\)) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+)\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
(t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))
line)
(setq ind (or (get-text-property 0 'original-indentation line)
(org-get-string-indentation line))
item-type (if (match-beginning 4) "o" "u")
starter (if (match-beginning 2)
(substring (match-string 2 line) 0 -1))
line (substring line (match-beginning 5))
item-tag nil
item-number nil)
(if (string-match "\\[@\\(?:start:\\)?\\([0-9]+\\)\\][ \t]?" line)
(setq item-number (match-string 1 line)
line (replace-match "" t t line)))
(if (and starter (string-match "\\(.*?\\) ::[ \t]*" line))
(setq item-type "d"
item-tag (match-string 1 line)
line (substring line (match-end 0))))
(cond
((and starter
(or (not in-local-list)
(> ind (car local-list-indent))))
;; Start new (level of) list
(org-export-docbook-close-para-maybe)
(insert (cond
((equal item-type "u") "<itemizedlist>\n<listitem>\n")
((and (equal item-type "o") item-number)
;; Check for a specific start number. If it
;; is specified, we use the ``override''
;; attribute of element <listitem> to pass the
;; info to DocBook. We could also use the
;; ``startingnumber'' attribute of element
;; <orderedlist>, but the former works on both
;; DocBook 5.0 and prior versions.
(format "<orderedlist>\n<listitem override=\"%s\">\n" item-number))
((equal item-type "o") "<orderedlist>\n<listitem>\n")
((equal item-type "d")
(format "<variablelist>\n<varlistentry><term>%s</term><listitem>\n" item-tag))))
;; For DocBook, we need to open a para right after tag
;; <listitem>.
(org-export-docbook-open-para)
(push item-type local-list-type)
(push ind local-list-indent)
(setq in-local-list t))
;; Continue current list
(starter
;; terminate any previous sublist but first ensure
;; list is not ill-formed
(let ((min-ind (apply 'min local-list-indent)))
(when (< ind min-ind) (setq ind min-ind)))
(while (< ind (car local-list-indent))
(let ((listtype (car local-list-type)))
(org-export-docbook-close-li listtype)
(insert (cond
((equal listtype "o") "</orderedlist>\n")
((equal listtype "u") "</itemizedlist>\n")
((equal listtype "d") "</variablelist>\n"))))
(pop local-list-type) (pop local-list-indent)
(setq in-local-list local-list-indent))
;; insert new item
(let ((listtype (car local-list-type)))
(org-export-docbook-close-li listtype)
(insert (cond
((and (equal listtype "o") item-number)
(format "<listitem override=\"%s\">" item-number))
((equal listtype "o") "<listitem>")
((equal listtype "u") "<listitem>")
((equal listtype "d") (format
"<varlistentry><term>%s</term><listitem>"
(or item-tag
"???"))))))
;; For DocBook, we need to open a para right after tag
;; <listitem>.
(org-export-docbook-open-para)))
;; Checkboxes.
(if (string-match "^[ \t]*\\(\\[[X -]\\]\\)" line)
(setq line
(replace-match (concat checkbox-start
(match-string 1 line)
checkbox-end)
t t line))))
;; This line either is list item or end a list.
(when (when (get-text-property 0 'list-item line)
(setq line (org-export-docbook-list-line
line
(get-text-property 0 'list-item line)
(get-text-property 0 'list-struct line)
(get-text-property 0 'list-prevs line)))))
;; Empty lines start a new paragraph. If hand-formatted lists
;; are not fully interpreted, lines starting with "-", "+", "*"
@ -1138,20 +1060,12 @@ publishing directory."
(if (eq major-mode (default-value 'major-mode))
(nxml-mode)))
;; Remove empty paragraphs and lists. Replace them with a
;; newline.
;; Remove empty paragraphs. Replace them with a newline.
(goto-char (point-min))
(while (re-search-forward
"[ \r\n\t]*\\(<para>\\)[ \r\n\t]*</para>[ \r\n\t]*" nil t)
(when (not (get-text-property (match-beginning 1) 'org-protected))
(replace-match "\n")
;; Avoid empty <listitem></listitem> caused by inline tasks.
;; We should add an empty para to make everything valid.
(when (and (looking-at "</listitem>")
(save-excursion
(backward-char (length "<listitem>\n"))
(looking-at "<listitem>")))
(insert "<para></para>"))
(backward-char 1)))
;; Fill empty sections with <para></para>. This is to make sure
;; that the DocBook document generated is valid and well-formed.
@ -1193,10 +1107,6 @@ publishing directory."
(insert "</listitem></varlistentry>\n")
(insert "</listitem>\n")))
(defvar in-local-list)
(defvar local-list-indent)
(defvar local-list-type)
(defun org-export-docbook-level-start (level title)
"Insert a new level in DocBook export.
When TITLE is nil, just close all open levels."
@ -1367,7 +1277,7 @@ TABLE is a string containing the HTML code generated by
(match-string 1 table)
(match-string 4 table)
"</table>")
nil nil table)
nil t table)
table))
;; Change <table> into <informaltable> if caption does not exist.
(if (string-match
@ -1377,7 +1287,7 @@ TABLE is a string containing the HTML code generated by
(match-string 1 table-with-label)
(match-string 3 table-with-label)
"</informaltable>")
nil nil table-with-label)
nil t table-with-label)
table-with-label)))
;; Note: This function is very similar to
@ -1438,6 +1348,102 @@ that need to be preserved in later phase of DocBook exporting."
line (substring line (match-end 0))))
(concat replaced line)))
(defun org-export-docbook-list-line (line pos struct prevs)
"Insert list syntax in export buffer. Return LINE, maybe modified.
POS is the item position or line position the line had before
modifications to buffer. STRUCT is the list structure. PREVS is
the alist of previous items."
(let* ((get-type
(function
;; Translate type of list containing POS to "ordered",
;; "variable" or "itemized".
(lambda (pos struct prevs)
(let ((type (org-list-get-list-type pos struct prevs)))
(cond
((eq 'ordered type) "ordered")
((eq 'descriptive type) "variable")
(t "itemized"))))))
(get-closings
(function
;; Return list of all items and sublists ending at POS, in
;; reverse order.
(lambda (pos)
(let (out)
(catch 'exit
(mapc (lambda (e)
(let ((end (nth 6 e))
(item (car e)))
(cond
((= end pos) (push item out))
((>= item pos) (throw 'exit nil)))))
struct))
out)))))
;; First close any previous item, or list, ending at POS.
(mapc (lambda (e)
(let* ((lastp (= (org-list-get-last-item e struct prevs) e))
(first-item (org-list-get-list-begin e struct prevs))
(type (funcall get-type first-item struct prevs)))
;; Ending for every item
(org-export-docbook-close-para-maybe)
(insert (if (equal type "variable")
"</listitem></varlistentry>\n"
"</listitem>\n"))
;; We're ending last item of the list: end list.
(when lastp
(insert (format "</%slist>\n" type))
(org-export-docbook-open-para))))
(funcall get-closings pos))
(cond
;; At an item: insert appropriate tags in export buffer.
((assq pos struct)
(string-match (concat "[ \t]*\\(\\S-+[ \t]*\\)"
"\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[a-zA-Z]\\)\\][ \t]*\\)?"
"\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?"
"\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?"
"\\(.*\\)")
line)
(let* ((checkbox (match-string 3 line))
(desc-tag (or (match-string 4 line) "???"))
(body (match-string 5 line))
(list-beg (org-list-get-list-begin pos struct prevs))
(firstp (= list-beg pos))
;; Always refer to first item to determine list type, in
;; case list is ill-formed.
(type (funcall get-type list-beg struct prevs))
;; Special variables for ordered lists.
(counter (let ((count-tmp (org-list-get-counter pos struct)))
(cond
((not count-tmp) nil)
((string-match "[A-Za-z]" count-tmp)
(- (string-to-char (upcase count-tmp)) 64))
((string-match "[0-9]+" count-tmp)
count-tmp)))))
;; When FIRSTP, a new list or sub-list is starting.
(when firstp
(org-export-docbook-close-para-maybe)
(insert (format "<%slist>\n" type)))
(insert (cond
((equal type "variable")
(format "<varlistentry><term>%s</term><listitem>" desc-tag))
((and (equal type "ordered") counter)
(format "<listitem override=\"%s\">" counter))
(t "<listitem>")))
;; For DocBook, we need to open a para right after tag
;; <listitem>.
(org-export-docbook-open-para)
;; If line had a checkbox, some additional modification is required.
(when checkbox (setq body (concat checkbox " " body)))
;; Return modified line
body))
;; At a list ender: normal text follows: need <para>.
((equal "ORG-LIST-END-MARKER" line)
(org-export-docbook-open-para)
(throw 'nextline nil))
;; Not at an item: return line unchanged (side-effects only).
(t line))))
(provide 'org-docbook)
;; arch-tag: a24a127c-d365-4c2a-9e9b-f7dcb0ebfdc3
;;; org-docbook.el ends here

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

@ -1,11 +1,11 @@
;;; org-docview.el --- support for links to doc-view-mode buffers
;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; Author: Jan Böcker <jan.boecker at jboecker dot de>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -88,5 +88,6 @@ and append it."
(provide 'org-docview)
;; arch-tag: dd147a78-cce1-481b-b40a-15869417debe
;;; org-docview.el ends here

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

@ -1,12 +1,12 @@
;;; org-entities.el --- Support for special entities in Org-mode
;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
;; Copyright (C) 2010 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>,
;; Ulf Stegemann <ulf at zeitform dot de>
;; Keywords: outlines, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -304,7 +304,7 @@ loaded, add these packages to `org-export-latex-packages-alist'."
("prod" "\\prod" t "&prod;" "[product]" "[n-ary product]" "∏")
("micro" "\\textmu{}" nil "&micro;" "micro" "µ" "µ")
("macr" "\\textasciimacron{}" nil "&macr;" "[macron]" "¯" "¯")
("deg" "\\textdegree{}" nil "deg" "degree" "°" "°")
("deg" "\\textdegree{}" nil "&deg;" "degree" "°" "°")
("prime" "\\prime" t "&prime;" "'" "'" "′")
("Prime" "\\prime{}\\prime" t "&Prime;" "''" "''" "″")
("infin" "\\propto" t "&infin;" "[infinity]" "[infinity]" "∞")
@ -568,5 +568,6 @@ Kind can be any of `latex', `html', `ascii', `latin1', or `utf8'."
;; coding: utf-8
;; End:
;; arch-tag: e6bd163f-7419-4009-9c93-a74623016424
;;; org-entities.el ends here

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

@ -1,9 +1,10 @@
;;; org-exp-blocks.el --- pre-process blocks when exporting org files
;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
;; Copyright (C) 2009, 2010
;; Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Version: 7.4
;; Version: 7.7
;; This file is part of GNU Emacs.
;;
@ -47,13 +48,15 @@
;;
;;; Currently Implemented Block Types
;;
;; ditaa :: Convert ascii pictures to actual images using ditaa
;; ditaa :: (DEPRECATED--use "#+begin_src ditaa" code blocks) Convert
;; ascii pictures to actual images using ditaa
;; http://ditaa.sourceforge.net/. To use this set
;; `org-ditaa-jar-path' to the path to ditaa.jar on your
;; system (should be set automatically in most cases) .
;;
;; dot :: Convert graphs defined using the dot graphing language to
;; images using the dot utility. For information on dot see
;; dot :: (DEPRECATED--use "#+begin_src dot" code blocks) Convert
;; graphs defined using the dot graphing language to images
;; using the dot utility. For information on dot see
;; http://www.graphviz.org/
;;
;; comment :: Wrap comments with titles and author information, in
@ -73,11 +76,6 @@
(require 'cl))
(require 'org)
(defvar htmlp)
(defvar latexp)
(defvar docbookp)
(defvar asciip)
(defun org-export-blocks-set (var value)
"Set the value of `org-export-blocks' and install fontification."
(set var value)
@ -170,33 +168,52 @@ which defaults to the value of `org-export-blocks-witheld'."
(save-window-excursion
(let ((case-fold-search t)
(types '())
indentation type func start body headers preserve-indent progress-marker)
matched indentation type func
start end body headers preserve-indent progress-marker)
(flet ((interblock (start end)
(mapcar (lambda (pair) (funcall (second pair) start end))
org-export-interblocks)))
(goto-char (point-min))
(setq start (point))
(while (re-search-forward
"^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]\\([^\000]*?\\)[\r\n][ \t]*#\\+end_\\S-+.*[\r\n]?" nil t)
(setq indentation (length (match-string 1)))
(setq type (intern (downcase (match-string 2))))
(setq headers (save-match-data (org-split-string (match-string 3) "[ \t]+")))
(setq body (match-string 4))
(setq preserve-indent (or org-src-preserve-indentation (member "-i" headers)))
(unless preserve-indent
(setq body (save-match-data (org-remove-indentation body))))
(unless (memq type types) (setq types (cons type types)))
(save-match-data (interblock start (match-beginning 0)))
(when (setq func (cadr (assoc type org-export-blocks)))
(let ((replacement (save-match-data
(if (memq type org-export-blocks-witheld) ""
(apply func body headers)))))
(when replacement
(replace-match replacement t t)
(unless preserve-indent
(indent-code-rigidly
(match-beginning 0) (match-end 0) indentation)))))
(setq start (match-end 0)))
(let ((beg-re "^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]"))
(while (re-search-forward beg-re nil t)
(let* ((match-start (match-beginning 0))
(body-start (match-end 0))
(indentation (length (match-string 1)))
(inner-re (format "[\r\n]*[ \t]*#\\+\\(begin\\|end\\)_%s"
(regexp-quote (downcase (match-string 2)))))
(type (intern (downcase (match-string 2))))
(headers (save-match-data
(org-split-string (match-string 3) "[ \t]+")))
(balanced 1)
(preserve-indent (or org-src-preserve-indentation
(member "-i" headers)))
match-end)
(while (and (not (zerop balanced))
(re-search-forward inner-re nil t))
(if (string= (downcase (match-string 1)) "end")
(decf balanced)
(incf balanced)))
(when (not (zerop balanced))
(error "unbalanced begin/end_%s blocks with %S"
type (buffer-substring match-start (point))))
(setq match-end (match-end 0))
(unless preserve-indent
(setq body (save-match-data (org-remove-indentation
(buffer-substring
body-start (match-beginning 0))))))
(unless (memq type types) (setq types (cons type types)))
(save-match-data (interblock start match-start))
(when (setq func (cadr (assoc type org-export-blocks)))
(let ((replacement (save-match-data
(if (memq type org-export-blocks-witheld) ""
(apply func body headers)))))
(when replacement
(delete-region match-start match-end)
(goto-char match-start) (insert replacement)
(unless preserve-indent
(indent-code-rigidly match-start (point) indentation))))))
(setq start (point))))
(interblock start (point-max))
(run-hooks 'org-export-blocks-postblock-hook)))))
@ -216,12 +233,15 @@ which defaults to the value of `org-export-blocks-witheld'."
(file-name-directory (or load-file-name buffer-file-name)))))))
"Path to the ditaa jar executable.")
(defvar org-export-current-backend) ; dynamically bound in org-exp.el
(defun org-export-blocks-format-ditaa (body &rest headers)
"Pass block BODY to the ditaa utility creating an image.
"DEPRECATED: use begin_src ditaa code blocks
Pass block BODY to the ditaa utility creating an image.
Specify the path at which the image should be saved as the first
element of headers, any additional elements of headers will be
passed to the ditaa utility as command line arguments."
(message "ditaa-formatting...")
(message "begin_ditaa blocks are DEPRECATED, use begin_src blocks")
(let* ((args (if (cdr headers) (mapconcat 'identity (cdr headers) " ")))
(data-file (make-temp-file "org-ditaa"))
(hash (progn
@ -240,8 +260,9 @@ passed to the ditaa utility as command line arguments."
(mapconcat (lambda (x) (substring x (if (> (length x) 1) 2 1)))
(org-split-string body "\n")
"\n")))
(prog1
(cond
((or htmlp latexp docbookp)
((member org-export-current-backend '(html latex docbook))
(unless (file-exists-p out-file)
(mapc ;; remove old hashed versions of this file
(lambda (file)
@ -261,13 +282,16 @@ passed to the ditaa utility as command line arguments."
(t (concat
"\n#+BEGIN_EXAMPLE\n"
body (if (string-match "\n$" body) "" "\n")
"#+END_EXAMPLE\n")))))
"#+END_EXAMPLE\n")))
(message "begin_ditaa blocks are DEPRECATED, use begin_src blocks"))))
;;--------------------------------------------------------------------------------
;; dot: create graphs using the dot graphing language
;; (require the dot executable to be in your path)
(defun org-export-blocks-format-dot (body &rest headers)
"Pass block BODY to the dot graphing utility creating an image.
"DEPRECATED: use \"#+begin_src dot\" code blocks
Pass block BODY to the dot graphing utility creating an image.
Specify the path at which the image should be saved as the first
element of headers, any additional elements of headers will be
passed to the dot utility as command line arguments. Don't
@ -283,7 +307,7 @@ digraph data_relationships {
\"data_requirement\" -> \"data_product\"
}
#+end_dot"
(message "dot-formatting...")
(message "begin_dot blocks are DEPRECATED, use begin_src blocks")
(let* ((args (if (cdr headers) (mapconcat 'identity (cdr headers) " ")))
(data-file (make-temp-file "org-ditaa"))
(hash (progn
@ -295,28 +319,30 @@ digraph data_relationships {
(match-string 2 raw-out-file))
(cons raw-out-file "png")))
(out-file (concat (car out-file-parts) "_" hash "." (cdr out-file-parts))))
(prog1
(cond
((or htmlp latexp docbookp)
((member org-export-current-backend '(html latex docbook))
(unless (file-exists-p out-file)
(mapc ;; remove old hashed versions of this file
(lambda (file)
(when (and (string-match (concat (regexp-quote (car out-file-parts))
"_\\([[:alnum:]]+\\)\\."
(regexp-quote (cdr out-file-parts)))
file)
(= (length (match-string 1 out-file)) 40))
(delete-file (expand-file-name file
(file-name-directory out-file)))))
(directory-files (or (file-name-directory out-file)
default-directory)))
(with-temp-file data-file (insert body))
(message (concat "dot " data-file " " args " -o " out-file))
(shell-command (concat "dot " data-file " " args " -o " out-file)))
(mapc ;; remove old hashed versions of this file
(lambda (file)
(when (and (string-match (concat (regexp-quote (car out-file-parts))
"_\\([[:alnum:]]+\\)\\."
(regexp-quote (cdr out-file-parts)))
file)
(= (length (match-string 1 out-file)) 40))
(delete-file (expand-file-name file
(file-name-directory out-file)))))
(directory-files (or (file-name-directory out-file)
default-directory)))
(with-temp-file data-file (insert body))
(message (concat "dot " data-file " " args " -o " out-file))
(shell-command (concat "dot " data-file " " args " -o " out-file)))
(format "\n[[file:%s]]\n" out-file))
(t (concat
"\n#+BEGIN_EXAMPLE\n"
body (if (string-match "\n$" body) "" "\n")
"#+END_EXAMPLE\n")))))
"#+END_EXAMPLE\n")))
(message "begin_dot blocks are DEPRECATED, use begin_src blocks"))))
;;--------------------------------------------------------------------------------
;; comment: export comments in author-specific css-stylable divs
@ -327,17 +353,17 @@ other backends, it converts the comment into an EXAMPLE segment."
(let ((owner (if headers (car headers)))
(title (if (cdr headers) (mapconcat 'identity (cdr headers) " "))))
(cond
(htmlp ;; We are exporting to HTML
((eq org-export-current-backend 'html) ;; We are exporting to HTML
(concat "#+BEGIN_HTML\n"
"<div class=\"org-comment\""
(if owner (format " id=\"org-comment-%s\" " owner))
">\n"
(if owner (concat "<b>" owner "</b> ") "")
(if (and title (> (length title) 0)) (concat " -- " title "</br>\n") "</br>\n")
(if (and title (> (length title) 0)) (concat " -- " title "<br/>\n") "<br/>\n")
"<p>\n"
"#+END_HTML\n"
body
"#+BEGIN_HTML\n"
"\n#+BEGIN_HTML\n"
"</p>\n"
"</div>\n"
"#+END_HTML\n"))
@ -351,4 +377,5 @@ other backends, it converts the comment into an EXAMPLE segment."
(provide 'org-exp-blocks)
;; arch-tag: 1c365fe9-8808-4f72-bb15-0b00f36d8024
;;; org-exp-blocks.el ends here

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

File diff suppressed because it is too large Load diff

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

@ -1,11 +1,12 @@
;;; org-faces.el --- Face definitions for Org-mode.
;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -50,6 +51,11 @@
:tag "Org Faces"
:group 'org-appearance)
(defface org-default
(org-compatible-face 'default nil)
"Face used for default text."
:group 'org-faces)
(defface org-hide
'((((background light)) (:foreground "white"))
(((background dark)) (:foreground "black")))
@ -136,7 +142,7 @@ color of the frame."
:group 'org-faces)
(defface org-special-keyword ;; originally copied from font-lock-string-face
(org-compatible-face nil
(org-compatible-face 'font-lock-keyword-face
'((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown"))
(((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon"))
(t (:italic t))))
@ -246,7 +252,10 @@ column view defines special faces for each outline level. See the file
:group 'org-faces)
(defface org-link
'((t :inherit link))
(org-compatible-face 'link
'((((class color) (background light)) (:foreground "Purple" :underline t))
(((class color) (background dark)) (:foreground "Cyan" :underline t))
(t (:underline t))))
"Face for links."
:group 'org-faces)
@ -318,7 +327,7 @@ specific tags."
(((class color) (min-colors 8)) (:foreground "green"))
(t (:bold nil))))
"Face used in agenda, to indicate lines switched to DONE.
This face is used to de-emphasize items that where brightly colord in the
This face is used to de-emphasize items that where brightly colored in the
agenda because they were things to do, or overdue. The DONE state itself
is of course immediately visible, but for example a passed deadline is
\(by default) very bright read. This face could be simply the default face
@ -507,6 +516,15 @@ follows a #+DATE:, #+AUTHOR: or #+EMAIL: keyword."
:group 'org-faces
:version "22.1")
(defface org-block-background '((t ()))
"Face used for the source block background.")
(org-copy-face 'org-meta-line 'org-block-begin-line
"Face used for the line delimiting the begin of source blocks.")
(org-copy-face 'org-meta-line 'org-block-end-line
"Face used for the line delimiting the end of source blocks.")
(defface org-verbatim
(org-compatible-face 'shadow
'((((class color grayscale) (min-colors 88) (background light))
@ -664,6 +682,9 @@ month and 365.24 days for a year)."
"Face used for time grids."
:group 'org-faces)
(org-copy-face 'org-time-grid 'org-agenda-current-time
"Face used to show the current time in the time grid.")
(defface org-agenda-diary
(org-compatible-face 'default
nil)
@ -715,5 +736,6 @@ level org-n-level-faces"
(provide 'org-faces)
;; arch-tag: 9dab5f91-c4b9-4d6f-bac3-1f6211ad0a04
;;; org-faces.el ends here

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

@ -1,11 +1,11 @@
;;; org-feed.el --- Add RSS feed items to Org files
;;
;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -436,7 +436,7 @@ it can be a list structured like an entry in `org-feed-alist'."
(if (stringp feed) (setq feed (assoc feed org-feed-alist)))
(unless feed
(error "No such feed in `org-feed-alist"))
(switch-to-buffer
(org-pop-to-buffer-same-window
(org-feed-update feed 'retrieve-only))
(goto-char (point-min)))
@ -674,4 +674,5 @@ formatted as a string, not the original XML data."
(provide 'org-feed)
;; arch-tag: 0929b557-9bc4-47f4-9633-30a12dbb5ae2
;;; org-feed.el ends here

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

@ -1,11 +1,11 @@
;;; org-footnote.el --- Footnote support in Org and elsewhere
;;
;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -38,8 +38,11 @@
(require 'org-macs)
(require 'org-compat)
(declare-function org-combine-plists "org" (&rest plists))
(declare-function org-in-commented-line "org" ())
(declare-function org-in-indented-comment-line "org" ())
(declare-function org-in-regexp "org" (re &optional nlines visually))
(declare-function org-in-block-p "org" (names))
(declare-function org-mark-ring-push "org" (&optional pos buffer))
(declare-function outline-next-heading "outline")
(declare-function org-trim "org" (s))
@ -48,24 +51,39 @@
(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
(declare-function org-in-verbatim-emphasis "org" ())
(declare-function org-inside-latex-macro-p "org" ())
(declare-function org-id-uuid "org" ())
(declare-function org-fill-paragraph "org" (&optional justify))
(declare-function org-export-preprocess-string "org-exp"
(string &rest parameters))
(defvar org-outline-regexp-bol) ; defined in org.el
(defvar org-odd-levels-only) ;; defined in org.el
(defvar org-bracket-link-regexp) ; defined in org.el
(defvar message-signature-separator) ;; defined in message.el
(defconst org-footnote-re
(concat "[^][\n]" ; to make sure it is not at the beginning of a line
"\\["
"\\(?:"
"\\([0-9]+\\)"
"\\|"
(org-re "\\(fn:\\([-_[:word:]]+?\\)?\\)\\(?::\\([^\]]*?\\)\\)?")
"\\)"
"\\]")
;; Only [1]-like footnotes are closed in this regexp, as footnotes
;; from other types might contain square brackets (i.e. links) in
;; their definition.
;;
;; `org-re' is used for regexp compatibility with XEmacs.
(org-re (concat "\\[\\(?:"
;; Match inline footnotes.
"fn:\\([-_[:word:]]+\\)?:\\|"
;; Match other footnotes.
"\\(?:\\([0-9]+\\)\\]\\)\\|"
"\\(fn:[-_[:word:]]+\\)"
"\\)"))
"Regular expression for matching footnotes.")
(defconst org-footnote-definition-re
(org-re "^\\(\\[\\([0-9]+\\|fn:[-_[:word:]]+\\)\\]\\)")
"Regular expression matching the definition of a footnote.")
(defvar org-footnote-forbidden-blocks '("example" "verse" "src" "ascii" "beamer"
"docbook" "html" "latex" "odt")
"Names of blocks where footnotes are not allowed.")
(defgroup org-footnote nil
"Footnotes in Org-mode."
:tag "Org Footnote"
@ -113,12 +131,14 @@ t create unique labels of the form [fn:1], [fn:2], ...
confirm like t, but let the user edit the created value. In particular,
the label can be removed from the minibuffer, to create
an anonymous footnote.
random Automatically generate a unique, random label.
plain Automatically create plain number labels like [1]"
:group 'org-footnote
:type '(choice
(const :tag "Prompt for label" nil)
(const :tag "Create automatic [fn:N]" t)
(const :tag "Offer automatic [fn:N] for editing" confirm)
(const :tag "Create a random label" random)
(const :tag "Create automatic [N]" plain)))
(defcustom org-footnote-auto-adjust nil
@ -146,45 +166,181 @@ extracted will be filled again."
:group 'org-footnote
:type 'boolean)
(defun org-footnote-in-valid-context-p ()
"Is point in a context where footnotes are allowed?"
(save-match-data
(not (or (org-in-commented-line)
(org-in-indented-comment-line)
(org-in-verbatim-emphasis)
;; Avoid literal example.
(save-excursion
(beginning-of-line)
(looking-at "[ \t]*:[ \t]+"))
;; Avoid cited text and headers in message-mode.
(and (derived-mode-p 'message-mode)
(or (save-excursion
(beginning-of-line)
(looking-at message-cite-prefix-regexp))
(message-point-in-header-p)))
;; Avoid forbidden blocks.
(org-in-block-p org-footnote-forbidden-blocks)))))
(defun org-footnote-at-reference-p ()
"Is the cursor at a footnote reference?
If yes, return the beginning position, the label, and the definition, if local."
(when (org-in-regexp org-footnote-re 15)
(list (match-beginning 0)
(or (match-string 1)
(if (equal (match-string 2) "fn:") nil (match-string 2)))
(match-string 4))))
If so, return a list containing its label, beginning and ending
positions, and the definition, when inlined."
(when (and (org-footnote-in-valid-context-p)
(or (looking-at org-footnote-re)
(org-in-regexp org-footnote-re)
(save-excursion (re-search-backward org-footnote-re nil t)))
;; Only inline footnotes can start at bol.
(or (eq (char-before (match-end 0)) 58)
(/= (match-beginning 0) (point-at-bol))))
(let* ((beg (match-beginning 0))
(label (or (match-string 2) (match-string 3)
;; Anonymous footnotes don't have labels
(and (match-string 1) (concat "fn:" (match-string 1)))))
;; Inline footnotes don't end at (match-end 0) as
;; `org-footnote-re' stops just after the second colon.
;; Find the real ending with `scan-sexps', so Org doesn't
;; get fooled by unrelated closing square brackets.
(end (ignore-errors (scan-sexps beg 1))))
;; Point is really at a reference if it's located before true
;; ending of the footnote.
(when (and end (< (point) end)
;; Verify match isn't a part of a link.
(not (save-excursion
(goto-char beg)
(let ((linkp
(save-match-data
(org-in-regexp org-bracket-link-regexp))))
(and linkp (< (point) (cdr linkp))))))
;; Verify point doesn't belong to a LaTeX macro.
;; Beware though, when two footnotes are side by
;; side, once the first one is changed into LaTeX,
;; the second one might then be considered as an
;; optional argument of the command. Thus, check
;; the `org-protected' property of that command.
(or (not (org-inside-latex-macro-p))
(and (get-text-property (1- beg) 'org-protected)
(not (get-text-property beg 'org-protected)))))
(list label beg end
;; Definition: ensure this is an inline footnote first.
(and (or (not label) (match-string 1))
(org-trim (buffer-substring (match-end 0) (1- end)))))))))
(defun org-footnote-at-definition-p ()
"Is the cursor at a footnote definition.
"Is the cursor at a footnote definition?
This matches only pure definitions like [1] or [fn:name] at the beginning
of a line. It does not a references like [fn:name:definition], where the
of a line. It does not match references like [fn:name:definition], where the
footnote text is included and defined locally.
The return value will be nil if not at a footnote definition, and a list
with start and label of the footnote if there is a definition at point."
The return value will be nil if not at a footnote definition, and a list with
label, start, end and definition of the footnote otherwise."
(when (org-footnote-in-valid-context-p)
(save-excursion
(end-of-line)
(let ((lim (save-excursion (re-search-backward
(concat org-outline-regexp-bol
"\\|^[ \t]*$") nil t))))
(when (re-search-backward org-footnote-definition-re lim t)
(end-of-line)
(list (match-string 2)
(match-beginning 0)
(save-match-data
;; In a message, limit search to signature.
(let ((bound (and (derived-mode-p 'message-mode)
(save-excursion
(goto-char (point-max))
(re-search-backward
message-signature-separator nil t)))))
(or (and (re-search-forward
(org-re
(concat "^[ \t]*$" "\\|"
org-outline-regexp-bol
"\\|"
"^\\[\\([0-9]+\\|fn:[-_[:word:]]+\\)\\]"))
bound 'move)
(progn (skip-chars-forward " \t\n") (point-at-bol)))
(point))))
(org-trim (buffer-substring (match-end 0) (point)))))))))
(defun org-footnote-get-next-reference (&optional label backward limit)
"Return complete reference of the next footnote.
If LABEL is provided, get the next reference of that footnote. If
BACKWARD is non-nil, find previous reference instead. LIMIT is
the buffer position bounding the search.
Return value is a list like those provided by `org-footnote-at-reference-p'.
If no footnote is found, return nil."
(save-excursion
(end-of-line 1)
(let ((lim (save-excursion (re-search-backward "^\\*+ \\|^[ \t]*$" nil t))))
(when (re-search-backward org-footnote-definition-re lim t)
(list (match-beginning 0) (match-string 2))))))
(let* ((label-fmt (if label (format "\\[%s[]:]" label) org-footnote-re)))
(catch 'exit
(while t
(unless (funcall (if backward #'re-search-backward #'re-search-forward)
label-fmt limit t)
(throw 'exit nil))
(unless backward (backward-char))
(let ((ref (org-footnote-at-reference-p)))
(when ref (throw 'exit ref))))))))
(defun org-footnote-next-reference-or-definition (limit)
"Move point to next footnote reference or definition.
LIMIT is the buffer position bounding the search.
Return value is a list like those provided by
`org-footnote-at-reference-p' or `org-footnote-at-definition-p'.
If no footnote is found, return nil."
(let* (ref)
(catch 'exit
(while t
(unless (re-search-forward org-footnote-re limit t)
(throw 'exit nil))
;; Beware: with [1]-like footnotes point will be just after
;; the closing square bracket.
(backward-char)
(cond
((setq ref (org-footnote-at-reference-p))
(throw 'exit ref))
;; Definition: also grab the last square bracket, only
;; matched in `org-footnote-re' for [1]-like footnotes.
((save-match-data (org-footnote-at-definition-p))
(let ((end (match-end 0)))
(throw 'exit
(list nil (match-beginning 0)
(if (eq (char-before end) 93) end (1+ end)))))))))))
(defun org-footnote-get-definition (label)
"Return label, boundaries and definition of the footnote LABEL."
(let* ((label (regexp-quote (org-footnote-normalize-label label)))
(re (format "^\\[%s\\]\\|.\\[%s:" label label))
pos)
(save-excursion
(when (or (re-search-forward re nil t)
(and (goto-char (point-min))
(re-search-forward re nil t))
(and (progn (widen) t)
(goto-char (point-min))
(re-search-forward re nil t)))
(let ((refp (org-footnote-at-reference-p)))
(cond
((and (nth 3 refp) refp))
((org-footnote-at-definition-p))))))))
(defun org-footnote-goto-definition (label)
"Find the definition of the footnote with label LABEL."
"Move point to the definition of the footnote LABEL."
(interactive "sLabel: ")
(org-mark-ring-push)
(setq label (org-footnote-normalize-label label))
(let ((re (format "^\\[%s\\]\\|.\\[%s:" label label))
pos)
(save-excursion
(setq pos (or (re-search-forward re nil t)
(and (goto-char (point-min))
(re-search-forward re nil t))
(and (progn (widen) t)
(goto-char (point-min))
(re-search-forward re nil t)))))
(if (not pos)
(let ((def (org-footnote-get-definition label)))
(if (not def)
(error "Cannot find definition of footnote %s" label)
(goto-char pos)
(goto-char (nth 1 def))
(looking-at (format "\\[%s\\]\\|\\[%s:" label label))
(goto-char (match-end 0))
(org-show-context 'link-search)
(message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'."))))
@ -192,45 +348,60 @@ with start and label of the footnote if there is a definition at point."
"Find the first closest (to point) reference of footnote with label LABEL."
(interactive "sLabel: ")
(org-mark-ring-push)
(setq label (org-footnote-normalize-label label))
(let ((re (format ".\\[%s[]:]" label))
(p0 (point)) pos)
(let* ((label (org-footnote-normalize-label label)) ref)
(save-excursion
(setq pos (or (re-search-backward re nil t)
(and (goto-char (point-max))
(re-search-backward re nil t))
(and (progn (widen) t)
(goto-char p0)
(re-search-backward re nil t))
(and (goto-char (point-max))
(re-search-forward re nil t)))))
(if pos
(progn
(goto-char (match-end 0))
(org-show-context 'link-search))
(error "Cannot find reference of footnote %s" label))))
(setq ref (or (org-footnote-get-next-reference label t)
(org-footnote-get-next-reference label)
(save-restriction
(widen)
(or
(org-footnote-get-next-reference label t)
(org-footnote-get-next-reference label))))))
(if (not ref)
(error "Cannot find reference of footnote %s" label)
(goto-char (nth 1 ref))
(org-show-context 'link-search))))
(defun org-footnote-normalize-label (label)
(if (numberp label) (setq label (number-to-string label)))
(if (not (string-match "^[0-9]+$\\|^$\\|^fn:" label))
(setq label (concat "fn:" label)))
label)
"Return LABEL as an appropriate string."
(cond
((numberp label) (number-to-string label))
((equal "" label) nil)
((not (string-match "^[0-9]+$\\|^fn:" label))
(concat "fn:" label))
(t label)))
(defun org-footnote-all-labels ()
"Return list with all defined foot labels used in the buffer."
(let (rtn l)
(defun org-footnote-all-labels (&optional with-defs)
"Return list with all defined foot labels used in the buffer.
If WITH-DEFS is non-nil, also associate the definition to each
label. The function will then return an alist whose key is label
and value definition."
(let* (rtn
(push-to-rtn
(function
;; Depending on WITH-DEFS, store label or (label . def) of
;; footnote reference/definition given as argument in RTN.
(lambda (el)
(let ((lbl (car el)))
(push (if with-defs (cons lbl (nth 3 el)) lbl) rtn))))))
(save-excursion
(save-restriction
(widen)
;; Find all labels found in definitions.
(goto-char (point-min))
(while (re-search-forward org-footnote-definition-re nil t)
(setq l (org-match-string-no-properties 2))
(and l (add-to-list 'rtn l)))
(let (def)
(while (re-search-forward org-footnote-definition-re nil t)
(when (setq def (org-footnote-at-definition-p))
(funcall push-to-rtn def))))
;; Find all labels found in references.
(goto-char (point-min))
(while (re-search-forward org-footnote-re nil t)
(setq l (or (org-match-string-no-properties 1)
(org-match-string-no-properties 2)))
(and l (not (equal l "fn:")) (add-to-list 'rtn l)))))
(let (ref)
(while (setq ref (org-footnote-get-next-reference))
(goto-char (nth 2 ref))
(and (car ref) ; ignore anonymous footnotes
(not (funcall (if with-defs #'assoc #'member) (car ref) rtn))
(funcall push-to-rtn ref))))))
rtn))
(defun org-footnote-unique-label (&optional current)
@ -253,19 +424,27 @@ This command prompts for a label. If this is a label referencing an
existing label, only insert the label. If the footnote label is empty
or new, let the user edit the definition of the footnote."
(interactive)
(let* ((labels (org-footnote-all-labels))
(unless (and (not (bolp)) (org-footnote-in-valid-context-p))
(error "Cannot insert a footnote here"))
(let* ((labels (and (not (equal org-footnote-auto-label 'random))
(org-footnote-all-labels)))
(propose (org-footnote-unique-label labels))
(label
(if (member org-footnote-auto-label '(t plain))
propose
(completing-read
"Label (leave empty for anonymous): "
(mapcar 'list labels) nil nil
(if (eq org-footnote-auto-label 'confirm) propose nil)
'org-footnote-label-history))))
(setq label (org-footnote-normalize-label label))
(org-footnote-normalize-label
(cond
((member org-footnote-auto-label '(t plain))
propose)
((equal org-footnote-auto-label 'random)
(require 'org-id)
(substring (org-id-uuid) 0 8))
(t
(completing-read
"Label (leave empty for anonymous): "
(mapcar 'list labels) nil nil
(if (eq org-footnote-auto-label 'confirm) propose nil)
'org-footnote-label-history))))))
(cond
((equal label "")
((not label)
(insert "[fn:: ]")
(backward-char 1))
((member label labels)
@ -283,47 +462,61 @@ or new, let the user edit the definition of the footnote."
(defun org-footnote-create-definition (label)
"Start the definition of a footnote with label LABEL."
(interactive "sLabel: ")
(setq label (org-footnote-normalize-label label))
(let (re)
(let ((label (org-footnote-normalize-label label)))
(cond
((org-mode-p)
(if (not org-footnote-section)
;; No section, put footnote into the current outline node
nil
;; Try to find or make the special node
(setq re (concat "^\\*+[ \t]+" org-footnote-section "[ \t]*$"))
(unless (or (re-search-forward re nil t)
(and (progn (widen) t)
(re-search-forward re nil t)))
;; No section, put footnote into the current outline node Try to
;; find or make the special node
(when org-footnote-section
(goto-char (point-min))
(let ((re (concat "^\\*+[ \t]+" org-footnote-section "[ \t]*$")))
(unless (or (re-search-forward re nil t)
(and (progn (widen) t)
(re-search-forward re nil t)))
(goto-char (point-max))
(insert "\n\n* " org-footnote-section "\n")))
(insert "\n\n* " org-footnote-section "\n"))))
;; Now go to the end of this entry and insert there.
(org-footnote-goto-local-insertion-point)
(org-show-context 'link-search))
(t
(setq re (concat "^" org-footnote-tag-for-non-org-mode-files "[ \t]*$"))
(unless (re-search-forward re nil t)
(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)))))
;; In a non-Org file. Search for footnote tag, or create it if
;; necessary (at the end of buffer, or before a signature if in
;; Message mode). Set point after any definition already there.
(let ((tag (concat "^" org-footnote-tag-for-non-org-mode-files "[ \t]*$"))
(max (save-excursion
(if (and (derived-mode-p 'message-mode)
(re-search-forward
message-signature-separator nil t))
(copy-marker (point-at-bol) t)
(copy-marker (point-max) t)))))
(goto-char max)
(unless (re-search-backward tag nil t)
(skip-chars-backward " \t\r\n")
(delete-region (point) max)
(insert "\n\n")
(insert org-footnote-tag-for-non-org-mode-files "\n")))))
;; Skip existing footnotes
(while (re-search-forward "^[[:space:]]*\\[[^]]+\\] " nil t)
(forward-line))
(insert "[" label "] \n")
(goto-char (1- (point)))
(insert "\n\n" org-footnote-tag-for-non-org-mode-files "\n"))
;; Skip existing footnotes.
(while (re-search-forward org-footnote-definition-re max t))
(let ((def (org-footnote-at-definition-p)))
(when def (goto-char (nth 2 def))))
(set-marker max nil))))
;; Insert footnote label, position point and notify user.
(unless (bolp) (insert "\n"))
(insert "\n[" label "] \n")
(backward-char)
(message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'.")))
;;;###autoload
(defun org-footnote-action (&optional special)
"Do the right thing for footnotes.
When at a footnote reference, jump to the definition. When at a definition,
jump to the references. When neither at definition or reference,
create a new footnote, interactively.
When at a footnote reference, jump to the definition.
When at a definition, jump to the references if they exist, offer
to create them otherwise.
When neither at definition or reference, create a new footnote,
interactively.
With prefix arg SPECIAL, offer additional commands in a menu."
(interactive "P")
(let (tmp c)
@ -332,35 +525,66 @@ With prefix arg SPECIAL, offer additional commands in a menu."
(message "Footnotes: [s]ort | [r]enumber fn:N | [S]=r+s |->[n]umeric | [d]elete")
(setq c (read-char-exclusive))
(cond
((equal c ?s)
(org-footnote-normalize 'sort))
((equal c ?r)
(org-footnote-renumber-fn:N))
((equal c ?S)
((eq c ?s) (org-footnote-normalize 'sort))
((eq c ?r) (org-footnote-renumber-fn:N))
((eq c ?S)
(org-footnote-renumber-fn:N)
(org-footnote-normalize 'sort))
((equal c ?n)
(org-footnote-normalize))
((equal c ?d)
(org-footnote-delete))
((eq c ?n) (org-footnote-normalize))
((eq c ?d) (org-footnote-delete))
(t (error "No such footnote command %c" c))))
((setq tmp (org-footnote-at-reference-p))
(if (nth 1 tmp)
(org-footnote-goto-definition (nth 1 tmp))
(goto-char (match-beginning 4))))
(cond
;; Anonymous footnote: move point at the beginning of its
;; definition.
((not (car tmp))
(goto-char (nth 1 tmp))
(forward-char 5))
;; A definition exists: move to it.
((ignore-errors (org-footnote-goto-definition (car tmp))))
;; No definition exists: offer to create it.
((yes-or-no-p (format "No definition for %s. Create one? " (car tmp)))
(org-footnote-create-definition (car tmp)))))
((setq tmp (org-footnote-at-definition-p))
(org-footnote-goto-previous-reference (nth 1 tmp)))
(org-footnote-goto-previous-reference (car tmp)))
(t (org-footnote-new)))))
(defvar org-footnote-insert-pos-for-preprocessor 'point-max
"See `org-footnote-normalize'.")
(defvar org-export-footnotes-seen nil) ; silence byte-compiler
(defvar org-export-footnotes-data nil) ; silence byte-compiler
;;;###autoload
(defun org-footnote-normalize (&optional sort-only for-preprocessor)
(defun org-footnote-normalize (&optional sort-only export-props)
"Collect the footnotes in various formats and normalize them.
This finds the different sorts of footnotes allowed in Org, and
normalizes them to the usual [N] format that is understood by the
Org-mode exporters.
When SORT-ONLY is set, only sort the footnote definitions into the
referenced sequence."
referenced sequence.
If Org is amidst an export process, EXPORT-PROPS will hold the
export properties of the buffer.
When EXPORT-PROPS is non-nil, the default action is to insert
normalized footnotes towards the end of the pre-processing buffer.
Some exporters like docbook, odt, etc. expect that footnote
definitions be available before any references to them. Such
exporters can let bind `org-footnote-insert-pos-for-preprocessor' to
symbol 'point-min to achieve the desired behaviour.
Additional note on `org-footnote-insert-pos-for-preprocessor':
1. This variable has not effect when FOR-PREPROCESSOR is nil.
2. This variable (potentially) obviates the need for extra scan
of pre-processor buffer as witnessed in
`org-export-docbook-get-footnotes'."
;; This is based on Paul's function, but rewritten.
;;
;; Re-create `org-with-limited-levels', but not limited to Org
;; buffers.
(let* ((limit-level
(and (boundp 'org-inlinetask-min-level)
org-inlinetask-min-level
@ -369,54 +593,71 @@ referenced sequence."
(if org-odd-levels-only
(and limit-level (1- (* limit-level 2)))
limit-level)))
(outline-regexp
(org-outline-regexp
(concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ ")))
(count 0)
ref def idef ref-table beg beg1 marker a before ins-point)
(save-excursion
;; Now find footnote references, and extract the definitions
;; Determine the highest marker used so far.
(ref-table (when export-props org-export-footnotes-seen))
(count (if (and export-props ref-table)
(apply 'max (mapcar (lambda (e) (nth 1 e)) ref-table))
0))
ins-point ref)
(save-excursion
;; 1. Find every footnote reference, extract the definition, and
;; collect that data in REF-TABLE. If SORT-ONLY is nil, also
;; normalize references.
(goto-char (point-min))
(while (re-search-forward org-footnote-re nil t)
(unless (or (org-in-commented-line) (org-in-verbatim-emphasis)
(org-inside-latex-macro-p))
(org-if-unprotected
(setq def (match-string 4)
idef def
ref (or (match-string 1) (match-string 2))
before (char-to-string (char-after (match-beginning 0))))
(if (equal ref "fn:") (setq ref nil))
(if (and ref (setq a (assoc ref ref-table)))
(progn
(setq marker (nth 1 a))
(unless (nth 2 a) (setf (caddr a) def)))
(setq marker (number-to-string (incf count))))
(save-match-data
(if def
(setq def (org-trim def))
(save-excursion
(goto-char (point-min))
(if (not (re-search-forward (concat "^\\[" (regexp-quote ref)
"\\]") nil t))
(setq def nil)
(setq beg (match-beginning 0))
(setq beg1 (match-end 0))
(re-search-forward
(org-re "^[ \t]*$\\|^\\*+ \\|^\\[\\([0-9]+\\|fn:[-_[:word:]]+\\)\\]")
nil 'move)
(setq def (buffer-substring beg1 (or (match-beginning 0)
(point-max))))
(goto-char beg)
(skip-chars-backward " \t\n\t")
(delete-region (1+ (point)) (match-beginning 0))))))
(unless sort-only
(replace-match (concat before "[" marker "]") t t)
(and idef
org-footnote-fill-after-inline-note-extraction
(fill-paragraph)))
(if (not a) (push (list ref marker def (if idef t nil))
ref-table)))))
;; First find and remove the footnote section
(while (setq ref (org-footnote-get-next-reference))
(let* ((lbl (car ref))
;; When footnote isn't anonymous, check if it's label
;; (REF) is already stored in REF-TABLE. In that case,
;; extract number used to identify it (MARKER). If
;; footnote is unknown, increment the global counter
;; (COUNT) to create an unused identifier.
(a (and lbl (assoc lbl ref-table)))
(marker (or (nth 1 a) (incf count)))
;; Is the reference inline or pointing to an inline
;; footnote?
(inlinep (or (stringp (nth 3 ref)) (nth 3 a))))
;; Replace footnote reference with [MARKER]. Maybe fill
;; paragraph once done. If SORT-ONLY is non-nil, only move
;; to the end of reference found to avoid matching it twice.
;; If EXPORT-PROPS isn't nil, also add `org-footnote'
;; property to it, so it can be easily recognized by
;; exporters.
(if sort-only
(goto-char (nth 2 ref))
(delete-region (nth 1 ref) (nth 2 ref))
(goto-char (nth 1 ref))
(let ((new-ref (format "[%d]" marker)))
(when export-props (org-add-props new-ref '(org-footnote t)))
(insert new-ref))
(and inlinep
org-footnote-fill-after-inline-note-extraction
(org-fill-paragraph)))
;; Add label (REF), identifier (MARKER) and definition (DEF)
;; to REF-TABLE if data was unknown.
(unless a
(let ((def (or (nth 3 ref) ; inline
(and export-props
(cdr (assoc lbl org-export-footnotes-data)))
(nth 3 (org-footnote-get-definition lbl)))))
(push (list lbl marker
;; When exporting, each definition goes
;; through `org-export-preprocess-string' so
;; it is ready to insert in the
;; backend-specific buffer.
(if export-props
(let ((parameters
(org-combine-plists
export-props
'(:todo-keywords t :tags t :priority t))))
(org-export-preprocess-string def parameters))
def)
inlinep) ref-table)))
;; Remove definition of non-inlined footnotes.
(unless inlinep (org-footnote-delete-definitions lbl))))
;; 2. Find and remove the footnote section, if any. Also
;; determine where footnotes shall be inserted (INS-POINT).
(goto-char (point-min))
(cond
((org-mode-p)
@ -425,82 +666,97 @@ referenced sequence."
(concat "^\\*[ \t]+" (regexp-quote org-footnote-section)
"[ \t]*$")
nil t))
(if (or for-preprocessor (not org-footnote-section))
(replace-match "")
(org-back-to-heading t)
(forward-line 1)
(setq ins-point (point))
(delete-region (point) (org-end-of-subtree t)))
(goto-char (point-max))
(unless for-preprocessor
(when org-footnote-section
(or (bolp) (insert "\n"))
(insert "* " org-footnote-section "\n")
(setq ins-point (point))))))
(progn
(setq ins-point (match-beginning 0))
(delete-region (match-beginning 0) (org-end-of-subtree t)))
(setq ins-point (point-max))))
(t
(if (re-search-forward
(concat "^"
(regexp-quote org-footnote-tag-for-non-org-mode-files)
"[ \t]*$")
nil t)
(replace-match ""))
(goto-char (point-max))
(skip-chars-backward " \t\n\r")
(delete-region (point) (point-max))
(insert "\n\n" org-footnote-tag-for-non-org-mode-files "\n")
(when (re-search-forward
(concat "^"
(regexp-quote org-footnote-tag-for-non-org-mode-files)
"[ \t]*$")
nil t)
(replace-match ""))
;; In message-mode, ensure footnotes are inserted before the
;; signature.
(let ((pt-max
(or (and (derived-mode-p 'message-mode)
(save-excursion
(goto-char (point-max))
(re-search-backward
message-signature-separator nil t)
(1- (point))))
(point-max))))
(goto-char pt-max)
(skip-chars-backward " \t\n\r")
(forward-line)
(delete-region (point) pt-max))
(setq ins-point (point))))
;; Insert the footnotes again
(goto-char (or ins-point (point-max)))
(setq ref-table (reverse ref-table))
(when sort-only
;; remove anonymous and inline footnotes from the list
(setq ref-table
(delq nil (mapcar
(lambda (x) (and (car x)
(not (equal (car x) "fn:"))
(not (nth 3 x))
x))
ref-table))))
;; Make sure each footnote has a description, or an error message.
;; 3. Clean-up REF-TABLE.
(setq ref-table
(mapcar
(lambda (x)
(if (not (nth 2 x))
(setcar (cddr x)
(format "FOOTNOTE DEFINITION NOT FOUND: %s" (car x)))
(setcar (cddr x) (org-trim (nth 2 x))))
x)
ref-table))
(if (or (not (org-mode-p)) ; not an Org file
org-footnote-section ; we do not use a footnote section
(not sort-only) ; this is normalization
for-preprocessor) ; the is the preprocessor
;; Insert the footnotes together in one place
(progn
(setq def
(mapconcat
(delq nil
(mapcar
(lambda (x)
(format "[%s] %s" (nth (if sort-only 0 1) x)
(org-trim (nth 2 x))))
ref-table "\n\n"))
(if ref-table (insert "\n" def "\n\n")))
;; Insert each footnote near the first reference
;; Happens only in Org files with no special footnote section,
;; and only when doing sorting
(mapc 'org-insert-footnote-reference-near-definition
ref-table)))))
(cond
;; When only sorting, ignore inline footnotes.
((and sort-only (nth 3 x)) nil)
;; No definition available: provide one.
((not (nth 2 x))
(append (butlast x 2)
(list (format "DEFINITION NOT FOUND: %s" (car x))
(nth 3 x))))
(t x)))
ref-table)))
(setq ref-table (nreverse ref-table))
;; 4. Insert the footnotes again in the buffer, at the
;; appropriate spot.
(goto-char (or
(and export-props
(eq org-footnote-insert-pos-for-preprocessor 'point-min)
(point-min))
ins-point
(point-max)))
(cond
;; No footnote: exit.
((not ref-table))
;; Cases when footnotes should be inserted in one place.
((or (not (org-mode-p))
org-footnote-section
(not sort-only))
;; Insert again the section title.
(cond
((not (org-mode-p))
(insert "\n\n" org-footnote-tag-for-non-org-mode-files "\n"))
((and org-footnote-section (not export-props))
(or (bolp) (insert "\n"))
(insert "* " org-footnote-section "\n")))
;; Insert the footnotes.
(insert "\n"
(mapconcat (lambda (x) (format "[%s] %s"
(nth (if sort-only 0 1) x) (nth 2 x)))
ref-table "\n\n")
"\n\n")
;; When exporting, add newly inserted markers along with their
;; associated definition to `org-export-footnotes-seen'.
(when export-props
(setq org-export-footnotes-seen ref-table)))
;; Else, insert each definition at the end of the section
;; containing their first reference. Happens only in Org files
;; with no special footnote section, and only when doing
;; sorting.
(t (mapc 'org-insert-footnote-reference-near-definition
ref-table))))))
(defun org-insert-footnote-reference-near-definition (entry)
"Find first reference of footnote ENTRY and insert the definition there.
ENTRY is (fn-label num-mark definition)."
(when (car entry)
(goto-char (point-min))
(when (re-search-forward (format ".\\[%s[]:]" (regexp-quote (car entry)))
nil t)
(org-footnote-goto-local-insertion-point)
(insert (format "\n\n[%s] %s" (car entry) (nth 2 entry))))))
(let ((ref (org-footnote-get-next-reference (car entry))))
(when ref
(goto-char (nth 2 ref))
(org-footnote-goto-local-insertion-point)
(insert (format "\n[%s] %s\n" (car entry) (nth 2 entry)))))))
(defun org-footnote-goto-local-insertion-point ()
"Find insertion point for footnote, just before next outline heading."
@ -514,39 +770,60 @@ ENTRY is (fn-label num-mark definition)."
(skip-chars-backward "\n\r\t ")
(forward-line))
(defun org-footnote-delete-references (label)
"Delete every reference to footnote LABEL.
Return the number of footnotes removed."
(save-excursion
(goto-char (point-min))
(let (ref (nref 0))
(while (setq ref (org-footnote-get-next-reference label))
(goto-char (nth 1 ref))
(delete-region (nth 1 ref) (nth 2 ref))
(incf nref))
nref)))
(defun org-footnote-delete-definitions (label)
"Delete every definition of the footnote LABEL.
Return the number of footnotes removed."
(save-excursion
(goto-char (point-min))
(let ((def-re (concat "^\\[" (regexp-quote label) "\\]"))
(ndef 0))
(while (re-search-forward def-re nil t)
(let ((full-def (org-footnote-at-definition-p)))
(delete-region (nth 1 full-def) (nth 2 full-def)))
(incf ndef))
ndef)))
(defun org-footnote-delete (&optional label)
"Delete the footnote at point.
This will remove the definition (even multiple definitions if they exist)
and all references of a footnote label."
and all references of a footnote label.
If LABEL is non-nil, delete that footnote instead."
(catch 'done
(let (x label l beg def-re (nref 0) (ndef 0))
(unless label
(when (setq x (org-footnote-at-reference-p))
(setq label (nth 1 x))
(when (or (not label) (equal "fn:" label))
(delete-region (1+ (match-beginning 0)) (match-end 0))
(message "Anonymous footnote removed")
(throw 'done t)))
(when (and (not label) (setq x (org-footnote-at-definition-p)))
(setq label (nth 1 x)))
(unless label (error "Don't know which footnote to remove")))
(save-excursion
(save-restriction
(goto-char (point-min))
(while (re-search-forward org-footnote-re nil t)
(setq l (or (match-string 1) (match-string 2)))
(when (equal l label)
(delete-region (1+ (match-beginning 0)) (match-end 0))
(incf nref)))
(goto-char (point-min))
(setq def-re (concat "^\\[" (regexp-quote label) "\\]"))
(while (re-search-forward def-re nil t)
(setq beg (match-beginning 0))
(if (re-search-forward "^\\[\\|^[ \t]*$\\|^\\*+ " nil t)
(goto-char (match-beginning 0))
(goto-char (point-max)))
(delete-region beg (point))
(incf ndef))))
(let* ((nref 0) (ndef 0) x
;; 1. Determine LABEL of footnote at point.
(label (cond
;; LABEL is provided as argument.
(label)
;; Footnote reference at point. If the footnote is
;; anonymous, delete it and exit instead.
((setq x (org-footnote-at-reference-p))
(or (car x)
(progn
(delete-region (nth 1 x) (nth 2 x))
(message "Anonymous footnote removed")
(throw 'done t))))
;; Footnote definition at point.
((setq x (org-footnote-at-definition-p))
(car x))
(t (error "Don't know which footnote to remove")))))
;; 2. Now that LABEL is non-nil, find every reference and every
;; definition, and delete them.
(setq nref (org-footnote-delete-references label)
ndef (org-footnote-delete-definitions label))
;; 3. Verify consistency of footnotes and notify user.
(org-footnote-auto-adjust-maybe)
(message "%d definition(s) of and %d reference(s) of footnote %s removed"
ndef nref label))))
@ -574,7 +851,7 @@ and all references of a footnote label."
(when (memq org-footnote-auto-adjust '(t renumber))
(org-footnote-renumber-fn:N))
(when (memq org-footnote-auto-adjust '(t sort))
(let ((label (nth 1 (org-footnote-at-definition-p))))
(let ((label (car (org-footnote-at-definition-p))))
(org-footnote-normalize 'sort)
(when label
(goto-char (point-min))
@ -585,5 +862,6 @@ and all references of a footnote label."
(provide 'org-footnote)
;; arch-tag: 1b5954df-fb5d-4da5-8709-78d944dbfc37
;;; org-footnote.el ends here

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

@ -1,11 +1,11 @@
;;; org-freemind.el --- Export Org files to freemind
;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; Author: Lennart Borgman (lennart O borgman A gmail O com)
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -308,7 +308,7 @@ MATCHED is the link just matched."
(let* ((link (match-string 1 matched))
(text (match-string 2 matched))
(ext (file-name-extension link))
(col-pos (string-match-p ":" link))
(col-pos (org-string-match-p ":" link))
(is-img (and (image-type-from-file-name link)
(let ((url-type (substring link 0 col-pos)))
(member url-type '("file" "http" "https")))))
@ -414,7 +414,7 @@ MATCHED is the link just matched."
(defun org-freemind-convert-text-p (text)
"Convert TEXT to html with <p> paragraphs."
;; (string-match-p "[^ ]" " a")
(setq org-freemind-bol-helper-base-indent (string-match-p "[^ ]" text))
(setq org-freemind-bol-helper-base-indent (org-string-match-p "[^ ]" text))
(setq text (org-freemind-escape-str-from-org text))
(setq text (replace-regexp-in-string "\\([[:space:]]\\)\\(/\\)\\([^/]+\\)\\(/\\)\\([[:space:]]\\)" "\\1<i>\\3</i>\\5" text))
@ -658,7 +658,7 @@ Otherwise give an error say the file exists."
(defun org-freemind-write-mm-buffer (org-buffer mm-buffer node-at-line)
(with-current-buffer org-buffer
(dolist (node-style org-freemind-node-styles)
(when (string-match-p (car node-style) buffer-file-name)
(when (org-string-match-p (car node-style) buffer-file-name)
(setq org-freemind-node-style (cadr node-style))))
;;(message "org-freemind-node-style =%s" org-freemind-node-style)
(save-match-data
@ -835,7 +835,7 @@ Otherwise give an error say the file exists."
(dolist (style-list org-freemind-node-style)
(let ((node-regexp (car style-list)))
(message "node-regexp=%s node-name=%s" node-regexp node-name)
(when (string-match-p node-regexp node-name)
(when (org-string-match-p node-regexp node-name)
;;(setq node-style (org-freemind-do-apply-node-style style-list))
(setq node-style (cadr style-list))
(when node-style
@ -1172,8 +1172,8 @@ PATH should be a list of steps, where each step has the form
(when (< 0 (- level skip-levels))
(dolist (attrib attributes)
(case (car attrib)
(TEXT (setq text (cdr attrib)))
(text (setq text (cdr attrib)))))
('TEXT (setq text (cdr attrib)))
('text (setq text (cdr attrib)))))
(unless text
;; There should be a richcontent node holding the text:
(setq text (org-freemind-get-richcontent-node-text node)))
@ -1193,7 +1193,7 @@ PATH should be a list of steps, where each step has the form
(setq text (replace-regexp-in-string "\n $" "" text))
(insert text))
(case qname
(node
('node
(insert (make-string (- level skip-levels) ?*) " " text "\n")
(when note
(insert ":COMMENT:\n" note "\n:END:\n"))
@ -1237,6 +1237,7 @@ PATH should be a list of steps, where each step has the form
(provide 'org-freemind)
;; arch-tag: e7b0d776-94fd-404a-b35e-0f855fae3627
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; org-freemind.el ends here

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

@ -1,12 +1,13 @@
;;; org-gnus.el --- Support for links to Gnus groups and messages from within Org-mode
;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Tassilo Horn <tassilo at member dot fsf dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -150,12 +151,17 @@ If `org-store-link' was called with a prefix arg the meaning of
(gnus-summary-article-header)))
(from (mail-header-from header))
(message-id (org-remove-angle-brackets (mail-header-id header)))
(date (mail-header-date header))
(date-ts (and date (format-time-string
(org-time-stamp-format t) (date-to-time date))))
(date-ts-ia (and date (format-time-string
(org-time-stamp-format t t)
(date-to-time date))))
(date (org-trim (mail-header-date header)))
(date-ts (and date
(ignore-errors
(format-time-string
(org-time-stamp-format t)
(date-to-time date)))))
(date-ts-ia (and date
(ignore-errors
(format-time-string
(org-time-stamp-format t t)
(date-to-time date)))))
(subject (copy-sequence (mail-header-subject header)))
(to (cdr (assq 'To (mail-header-extra header))))
newsgroups x-no-archive desc link)
@ -180,7 +186,35 @@ If `org-store-link' was called with a prefix arg the meaning of
link (org-gnus-article-link
group newsgroups message-id x-no-archive))
(org-add-link-props :link link :description desc)
link))))
link))
((eq major-mode 'message-mode)
(setq org-store-link-plist nil) ; reset
(save-excursion
(save-restriction
(message-narrow-to-headers)
(and (not (message-fetch-field "Message-ID"))
(message-generate-headers '(Message-ID)))
(goto-char (point-min))
(re-search-forward "^Message-ID: *.*$" nil t)
(put-text-property (match-beginning 0) (match-end 0) 'message-deletable nil)
(let ((gcc (car (last
(message-unquote-tokens
(message-tokenize-header (mail-fetch-field "gcc" nil t) " ,")))))
(id (org-remove-angle-brackets (mail-fetch-field "Message-ID")))
(to (mail-fetch-field "To"))
(from (mail-fetch-field "From"))
(subject (mail-fetch-field "Subject"))
desc link
newsgroup xarchive) ; those are always nil for gcc
(and (not gcc)
(error "Can not create link: No Gcc header found."))
(org-store-link-props :type "gnus" :from from :subject subject
:message-id id :group gcc :to to)
(setq desc (org-email-link-description)
link (org-gnus-article-link
gcc newsgroup id xarchive))
(org-add-link-props :link link :description desc)
link))))))
(defun org-gnus-open-nntp (path)
"Follow the nntp: link specified by PATH."
@ -215,7 +249,7 @@ If `org-store-link' was called with a prefix arg the meaning of
(when article
(setq article (org-substring-no-properties article)))
(cond ((and group article)
(gnus-activate-group group t)
(gnus-activate-group group)
(condition-case nil
(let* ((method (gnus-find-method-for-group group))
(backend (car method))
@ -257,5 +291,6 @@ If `org-store-link' was called with a prefix arg the meaning of
(provide 'org-gnus)
;; arch-tag: 512e0840-58fa-45b3-b456-71e10fa2376d
;;; org-gnus.el ends here

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

@ -1,11 +1,11 @@
;;; org-habit.el --- The habit tracking code for Org-mode
;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw at gnu dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -170,10 +170,18 @@ This list represents a \"habit\" for the rest of this module."
habit-entry scheduled-repeat))
(setq deadline (+ scheduled (- dr-days sr-days))))
(org-back-to-heading t)
(while (re-search-forward "- State \"DONE\".*\\[\\([^]]+\\)\\]" end t)
(push (time-to-days
(org-time-string-to-time (match-string-no-properties 1)))
closed-dates))
(let* ((maxdays (+ org-habit-preceding-days org-habit-following-days))
(reversed org-log-states-order-reversed)
(search (if reversed 're-search-forward 're-search-backward))
(limit (if reversed end (point)))
(count 0))
(unless reversed (goto-char end))
(while (and (< count maxdays)
(funcall search "- State \"DONE\".*\\[\\([^]]+\\)\\]" limit t))
(push (time-to-days
(org-time-string-to-time (match-string-no-properties 1)))
closed-dates)
(setq count (1+ count))))
(list scheduled sr-days deadline dr-days closed-dates))))
(defsubst org-habit-scheduled (habit)
@ -350,5 +358,6 @@ current time."
(provide 'org-habit)
;; arch-tag: 64e070d9-bd09-4917-bd44-44465f5ed348
;;; org-habit.el ends here

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

File diff suppressed because it is too large Load diff

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

@ -1,11 +1,12 @@
;;; org-icalendar.el --- iCalendar export for Org-mode
;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -72,6 +73,11 @@ for timed events. If non-zero, alarms are created.
:group 'org-export-icalendar
:type 'boolean)
(defcustom org-icalendar-honor-noexport-tag nil
"Non-nil means don't export entries with a tag in `org-export-exclude-tags'."
:group 'org-export-icalendar
:type 'boolean)
(defcustom org-icalendar-use-deadline '(event-if-not-todo todo-due)
"Contexts where iCalendar export should use a deadline time stamp.
This is a list with several symbols in it. Valid symbol are:
@ -193,12 +199,31 @@ When nil of the empty string, use the abbreviation retrieved from Emacs."
(const :tag "Unspecified" nil)
(string :tag "Time zone")))
(defcustom org-icalendar-use-UTC-date-time ()
"Non-nil force the use of the universal time for iCalendar DATE-TIME.
The iCalendar DATE-TIME can be expressed with local time or universal Time,
universal time could be more compatible with some external tools."
;; Backward compatibility with previous variable
(defvar org-icalendar-use-UTC-date-time nil)
(defcustom org-icalendar-date-time-format
(if org-icalendar-use-UTC-date-time
":%Y%m%dT%H%M%SZ"
":%Y%m%dT%H%M%S")
"Format-string for exporting icalendar DATE-TIME.
See `format-time-string' for a full documentation. The only
difference is that `org-icalendar-timezone' is used for %Z.
Interesting value are:
- \":%Y%m%dT%H%M%S\" for local time
- \";TZID=%Z:%Y%m%dT%H%M%S\" for local time with explicit timezone
- \":%Y%m%dT%H%M%SZ\" for time expressed in Universal Time"
:group 'org-export-icalendar
:type 'boolean)
:type '(choice
(const :tag "Local time" ":%Y%m%dT%H%M%S")
(const :tag "Explicit local time" ";TZID=%Z:%Y%m%dT%H%M%S")
(const :tag "Universal time" ":%Y%m%dT%H%M%SZ")
(string :tag "Explicit format")))
(defun org-icalendar-use-UTC-date-timep ()
(char-equal (elt org-icalendar-date-time-format
(1- (length org-icalendar-date-time-format))) ?Z))
;;; iCalendar export
@ -298,7 +323,7 @@ When COMBINE is non nil, add the category to each line."
(format-time-string (cdr org-time-stamp-formats) (current-time))
"DTSTART"))
hd ts ts2 state status (inc t) pos b sexp rrule
scheduledp deadlinep todo prefix due start
scheduledp deadlinep todo prefix due start tags
tmp pri categories location summary desc uid alarm
(sexp-buffer (get-buffer-create "*ical-tmp*")))
(org-refresh-category-properties)
@ -314,6 +339,7 @@ When COMBINE is non nil, add the category to each line."
(throw :skip nil)))
(setq pos (match-beginning 0)
ts (match-string 0)
tags (org-get-tags-at)
inc t
hd (condition-case nil
(org-icalendar-cleanup-string
@ -354,6 +380,11 @@ When COMBINE is non nil, add the category to each line."
(when (and (not org-icalendar-use-plain-timestamp)
(not deadlinep) (not scheduledp))
(throw :skip t))
;; don't export entries with a :noexport: tag
(when (and org-icalendar-honor-noexport-tag
(delq nil (mapcar (lambda(x)
(member x org-export-exclude-tags)) tags)))
(throw :skip t))
(when (and
deadlinep
(if todo
@ -386,7 +417,7 @@ When COMBINE is non nil, add the category to each line."
;; (c) only a DISPLAY action is defined.
;; [ESF]
(let ((t1 (ignore-errors (org-parse-time-string ts 'nodefault))))
(if (and (> org-icalendar-alarm-time 0)
(if (and (> org-icalendar-alarm-time 0)
(car t1) (nth 1 t1) (nth 2 t1))
(setq alarm (format "\nBEGIN:VALARM\nACTION:DISPLAY\nDESCRIPTION:%s\nTRIGGER:-P0D0H%dM0S\nEND:VALARM" summary org-icalendar-alarm-time))
(setq alarm ""))
@ -401,7 +432,10 @@ When COMBINE is non nil, add the category to each line."
(if scheduledp (setq summary (concat "S: " summary)))
(if (string-match "\\`<%%" ts)
(with-current-buffer sexp-buffer
(insert (substring ts 1 -1) " " summary "\n"))
(let ((entry (substring ts 1 -1)))
(put-text-property 0 1 'uid
(concat " " prefix uid) entry)
(insert entry " " summary "\n")))
(princ (format "BEGIN:VEVENT
UID: %s
%s
@ -640,14 +674,16 @@ a time), or the day by one (if it does not contain a time)."
(setq h (+ 2 h)))
(setq d (1+ d))))
(setq time (encode-time s mi h d m y)))
(setq fmt (if have-time (if org-icalendar-use-UTC-date-time
":%Y%m%dT%H%M%SZ"
":%Y%m%dT%H%M%S")
(setq fmt (if have-time
(replace-regexp-in-string "%Z"
org-icalendar-timezone
org-icalendar-date-time-format)
";VALUE=DATE:%Y%m%d"))
(concat keyword (format-time-string fmt time
(and org-icalendar-use-UTC-date-time
(concat keyword (format-time-string fmt time
(and (org-icalendar-use-UTC-date-timep)
have-time))))))
(provide 'org-icalendar)
;; arch-tag: 2dee2b6e-9211-4aee-8a47-a3c7e5bc30cf
;;; org-icalendar.el ends here

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

@ -1,11 +1,11 @@
;;; org-id.el --- Global identifiers for Org-mode entries
;;
;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -74,6 +74,8 @@
(require 'org)
(declare-function message-make-fqdn "message" ())
(declare-function org-pop-to-buffer-same-window
"org-compat" (&optional buffer-or-name norecord label))
;;; Customization
@ -151,9 +153,7 @@ This variable is only relevant when `org-id-track-globally' is set."
:type 'file)
(defvar org-id-locations nil
"List of files with IDs in those files.
Depending on `org-id-use-hash' this can also be a hash table mapping IDs
to files.")
"List of files with IDs in those files.")
(defvar org-id-files nil
"List of files that contain IDs.")
@ -231,7 +231,7 @@ It returns the ID of the entry. If necessary, the ID is created."
(org-refile-use-outline-path
(if (caar org-refile-targets) 'file t))
(org-refile-target-verify-function nil)
(spos (org-refile-get-location "Entry: "))
(spos (org-refile-get-location "Entry"))
(pom (and spos (move-marker (make-marker) (nth 3 spos)
(get-file-buffer (nth 1 spos))))))
(prog1 (org-id-get pom 'create)
@ -255,7 +255,7 @@ Move the cursor to that entry in that buffer."
(let ((m (org-id-find id 'marker)))
(unless m
(error "Cannot find entry with ID \"%s\"" id))
(switch-to-buffer (marker-buffer m))
(org-pop-to-buffer-same-window (marker-buffer m))
(goto-char m)
(move-marker m nil)
(org-show-context)))
@ -643,5 +643,6 @@ optional argument MARKERP, return the position as a new marker."
;;; org-id.el ends here
;; arch-tag: e5abaca4-e16f-4b25-832a-540cfb63a712

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

@ -1,10 +1,10 @@
;;; org-indent.el --- Dynamic indentation for Org-mode
;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -212,12 +212,12 @@ useful to make it ever so slightly different."
(remove-text-properties beg end '(line-prefix nil wrap-prefix nil)))))
(defun org-indent-remove-properties-from-string (string)
"Remove indentations between BEG and END."
"Remove indentation properties from STRING."
(remove-text-properties 0 (length string)
'(line-prefix nil wrap-prefix nil) string)
string)
(defvar org-indent-outline-re (concat "^" org-outline-regexp)
(defvar org-indent-outline-re org-outline-regexp-bol
"Outline heading regexp.")
(defun org-indent-add-properties (beg end)
@ -273,7 +273,7 @@ Point is assumed to be at the beginning of a headline."
(when org-indent-mode
(let (beg end)
(save-excursion
(when (ignore-errors (let ((outline-regexp (format "\\*\\{1,%s\\}[ \t]+"
(when (ignore-errors (let ((org-outline-regexp (format "\\*\\{1,%s\\}[ \t]+"
(if (featurep 'org-inlinetask)
(1- org-inlinetask-min-level)
""))))
@ -290,7 +290,7 @@ 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 (let ((outline-regexp (format "\\*\\{1,%s\\}[ \t]+"
(and (ignore-errors (let ((org-outline-regexp (format "\\*\\{1,%s\\}[ \t]+"
(if (featurep 'org-inlinetask)
(1- org-inlinetask-min-level)
""))))
@ -322,4 +322,5 @@ Point is assumed to be at the beginning of a headline."
(provide 'org-indent)
;; arch-tag: b76736bc-9f4a-43cd-977c-ecfd6689846a
;;; org-indent.el ends here

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

@ -1,11 +1,12 @@
;;; org-info.el --- Support for links to Info nodes from within Org-Mode
;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -51,9 +52,9 @@
(let (link desc)
(setq link (org-make-link "info:"
(file-name-nondirectory Info-current-file)
":" Info-current-node))
"#" Info-current-node))
(setq desc (concat (file-name-nondirectory Info-current-file)
":" Info-current-node))
"#" Info-current-node))
(org-store-link-props :type "info" :file Info-current-file
:node Info-current-node
:link link :desc desc)
@ -66,7 +67,7 @@
(defun org-info-follow-link (name)
"Follow an Info file and node link specified by NAME."
(if (or (string-match "\\(.*\\)::?\\(.*\\)" name)
(if (or (string-match "\\(.*\\)[#:]:?\\(.*\\)" name)
(string-match "\\(.*\\)" name))
(progn
(require 'info)
@ -77,5 +78,6 @@
(provide 'org-info)
;; arch-tag: 1e289f54-7176-487f-b575-dd4854bab15e
;;; org-info.el ends here

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

@ -1,11 +1,11 @@
;;; org-inlinetask.el --- Tasks independent of outline hierarchy
;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -42,7 +42,9 @@
;;
;; Export commands do not treat these nodes as part of the sectioning
;; structure, but as a special inline text that is either removed, or
;; formatted in some special way.
;; formatted in some special way. This in handled by
;; `org-inlinetask-export' and `org-inlinetask-export-templates'
;; variables.
;;
;; Special fontification of inline tasks, so that they can be immediately
;; recognized. From the stars of the headline, only the first and the
@ -52,14 +54,18 @@
;; An inline task is identified solely by a minimum outline level, given
;; by the variable `org-inlinetask-min-level', default 15.
;;
;; Inline tasks are normally assumed to contain at most a time planning
;; line (DEADLINE etc) after it, and then any number of drawers, for
;; example LOGBOOK of PROPERTIES. No empty lines are allowed.
;; If you need to have normal text as part of an inline task, you
;; can do so by adding an "END" headline with the same number of stars,
;; for example
;; If you need to have a time planning line (DEADLINE etc), drawers,
;; for example LOGBOOK of PROPERTIES, or even normal text as part of
;; the inline task, you must add an "END" headline with the same
;; number of stars.
;;
;; **************** TODO some small task
;; As an example, here are two valid inline tasks:
;;
;; **************** TODO a small task
;;
;; and
;;
;; **************** TODO another small task
;; DEADLINE: <2009-03-30 Mon>
;; :PROPERTIES:
;; :SOMETHING: or other
@ -101,12 +107,12 @@ When nil, they will not be exported."
:type 'boolean)
(defvar org-inlinetask-export-templates
'((html "<pre class=\"inlinetask\"><b>%s%s</b><br>%s</pre>"
'((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\}"
(latex "\\begin\{description\}\n\\item[%s%s]~%s\\end\{description\}"
'((unless (eq todo "") (format "\\textsc\{%s%s\} " todo priority))
heading content))
(ascii " -- %s%s%s"
@ -193,38 +199,50 @@ The number of levels is controlled by `org-inlinetask-min-level'."
org-inlinetask-min-level)))
(format "^\\(\\*\\{%d,\\}\\)[ \t]+" nstars)))
(defun org-inlinetask-at-task-p ()
"Return true if point is at beginning of an inline task."
(save-excursion
(beginning-of-line)
(and (looking-at (concat (org-inlinetask-outline-regexp) "\\(.*\\)"))
(not (string-match "^end[ \t]*$" (downcase (match-string 2)))))))
(defun org-inlinetask-in-task-p ()
"Return true if point is inside an inline task."
(save-excursion
(let* ((stars-re (org-inlinetask-outline-regexp))
(beginning-of-line)
(let* ((case-fold-search t)
(stars-re (org-inlinetask-outline-regexp))
(task-beg-re (concat stars-re "\\(?:.*\\)"))
(task-end-re (concat stars-re "\\(?:END\\|end\\)[ \t]*$")))
(beginning-of-line)
(or (looking-at task-beg-re)
(task-end-re (concat stars-re "END[ \t]*$")))
(or (org-looking-at-p task-beg-re)
(and (re-search-forward "^\\*+[ \t]+" nil t)
(progn (beginning-of-line) (looking-at task-end-re)))))))
(progn (beginning-of-line) (org-looking-at-p task-end-re)))))))
(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)))
(let ((case-fold-search t)
(inlinetask-re (org-inlinetask-outline-regexp)))
(re-search-backward inlinetask-re nil t)
(when (org-looking-at-p (concat inlinetask-re "END[ \t]*$"))
(re-search-backward inlinetask-re 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))))
(let ((case-fold-search t)
(inlinetask-re (org-inlinetask-outline-regexp)))
(cond
((org-looking-at-p (concat inlinetask-re "END[ \t]*$"))
(forward-line 1))
((org-looking-at-p inlinetask-re)
(forward-line 1)
(when (org-inlinetask-in-task-p)
(re-search-forward inlinetask-re nil t)
(forward-line 1)))
(t
(re-search-forward inlinetask-re nil t)
(forward-line 1)))))
(defun org-inlinetask-get-task-level ()
"Get the level of the inline task around.
@ -234,65 +252,128 @@ This assumes the point is inside an inline task."
(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-promote ()
"Promote the inline task at point.
If the task has an end part, promote it. Also, prevents level from
going below `org-inlinetask-min-level'."
(interactive)
(if (not (org-inlinetask-in-task-p))
(error "Not in an inline task")
(save-excursion
(let* ((lvl (org-inlinetask-get-task-level))
(next-lvl (org-get-valid-level lvl -1))
(diff (- next-lvl lvl))
(down-task (concat (make-string next-lvl ?*)))
beg)
(if (< next-lvl org-inlinetask-min-level)
(error "Cannot promote an inline task at minimum level")
(org-inlinetask-goto-beginning)
(setq beg (point))
(replace-match down-task nil t nil 1)
(org-inlinetask-goto-end)
(if (eobp) (beginning-of-line) (forward-line -1))
(unless (= (point) beg)
(replace-match down-task nil t nil 1)
(when org-adapt-indentation
(goto-char beg)
(org-fixup-indentation diff))))))))
(defun org-inlinetask-demote ()
"Demote the inline task at point.
If the task has an end part, also demote it."
(interactive)
(if (not (org-inlinetask-in-task-p))
(error "Not in an inline task")
(save-excursion
(let* ((lvl (org-inlinetask-get-task-level))
(next-lvl (org-get-valid-level lvl 1))
(diff (- next-lvl lvl))
(down-task (concat (make-string next-lvl ?*)))
beg)
(org-inlinetask-goto-beginning)
(setq beg (point))
(replace-match down-task nil t nil 1)
(org-inlinetask-goto-end)
(if (eobp) (beginning-of-line) (forward-line -1))
(unless (= (point) beg)
(replace-match down-task nil t nil 1)
(when org-adapt-indentation
(goto-char beg)
(org-fixup-indentation diff)))))))
(defvar org-export-current-backend) ; dynamically bound in org-exp.el
(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."
(goto-char (point-min))
(let* ((nstars (if org-odd-levels-only
(1- (* 2 (or org-inlinetask-min-level 200)))
(or org-inlinetask-min-level 200)))
(re1 (format "^\\(\\*\\{%d,\\}\\) .*\n" nstars))
(re2 (concat "^[ \t]*" org-keyword-time-regexp))
headline beg end stars content)
(while (re-search-forward re1 nil t)
(setq headline (match-string 0)
stars (match-string 1)
content nil)
(replace-match "")
(while (looking-at re2)
(delete-region (point) (1+ (point-at-eol))))
(while (looking-at org-drawer-regexp)
(setq beg (point))
(if (re-search-forward org-property-end-re nil t)
(delete-region beg (1+ (match-end 0)))))
(setq beg (point))
(when (and (re-search-forward "^\\(\\*+\\) " nil t)
(= (length (match-string 1)) (length stars))
(progn (goto-char (match-end 0))
(looking-at "END[ \t]*$")))
(setq content (buffer-substring beg (1- (point-at-bol))))
(delete-region beg (1+ (match-end 0))))
(let* ((keywords-re (concat "^[ \t]*" org-keyword-time-regexp))
(inline-re (concat (org-inlinetask-outline-regexp) ".*")))
(while (re-search-forward inline-re nil t)
(let ((headline (match-string 0))
(beg (point-at-bol))
(end (copy-marker (save-excursion
(org-inlinetask-goto-end) (point))))
content)
;; Delete SCHEDULED, DEADLINE...
(while (re-search-forward keywords-re end t)
(delete-region (point-at-bol) (1+ (point-at-eol))))
(goto-char beg)
;; Delete drawers
(while (re-search-forward org-drawer-regexp end t)
(when (save-excursion (re-search-forward org-property-end-re nil t))
(delete-region beg (1+ (match-end 0)))))
;; Get CONTENT, if any.
(goto-char beg)
(forward-line 1)
(unless (= (point) end)
(setq content (buffer-substring (point)
(save-excursion (goto-char end)
(forward-line -1)
(point)))))
;; Remove the task.
(goto-char beg)
(delete-region beg end)
(when org-inlinetask-export
;; content formatting
(when content
(if (not (string-match "\\S-" content))
(setq content nil)
(if (string-match "[ \t\n]+\\'" content)
;; Format CONTENT, if appropriate.
(setq content
(if (not (and content (string-match "\\S-" content)))
""
;; Ensure CONTENT has minimal indentation, a single
;; newline character at its boundaries, and isn't
;; protected.
(when (string-match "`\\([ \t]*\n\\)+" content)
(setq content (substring content (match-end 0))))
(when (string-match "[ \t\n]+\\'" content)
(setq content (substring content 0 (match-beginning 0))))
(setq content (org-remove-indentation content))))
(setq content (or content ""))
;; grab elements to export
(org-add-props (concat "\n" (org-remove-indentation content) "\n")
'(org-protected nil))))
(when (string-match org-complex-heading-regexp headline)
(let* ((todo (or (match-string 2 headline) ""))
(let* ((nil-to-str
(function
;; Change nil arguments into empty strings.
(lambda (el) (or (eval el) ""))))
;; Set up keywords provided to templates.
(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))
;; Read `org-inlinetask-export-templates'.
(backend-spec (assq org-export-current-backend
org-inlinetask-export-templates))
(format-str (org-add-props (nth 1 backend-spec)
'(org-protected t)))
(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
;; Build export string. Ensure it won't break
;; surrounding lists by giving it arbitrary high
;; indentation.
(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")))))))
'(original-indentation 1000))))
(insert export-str)
(unless (bolp) (insert "\n")))))))))
(defun org-inlinetask-get-current-indentation ()
"Get the indentation of the last non-while line above this one."
@ -321,6 +402,22 @@ Either remove headline and meta data, or do special formatting."
(add-text-properties (match-beginning 3) (match-end 3)
'(face shadow font-lock-fontified t)))))
(defun org-inlinetask-toggle-visibility ()
"Toggle visibility of inline task at point."
(let ((end (save-excursion
(org-inlinetask-goto-end)
(if (bolp) (1- (point)) (point))))
(start (save-excursion
(org-inlinetask-goto-beginning)
(point-at-eol))))
(cond
;; Nothing to show/hide.
((= end start))
;; Inlinetask was folded: expand it.
((get-char-property (1+ start) 'invisible)
(outline-flag-region start end nil))
(t (outline-flag-region start end t)))))
(defun org-inlinetask-remove-END-maybe ()
"Remove an END line when present."
(when (looking-at (format "\\([ \t]*\n\\)*\\*\\{%d,\\}[ \t]+END[ \t]*$"
@ -328,7 +425,7 @@ Either remove headline and meta data, or do special formatting."
(replace-match "")))
(eval-after-load "org-exp"
'(add-hook 'org-export-preprocess-after-tree-selection-hook
'(add-hook 'org-export-preprocess-before-backend-specifics-hook
'org-inlinetask-export-handler))
(eval-after-load "org"
'(add-hook 'org-font-lock-hook 'org-inlinetask-fontify))

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

@ -1,10 +1,10 @@
;;; org-irc.el --- Store links to IRC sessions
;;
;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc.
;;
;; Author: Philip Jackson <emacs@shellarchive.co.uk>
;; Keywords: erc, irc, link, org
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -60,6 +60,8 @@
(declare-function erc-server-buffer "erc" ())
(declare-function erc-get-server-nickname-list "erc" ())
(declare-function erc-cmd-JOIN "erc" (channel &optional key))
(declare-function org-pop-to-buffer-same-window
"org-compat" (&optional buffer-or-name norecord label))
(defvar org-irc-client 'erc
"The IRC client to act on.")
@ -232,7 +234,7 @@ default."
(throw 'found x))))))
(if chan-buf
(progn
(switch-to-buffer chan-buf)
(org-pop-to-buffer-same-window chan-buf)
;; if we got a nick, and they're in the chan,
;; then start a chat with them
(let ((nick (pop link)))
@ -243,13 +245,14 @@ default."
(insert (concat nick ": ")))
(error "%s not found in %s" nick chan-name)))))
(progn
(switch-to-buffer server-buffer)
(org-pop-to-buffer-same-window server-buffer)
(erc-cmd-JOIN chan-name))))
(switch-to-buffer server-buffer)))
(org-pop-to-buffer-same-window server-buffer)))
;; no server match, make new connection
(erc-select :server server :port port))))
(provide 'org-irc)
;; arch-tag: 018d7dda-53b8-4a35-ba92-6670939e525a
;;; org-irc.el ends here

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

@ -1,11 +1,12 @@
;;; org-jsinfo.el --- Support for org-info.js Javascript in Org HTML export
;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -204,5 +205,6 @@ Option settings will replace the %MANAGER-OPTIONS cookie."
(provide 'org-infojs)
(provide 'org-jsinfo)
;; arch-tag: c71d1d85-3337-4817-a066-725e74ac9eac
;;; org-jsinfo.el ends here

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

File diff suppressed because it is too large Load diff

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

File diff suppressed because it is too large Load diff

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

@ -1,11 +1,11 @@
;;; org-mac-message.el --- Links to Apple Mail.app messages from within Org-mode
;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Christopher Suckling <suckling at gmail dot com>
;; Version: 7.4
;; Version: 7.7
;; Keywords: outlines, hypermedia, calendar, wp
;; This file is part of GNU Emacs.
@ -214,5 +214,6 @@ list of message:// links to flagged mail after heading."
(provide 'org-mac-message)
;; arch-tag: 3806d0c1-abe1-4db6-9c31-f3ed7d4a9b32
;;; org-mac-message.el ends here

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

@ -1,11 +1,12 @@
;;; org-macs.el --- Top-level definitions for Org-mode
;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -34,19 +35,26 @@
(eval-and-compile
(unless (fboundp 'declare-function)
(defmacro declare-function (fn file &optional arglist fileonly))))
(defmacro declare-function (fn file &optional arglist fileonly)))
(if (>= emacs-major-version 23)
(defsubst org-char-to-string(c)
"Defsubst to decode UTF-8 character values in emacs 23 and beyond."
(char-to-string c))
(defsubst org-char-to-string (c)
"Defsubst to decode UTF-8 character values in emacs 22."
(string (decode-char 'ucs c)))))
(declare-function org-add-props "org-compat" (string plist &rest props))
(declare-function org-string-match-p "org-compat" (&rest args))
(defmacro org-called-interactively-p (&optional kind)
`(if (featurep 'xemacs)
(interactive-p)
(if (featurep 'xemacs)
`(interactive-p)
(if (or (> emacs-major-version 23)
(and (>= emacs-major-version 23)
(>= emacs-minor-version 2)))
(with-no-warnings (called-interactively-p ,kind)) ;; defined with no argument in <=23.1
(interactive-p))))
`(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)
@ -104,13 +112,15 @@ Also, do not record undo information."
(org-move-to-column _col))))
(defmacro org-without-partial-completion (&rest body)
`(let ((pc-mode (and (boundp 'partial-completion-mode)
partial-completion-mode)))
`(if (and (boundp 'partial-completion-mode)
partial-completion-mode
(fboundp 'partial-completion-mode))
(unwind-protect
(progn
(if pc-mode (partial-completion-mode -1))
(partial-completion-mode -1)
,@body)
(if pc-mode (partial-completion-mode 1)))))
(partial-completion-mode 1))
,@body))
(defmacro org-maybe-intangible (props)
"Add '(intangible t) to PROPS if Emacs version is earlier than Emacs 22.
@ -126,11 +136,12 @@ We use a macro so that the test can happen at compilation time."
(defmacro org-with-point-at (pom &rest body)
"Move to buffer and point of point-or-marker POM for the duration of BODY."
`(save-excursion
(if (markerp ,pom) (set-buffer (marker-buffer ,pom)))
`(let ((pom ,pom))
(save-excursion
(goto-char (or ,pom (point)))
,@body)))
(if (markerp pom) (set-buffer (marker-buffer pom)))
(save-excursion
(goto-char (or pom (point)))
,@body))))
(put 'org-with-point-at 'lisp-indent-function 1)
(defmacro org-no-warnings (&rest body)
@ -183,6 +194,7 @@ We use a macro so that the test can happen at compilation time."
;; remember which buffer to undo
(push (list _cmd _cline _buf1 _c1 _buf2 _c2)
org-agenda-undo-list)))))
(put 'org-with-remote-undo 'lisp-indent-function 1)
(defmacro org-no-read-only (&rest body)
"Inhibit read-only for BODY."
@ -313,35 +325,53 @@ but it also means that the buffer should stay alive
during the operation, because otherwise all these markers will
point nowhere."
(declare (indent 1))
`(let ((data (org-outline-overlay-data ,use-markers)))
`(let ((data (org-outline-overlay-data ,use-markers))
rtn)
(unwind-protect
(progn
,@body
(setq rtn (progn ,@body))
(org-set-outline-overlay-data data))
(when ,use-markers
(mapc (lambda (c)
(and (markerp (car c)) (move-marker (car c) nil))
(and (markerp (cdr c)) (move-marker (cdr c) nil)))
data)))))
data)))
rtn))
(defmacro org-with-wide-buffer (&rest body)
"Execute body while temporarily widening the buffer."
`(save-excursion
(save-restriction
(widen)
,@body)))
(defmacro org-with-limited-levels (&rest body)
"Execute BODY with limited number of outline levels."
`(let* ((outline-regexp (org-get-limited-outline-regexp)))
`(let* ((org-outline-regexp (org-get-limited-outline-regexp))
(outline-regexp org-outline-regexp)
(org-outline-regexp-at-bol (concat "^" org-outline-regexp)))
,@body))
(defvar org-outline-regexp) ; defined in org.el
(defvar org-odd-levels-only) ; defined in org.el
(defvar org-inlinetask-min-level) ; defined in org-inlinetask.el
(defun org-get-limited-outline-regexp ()
"Return outline-regexp with limited number of levels.
The number of levels is controlled by `org-inlinetask-min-level'"
(if (or (not (org-mode-p)) (not (featurep 'org-inlinetask)))
outline-regexp
org-outline-regexp
(let* ((limit-level (1- org-inlinetask-min-level))
(nstars (if org-odd-levels-only (1- (* limit-level 2)) limit-level)))
(format "\\*\\{1,%d\\} " nstars))))
(defun org-format-seconds (string seconds)
"Compatibility function replacing format-seconds"
(if (fboundp 'format-seconds)
(format-seconds string seconds)
(format-time-string string (seconds-to-time seconds))))
(provide 'org-macs)
;; arch-tag: 7e6a73ce-aac9-4fc0-9b30-ce6f89dc6668
;;; org-macs.el ends here

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

@ -1,11 +1,11 @@
;;; org-mew.el --- Support for links to Mew messages from within Org-mode
;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;; This file is part of GNU Emacs.
@ -135,5 +135,6 @@
(provide 'org-mew)
;; arch-tag: 07ccdca7-6020-4941-a593-588a1e51b870
;;; org-mew.el ends here

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