summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Makefile1
-rw-r--r--contrib/README5
-rw-r--r--contrib/lisp/ob-eukleides.el2
-rw-r--r--contrib/lisp/ob-fomus.el2
-rw-r--r--contrib/lisp/ob-julia.el2
-rw-r--r--contrib/lisp/ob-mathomatic.el2
-rw-r--r--contrib/lisp/ob-oz.el4
-rw-r--r--contrib/lisp/ob-tcl.el2
-rw-r--r--contrib/lisp/org-annotate-file.el92
-rw-r--r--contrib/lisp/org-bibtex-extras.el8
-rw-r--r--contrib/lisp/org-bookmark.el2
-rw-r--r--contrib/lisp/org-checklist.el2
-rw-r--r--contrib/lisp/org-choose.el2
-rw-r--r--contrib/lisp/org-collector.el2
-rw-r--r--contrib/lisp/org-colview-xemacs.el2
-rw-r--r--contrib/lisp/org-contacts.el2
-rw-r--r--contrib/lisp/org-contribdir.el2
-rw-r--r--contrib/lisp/org-depend.el2
-rw-r--r--contrib/lisp/org-download.el336
-rw-r--r--contrib/lisp/org-drill.el601
-rw-r--r--contrib/lisp/org-ebib.el47
-rw-r--r--contrib/lisp/org-effectiveness.el43
-rw-r--r--contrib/lisp/org-elisp-symbol.el2
-rw-r--r--contrib/lisp/org-eval-light.el2
-rw-r--r--contrib/lisp/org-eval.el2
-rw-r--r--contrib/lisp/org-expiry.el7
-rw-r--r--contrib/lisp/org-git-link.el2
-rw-r--r--contrib/lisp/org-index.el4160
-rw-r--r--contrib/lisp/org-interactive-query.el2
-rw-r--r--contrib/lisp/org-invoice.el2
-rw-r--r--contrib/lisp/org-jira.el2
-rw-r--r--contrib/lisp/org-learn.el2
-rw-r--r--contrib/lisp/org-license.el56
-rw-r--r--contrib/lisp/org-mac-iCal.el2
-rw-r--r--contrib/lisp/org-mac-link.el44
-rw-r--r--contrib/lisp/org-mairix.el2
-rw-r--r--contrib/lisp/org-mew.el2
-rw-r--r--contrib/lisp/org-mime.el2
-rw-r--r--contrib/lisp/org-mtags.el2
-rw-r--r--contrib/lisp/org-notify.el2
-rw-r--r--contrib/lisp/org-notmuch.el2
-rw-r--r--contrib/lisp/org-registry.el2
-rw-r--r--contrib/lisp/org-screen.el2
-rw-r--r--contrib/lisp/org-screenshot.el2
-rw-r--r--contrib/lisp/org-secretary.el2
-rw-r--r--contrib/lisp/org-sudoku.el2
-rw-r--r--contrib/lisp/org-toc.el2
-rw-r--r--contrib/lisp/org-track.el2
-rw-r--r--contrib/lisp/org-velocity.el2
-rw-r--r--contrib/lisp/org-vm.el2
-rw-r--r--contrib/lisp/org-wikinodes.el11
-rw-r--r--contrib/lisp/org-wl.el2
-rw-r--r--contrib/lisp/orgtbl-sqlinsert.el2
-rw-r--r--contrib/lisp/ox-bibtex.el307
-rw-r--r--contrib/lisp/ox-confluence.el2
-rw-r--r--contrib/lisp/ox-deck.el10
-rw-r--r--contrib/lisp/ox-freemind.el2
-rw-r--r--contrib/lisp/ox-gfm.el193
-rw-r--r--contrib/lisp/ox-groff.el23
-rw-r--r--contrib/lisp/ox-koma-letter.el615
-rw-r--r--contrib/lisp/ox-rss.el12
-rw-r--r--contrib/lisp/ox-s5.el6
-rw-r--r--contrib/lisp/ox-taskjuggler.el2
-rw-r--r--doc/Makefile5
-rw-r--r--doc/doclicense.texi2
-rw-r--r--doc/org.texi430
-rw-r--r--doc/orgcard.tex8
-rw-r--r--doc/orgguide.texi14
-rw-r--r--etc/ORG-NEWS36
-rw-r--r--etc/styles/README2
-rw-r--r--lisp/ob-C.el165
-rw-r--r--lisp/ob-J.el179
-rw-r--r--lisp/ob-R.el44
-rw-r--r--lisp/ob-asymptote.el2
-rw-r--r--lisp/ob-awk.el2
-rw-r--r--lisp/ob-calc.el2
-rw-r--r--lisp/ob-clojure.el73
-rw-r--r--lisp/ob-comint.el2
-rw-r--r--lisp/ob-coq.el77
-rw-r--r--lisp/ob-core.el142
-rw-r--r--lisp/ob-css.el2
-rw-r--r--lisp/ob-ditaa.el2
-rw-r--r--lisp/ob-dot.el6
-rw-r--r--lisp/ob-emacs-lisp.el2
-rw-r--r--lisp/ob-eval.el2
-rw-r--r--lisp/ob-exp.el331
-rw-r--r--lisp/ob-fortran.el8
-rw-r--r--lisp/ob-gnuplot.el17
-rw-r--r--lisp/ob-groovy.el120
-rw-r--r--lisp/ob-haskell.el2
-rw-r--r--lisp/ob-io.el2
-rw-r--r--lisp/ob-java.el2
-rw-r--r--lisp/ob-js.el2
-rw-r--r--lisp/ob-keys.el3
-rw-r--r--lisp/ob-latex.el4
-rw-r--r--lisp/ob-ledger.el2
-rw-r--r--lisp/ob-lilypond.el2
-rw-r--r--lisp/ob-lisp.el8
-rw-r--r--lisp/ob-lob.el33
-rw-r--r--lisp/ob-makefile.el5
-rw-r--r--lisp/ob-matlab.el2
-rw-r--r--lisp/ob-maxima.el5
-rw-r--r--lisp/ob-mscgen.el2
-rw-r--r--lisp/ob-ocaml.el58
-rw-r--r--lisp/ob-octave.el2
-rw-r--r--lisp/ob-org.el2
-rw-r--r--lisp/ob-perl.el2
-rw-r--r--lisp/ob-picolisp.el2
-rw-r--r--lisp/ob-plantuml.el2
-rw-r--r--lisp/ob-python.el14
-rw-r--r--lisp/ob-ref.el187
-rw-r--r--lisp/ob-ruby.el2
-rw-r--r--lisp/ob-sass.el2
-rw-r--r--lisp/ob-scala.el2
-rw-r--r--lisp/ob-scheme.el5
-rw-r--r--lisp/ob-screen.el2
-rw-r--r--lisp/ob-shell.el (renamed from lisp/ob-sh.el)105
-rw-r--r--lisp/ob-shen.el2
-rw-r--r--lisp/ob-sql.el5
-rw-r--r--lisp/ob-sqlite.el2
-rw-r--r--lisp/ob-table.el14
-rw-r--r--lisp/ob-tangle.el23
-rw-r--r--lisp/ob.el2
-rw-r--r--lisp/org-agenda.el270
-rw-r--r--lisp/org-archive.el6
-rw-r--r--lisp/org-attach.el13
-rw-r--r--lisp/org-bbdb.el2
-rw-r--r--lisp/org-bibtex.el15
-rw-r--r--lisp/org-capture.el17
-rw-r--r--lisp/org-clock.el53
-rw-r--r--lisp/org-colview.el29
-rw-r--r--lisp/org-compat.el39
-rw-r--r--lisp/org-crypt.el12
-rw-r--r--lisp/org-ctags.el2
-rw-r--r--lisp/org-datetree.el2
-rw-r--r--lisp/org-docview.el17
-rw-r--r--lisp/org-element.el3543
-rw-r--r--lisp/org-entities.el10
-rw-r--r--lisp/org-eshell.el2
-rw-r--r--lisp/org-faces.el10
-rw-r--r--lisp/org-feed.el9
-rw-r--r--lisp/org-footnote.el4
-rw-r--r--lisp/org-gnus.el2
-rw-r--r--lisp/org-habit.el6
-rw-r--r--lisp/org-id.el2
-rw-r--r--lisp/org-indent.el2
-rw-r--r--lisp/org-info.el2
-rw-r--r--lisp/org-inlinetask.el6
-rw-r--r--lisp/org-irc.el6
-rw-r--r--lisp/org-list.el6
-rw-r--r--lisp/org-macro.el4
-rw-r--r--lisp/org-macs.el2
-rw-r--r--lisp/org-mhe.el2
-rw-r--r--lisp/org-mobile.el3
-rw-r--r--lisp/org-mouse.el4
-rw-r--r--lisp/org-pcomplete.el2
-rw-r--r--lisp/org-plot.el2
-rw-r--r--lisp/org-protocol.el2
-rw-r--r--lisp/org-rmail.el10
-rw-r--r--lisp/org-src.el39
-rw-r--r--lisp/org-table.el53
-rw-r--r--lisp/org-timer.el40
-rw-r--r--lisp/org-w3m.el2
-rw-r--r--lisp/org.el2425
-rw-r--r--lisp/ox-ascii.el118
-rw-r--r--lisp/ox-beamer.el28
-rw-r--r--lisp/ox-html.el307
-rw-r--r--lisp/ox-icalendar.el6
-rw-r--r--lisp/ox-latex.el511
-rw-r--r--lisp/ox-man.el22
-rw-r--r--lisp/ox-md.el127
-rw-r--r--lisp/ox-odt.el104
-rw-r--r--lisp/ox-org.el17
-rw-r--r--lisp/ox-publish.el78
-rw-r--r--lisp/ox-texinfo.el34
-rw-r--r--lisp/ox.el492
-rw-r--r--mk/default.mk48
-rw-r--r--mk/eldo.el2
-rw-r--r--mk/targets.mk20
-rw-r--r--request-assign-future.txt2
-rw-r--r--testing/README2
-rw-r--r--testing/examples/ob-shell-test.org88
-rw-r--r--testing/examples/open-at-point.org8
-rw-r--r--testing/lisp/test-ob-C.el2
-rw-r--r--testing/lisp/test-ob-R.el2
-rw-r--r--testing/lisp/test-ob-awk.el2
-rw-r--r--testing/lisp/test-ob-emacs-lisp.el2
-rw-r--r--testing/lisp/test-ob-exp.el142
-rw-r--r--testing/lisp/test-ob-fortran.el2
-rw-r--r--testing/lisp/test-ob-header-arg-defaults.el2
-rw-r--r--testing/lisp/test-ob-lilypond.el2
-rw-r--r--testing/lisp/test-ob-lob.el52
-rw-r--r--testing/lisp/test-ob-maxima.el2
-rw-r--r--testing/lisp/test-ob-octave.el2
-rw-r--r--testing/lisp/test-ob-perl.el2
-rw-r--r--testing/lisp/test-ob-python.el2
-rw-r--r--testing/lisp/test-ob-sh.el52
-rw-r--r--testing/lisp/test-ob-shell.el92
-rw-r--r--testing/lisp/test-ob-table.el2
-rw-r--r--testing/lisp/test-ob-tangle.el2
-rw-r--r--testing/lisp/test-ob.el38
-rw-r--r--testing/lisp/test-org-clock.el2
-rw-r--r--testing/lisp/test-org-element.el527
-rw-r--r--testing/lisp/test-org-footnote.el2
-rw-r--r--testing/lisp/test-org-list.el2
-rw-r--r--testing/lisp/test-org-macro.el2
-rw-r--r--testing/lisp/test-org-open-at-point.el61
-rw-r--r--testing/lisp/test-org-src.el2
-rw-r--r--testing/lisp/test-org-table.el176
-rw-r--r--testing/lisp/test-org.el234
-rw-r--r--testing/lisp/test-ox.el239
-rw-r--r--testing/lisp/test-property-inheritance.el2
-rw-r--r--testing/org-batch-test-init.el20
-rw-r--r--testing/org-test.el40
214 files changed, 11780 insertions, 7471 deletions
diff --git a/Makefile b/Makefile
index f95bcb2..ce06116 100644
--- a/Makefile
+++ b/Makefile
@@ -30,6 +30,7 @@ help helpall::
$(info make single - build Org ELisp files, single Emacs per source)
$(info make autoloads - create org-loaddefs.el to load Org in-place)
$(info make test - build Org ELisp files and run test suite)
+ $(info make vanilla - run Emacs with this Org-mode and no personal config)
helpall::
$(info make test-dirty - check without building first)
$(info make compile-dirty - build only stale Org ELisp files)
diff --git a/contrib/README b/contrib/README
index 15df87c..2a67b65 100644
--- a/contrib/README
+++ b/contrib/README
@@ -24,6 +24,7 @@ org-contacts.el --- Contacts management
org-contribdir.el --- Dummy file to mark the org contrib Lisp directory
org-depend.el --- TODO dependencies for Org-mode
org-drill.el --- Self-testing with org-learn
+org-effectiveness.el --- Measuring your personal effectiveness
org-element.el --- Parser and applications for Org syntax
org-elisp-symbol.el --- Org links to emacs-lisp symbols
org-eval-light.el --- Evaluate in-buffer code on demand
@@ -36,9 +37,9 @@ org-interactive-query.el --- Interactive modification of tags query
org-invoice.el --- Help manage client invoices in OrgMode
org-jira.el --- Add a jira:ticket protocol to Org
org-learn.el --- SuperMemo's incremental learning algorithm
+org-license.el --- Insert free licenses to your org documents
org-mac-iCal.el --- Imports events from iCal.app to the Emacs diary
-org-mac-link-grabber.el --- Grab links and URLs from various Mac applications
-org-mac-message.el --- Links to Apple Mail.app messages from within Org-mode
+org-mac-link.el --- Grab links and URLs from various Mac applications
org-mairix.el --- Hook mairix search into Org for different MUAs
org-man.el --- Support for links to manpages in Org-mode
org-mew.el --- Support for links to Mew messages
diff --git a/contrib/lisp/ob-eukleides.el b/contrib/lisp/ob-eukleides.el
index e25ed1c..c8ce881 100644
--- a/contrib/lisp/ob-eukleides.el
+++ b/contrib/lisp/ob-eukleides.el
@@ -1,6 +1,6 @@
;;; ob-eukleides.el --- Org-babel functions for eukleides evaluation
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Author: Luis Anaya
;; Keywords: literate programming, reproducible research
diff --git a/contrib/lisp/ob-fomus.el b/contrib/lisp/ob-fomus.el
index 58183fb..1db32e4 100644
--- a/contrib/lisp/ob-fomus.el
+++ b/contrib/lisp/ob-fomus.el
@@ -1,6 +1,6 @@
;;; ob-fomus.el --- Org-babel functions for fomus evaluation
-;; Copyright (C) 2011-2013 Torsten Anders
+;; Copyright (C) 2011-2014 Torsten Anders
;; Author: Torsten Anders
;; Keywords: literate programming, reproducible research
diff --git a/contrib/lisp/ob-julia.el b/contrib/lisp/ob-julia.el
index 3aed818..4d8deb2 100644
--- a/contrib/lisp/ob-julia.el
+++ b/contrib/lisp/ob-julia.el
@@ -1,6 +1,6 @@
;;; ob-julia.el --- org-babel functions for julia code evaluation
-;; Copyright (C) 2013 G. Jay Kerns
+;; Copyright (C) 2013, 2014 G. Jay Kerns
;; Author: G. Jay Kerns, based on ob-R.el by Eric Schulte and Dan Davison
;; This file is not part of GNU Emacs.
diff --git a/contrib/lisp/ob-mathomatic.el b/contrib/lisp/ob-mathomatic.el
index 585604e..bfd8ecf 100644
--- a/contrib/lisp/ob-mathomatic.el
+++ b/contrib/lisp/ob-mathomatic.el
@@ -1,6 +1,6 @@
;;; ob-mathomatic.el --- Org-babel functions for mathomatic evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric S Fraga
;; Eric Schulte
diff --git a/contrib/lisp/ob-oz.el b/contrib/lisp/ob-oz.el
index ce8e8a6..3531d95 100644
--- a/contrib/lisp/ob-oz.el
+++ b/contrib/lisp/ob-oz.el
@@ -1,6 +1,6 @@
;;; ob-oz.el --- Org-babel functions for Oz evaluation
-;; Copyright (C) 2009-2013 Torsten Anders and Eric Schulte
+;; Copyright (C) 2009-2014 Torsten Anders and Eric Schulte
;; Author: Torsten Anders and Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -90,7 +90,7 @@
(require 'ob)
;;; major mode for editing Oz programs
-(require 'mozart)
+(require 'mozart nil t)
;;
;; Interface to communicate with Oz.
diff --git a/contrib/lisp/ob-tcl.el b/contrib/lisp/ob-tcl.el
index e8d735b..50afe5a 100644
--- a/contrib/lisp/ob-tcl.el
+++ b/contrib/lisp/ob-tcl.el
@@ -1,6 +1,6 @@
;;; ob-tcl.el --- Org-babel functions for tcl evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Authors: Dan Davison
;; Eric Schulte
diff --git a/contrib/lisp/org-annotate-file.el b/contrib/lisp/org-annotate-file.el
index bdb9acb..8fbb590 100644
--- a/contrib/lisp/org-annotate-file.el
+++ b/contrib/lisp/org-annotate-file.el
@@ -1,6 +1,6 @@
;;; org-annotate-file.el --- Annotate a file with org syntax
-;; Copyright (C) 2008-2013 Philip Jackson
+;; Copyright (C) 2008-2014 Philip Jackson
;; Author: Philip Jackson <phil@shellarchive.co.uk>
;; Version: 0.2
@@ -25,7 +25,7 @@
;;; Commentary:
;; This is yet another implementation to allow the annotation of a
-;; file without modification of the file itself. The annotation is in
+;; file without modification of the file itself. The annotation is in
;; org syntax so you can use all of the org features you are used to.
;; To use you might put the following in your .emacs:
@@ -47,30 +47,31 @@
;; and next time you hit C-c C-l you will hit those notes again.
;;
;; To put a subheading with a text search for the current line set
-;; `org-annotate-file-add-search` to non-nil value. Then when you hit
+;; `org-annotate-file-add-search` to non-nil value. Then when you hit
;; C-c C-l (on the above line for example) you will get:
;; * ~/org-annotate-file.el
-;; ** `org-annotate-file-add-search` to non-nil value. Then whe...
+;; ** `org-annotate-file-add-search` to non-nil value. Then whe...
;; Note that both of the above will be links.
+;;; Code:
+
(require 'org)
(defvar org-annotate-file-storage-file "~/.org-annotate-file.org"
"File in which to keep annotations.")
(defvar org-annotate-file-add-search nil
- "If non-nil then add a link as a second level to the actual
-location in the file")
+ "If non-nil, add a link as a second level to the actual file location.")
(defvar org-annotate-file-always-open t
- "non-nil means always expand the full tree when you visit
-`org-annotate-file-storage-file'.")
+ "If non-nil, always expand the full tree when visiting the annotation file.")
-(defun org-annotate-file-elipsify-desc (string &optional after)
- "Strip starting and ending whitespace and replace any chars
-that appear after the value in `after' with '...'"
+(defun org-annotate-file-ellipsify-desc (string &optional after)
+ "Return shortened STRING with appended ellipsis.
+Trim whitespace at beginning and end of STRING and replace any
+ characters that appear after the occurrence of AFTER with '...'"
(let* ((after (number-to-string (or after 30)))
(replace-map (list (cons "^[ \t]*" "")
(cons "[ \t]*$" "")
@@ -82,46 +83,61 @@ that appear after the value in `after' with '...'"
replace-map)
string))
+;;;###autoload
(defun org-annotate-file ()
- "Put a section for the current file into your annotation file"
+ "Visit `org-annotate-file-storage-file` and add a new annotation section.
+The annotation is opened at the new section which will be referencing
+the point in the current file."
(interactive)
(unless (buffer-file-name)
- (error "This buffer has no associated file"))
- (org-annotate-file-show-section))
-
-(defun org-annotate-file-show-section (&optional buffer)
- "Visit the buffer named `org-annotate-file-storage-file' and
-show the relevant section"
- (let* ((filename (abbreviate-file-name (or buffer (buffer-file-name))))
- (line (buffer-substring-no-properties (point-at-bol) (point-at-eol)))
- (link (org-make-link-string (concat "file:" filename) filename))
+ (error "This buffer has no associated file!"))
+ (switch-to-buffer
+ (org-annotate-file-show-section org-annotate-file-storage-file)))
+
+;;;###autoload
+(defun org-annotate-file-show-section (storage-file &optional annotated-buffer)
+ "Add or show annotation entry in STORAGE-FILE and return the buffer.
+The annotation will link to ANNOTATED-BUFFER if specified,
+ otherwise the current buffer is used."
+ (let ((filename (abbreviate-file-name (or annotated-buffer
+ (buffer-file-name))))
+ (line (buffer-substring-no-properties (point-at-bol) (point-at-eol)))
+ (annotation-buffer (find-file-noselect storage-file)))
+ (with-current-buffer annotation-buffer
+ (org-annotate-file-annotate filename line))
+ annotation-buffer))
+
+(defun org-annotate-file-annotate (filename line)
+ "Add annotation for FILENAME at LINE using current buffer."
+ (let* ((link (org-make-link-string (concat "file:" filename) filename))
(search-link (org-make-link-string
(concat "file:" filename "::" line)
- (org-annotate-file-elipsify-desc line))))
- (with-current-buffer (find-file org-annotate-file-storage-file)
- (unless (eq major-mode 'org-mode)
- (org-mode))
- (goto-char (point-min))
- (widen)
- (when org-annotate-file-always-open
- (show-all))
+ (org-annotate-file-ellipsify-desc line))))
+ (unless (eq major-mode 'org-mode)
+ (org-mode))
+ (goto-char (point-min))
+ (widen)
+ (when org-annotate-file-always-open
+ (show-all))
+ (unless (search-forward-regexp
+ (concat "^* " (regexp-quote link)) nil t)
+ (org-annotate-file-add-upper-level link))
+ (beginning-of-line)
+ (org-narrow-to-subtree)
+ ;; deal with a '::' search if need be
+ (when org-annotate-file-add-search
(unless (search-forward-regexp
- (concat "^* " (regexp-quote link)) nil t)
- (org-annotate-file-add-upper-level link))
- (beginning-of-line)
- (org-narrow-to-subtree)
- ;; deal with a '::' search if need be
- (when org-annotate-file-add-search
- (unless (search-forward-regexp
- (concat "^** " (regexp-quote search-link)) nil t)
- (org-annotate-file-add-second-level search-link))))))
+ (concat "^** " (regexp-quote search-link)) nil t)
+ (org-annotate-file-add-second-level search-link)))))
(defun org-annotate-file-add-upper-level (link)
+ "Add and link heading to LINK."
(goto-char (point-min))
(call-interactively 'org-insert-heading)
(insert link))
(defun org-annotate-file-add-second-level (link)
+ "Add and link subheading to LINK."
(goto-char (point-at-eol))
(call-interactively 'org-insert-subheading)
(insert link))
diff --git a/contrib/lisp/org-bibtex-extras.el b/contrib/lisp/org-bibtex-extras.el
index 93c97a9..8d5b2ac 100644
--- a/contrib/lisp/org-bibtex-extras.el
+++ b/contrib/lisp/org-bibtex-extras.el
@@ -1,6 +1,6 @@
;;; org-bibtex-extras --- extras for working with org-bibtex entries
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte <eric dot schulte at gmx dot com>
;; Keywords: outlines, hypermedia, bibtex, d3
@@ -75,7 +75,8 @@ For example, to point to your `obe-bibtex-file' use the following.
"Return all citations from `obe-bibtex-file'."
(or obe-citations
(save-window-excursion
- (find-file obe-bibtex-file)
+ (find-file (or obe-bibtex-file
+ (error "`obe-bibtex-file' has not been configured")))
(goto-char (point-min))
(while (re-search-forward " :CUSTOM_ID: \\(.+\\)$" nil t)
(push (org-no-properties (match-string 1))
@@ -88,7 +89,8 @@ For example, to point to your `obe-bibtex-file' use the following.
(let ((citation (or citation
(org-icompleting-read "Citation: "
(obe-citations)))))
- (find-file obe-bibtex-file)
+ (find-file (or obe-bibtex-file
+ (error "`obe-bibtex-file' has not been configured")))
(goto-char (point-min))
(when (re-search-forward (format " :CUSTOM_ID: %s" citation) nil t)
(outline-previous-visible-heading 1)
diff --git a/contrib/lisp/org-bookmark.el b/contrib/lisp/org-bookmark.el
index 44588b6..9a69bbb 100644
--- a/contrib/lisp/org-bookmark.el
+++ b/contrib/lisp/org-bookmark.el
@@ -1,5 +1,5 @@
;;; org-bookmark.el - Support for links to bookmark
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
;;
;; Author: Tokuya Kameshima <kames AT fa2.so-net.ne.jp>
;; Version: 1.0
diff --git a/contrib/lisp/org-checklist.el b/contrib/lisp/org-checklist.el
index faa5998..2bc00c0 100644
--- a/contrib/lisp/org-checklist.el
+++ b/contrib/lisp/org-checklist.el
@@ -1,6 +1,6 @@
;;; org-checklist.el --- org functions for checklist handling
-;; Copyright (C) 2008-2013 James TD Smith
+;; Copyright (C) 2008-2014 James TD Smith
;; Author: James TD Smith (@ ahktenzero (. mohorovi cc))
;; Version: 1.0
diff --git a/contrib/lisp/org-choose.el b/contrib/lisp/org-choose.el
index 8e5935d..c1006d0 100644
--- a/contrib/lisp/org-choose.el
+++ b/contrib/lisp/org-choose.el
@@ -1,6 +1,6 @@
;;; org-choose.el --- decision management for org-mode
-;; Copyright (C) 2009-2013 Tom Breton (Tehom)
+;; Copyright (C) 2009-2014 Tom Breton (Tehom)
;; This file is not part of GNU Emacs.
diff --git a/contrib/lisp/org-collector.el b/contrib/lisp/org-collector.el
index d62a462..5894707 100644
--- a/contrib/lisp/org-collector.el
+++ b/contrib/lisp/org-collector.el
@@ -1,6 +1,6 @@
;;; org-collector --- collect properties into tables
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte <schulte dot eric at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp, experimentation,
diff --git a/contrib/lisp/org-colview-xemacs.el b/contrib/lisp/org-colview-xemacs.el
index f9b35d3..67a2aad 100644
--- a/contrib/lisp/org-colview-xemacs.el
+++ b/contrib/lisp/org-colview-xemacs.el
@@ -1,6 +1,6 @@
;;; org-colview-xemacs.el --- Column View in Org-mode, XEmacs-specific version
-;; Copyright (C) 2004-2013
+;; Copyright (C) 2004-2014
;; Carsten Dominik
;; Author: Carsten Dominik <carsten at orgmode dot org>
diff --git a/contrib/lisp/org-contacts.el b/contrib/lisp/org-contacts.el
index dbbc057..7cc42fc 100644
--- a/contrib/lisp/org-contacts.el
+++ b/contrib/lisp/org-contacts.el
@@ -1,6 +1,6 @@
;;; org-contacts.el --- Contacts management
-;; Copyright (C) 2010-2013 Julien Danjou <julien@danjou.info>
+;; Copyright (C) 2010-2014 Julien Danjou <julien@danjou.info>
;; Author: Julien Danjou <julien@danjou.info>
;; Keywords: outlines, hypermedia, calendar
diff --git a/contrib/lisp/org-contribdir.el b/contrib/lisp/org-contribdir.el
index 8132750..d94e7a0 100644
--- a/contrib/lisp/org-contribdir.el
+++ b/contrib/lisp/org-contribdir.el
@@ -1,5 +1,5 @@
;;; org-contribdir.el --- Mark the location of the contrib directory
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
diff --git a/contrib/lisp/org-depend.el b/contrib/lisp/org-depend.el
index dc99a1d..1cd4130 100644
--- a/contrib/lisp/org-depend.el
+++ b/contrib/lisp/org-depend.el
@@ -1,5 +1,5 @@
;;; org-depend.el --- TODO dependencies for Org-mode
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
diff --git a/contrib/lisp/org-download.el b/contrib/lisp/org-download.el
new file mode 100644
index 0000000..39312cf
--- a/dev/null
+++ b/contrib/lisp/org-download.el
@@ -0,0 +1,336 @@
+;;; org-download.el --- Image drag-and-drop for Emacs org-mode
+
+;; Copyright (C) 2014 Free Software Foundation, Inc.
+
+;; Author: Oleh Krehel
+;; Keywords: images, screenshots, download
+;; Homepage: http://orgmode.org
+
+;; 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:
+;;
+;; This extension facilitates moving images from point A to point B.
+;;
+;; Point A (the source) can be:
+;; 1. An image inside your browser that you can drag to Emacs.
+;; 2. An image on your file system that you can drag to Emacs.
+;; 3. A local or remote image address in kill-ring.
+;; Use the `org-download-yank' command for this.
+;; Remember that you can use "0 w" in `dired' to get an address.
+;; 4. An screenshot taken using `gnome-screenshot' or `scrot' or `gm'.
+;; Use the `org-download-screenshot' command for this.
+;; Customize the backend with `org-download-screenshot-method'.
+;;
+;; Point B (the target) is an Emacs `org-mode' buffer where the inline
+;; link will be inserted. Several customization options will determine
+;; where exactly on the file system the file will be stored.
+;;
+;; They are:
+;; `org-download-method':
+;; a. 'attach => use `org-mode' attachment machinery
+;; b. 'directory => construct the directory in two stages:
+;; 1. first part of the folder name is:
+;; * either "." (current folder)
+;; * or `org-download-image-dir' (if it's not nil).
+;; `org-download-image-dir' becomes buffer-local when set,
+;; so each file can customize this value, e.g with:
+;; # -*- mode: Org; org-download-image-dir: ~/Pictures/foo; -*-
+;; 2. second part is:
+;; * `org-download-heading-lvl' is nil => ""
+;; * `org-download-heading-lvl' is n => the name of current
+;; heading with level n. Level count starts with 0,
+;; i.e. * is 0, ** is 1, *** is 2 etc.
+;; `org-download-heading-lvl' becomes buffer-local when set,
+;; so each file can customize this value, e.g with:
+;; # -*- mode: Org; org-download-heading-lvl: nil; -*-
+;;
+;; `org-download-timestamp':
+;; optionally add a timestamp to the file name.
+;;
+;; Customize `org-download-backend' to choose between `url-retrieve'
+;; (the default) or `wget' or `curl'.
+;;
+;;; Code:
+
+
+(eval-when-compile
+ (require 'cl))
+(require 'url-parse)
+(require 'url-http)
+
+(defgroup org-download nil
+ "Image drag-and-drop for org-mode."
+ :group 'org
+ :prefix "org-download-")
+
+(defcustom org-download-method 'directory
+ "The way images should be stored."
+ :type '(choice
+ (const :tag "Directory" directory)
+ (const :tag "Attachment" attach))
+ :group 'org-download)
+
+(defcustom org-download-image-dir nil
+ "If set, images will be stored in this directory instead of \".\".
+See `org-download--dir-1' for more info."
+ :type '(choice
+ (const :tag "Default" nil)
+ (string :tag "Directory"))
+ :group 'org-download)
+(make-variable-buffer-local 'org-download-image-dir)
+
+(defcustom org-download-heading-lvl 0
+ "Heading level to be used in `org-download--dir-2'."
+ :group 'org-download)
+(make-variable-buffer-local 'org-download-heading-lvl)
+
+(defcustom org-download-backend t
+ "Method to use for downloading."
+ :type '(choice
+ (const :tag "wget" "wget \"%s\" -O \"%s\"")
+ (const :tag "curl" "curl \"%s\" -o \"%s\"")
+ (const :tag "url-retrieve" t))
+ :group 'org-download)
+
+(defcustom org-download-timestamp "_%Y-%m-%d_%H:%M:%S"
+ "This `format-time-string'-style string will be appended to the file name.
+Set this to \"\" if you don't want time stamps."
+ :type 'string
+ :group 'org-download)
+
+(defcustom org-download-screenshot-method "gnome-screenshot -a -f %s"
+ "The tool to capture screenshots."
+ :type '(choice
+ (const :tag "gnome-screenshot" "gnome-screenshot -a -f %s")
+ (const :tag "scrot" "scrot -s %s")
+ (const :tag "gm" "gm import %s"))
+ :group 'org-download)
+
+(defcustom org-download-image-width 0
+ "When non-zero add #+attr_html: :width tag to the image."
+ :type 'integer
+ :group 'org-download)
+
+(defun org-download-get-heading (lvl)
+ "Return the heading of the current entry's LVL level parent."
+ (save-excursion
+ (let ((cur-lvl (org-current-level)))
+ (unless (= cur-lvl 1)
+ (org-up-heading-all (- (1- (org-current-level)) lvl)))
+ (substring-no-properties
+ (org-get-heading)))))
+
+(defun org-download--dir-1 ()
+ "Return the first part of the directory path for `org-download--dir'.
+It's `org-download-image-dir', unless it's nil. Then it's \".\"."
+ (or org-download-image-dir "."))
+
+(defun org-download--dir-2 ()
+ "Return the second part of the directory path for `org-download--dir'.
+Unless `org-download-heading-lvl' is nil, it's the name of the current
+`org-download-heading-lvl'-leveled heading. Otherwise it's \"\"."
+ (and org-download-heading-lvl
+ (org-download-get-heading
+ org-download-heading-lvl)))
+
+(defun org-download--dir ()
+ "Return the directory path for image storage.
+
+The path is composed from `org-download--dir-1' and `org-download--dir-2'.
+The directory is created if it didn't exist before."
+ (let* ((part1 (org-download--dir-1))
+ (part2 (org-download--dir-2))
+ (dir (if part2
+ (format "%s/%s" part1 part2)
+ part1)))
+ (unless (file-exists-p dir)
+ (make-directory dir t))
+ dir))
+
+(defun org-download--fullname (link)
+ "Return the file name where LINK will be saved to.
+
+It's affected by `org-download-timestamp' and `org-download--dir'."
+ (let ((filename
+ (file-name-nondirectory
+ (car (url-path-and-query
+ (url-generic-parse-url link)))))
+ (dir (org-download--dir)))
+ (format "%s/%s%s.%s"
+ dir
+ (file-name-sans-extension filename)
+ (format-time-string org-download-timestamp)
+ (file-name-extension filename))))
+
+(defun org-download--image (link filename)
+ "Save LINK to FILENAME asynchronously and show inline images in current buffer."
+ (when (string-match "^file://\\(.*\\)" link)
+ (setq link (url-unhex-string (match-string 1 link))))
+ (cond ((file-exists-p link)
+ (org-download--image/command "cp \"%s\" \"%s\"" link filename))
+ ((eq org-download-backend t)
+ (org-download--image/url-retrieve link filename))
+ (t
+ (org-download--image/command org-download-backend link filename))))
+
+(defun org-download--image/command (command link filename)
+ "Using COMMAND, save LINK to FILENAME.
+COMMAND is a format-style string with two slots for LINK and FILENAME."
+ (require 'async)
+ (async-start
+ `(lambda() (shell-command
+ ,(format command link
+ (expand-file-name filename))))
+ (lexical-let ((cur-buf (current-buffer)))
+ (lambda(x)
+ (with-current-buffer cur-buf
+ (org-display-inline-images))))))
+
+(defun org-download--image/url-retrieve (link filename)
+ "Save LINK to FILENAME using `url-retrieve'."
+ (url-retrieve
+ link
+ (lambda (status filename buffer)
+ ;; Write current buffer to FILENAME
+ ;; and update inline images in BUFFER
+ (let ((err (plist-get status :error)))
+ (if err (error
+ "\"%s\" %s" link
+ (downcase (nth 2 (assq (nth 2 err) url-http-codes))))))
+ (delete-region
+ (point-min)
+ (progn
+ (re-search-forward "\n\n" nil 'move)
+ (point)))
+ (let ((coding-system-for-write 'no-conversion))
+ (write-region nil nil filename nil nil nil 'confirm))
+ (with-current-buffer buffer
+ (org-display-inline-images)))
+ (list
+ (expand-file-name filename)
+ (current-buffer))
+ nil t))
+
+(defun org-download-yank ()
+ "Call `org-download-image' with current kill."
+ (interactive)
+ (org-download-image (current-kill 0)))
+
+(defun org-download-screenshot ()
+ "Capture screenshot and insert the resulting file.
+The screenshot tool is determined by `org-download-screenshot-method'."
+ (interactive)
+ (let ((link "/tmp/screenshot.png"))
+ (shell-command (format org-download-screenshot-method link))
+ (org-download-image link)))
+
+(defun org-download-image (link)
+ "Save image at address LINK to `org-download--dir'."
+ (interactive "sUrl: ")
+ (let ((filename
+ (if (eq org-download-method 'attach)
+ (let ((org-download-image-dir (progn (require 'org-attach)
+ (org-attach-dir t)))
+ org-download-heading-lvl)
+ (org-download--fullname link))
+ (org-download--fullname link))))
+ (when (image-type-from-file-name filename)
+ (org-download--image link filename)
+ (when (eq org-download-method 'attach)
+ (org-attach-attach filename nil 'none))
+ (if (looking-back "^[ \t]+")
+ (delete-region (match-beginning 0) (match-end 0))
+ (newline))
+ (insert (format "#+DOWNLOADED: %s @ %s\n%s [[%s]]"
+ link
+ (format-time-string "%Y-%m-%d %H:%M:%S")
+ (if (= org-download-image-width 0)
+ ""
+ (format "#+attr_html: :width %dpx\n" org-download-image-width))
+ filename))
+ (org-display-inline-images))))
+
+(defun org-download--at-comment-p ()
+ "Check if current line begins with #+DOWLOADED:."
+ (save-excursion
+ (move-beginning-of-line nil)
+ (looking-at "#\\+DOWNLOADED:")))
+
+(defun org-download-delete ()
+ "Delete inline image link on current line, and the file that it points to."
+ (interactive)
+ (cond ((org-download--at-comment-p)
+ (delete-region (line-beginning-position)
+ (line-end-position))
+ (org-download--delete (line-beginning-position)
+ nil
+ 1))
+ ((region-active-p)
+ (org-download--delete (region-beginning)
+ (region-end))
+ (delete-region (region-beginning)
+ (region-end)))
+
+ (t (org-download--delete (line-beginning-position)
+ (line-end-position)))))
+
+(defun org-download--delete (beg end &optional times)
+ "Delete inline image links and the files they point to between BEG and END.
+
+When TIMES isn't nil, delete only TIMES links."
+ (unless times
+ (setq times most-positive-fixnum))
+ (save-excursion
+ (goto-char beg)
+ (while (and (>= (decf times) 0)
+ (re-search-forward "\\[\\[\\([^]]*\\)\\]\\]" end t))
+ (let ((str (match-string-no-properties 1)))
+ (delete-region (match-beginning 0)
+ (match-end 0))
+ (when (file-exists-p str)
+ (delete-file str))))))
+
+(defun org-download-dnd (uri action)
+ "When in `org-mode' and URI points to image, download it.
+Otherwise, pass URI and ACTION back to dnd dispatch."
+ (if (eq major-mode 'org-mode)
+ ;; probably shouldn't redirect
+ (unless (org-download-image uri)
+ (message "not an image URL"))
+ ;; redirect to someone else
+ (let ((dnd-protocol-alist
+ (rassq-delete-all
+ 'org-download-dnd
+ (copy-alist dnd-protocol-alist))))
+ (dnd-handle-one-url nil action uri))))
+
+(defun org-download-enable ()
+ "Enable org-download."
+ (unless (eq (cdr (assoc "^\\(https?\\|ftp\\|file\\|nfs\\)://" dnd-protocol-alist))
+ 'org-download-dnd)
+ (setq dnd-protocol-alist
+ `(("^\\(https?\\|ftp\\|file\\|nfs\\)://" . org-download-dnd) ,@dnd-protocol-alist))))
+
+(defun org-download-disable ()
+ "Disable org-download."
+ (rassq-delete-all 'org-download-dnd dnd-protocol-alist))
+
+(org-download-enable)
+
+(provide 'org-download)
+
+;;; org-download.el ends here
diff --git a/contrib/lisp/org-drill.el b/contrib/lisp/org-drill.el
index 5bf6dd4..e5b0d49 100644
--- a/contrib/lisp/org-drill.el
+++ b/contrib/lisp/org-drill.el
@@ -1,73 +1,72 @@
-;; -*- coding: utf-8-unix -*-
+;;; -*- coding: utf-8-unix -*-
;;; org-drill.el - Self-testing using spaced repetition
;;;
-;; Author: Paul Sexton <eeeickythump@gmail.com>
-;; Version: 2.3.7
-;; Repository at http://bitbucket.org/eeeickythump/org-drill/
-;;
-;; This file is not part of GNU Emacs.
-;;
-;; 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. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary and synopsis:
+;;; Author: Paul Sexton <eeeickythump@gmail.com>
+;;; Version: 2.4.1
+;;; Repository at http://bitbucket.org/eeeickythump/org-drill/
;;;
-;; Uses the SuperMemo spaced repetition algorithms to conduct interactive
-;; "drill sessions", where the material to be remembered is presented to the
-;; student in random order. The student rates his or her recall of each item,
-;; and this information is used to schedule the item for later revision.
-;;
-;; Each drill session can be restricted to topics in the current buffer
-;; (default), one or several files, all agenda files, or a subtree. A single
-;; topic can also be drilled.
-;;
-;; Different "card types" can be defined, which present their information to
-;; the student in different ways.
-;;
-;; See the file README.org for more detailed documentation.
-;;
-;;; Code:
+;;;
+;;; Synopsis
+;;; ========
+;;;
+;;; Uses the SuperMemo spaced repetition algorithms to conduct interactive
+;;; "drill sessions", where the material to be remembered is presented to the
+;;; student in random order. The student rates his or her recall of each item,
+;;; and this information is used to schedule the item for later revision.
+;;;
+;;; Each drill session can be restricted to topics in the current buffer
+;;; (default), one or several files, all agenda files, or a subtree. A single
+;;; topic can also be drilled.
+;;;
+;;; Different "card types" can be defined, which present their information to
+;;; the student in different ways.
+;;;
+;;; See the file README.org for more detailed documentation.
+
(eval-when-compile (require 'cl))
(eval-when-compile (require 'hi-lock))
+(require 'cl-lib)
+(require 'hi-lock)
(require 'org)
(require 'org-id)
(require 'org-learn)
+
(defgroup org-drill nil
"Options concerning interactive drill sessions in Org mode (org-drill)."
:tag "Org-Drill"
:group 'org-link)
-(defcustom org-drill-question-tag "drill"
+
+
+(defcustom org-drill-question-tag
+ "drill"
"Tag which topics must possess in order to be identified as review topics
by `org-drill'."
:group 'org-drill
:type 'string)
-(defcustom org-drill-maximum-items-per-session 30
+
+(defcustom org-drill-maximum-items-per-session
+ 30
"Each drill session will present at most this many topics for review.
Nil means unlimited."
:group 'org-drill
:type '(choice integer (const nil)))
-(defcustom org-drill-maximum-duration 20
+
+
+(defcustom org-drill-maximum-duration
+ 20
"Maximum duration of a drill session, in minutes.
Nil means unlimited."
:group 'org-drill
:type '(choice integer (const nil)))
-(defcustom org-drill-failure-quality 2
+
+(defcustom org-drill-failure-quality
+ 2
"If the quality of recall for an item is this number or lower,
it is regarded as an unambiguous failure, and the repetition
interval for the card is reset to 0 days. If the quality is higher
@@ -81,7 +80,9 @@ really sensible."
:group 'org-drill
:type '(choice (const 2) (const 1)))
-(defcustom org-drill-forgetting-index 10
+
+(defcustom org-drill-forgetting-index
+ 10
"What percentage of items do you consider it is 'acceptable' to
forget each drill session? The default is 10%. A warning message
is displayed at the end of the session if the percentage forgotten
@@ -89,13 +90,17 @@ climbs above this number."
:group 'org-drill
:type 'integer)
-(defcustom org-drill-leech-failure-threshold 15
+
+(defcustom org-drill-leech-failure-threshold
+ 15
"If an item is forgotten more than this many times, it is tagged
as a 'leech' item."
:group 'org-drill
:type '(choice integer (const nil)))
-(defcustom org-drill-leech-method 'skip
+
+(defcustom org-drill-leech-method
+ 'skip
"How should 'leech items' be handled during drill sessions?
Possible values:
- nil :: Leech items are treated the same as normal items.
@@ -104,62 +109,89 @@ Possible values:
but a warning message is printed when each leech item is
presented."
:group 'org-drill
- :type '(choice (const 'warn) (const 'skip) (const nil)))
+ :type '(choice (const warn) (const skip) (const nil)))
+
(defface org-drill-visible-cloze-face
'((t (:foreground "darkseagreen")))
"The face used to hide the contents of cloze phrases."
:group 'org-drill)
+
(defface org-drill-visible-cloze-hint-face
'((t (:foreground "dark slate blue")))
"The face used to hide the contents of cloze phrases."
:group 'org-drill)
+
(defface org-drill-hidden-cloze-face
'((t (:foreground "deep sky blue" :background "blue")))
"The face used to hide the contents of cloze phrases."
:group 'org-drill)
-(defcustom org-drill-use-visible-cloze-face-p nil
+
+(defcustom org-drill-use-visible-cloze-face-p
+ nil
"Use a special face to highlight cloze-deleted text in org mode
buffers?"
:group 'org-drill
:type 'boolean)
-(defcustom org-drill-hide-item-headings-p nil
+
+(defcustom org-drill-hide-item-headings-p
+ nil
"Conceal the contents of the main heading of each item during drill
sessions? You may want to enable this behaviour if item headings or tags
contain information that could 'give away' the answer."
:group 'org-drill
:type 'boolean)
-(defcustom org-drill-new-count-color "royal blue"
+
+(defcustom org-drill-new-count-color
+ "royal blue"
"Foreground colour used to display the count of remaining new items
during a drill session."
:group 'org-drill
:type 'color)
-(defcustom org-drill-mature-count-color "green"
+(defcustom org-drill-mature-count-color
+ "green"
"Foreground colour used to display the count of remaining mature items
during a drill session. Mature items are due for review, but are not new."
:group 'org-drill
:type 'color)
-(defcustom org-drill-failed-count-color "red"
+(defcustom org-drill-failed-count-color
+ "red"
"Foreground colour used to display the count of remaining failed items
during a drill session."
:group 'org-drill
:type 'color)
-(defcustom org-drill-done-count-color "sienna"
+(defcustom org-drill-done-count-color
+ "sienna"
"Foreground colour used to display the count of reviewed items
during a drill session."
:group 'org-drill
:type 'color)
+(defcustom org-drill-left-cloze-delimiter
+ "["
+ "String used within org buffers to delimit cloze deletions."
+ :group 'org-drill
+ :type 'string)
+
+(defcustom org-drill-right-cloze-delimiter
+ "]"
+ "String used within org buffers to delimit cloze deletions."
+ :group 'org-drill
+ :type 'string)
+
+
(setplist 'org-drill-cloze-overlay-defaults
- '(display "[...]"
+ `(display ,(format "%s...%s"
+ org-drill-left-cloze-delimiter
+ org-drill-right-cloze-delimiter)
face org-drill-hidden-cloze-face
window t))
@@ -171,21 +203,35 @@ during a drill session."
face default
window t))
+
(defvar org-drill-hint-separator "||"
"String which, if it occurs within a cloze expression, signifies that the
rest of the expression after the string is a `hint', to be displayed instead of
the hidden cloze during a test.")
-(defvar org-drill-cloze-regexp
- (concat "\\(\\[[[:cntrl:][:graph:][:space:]]+?\\)\\(\\|"
+(defun org-drill--compute-cloze-regexp ()
+ (concat "\\("
+ (regexp-quote org-drill-left-cloze-delimiter)
+ "[[:cntrl:][:graph:][:space:]]+?\\)\\(\\|"
(regexp-quote org-drill-hint-separator)
- ".+?\\)\\(\\]\\)"))
+ ".+?\\)\\("
+ (regexp-quote org-drill-right-cloze-delimiter)
+ "\\)"))
+
+(defun org-drill--compute-cloze-keywords ()
+ (list (list (org-drill--compute-cloze-regexp)
+ (copy-list '(1 'org-drill-visible-cloze-face nil))
+ (copy-list '(2 'org-drill-visible-cloze-hint-face t))
+ (copy-list '(3 'org-drill-visible-cloze-face nil))
+ )))
+
+(defvar-local org-drill-cloze-regexp
+ (org-drill--compute-cloze-regexp))
+
+
+(defvar-local org-drill-cloze-keywords
+ (org-drill--compute-cloze-keywords))
-(defvar org-drill-cloze-keywords
- `((,org-drill-cloze-regexp
- (1 'org-drill-visible-cloze-face nil)
- (2 'org-drill-visible-cloze-hint-face t)
- (3 'org-drill-visible-cloze-face nil))))
(defcustom org-drill-card-type-alist
'((nil org-drill-present-simple-card)
@@ -234,7 +280,9 @@ even if their bodies are empty."
:type '(alist :key-type (choice string (const nil))
:value-type function))
-(defcustom org-drill-scope 'file
+
+(defcustom org-drill-scope
+ 'file
"The scope in which to search for drill items when conducting a
drill session. This can be any of:
@@ -256,18 +304,34 @@ directory All files with the extension '.org' in the same
;; 'file-no-restriction' means current file/buffer, ignoring restrictions
;; 'directory' means all *.org files in current directory
:group 'org-drill
- :type '(choice (const 'file) (const 'tree) (const 'file-no-restriction)
- (const 'file-with-archives) (const 'agenda)
- (const 'agenda-with-archives) (const 'directory)
- list))
+ :type '(choice (const :tag "The current buffer, respecting the restriction if any." file)
+ (const :tag "The subtree started with the entry at point" tree)
+ (const :tag "The current buffer, without restriction" file-no-restriction)
+ (const :tag "The current buffer, and any archives associated with it." file-with-archives)
+ (const :tag "All agenda files" agenda)
+ (const :tag "All agenda files with any archive files associated with them." agenda-with-archives)
+ (const :tag "All files with the extension '.org' in the same directory as the current file (includes the current file if it is an .org file.)" directory)
+ (repeat :tag "List of files to scan for drill items." file)))
+
+
+(defcustom org-drill-match
+ nil
+ "If non-nil, a string specifying a tags/property/TODO query. During
+drill sessions, only items that match this query will be considered."
+ :group 'org-drill
+ :type '(choice (const nil) string))
+
-(defcustom org-drill-save-buffers-after-drill-sessions-p t
+(defcustom org-drill-save-buffers-after-drill-sessions-p
+ t
"If non-nil, prompt to save all modified buffers after a drill session
finishes."
:group 'org-drill
:type 'boolean)
-(defcustom org-drill-spaced-repetition-algorithm 'sm5
+
+(defcustom org-drill-spaced-repetition-algorithm
+ 'sm5
"Which SuperMemo spaced repetition algorithm to use for scheduling items.
Available choices are:
- SM2 :: the SM2 algorithm, used in SuperMemo 2.0
@@ -280,9 +344,11 @@ Available choices are:
adjusting intervals when items are reviewed early or late has been taken
from SM11, a later version of the algorithm, and included in Simple8."
:group 'org-drill
- :type '(choice (const 'sm2) (const 'sm5) (const 'simple8)))
+ :type '(choice (const sm2) (const sm5) (const simple8)))
+
-(defcustom org-drill-optimal-factor-matrix nil
+(defcustom org-drill-optimal-factor-matrix
+ nil
"DO NOT CHANGE THE VALUE OF THIS VARIABLE.
Persistent matrix of optimal factors, used by the SuperMemo SM5 algorithm.
@@ -294,14 +360,18 @@ pace of learning."
:group 'org-drill
:type 'sexp)
-(defcustom org-drill-sm5-initial-interval 4.0
+
+(defcustom org-drill-sm5-initial-interval
+ 4.0
"In the SM5 algorithm, the initial interval after the first
successful presentation of an item is always 4 days. If you wish to change
this, you can do so here."
:group 'org-drill
:type 'float)
-(defcustom org-drill-add-random-noise-to-intervals-p nil
+
+(defcustom org-drill-add-random-noise-to-intervals-p
+ nil
"If true, the number of days until an item's next repetition
will vary slightly from the interval calculated by the SM2
algorithm. The variation is very small when the interval is
@@ -309,7 +379,9 @@ small, but scales up with the interval."
:group 'org-drill
:type 'boolean)
-(defcustom org-drill-adjust-intervals-for-early-and-late-repetitions-p nil
+
+(defcustom org-drill-adjust-intervals-for-early-and-late-repetitions-p
+ nil
"If true, when the student successfully reviews an item 1 or more days
before or after the scheduled review date, this will affect that date of
the item's next scheduled review, according to the algorithm presented at
@@ -324,7 +396,9 @@ is used."
:group 'org-drill
:type 'boolean)
-(defcustom org-drill-cloze-text-weight 4
+
+(defcustom org-drill-cloze-text-weight
+ 4
"For card types 'hide1_firstmore', 'show1_lastmore' and 'show1_firstless',
this number determines how often the 'less favoured' situation
should arise. It will occur 1 in every N trials, where N is the
@@ -343,12 +417,15 @@ all weighted card types are treated as their unweighted equivalents."
:group 'org-drill
:type '(choice integer (const nil)))
-(defcustom org-drill-cram-hours 12
+
+(defcustom org-drill-cram-hours
+ 12
"When in cram mode, items are considered due for review if
they were reviewed at least this many hours ago."
:group 'org-drill
:type 'integer)
+
;;; NEW items have never been presented in a drill session before.
;;; MATURE items HAVE been presented at least once before.
;;; - YOUNG mature items were scheduled no more than
@@ -361,13 +438,17 @@ they were reviewed at least this many hours ago."
;;; LAST-INTERVAL * (ORG-DRILL-OVERDUE-INTERVAL-FACTOR - 1) days,
;;; regardless of young/old status.
-(defcustom org-drill-days-before-old 10
+
+(defcustom org-drill-days-before-old
+ 10
"When an item's inter-repetition interval rises above this value in days,
it is no longer considered a 'young' (recently learned) item."
:group 'org-drill
:type 'integer)
-(defcustom org-drill-overdue-interval-factor 1.2
+
+(defcustom org-drill-overdue-interval-factor
+ 1.2
"An item is considered overdue if its scheduled review date is
more than (ORG-DRILL-OVERDUE-INTERVAL-FACTOR - 1) * LAST-INTERVAL
days in the past. For example, a value of 1.2 means an additional
@@ -379,7 +460,9 @@ should never be less than 1.0."
:group 'org-drill
:type 'float)
-(defcustom org-drill-learn-fraction 0.5
+
+(defcustom org-drill-learn-fraction
+ 0.5
"Fraction between 0 and 1 that governs how quickly the spaces
between successive repetitions increase, for all items. The
default value is 0.5. Higher values make spaces increase more
@@ -389,6 +472,7 @@ exponential effect on inter-repetition spacing."
:group 'org-drill
:type 'float)
+
(defvar drill-answer nil
"Global variable that can be bound to a correct answer when an
item is being presented. If this variable is non-nil, the default
@@ -399,6 +483,7 @@ This variable is useful for card types that compute their answers
-- for example, a card type that asks the student to translate a
random number to another language. ")
+
(defvar *org-drill-session-qualities* nil)
(defvar *org-drill-start-time* 0)
(defvar *org-drill-new-entries* nil)
@@ -428,8 +513,10 @@ for review unless they were already reviewed in the recent past?")
"DRILL_TOTAL_REPEATS" "DRILL_FAILURE_COUNT" "DRILL_AVERAGE_QUALITY"
"DRILL_EASE" "DRILL_LAST_QUALITY" "DRILL_LAST_REVIEWED"))
+
;;; Make the above settings safe as file-local variables.
+
(put 'org-drill-question-tag 'safe-local-variable 'stringp)
(put 'org-drill-maximum-items-per-session 'safe-local-variable
'(lambda (val) (or (integerp val) (null val))))
@@ -454,15 +541,22 @@ for review unless they were already reviewed in the recent past?")
(put 'org-drill-overdue-interval-factor 'safe-local-variable 'floatp)
(put 'org-drill-scope 'safe-local-variable
'(lambda (val) (or (symbolp val) (listp val))))
+(put 'org-drill-match 'safe-local-variable
+ '(lambda (val) (or (stringp val) (null val))))
(put 'org-drill-save-buffers-after-drill-sessions-p 'safe-local-variable 'booleanp)
(put 'org-drill-cloze-text-weight 'safe-local-variable
'(lambda (val) (or (null val) (integerp val))))
+(put 'org-drill-left-cloze-delimiter 'safe-local-variable 'stringp)
+(put 'org-drill-right-cloze-delimiter 'safe-local-variable 'stringp)
+
;;;; Utilities ================================================================
+
(defun free-marker (m)
(set-marker m nil))
+
(defmacro pop-random (place)
(let ((idx (gensym)))
`(if (null ,place)
@@ -472,18 +566,20 @@ for review unless they were already reviewed in the recent past?")
(setq ,place (append (subseq ,place 0 ,idx)
(subseq ,place (1+ ,idx)))))))))
+
(defmacro push-end (val place)
"Add VAL to the end of the sequence stored in PLACE. Return the new
value."
`(setq ,place (append ,place (list ,val))))
+
(defun shuffle-list (list)
"Randomly permute the elements of LIST (all permutations equally likely)."
;; Adapted from 'shuffle-vector' in cookie1.el
(let ((i 0)
- j
- temp
- (len (length list)))
+ j
+ temp
+ (len (length list)))
(while (< i len)
(setq j (+ i (random* (- len i))))
(setq temp (nth i list))
@@ -492,28 +588,43 @@ value."
(setq i (1+ i))))
list)
+
(defun round-float (floatnum fix)
"Round the floating point number FLOATNUM to FIX decimal places.
Example: (round-float 3.56755765 3) -> 3.568"
(let ((n (expt 10 fix)))
(/ (float (round (* floatnum n))) n)))
+
(defun command-keybinding-to-string (cmd)
"Return a human-readable description of the key/keys to which the command
CMD is bound, or nil if it is not bound to a key."
(let ((key (where-is-internal cmd overriding-local-map t)))
(if key (key-description key))))
+
(defun time-to-inactive-org-timestamp (time)
(format-time-string
(concat "[" (substring (cdr org-time-stamp-formats) 1 -1) "]")
time))
-(defun org-map-drill-entries (func &optional scope &rest skip)
+
+(defun time-to-active-org-timestamp (time)
+ (format-time-string
+ (concat "<" (substring (cdr org-time-stamp-formats) 1 -1) ">")
+ time))
+
+
+(defun org-map-drill-entries (func &optional scope drill-match &rest skip)
"Like `org-map-entries', but only drill entries are processed."
- (let ((org-drill-scope (or scope org-drill-scope)))
+ (let ((org-drill-scope (or scope org-drill-scope))
+ (org-drill-match (or drill-match org-drill-match)))
(apply 'org-map-entries func
- (concat "+" org-drill-question-tag)
+ (concat "+" org-drill-question-tag
+ (if (and (stringp org-drill-match)
+ (not (member '(?+ ?- ?|) (elt org-drill-match 0))))
+ "+" "")
+ (or org-drill-match ""))
(case org-drill-scope
(file nil)
(file-no-restriction 'file)
@@ -523,6 +634,7 @@ CMD is bound, or nil if it is not bound to a key."
(t org-drill-scope))
skip)))
+
(defmacro with-hidden-cloze-text (&rest body)
`(progn
(org-drill-hide-clozed-text)
@@ -531,6 +643,7 @@ CMD is bound, or nil if it is not bound to a key."
,@body)
(org-drill-unhide-clozed-text))))
+
(defmacro with-hidden-cloze-hints (&rest body)
`(progn
(org-drill-hide-cloze-hints)
@@ -539,6 +652,7 @@ CMD is bound, or nil if it is not bound to a key."
,@body)
(org-drill-unhide-text))))
+
(defmacro with-hidden-comments (&rest body)
`(progn
(if org-drill-hide-item-headings-p
@@ -549,6 +663,7 @@ CMD is bound, or nil if it is not bound to a key."
,@body)
(org-drill-unhide-text))))
+
(defun org-drill-days-since-last-review ()
"Nil means a last review date has not yet been stored for
the item.
@@ -562,6 +677,7 @@ this should never happen."
(time-to-days (apply 'encode-time
(org-parse-time-string datestr)))))))
+
(defun org-drill-hours-since-last-review ()
"Like `org-drill-days-since-last-review', but return value is
in hours rather than days."
@@ -573,6 +689,7 @@ in hours rather than days."
(org-parse-time-string datestr))))
(* 60 60))))))
+
(defun org-drill-entry-p (&optional marker)
"Is MARKER, or the point, in a 'drill item'? This will return nil if
the point is inside a subheading of a drill item -- to handle that
@@ -582,10 +699,12 @@ situation use `org-part-of-drill-entry-p'."
(org-drill-goto-entry marker))
(member org-drill-question-tag (org-get-local-tags))))
+
(defun org-drill-goto-entry (marker)
(switch-to-buffer (marker-buffer marker))
(goto-char marker))
+
(defun org-part-of-drill-entry-p ()
"Is the current entry either the main heading of a 'drill item',
or a subheading within a drill item?"
@@ -593,6 +712,7 @@ or a subheading within a drill item?"
;; Does this heading INHERIT the drill tag
(member org-drill-question-tag (org-get-tags-at))))
+
(defun org-drill-goto-drill-entry-heading ()
"Move the point to the heading which holds the :drill: tag for this
drill entry."
@@ -604,11 +724,14 @@ drill entry."
(unless (org-up-heading-safe)
(error "Cannot find a parent heading that is marked as a drill entry"))))
+
+
(defun org-drill-entry-leech-p ()
"Is the current entry a 'leech item'?"
(and (org-drill-entry-p)
(member "leech" (org-get-local-tags))))
+
;; (defun org-drill-entry-due-p ()
;; (cond
;; (*org-drill-cram-mode*
@@ -626,6 +749,7 @@ drill entry."
;; (- (time-to-days (current-time))
;; (time-to-days item-time))))))))))
+
(defun org-drill-entry-days-overdue ()
"Returns:
- NIL if the item is not to be regarded as scheduled for review at all.
@@ -655,6 +779,7 @@ drill entry."
(- (time-to-days (current-time))
(time-to-days item-time))))))))
+
(defun org-drill-entry-overdue-p (&optional days-overdue last-interval)
"Returns true if entry that is scheduled DAYS-OVERDUE dasy in the past,
and whose last inter-repetition interval was LAST-INTERVAL, should be
@@ -670,28 +795,34 @@ from the entry at point."
(> (/ (+ days-overdue last-interval 1.0) last-interval)
org-drill-overdue-interval-factor)))
+
+
(defun org-drill-entry-due-p ()
(let ((due (org-drill-entry-days-overdue)))
(and (not (null due))
(not (minusp due)))))
+
(defun org-drill-entry-new-p ()
(and (org-drill-entry-p)
(let ((item-time (org-get-scheduled-time (point))))
(null item-time))))
+
(defun org-drill-entry-last-quality (&optional default)
(let ((quality (org-entry-get (point) "DRILL_LAST_QUALITY")))
(if quality
(string-to-number quality)
default)))
+
(defun org-drill-entry-failure-count ()
(let ((quality (org-entry-get (point) "DRILL_FAILURE_COUNT")))
(if quality
(string-to-number quality)
0)))
+
(defun org-drill-entry-average-quality (&optional default)
(let ((val (org-entry-get (point) "DRILL_AVERAGE_QUALITY")))
(if val
@@ -722,16 +853,17 @@ from the entry at point."
(string-to-number val)
default)))
+
;;; From http://www.supermemo.com/english/ol/sm5.htm
(defun org-drill-random-dispersal-factor ()
"Returns a random number between 0.5 and 1.5."
(let ((a 0.047)
(b 0.092)
(p (- (random* 1.0) 0.5)))
- (flet ((sign (n)
- (cond ((zerop n) 0)
- ((plusp n) 1)
- (t -1))))
+ (cl-flet ((sign (n)
+ (cond ((zerop n) 0)
+ ((plusp n) 1)
+ (t -1))))
(/ (+ 100 (* (* (/ -1 b) (log (- 1 (* (/ b a ) (abs p)))))
(sign p)))
100.0))))
@@ -744,9 +876,10 @@ from the entry at point."
(- variation)
mean))
+
(defun org-drill-early-interval-factor (optimal-factor
- optimal-interval
- days-ahead)
+ optimal-interval
+ days-ahead)
"Arguments:
- OPTIMAL-FACTOR: interval-factor if the item had been tested
exactly when it was supposed to be.
@@ -763,6 +896,7 @@ in the matrix."
(- optimal-factor
(* delta-ofmax (/ days-ahead (+ days-ahead (* 0.6 optimal-interval)))))))
+
(defun org-drill-get-item-data ()
"Returns a list of 6 items, containing all the stored recall
data for the item at point:
@@ -800,6 +934,7 @@ in the matrix."
(t ; virgin item
(list 0 0 0 0 nil nil)))))
+
(defun org-drill-store-item-data (last-interval repeats failures
total-repeats meanq
ease)
@@ -815,8 +950,11 @@ in the matrix."
(org-set-property "DRILL_EASE"
(number-to-string (round-float ease 3))))
+
+
;;; SM2 Algorithm =============================================================
+
(defun determine-next-interval-sm2 (last-interval n ef quality
failures meanq total-repeats)
"Arguments:
@@ -865,6 +1003,8 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher
;;; SM5 Algorithm =============================================================
+
+
(defun initial-optimal-factor-sm5 (n ef)
(if (= 1 n)
org-drill-sm5-initial-interval
@@ -873,17 +1013,19 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher
(defun get-optimal-factor-sm5 (n ef of-matrix)
(let ((factors (assoc n of-matrix)))
(or (and factors
- (let ((ef-of (assoc ef (cdr factors))))
- (and ef-of (cdr ef-of))))
- (initial-optimal-factor-sm5 n ef))))
+ (let ((ef-of (assoc ef (cdr factors))))
+ (and ef-of (cdr ef-of))))
+ (initial-optimal-factor-sm5 n ef))))
+
(defun inter-repetition-interval-sm5 (last-interval n ef &optional of-matrix)
(let ((of (get-optimal-factor-sm5 n ef (or of-matrix
org-drill-optimal-factor-matrix))))
(if (= 1 n)
- of
+ of
(* of last-interval))))
+
(defun determine-next-interval-sm5 (last-interval n ef quality
failures meanq total-repeats
of-matrix &optional delta-days)
@@ -894,10 +1036,12 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher
(unless of-matrix
(setq of-matrix org-drill-optimal-factor-matrix))
(setq of-matrix (cl-copy-tree of-matrix))
+
(setq meanq (if meanq
(/ (+ quality (* meanq total-repeats 1.0))
(1+ total-repeats))
quality))
+
(let ((next-ef (modify-e-factor ef quality))
(old-ef ef)
(new-of (modify-of (get-optimal-factor-sm5 n ef of-matrix)
@@ -910,10 +1054,13 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher
(inter-repetition-interval-sm5
last-interval n ef of-matrix)
delta-days)))
+
(setq of-matrix
(set-optimal-factor n next-ef of-matrix
(round-float new-of 3))) ; round OF to 3 d.p.
+
(setq ef next-ef)
+
(cond
;; "Failed" -- reset repetitions to 0,
((<= quality org-drill-failure-quality)
@@ -938,8 +1085,10 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher
(1+ total-repeats)
of-matrix)))))
+
;;; Simple8 Algorithm =========================================================
+
(defun org-drill-simple8-first-interval (failures)
"Arguments:
- FAILURES: integer >= 0. The total number of times the item has
@@ -949,6 +1098,7 @@ Returns the optimal FIRST interval for an item which has previously been
forgotten on FAILURES occasions."
(* 2.4849 (exp (* -0.057 failures))))
+
(defun org-drill-simple8-interval-factor (ease repetition)
"Arguments:
- EASE: floating point number >= 1.2. Corresponds to `AF' in SM8 algorithm.
@@ -959,6 +1109,7 @@ The factor by which the last interval should be
multiplied to give the next interval. Corresponds to `RF' or `OF'."
(+ 1.2 (* (- ease 1.2) (expt org-drill-learn-fraction (log repetition 2)))))
+
(defun org-drill-simple8-quality->ease (quality)
"Returns the ease (`AF' in the SM8 algorithm) which corresponds
to a mean item quality of QUALITY."
@@ -968,6 +1119,7 @@ to a mean item quality of QUALITY."
(* -1.2403 quality)
1.4515))
+
(defun determine-next-interval-simple8 (last-interval repeats quality
failures meanq totaln
&optional delta-days)
@@ -1034,7 +1186,11 @@ See the documentation for `org-drill-get-item-data' for a description of these."
(org-drill-simple8-quality->ease meanq)
failures
meanq
- totaln)))
+ totaln
+ )))
+
+
+
;;; Essentially copied from `org-learn.el', but modified to
;;; optionally call the SM2 or simple8 functions.
@@ -1087,7 +1243,7 @@ item will be scheduled exactly this many days into the future."
(cond
((= 0 days-ahead)
- (org-schedule t))
+ (org-schedule '(4)))
((minusp days-ahead)
(org-schedule nil (current-time)))
(t
@@ -1207,13 +1363,14 @@ How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)"
(sit-for 0.5)))))
(org-set-property "DRILL_LAST_QUALITY" (format "%d" quality))
(org-set-property "DRILL_LAST_REVIEWED"
- (time-to-inactive-org-timestamp (current-time))))
+ (time-to-active-org-timestamp (current-time))))
quality))
((= ch ?e)
'edit)
(t
nil))))
+
;; (defun org-drill-hide-all-subheadings-except (heading-list)
;; "Returns a list containing the position of each immediate subheading of
;; the current topic."
@@ -1234,6 +1391,8 @@ How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)"
;; "" 'tree))
;; (reverse drill-sections)))
+
+
(defun org-drill-hide-subheadings-if (test)
"TEST is a function taking no arguments. TEST will be called for each
of the immediate subheadings of the current drill item, with the point
@@ -1256,11 +1415,13 @@ the current topic."
"" 'tree))
(reverse drill-sections)))
+
(defun org-drill-hide-all-subheadings-except (heading-list)
(org-drill-hide-subheadings-if
(lambda () (let ((drill-heading (org-get-heading t)))
(not (member drill-heading heading-list))))))
+
(defun org-drill-presentation-prompt (&rest fmt-and-args)
(let* ((item-start-time (current-time))
(input nil)
@@ -1341,22 +1502,26 @@ Consider reformulating the item to make it easier to remember.\n"
(?s 'skip)
(otherwise t))))
+
(defun org-pos-in-regexp (pos regexp &optional nlines)
(save-excursion
(goto-char pos)
(org-in-regexp regexp nlines)))
+
(defun org-drill-hide-region (beg end &optional text)
"Hide the buffer region between BEG and END with an 'invisible text'
visual overlay, or with the string TEXT if it is supplied."
(let ((ovl (make-overlay beg end)))
(overlay-put ovl 'category
'org-drill-hidden-text-overlay)
+ (overlay-put ovl 'priority 9999)
(when (stringp text)
(overlay-put ovl 'invisible nil)
(overlay-put ovl 'face 'default)
(overlay-put ovl 'display text))))
+
(defun org-drill-hide-heading-at-point (&optional text)
(unless (org-at-heading-p)
(error "Point is not on a heading."))
@@ -1365,11 +1530,13 @@ visual overlay, or with the string TEXT if it is supplied."
(end-of-line)
(org-drill-hide-region beg (point) text))))
+
(defun org-drill-hide-comments ()
(save-excursion
(while (re-search-forward "^#.*$" nil t)
(org-drill-hide-region (match-beginning 0) (match-end 0)))))
+
(defun org-drill-unhide-text ()
;; This will also unhide the item's heading.
(save-excursion
@@ -1377,16 +1544,20 @@ visual overlay, or with the string TEXT if it is supplied."
(when (eql 'org-drill-hidden-text-overlay (overlay-get ovl 'category))
(delete-overlay ovl)))))
+
(defun org-drill-hide-clozed-text ()
(save-excursion
(while (re-search-forward org-drill-cloze-regexp nil t)
;; Don't hide org links, partly because they might contain inline
- ;; images which we want to keep visible
+ ;; images which we want to keep visible.
+ ;; And don't hide LaTeX math fragments.
(unless (save-match-data
- (org-pos-in-regexp (match-beginning 0)
- org-bracket-link-regexp 1))
+ (or (org-pos-in-regexp (match-beginning 0)
+ org-bracket-link-regexp 1)
+ (org-inside-LaTeX-fragment-p)))
(org-drill-hide-matched-cloze-text)))))
+
(defun org-drill-hide-matched-cloze-text ()
"Hide the current match with a 'cloze' visual overlay."
(let ((ovl (make-overlay (match-beginning 0) (match-end 0)))
@@ -1394,6 +1565,7 @@ visual overlay, or with the string TEXT if it is supplied."
(match-string 0))))
(overlay-put ovl 'category
'org-drill-cloze-overlay-defaults)
+ (overlay-put ovl 'priority 9999)
(when (and hint-sep-pos
(> hint-sep-pos 1))
(let ((hint (substring-no-properties
@@ -1407,6 +1579,7 @@ visual overlay, or with the string TEXT if it is supplied."
(format (if (string-match-p (regexp-quote "...") hint) "[%s]" "[%s...]")
hint))))))
+
(defun org-drill-hide-cloze-hints ()
(save-excursion
(while (re-search-forward org-drill-cloze-regexp nil t)
@@ -1416,6 +1589,7 @@ visual overlay, or with the string TEXT if it is supplied."
(null (match-beginning 2))) ; hint subexpression matched
(org-drill-hide-region (match-beginning 2) (match-end 2))))))
+
(defmacro with-replaced-entry-text (text &rest body)
"During the execution of BODY, the entire text of the current entry is
concealed by an overlay that displays the string TEXT."
@@ -1426,6 +1600,7 @@ concealed by an overlay that displays the string TEXT."
,@body)
(org-drill-unreplace-entry-text))))
+
(defmacro with-replaced-entry-text-multi (replacements &rest body)
"During the execution of BODY, the entire text of the current entry is
concealed by an overlay that displays the overlays in REPLACEMENTS."
@@ -1436,6 +1611,7 @@ concealed by an overlay that displays the overlays in REPLACEMENTS."
,@body)
(org-drill-unreplace-entry-text))))
+
(defun org-drill-replace-entry-text (text &optional multi-p)
"Make an overlay that conceals the entire text of the item, not
including properties or the contents of subheadings. The overlay shows
@@ -1454,16 +1630,19 @@ Note: does not actually alter the item."
(save-excursion
(outline-next-heading)
(point)))))
+ (overlay-put ovl 'priority 9999)
(overlay-put ovl 'category
'org-drill-replaced-text-overlay)
(overlay-put ovl 'display text)))))
+
(defun org-drill-unreplace-entry-text ()
(save-excursion
(dolist (ovl (overlays-in (point-min) (point-max)))
(when (eql 'org-drill-replaced-text-overlay (overlay-get ovl 'category))
(delete-overlay ovl)))))
+
(defun org-drill-replace-entry-text-multi (replacements)
"Make overlays that conceal the entire text of the item, not
including properties or the contents of subheadings. The overlay shows
@@ -1480,10 +1659,12 @@ Note: does not actually alter the item."
(if (= i (1- (length replacements)))
p-max
(+ p-min (* 2 i) 1))))
+ (overlay-put ovl 'priority 9999)
(overlay-put ovl 'category
'org-drill-replaced-text-overlay)
(overlay-put ovl 'display (nth i replacements)))))
+
(defmacro with-replaced-entry-heading (heading &rest body)
`(progn
(org-drill-replace-entry-heading ,heading)
@@ -1492,18 +1673,21 @@ Note: does not actually alter the item."
,@body)
(org-drill-unhide-text))))
+
(defun org-drill-replace-entry-heading (heading)
"Make an overlay that conceals the heading of the item. The overlay shows
the string TEXT.
Note: does not actually alter the item."
(org-drill-hide-heading-at-point heading))
+
(defun org-drill-unhide-clozed-text ()
(save-excursion
(dolist (ovl (overlays-in (point-min) (point-max)))
(when (eql 'org-drill-cloze-overlay-defaults (overlay-get ovl 'category))
(delete-overlay ovl)))))
+
(defun org-drill-get-entry-text (&optional keep-properties-p)
(let ((text (org-agenda-get-some-entry-text (point-marker) 100)))
(if keep-properties-p
@@ -1526,6 +1710,7 @@ Note: does not actually alter the item."
(defun org-drill-entry-empty-p () (org-entry-empty-p))
+
;;; Presentation functions ====================================================
;;
;; Each of these is called with point on topic heading. Each needs to show the
@@ -1540,12 +1725,14 @@ Note: does not actually alter the item."
(with-hidden-cloze-hints
(with-hidden-cloze-text
(org-drill-hide-all-subheadings-except nil)
+ (org-preview-latex-fragment) ; overlay all LaTeX fragments with images
(ignore-errors
(org-display-inline-images t))
(org-cycle-hide-drawers 'all)
(prog1 (org-drill-presentation-prompt)
(org-drill-hide-subheadings-if 'org-drill-entry-p))))))
+
(defun org-drill-present-default-answer (reschedule-fn)
(cond
(drill-answer
@@ -1557,12 +1744,14 @@ Note: does not actually alter the item."
(t
(org-drill-hide-subheadings-if 'org-drill-entry-p)
(org-drill-unhide-clozed-text)
+ (org-preview-latex-fragment)
(ignore-errors
(org-display-inline-images t))
(org-cycle-hide-drawers 'all)
(with-hidden-cloze-hints
(funcall reschedule-fn)))))
+
(defun org-drill-present-two-sided-card ()
(with-hidden-comments
(with-hidden-cloze-hints
@@ -1573,12 +1762,15 @@ Note: does not actually alter the item."
(goto-char (nth (random* (min 2 (length drill-sections)))
drill-sections))
(org-show-subtree)))
+ (org-preview-latex-fragment)
(ignore-errors
(org-display-inline-images t))
(org-cycle-hide-drawers 'all)
(prog1 (org-drill-presentation-prompt)
(org-drill-hide-subheadings-if 'org-drill-entry-p)))))))
+
+
(defun org-drill-present-multi-sided-card ()
(with-hidden-comments
(with-hidden-cloze-hints
@@ -1588,12 +1780,14 @@ Note: does not actually alter the item."
(save-excursion
(goto-char (nth (random* (length drill-sections)) drill-sections))
(org-show-subtree)))
+ (org-preview-latex-fragment)
(ignore-errors
(org-display-inline-images t))
(org-cycle-hide-drawers 'all)
(prog1 (org-drill-presentation-prompt)
(org-drill-hide-subheadings-if 'org-drill-entry-p)))))))
+
(defun org-drill-present-multicloze-hide-n (number-to-hide
&optional
force-show-first
@@ -1628,7 +1822,8 @@ items if FORCE-SHOW-FIRST or FORCE-SHOW-LAST is non-nil)."
(let ((in-regexp? (save-match-data
(org-pos-in-regexp (match-beginning 0)
org-bracket-link-regexp 1))))
- (unless in-regexp?
+ (unless (or in-regexp?
+ (org-inside-LaTeX-fragment-p))
(incf match-count)))))
(if (minusp number-to-hide)
(setq number-to-hide (+ match-count number-to-hide)))
@@ -1655,8 +1850,9 @@ items if FORCE-SHOW-FIRST or FORCE-SHOW-LAST is non-nil)."
(setq cnt 0)
(while (re-search-forward org-drill-cloze-regexp item-end t)
(unless (save-match-data
- (org-pos-in-regexp (match-beginning 0)
- org-bracket-link-regexp 1))
+ (or (org-pos-in-regexp (match-beginning 0)
+ org-bracket-link-regexp 1)
+ (org-inside-LaTeX-fragment-p)))
(incf cnt)
(if (memq cnt match-nums)
(org-drill-hide-matched-cloze-text)))))))
@@ -1666,6 +1862,7 @@ items if FORCE-SHOW-FIRST or FORCE-SHOW-LAST is non-nil)."
;; while (org-pos-in-regexp (match-beginning 0)
;; org-bracket-link-regexp 1))
;; (org-drill-hide-matched-cloze-text)))))
+ (org-preview-latex-fragment)
(ignore-errors
(org-display-inline-images t))
(org-cycle-hide-drawers 'all)
@@ -1673,6 +1870,7 @@ items if FORCE-SHOW-FIRST or FORCE-SHOW-LAST is non-nil)."
(org-drill-hide-subheadings-if 'org-drill-entry-p)
(org-drill-unhide-clozed-text))))))
+
(defun org-drill-present-multicloze-hide-nth (to-hide)
"Hide the TO-HIDE'th piece of clozed text. 1 is the first piece. If
TO-HIDE is negative, count backwards, so -1 means the last item, -2
@@ -1694,7 +1892,8 @@ the second to last, etc."
(let ((in-regexp? (save-match-data
(org-pos-in-regexp (match-beginning 0)
org-bracket-link-regexp 1))))
- (unless in-regexp?
+ (unless (or in-regexp?
+ (org-inside-LaTeX-fragment-p))
(incf match-count)))))
(if (minusp to-hide)
(setq to-hide (+ 1 to-hide match-count)))
@@ -1708,11 +1907,16 @@ the second to last, etc."
(setq cnt 0)
(while (re-search-forward org-drill-cloze-regexp item-end t)
(unless (save-match-data
- (org-pos-in-regexp (match-beginning 0)
- org-bracket-link-regexp 1))
+ ;; Don't consider this a cloze region if it is part of an
+ ;; org link, or if it occurs inside a LaTeX math
+ ;; fragment
+ (or (org-pos-in-regexp (match-beginning 0)
+ org-bracket-link-regexp 1)
+ (org-inside-LaTeX-fragment-p)))
(incf cnt)
(if (= cnt to-hide)
(org-drill-hide-matched-cloze-text)))))))
+ (org-preview-latex-fragment)
(ignore-errors
(org-display-inline-images t))
(org-cycle-hide-drawers 'all)
@@ -1720,24 +1924,29 @@ the second to last, etc."
(org-drill-hide-subheadings-if 'org-drill-entry-p)
(org-drill-unhide-clozed-text))))))
+
(defun org-drill-present-multicloze-hide1 ()
"Hides one of the pieces of text that are marked for cloze deletion,
chosen at random."
(org-drill-present-multicloze-hide-n 1))
+
(defun org-drill-present-multicloze-hide2 ()
"Hides two of the pieces of text that are marked for cloze deletion,
chosen at random."
(org-drill-present-multicloze-hide-n 2))
+
(defun org-drill-present-multicloze-hide-first ()
"Hides the first piece of text that is marked for cloze deletion."
(org-drill-present-multicloze-hide-nth 1))
+
(defun org-drill-present-multicloze-hide-last ()
"Hides the last piece of text that is marked for cloze deletion."
(org-drill-present-multicloze-hide-nth -1))
+
(defun org-drill-present-multicloze-hide1-firstmore ()
"Commonly, hides the FIRST piece of text that is marked for
cloze deletion. Uncommonly, hide one of the other pieces of text,
@@ -1767,6 +1976,7 @@ the value of `org-drill-cloze-text-weight'."
;; Commonly, hide first item
(org-drill-present-multicloze-hide-first))))
+
(defun org-drill-present-multicloze-show1-lastmore ()
"Commonly, hides all pieces except the last. Uncommonly, shows
any random piece. The effect is similar to 'show1cloze' except
@@ -1791,6 +2001,7 @@ the value of `org-drill-cloze-text-weight'."
;; Commonly, show the LAST item
(org-drill-present-multicloze-hide-n -1 nil t))))
+
(defun org-drill-present-multicloze-show1-firstless ()
"Commonly, hides all pieces except one, where the shown piece
is guaranteed NOT to be the first piece. Uncommonly, shows any
@@ -1816,49 +2027,19 @@ the value of `org-drill-cloze-text-weight'."
;; Commonly, show any item, except the first
(org-drill-present-multicloze-hide-n -1 nil nil t))))
+
(defun org-drill-present-multicloze-show1 ()
"Similar to `org-drill-present-multicloze-hide1', but hides all
the pieces of text that are marked for cloze deletion, except for one
piece which is chosen at random."
(org-drill-present-multicloze-hide-n -1))
+
(defun org-drill-present-multicloze-show2 ()
"Similar to `org-drill-present-multicloze-show1', but reveals two
pieces rather than one."
(org-drill-present-multicloze-hide-n -2))
-;; (defun org-drill-present-multicloze-show1 ()
-;; "Similar to `org-drill-present-multicloze-hide1', but hides all
-;; the pieces of text that are marked for cloze deletion, except for one
-;; piece which is chosen at random."
-;; (with-hidden-comments
-;; (with-hidden-cloze-hints
-;; (let ((item-end nil)
-;; (match-count 0)
-;; (body-start (or (cdr (org-get-property-block))
-;; (point))))
-;; (org-drill-hide-all-subheadings-except nil)
-;; (save-excursion
-;; (outline-next-heading)
-;; (setq item-end (point)))
-;; (save-excursion
-;; (goto-char body-start)
-;; (while (re-search-forward org-drill-cloze-regexp item-end t)
-;; (incf match-count)))
-;; (when (plusp match-count)
-;; (let ((match-to-hide (random* match-count)))
-;; (save-excursion
-;; (goto-char body-start)
-;; (dotimes (n match-count)
-;; (re-search-forward org-drill-cloze-regexp
-;; item-end t)
-;; (unless (= n match-to-hide)
-;; (org-drill-hide-matched-cloze-text))))))
-;; (org-display-inline-images t)
-;; (org-cycle-hide-drawers 'all)
-;; (prog1 (org-drill-presentation-prompt)
-;; (org-drill-hide-subheadings-if 'org-drill-entry-p)
-;; (org-drill-unhide-clozed-text))))))
(defun org-drill-present-card-using-text (question &optional answer)
"Present the string QUESTION as the only visible content of the card.
@@ -1874,6 +2055,7 @@ If ANSWER is supplied, set the global variable `drill-answer' to its value."
(prog1 (org-drill-presentation-prompt)
(org-drill-hide-subheadings-if 'org-drill-entry-p)))))
+
(defun org-drill-present-card-using-multiple-overlays (replacements &optional answer)
"TEXTS is a list of valid values for the 'display' text property.
Present these overlays, in sequence, as the only
@@ -1890,6 +2072,7 @@ If ANSWER is supplied, set the global variable `drill-answer' to its value."
(prog1 (org-drill-presentation-prompt)
(org-drill-hide-subheadings-if 'org-drill-entry-p)))))
+
(defun org-drill-entry ()
"Present the current topic for interactive review, as in `org-drill'.
Review will occur regardless of whether the topic is due for review or whether
@@ -1907,7 +2090,7 @@ See `org-drill' for more details."
;; (error "Point is not inside a drill entry"))
;;(unless (org-at-heading-p)
;; (org-back-to-heading))
- (let ((card-type (org-entry-get (point) "DRILL_CARD_TYPE"))
+ (let ((card-type (org-entry-get (point) "DRILL_CARD_TYPE" t))
(answer-fn 'org-drill-present-default-answer)
(present-empty-cards nil)
(cont nil)
@@ -1949,6 +2132,7 @@ See `org-drill' for more details."
(funcall answer-fn
(lambda () (org-drill-reschedule)))))))))))))
+
(defun org-drill-entries-pending-p ()
(or *org-drill-again-entries*
*org-drill-current-item*
@@ -1961,6 +2145,7 @@ See `org-drill' for more details."
*org-drill-overdue-entries*
*org-drill-again-entries*))))
+
(defun org-drill-pending-entry-count ()
(+ (if (markerp *org-drill-current-item*) 1 0)
(length *org-drill-new-entries*)
@@ -1970,6 +2155,7 @@ See `org-drill' for more details."
(length *org-drill-overdue-entries*)
(length *org-drill-again-entries*)))
+
(defun org-drill-maximum-duration-reached-p ()
"Returns true if the current drill session has continued past its
maximum duration."
@@ -1979,6 +2165,7 @@ maximum duration."
(> (- (float-time (current-time)) *org-drill-start-time*)
(* org-drill-maximum-duration 60))))
+
(defun org-drill-maximum-item-count-reached-p ()
"Returns true if the current drill session has reached the
maximum number of items."
@@ -1987,6 +2174,7 @@ maximum number of items."
(>= (length *org-drill-done-entries*)
org-drill-maximum-items-per-session)))
+
(defun org-drill-pop-next-pending-entry ()
(block org-drill-pop-next-pending-entry
(let ((m nil))
@@ -2034,6 +2222,7 @@ maximum number of items."
(return-from org-drill-pop-next-pending-entry nil)))))
m)))
+
(defun org-drill-entries (&optional resuming-p)
"Returns nil, t, or a list of markers representing entries that were
'failed' and need to be presented again before the session ends.
@@ -2086,6 +2275,8 @@ RESUMING-P is true if we are resuming a suspended drill session."
(push m *org-drill-done-entries*)))
(setq *org-drill-current-item* nil))))))))))
+
+
(defun org-drill-final-report ()
(let ((pass-percent
(round (* 100 (count-if (lambda (qual)
@@ -2172,7 +2363,10 @@ order to make items appear more frequently over time."
*org-drill-overdue-entry-count*
(round (* 100 *org-drill-overdue-entry-count*)
(+ *org-drill-dormant-entry-count*
- *org-drill-due-entry-count*)))))))
+ *org-drill-due-entry-count*)))
+ ))))
+
+
(defun org-drill-free-markers (markers)
"MARKERS is a list of markers, all of which will be freed (set to
@@ -2268,7 +2462,7 @@ one of the following values:
sym1)))))
-(defun org-drill (&optional scope resume-p)
+(defun org-drill (&optional scope drill-match resume-p)
"Begin an interactive 'drill session'. The user is asked to
review a series of topics (headers). Each topic is initially
presented as a 'question', often with part of the topic content
@@ -2296,10 +2490,24 @@ SCOPE determines the scope in which to search for
questions. It accepts the same values as `org-drill-scope',
which see.
+DRILL-MATCH, if supplied, is a string specifying a tags/property/
+todo query. Only items matching the query will be considered.
+It accepts the same values as `org-drill-match', which see.
+
If RESUME-P is non-nil, resume a suspended drill session rather
than starting a new one."
(interactive)
+ ;; Check org version. Org 7.9.3f introduced a backwards-incompatible change
+ ;; to the arguments accepted by `org-schedule'. At the time of writing there
+ ;; are still lots of people using versions of org older than this.
+ (let ((majorv (first (mapcar 'string-to-number (split-string (org-release) "[.]")))))
+ (if (and (< majorv 8)
+ (not (string-match-p "universal prefix argument" (documentation 'org-schedule))))
+ (read-char-exclusive
+ (format "Warning: org-drill requires org mode 7.9.3f or newer. Scheduling of failed cards will not
+work correctly with older versions of org mode. Your org mode version (%s) appears to be older than
+7.9.3f. Please consider installing a more recent version of org mode." (org-release)))))
(let ((end-pos nil)
(overdue-data nil)
(cnt 0))
@@ -2368,7 +2576,7 @@ than starting a new one."
(:old
(push (point-marker) *org-drill-old-mature-entries*))
)))))
- scope)
+ scope drill-match)
(org-drill-order-overdue-entries overdue-data)
(setq *org-drill-overdue-entry-count*
(length *org-drill-overdue-entries*))))
@@ -2405,7 +2613,8 @@ than starting a new one."
(org-drill-save-optimal-factor-matrix))
(if org-drill-save-buffers-after-drill-sessions-p
(save-some-buffers))
- (message "Drill session finished!")))))
+ (message "Drill session finished!")
+ ))))
(defun org-drill-save-optimal-factor-matrix ()
@@ -2414,14 +2623,14 @@ than starting a new one."
org-drill-optimal-factor-matrix))
-(defun org-drill-cram (&optional scope)
+(defun org-drill-cram (&optional scope drill-match)
"Run an interactive drill session in 'cram mode'. In cram mode,
all drill items are considered to be due for review, unless they
have been reviewed within the last `org-drill-cram-hours'
hours."
(interactive)
(setq *org-drill-cram-mode* t)
- (org-drill scope))
+ (org-drill scope drill-match))
(defun org-drill-tree ()
@@ -2438,7 +2647,7 @@ files in the same directory as the current file."
(org-drill 'directory))
-(defun org-drill-again (&optional scope)
+(defun org-drill-again (&optional scope drill-match)
"Run a new drill session, but try to use leftover due items that
were not reviewed during the last session, rather than scanning for
unreviewed items. If there are no leftover items in memory, a full
@@ -2453,9 +2662,9 @@ scan will be performed."
(setq *org-drill-start-time* (float-time (current-time))
*org-drill-done-entries* nil
*org-drill-current-item* nil)
- (org-drill scope t))
+ (org-drill scope drill-match t))
(t
- (org-drill scope))))
+ (org-drill scope drill-match))))
@@ -2465,7 +2674,7 @@ exiting them with the `edit' or `quit' options."
(interactive)
(cond
((org-drill-entries-pending-p)
- (org-drill nil t))
+ (org-drill nil nil t))
((and (plusp (org-drill-pending-entry-count))
;; Current drill session is finished, but there are still
;; more items which need to be reviewed.
@@ -2478,10 +2687,18 @@ need reviewing. Start a new drill session? "
(message "You have finished the drill session."))))
+(defun org-drill-relearn-item ()
+ "Make the current item due for revision, and set its last interval to 0.
+Makes the item behave as if it has been failed, without actually recording a
+failure. This command can be used to 'reset' repetitions for an item."
+ (interactive)
+ (org-drill-smart-reschedule 4 0))
+
+
(defun org-drill-strip-entry-data ()
(dolist (prop org-drill-scheduling-properties)
(org-delete-property prop))
- (org-schedule t))
+ (org-schedule '(4)))
(defun org-drill-strip-all-data (&optional scope)
@@ -2499,22 +2716,42 @@ values as `org-drill-scope'."
;; `org-delete-property-globally', which is faster.
(dolist (prop org-drill-scheduling-properties)
(org-delete-property-globally prop))
- (org-map-drill-entries (lambda () (org-schedule t)) scope))
+ (org-map-drill-entries (lambda () (org-schedule '(4))) scope))
(t
(org-map-drill-entries 'org-drill-strip-entry-data scope)))
(message "Done.")))
-
(defun org-drill-add-cloze-fontification ()
+ ;; Compute local versions of the regexp for cloze deletions, in case
+ ;; the left and right delimiters are redefined locally.
+ (setq-local org-drill-cloze-regexp (org-drill--compute-cloze-regexp))
+ (setq-local org-drill-cloze-keywords (org-drill--compute-cloze-keywords))
(when org-drill-use-visible-cloze-face-p
- (font-lock-add-keywords 'org-mode
- org-drill-cloze-keywords
- nil)))
-
-(add-hook 'org-mode-hook 'org-drill-add-cloze-fontification)
-
-(org-drill-add-cloze-fontification)
+ (add-to-list 'org-font-lock-extra-keywords
+ (first org-drill-cloze-keywords))))
+
+(add-hook 'org-font-lock-set-keywords-hook 'org-drill-add-cloze-fontification)
+
+;; Can't add to org-mode-hook, because local variables won't have been loaded
+;; yet.
+
+;; (defun org-drill-add-cloze-fontification ()
+;; (when (eql major-mode 'org-mode)
+;; ;; Compute local versions of the regexp for cloze deletions, in case
+;; ;; the left and right delimiters are redefined locally.
+;; (setq-local org-drill-cloze-regexp (org-drill--compute-cloze-regexp))
+;; (setq-local org-drill-cloze-keywords (org-drill--compute-cloze-keywords))
+;; (when org-drill-use-visible-cloze-face-p
+;; (font-lock-add-keywords nil ;'org-mode
+;; org-drill-cloze-keywords
+;; nil))))
+
+;; XXX
+;; (add-hook 'hack-local-variables-hook
+;; 'org-drill-add-cloze-fontification)
+;;
+;; (org-drill-add-cloze-fontification)
;;; Synching card collections =================================================
@@ -2530,18 +2767,18 @@ the tag 'imported'."
(save-excursion
(let ((src (current-buffer))
(m nil))
- (flet ((paste-tree-here (&optional level)
- (org-paste-subtree level)
- (org-drill-strip-entry-data)
- (org-toggle-tag "imported" 'on)
- (org-map-drill-entries
- (lambda ()
- (let ((id (org-id-get)))
- (org-drill-strip-entry-data)
- (unless (gethash id *org-drill-dest-id-table*)
- (puthash id (point-marker)
- *org-drill-dest-id-table*))))
- 'tree)))
+ (cl-flet ((paste-tree-here (&optional level)
+ (org-paste-subtree level)
+ (org-drill-strip-entry-data)
+ (org-toggle-tag "imported" 'on)
+ (org-map-drill-entries
+ (lambda ()
+ (let ((id (org-id-get)))
+ (org-drill-strip-entry-data)
+ (unless (gethash id *org-drill-dest-id-table*)
+ (puthash id (point-marker)
+ *org-drill-dest-id-table*))))
+ 'tree)))
(unless path
(setq path (org-get-outline-path)))
(org-copy-subtree)
@@ -2565,7 +2802,9 @@ the tag 'imported'."
(outline-next-heading)
(newline)
(forward-line -1)
- (paste-tree-here (1+ (or (org-current-level) 0))))))))
+ (paste-tree-here (1+ (or (org-current-level) 0)))
+ )))))
+
(defun org-drill-merge-buffers (src &optional dest ignore-new-items-p)
@@ -2658,12 +2897,15 @@ copy them across."
(free-marker m))
*org-drill-dest-id-table*))))
+
+
;;; Card types for learning languages =========================================
;;; Get spell-number.el from:
;;; http://www.emacswiki.org/emacs/spell-number.el
(autoload 'spelln-integer-in-words "spell-number")
+
;;; `conjugate' card type =====================================================
;;; See spanish.org for usage
@@ -2726,15 +2968,15 @@ the name of the tense.")
(defun org-drill-present-verb-conjugation ()
"Present a drill entry whose card type is 'conjugate'."
- (flet ((tense-and-mood-to-string
- (tense mood)
- (cond
- ((and tense mood)
- (format "%s tense, %s mood" tense mood))
- (tense
- (format "%s tense" tense))
- (mood
- (format "%s mood" mood)))))
+ (cl-flet ((tense-and-mood-to-string
+ (tense mood)
+ (cond
+ ((and tense mood)
+ (format "%s tense, %s mood" tense mood))
+ (tense
+ (format "%s tense" tense))
+ (mood
+ (format "%s mood" mood)))))
(destructuring-bind (infinitive inf-hint translation tense mood)
(org-drill-get-verb-conjugation-info)
(org-drill-present-card-using-text
@@ -2915,6 +3157,7 @@ returns its return value."
'face highlight-face))
(spelln-integer-in-language drilled-number language))))))))
+
;; (defun org-drill-show-answer-translate-number (reschedule-fn)
;; (let* ((language (read (org-entry-get (point) "DRILL_LANGUAGE" t)))
;; (highlight-face 'font-lock-warning-face)
diff --git a/contrib/lisp/org-ebib.el b/contrib/lisp/org-ebib.el
new file mode 100644
index 0000000..2136a13
--- a/dev/null
+++ b/contrib/lisp/org-ebib.el
@@ -0,0 +1,47 @@
+;;; org-ebib.el - Support for links to Ebib's entries in Org
+;;
+;; Author: Grégoire Jadi <daimrod@gmail.com>
+;;
+;; This file is not yet part of GNU Emacs.
+;;
+;; 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. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+(require 'org)
+
+(org-add-link-type "ebib" 'org-ebib-open)
+
+(add-hook 'org-store-link-functions 'org-ebib-store-link)
+
+(defun org-ebib-open (key)
+ "Open Ebib and jump to KEY."
+ (ebib nil key))
+
+(defun org-ebib-store-link ()
+ "Store a key to an Ebib entry."
+ (when (memq major-mode '(ebib-index-mode ebib-entry-mode))
+ ;; This is an Ebib entry
+ (let* ((key (ebib-cur-entry-key))
+ (link (concat "ebib:" key))
+ (description (ignore-errors (ebib-db-get-field-value 'title key ebib-cur-db))))
+ (org-store-link-props
+ :type "ebib"
+ :link link
+ :description description))))
+
+(provide 'org-ebib)
+
+;;; org-ebib.el ends here
diff --git a/contrib/lisp/org-effectiveness.el b/contrib/lisp/org-effectiveness.el
index a872cb2..9981712 100644
--- a/contrib/lisp/org-effectiveness.el
+++ b/contrib/lisp/org-effectiveness.el
@@ -33,6 +33,22 @@
(require 'org)
+(defcustom org-effectiveness-max-todo 50
+ "This variable is useful to advice to the user about
+many TODO pending"
+ :type 'integer
+ :group 'org-effectiveness)
+
+(defun org-effectiveness-advice()
+ "Advicing about a possible excess of TODOS"
+ (interactive)
+ (goto-char (point-min))
+ (if (< org-effectiveness-max-todo (count-matches "* TODO"))
+ (message "An excess of TODOS!")))
+
+;; Check advice starting an org file
+(add-hook 'org-mode-hook 'org-effectiveness-advice)
+
(defun org-effectiveness-count-keyword(keyword)
"Print a message with the number of keyword outline in the current buffer"
(interactive "sKeyword: ")
@@ -208,21 +224,26 @@
(defun org-effectiveness-plot-ascii (startdate enddate)
(interactive "sGive me the start date: \nsGive me the end date: " startdate enddate)
(setq dates (org-effectiveness-check-dates startdate enddate))
- (setq syear (cadr (assoc 'startyear dates)))
- (setq smonth (cadr (assoc 'startmonth dates)))
- (setq eyear (cadr (assoc 'endyear dates)))
- (setq emonth (cadr (assoc 'endmonth dates)))
-;; (switch-to-buffer "*org-effectiveness*")
- (let ((month smonth)
- (year syear)
+ (let ((syear (cadr (assoc 'startyear dates)))
+ (smonth (cadr (assoc 'startmonth dates)))
+ (year (cadr (assoc 'startyear dates)))
+ (month (cadr (assoc 'startmonth dates)))
+ (emonth (cadr (assoc 'endmonth dates)))
+ (eyear (cadr (assoc 'endyear dates)))
+ (buffer (current-buffer))
(str ""))
- (while (and (>= eyear year) (>= emonth month))
- (org-effectiveness-ascii-bar (string-to-number (org-effectiveness-in-date (concat (number-to-string year) "-" (org-effectiveness-month-to-string month)) 1)) (format "%s-%s" year month))
- (if (= month 12)
+ (while (or (> eyear year) (and (= eyear year) (>= emonth month)))
+ (setq str (org-effectiveness-in-date (concat (number-to-string year) "-" (org-effectiveness-month-to-string month)) 1))
+ (switch-to-buffer "*org-effectiveness*")
+ (org-effectiveness-ascii-bar (string-to-number str) (format "%s-%s" year month))
+ (switch-to-buffer buffer)
+ (if (eq month 12)
(progn
(setq year (+ 1 year))
(setq month 1))
- (setq month (+ 1 month))))))
+ (setq month (+ 1 month)))))
+ (switch-to-buffer "*org-effectiveness*"))
+
(provide 'org-effectiveness)
diff --git a/contrib/lisp/org-elisp-symbol.el b/contrib/lisp/org-elisp-symbol.el
index e0bc284..167731e 100644
--- a/contrib/lisp/org-elisp-symbol.el
+++ b/contrib/lisp/org-elisp-symbol.el
@@ -1,6 +1,6 @@
;;; org-elisp-symbol.el --- Org links to emacs-lisp symbols
;;
-;; Copyright 2007-2013 Free Software Foundation, Inc.
+;; Copyright 2007-2014 Free Software Foundation, Inc.
;;
;; Author: Bastien Guerry
;; Version: 0.2
diff --git a/contrib/lisp/org-eval-light.el b/contrib/lisp/org-eval-light.el
index 34a2e99..872f3a4 100644
--- a/contrib/lisp/org-eval-light.el
+++ b/contrib/lisp/org-eval-light.el
@@ -1,6 +1,6 @@
;;; org-eval-light.el --- Display result of evaluating code in various languages (light)
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>,
;; Eric Schulte <schulte dot eric at gmail dot com>
diff --git a/contrib/lisp/org-eval.el b/contrib/lisp/org-eval.el
index 6cd7f78..cb5620c 100644
--- a/contrib/lisp/org-eval.el
+++ b/contrib/lisp/org-eval.el
@@ -1,5 +1,5 @@
;;; org-eval.el --- Display result of evaluating code in various languages
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
diff --git a/contrib/lisp/org-expiry.el b/contrib/lisp/org-expiry.el
index 363bebe..1506c3b 100644
--- a/contrib/lisp/org-expiry.el
+++ b/contrib/lisp/org-expiry.el
@@ -1,6 +1,6 @@
;;; org-expiry.el --- expiry mechanism for Org entries
;;
-;; Copyright 2007-2013 Free Software Foundation, Inc.
+;; Copyright 2007-2014 Free Software Foundation, Inc.
;;
;; Author: Bastien Guerry
;; Version: 0.2
@@ -218,11 +218,12 @@ Return nil if the entry is not expired. Otherwise return the
amount of time between today and the expiry date.
If there is no creation date, use `org-expiry-created-date'.
-If there is no expiry date, use `org-expiry-expiry-date'."
+If there is no expiry date, use `org-expiry-wait'."
(let* ((ex-prop org-expiry-expiry-property-name)
(cr-prop org-expiry-created-property-name)
(ct (current-time))
- (cr (org-read-date nil t (or (org-entry-get (point) cr-prop t) "+0d")))
+ (cr (org-read-date nil t (or (org-entry-get (point) cr-prop t)
+ org-expiry-created-date)))
(ex-field (or (org-entry-get (point) ex-prop t) org-expiry-wait))
(ex (if (string-match "^[ \t]?[+-]" ex-field)
(time-add cr (time-subtract (org-read-date nil t ex-field) ct))
diff --git a/contrib/lisp/org-git-link.el b/contrib/lisp/org-git-link.el
index b9e6a4e..7d95bbb 100644
--- a/contrib/lisp/org-git-link.el
+++ b/contrib/lisp/org-git-link.el
@@ -1,6 +1,6 @@
;;; org-git-link.el --- Provide org links to specific file version
-;; Copyright (C) 2009-2013 Reimar Finken
+;; Copyright (C) 2009-2014 Reimar Finken
;; Author: Reimar Finken <reimar.finken@gmx.de>
;; Keywords: files, calendar, hypermedia
diff --git a/contrib/lisp/org-index.el b/contrib/lisp/org-index.el
index a670cd6..ce53947 100644
--- a/contrib/lisp/org-index.el
+++ b/contrib/lisp/org-index.el
@@ -1,1943 +1,2217 @@
-;;; org-index.el --- A personal index for org and beyond
-
-;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
-
-;; Author: Marc Ihm <org-index@2484.de>
-;; Keywords: outlines, hypermedia, matching
-;; Requires: org
-;; Version: 2.3.2.1
-
-;; This file is not part of GNU Emacs.
-
-;;; 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. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Purpose:
-;;
-;; Mark and find your favorite org-locations and other points of interest
-;; easily; create and update a lookup table of references and links. When
-;; searching, frequently used entries appear at the the top and entering
-;; some keywords narrows down to matching entries only, so that the
-;; right one can be spotted easily.
-;;
-;; References are essentially small numbers (e.g. "R237" or "-455-"),
-;; which are created by this package; they are well suited to be used
-;; outside org. Links are normal org-mode links.
-;;
-;; Setup:
-;;
-;; - Add these lines to your .emacs:
-;;
-;; (require 'org-index)
-;;
-;; ;; Optionally assign a key. Pick your own.
-;; (global-set-key (kbd "C-+") 'org-index)
-;;
-;; - Invoke `org-index', which will assist you to create your
-;; index table.
-;;
-;; - Do not forget to restart emacs to make these lines effective.
-;;
-;;
-;; Further reading:
-;;
-;; See the documentation of `org-index', which can also be read
-;; by invoking `org-index' and and choosing the help-command.
-;;
-;; For more documentation and working examples, see:
-;;
-;; http://orgmode.org/worg/org-contrib/org-index.html
-;;
-
-;;; Change Log:
-
-;; [2013-10-04 Fr] Version 2.3.2:
-;; - Bugfix: index-table created by assistant is found after
-;; restart of emacs instead of invoking assistent again
-;;
-;; [2013-07-20 Sa] Version 2.3.0:
-;; - Renamed from "org-favtable" to "org-index"
-;; - Added an assistent to set up the index table
-;; - occur is now incremental, searching as you type
-;; - simplified the documentation and help-system
-;; - Saving keystrokes, as "+g237" is now valid input
-;; - Many bugfixes
-;;
-;; [2013-02-28 Th] Version 2.2.0:
-;; - Allowed shortcuts like "h237" for command "head" with argument "237"
-;; - Integrated with org-mark-ring-goto
-;;
-;; [2013-01-25 Fr] Version 2.1.0:
-;; - Added full support for links
-;; - New commands "missing" and "statistics"
-;; - Renamed the package from "org-reftable" to "org-favtable"
-;; - Additional columns are required (e.g. "link"). Error messages will
-;; guide you
-;;
-;; [2012-12-07 Fr] Version 2.0.0:
-;; - The format of the table of favorites has changed ! You need to bring
-;; your existing table into the new format by hand (which however is
-;; easy and explained below)
-;; - Reference table can be sorted after usage count or date of last access
-;; - Ask user explicitly, which command to invoke
-;; - Renamed the package from "org-refer-by-number" to "org-reftable"
-
-;; [2012-09-22 Sa] Version 1.5.0:
-;; - New command "sort" to sort a buffer or region by reference number
-;; - New commands "highlight" and "unhighlight" to mark references
-
-;; [2012-07-13 Fr] Version 1.4.0:
-;; - New command "head" to find a headline with a reference number
-
-;; [2012-04-28 Sa] Version 1.3.0:
-;; - New commands occur and multi-occur
-;; - All commands can now be invoked explicitly
-;; - New documentation
-;; - Many bugfixes
-
-;; [2011-12-10 Sa] Version 1.2.0:
-;; - Fixed a bug, which lead to a loss of newly created reference numbers
-;; - Introduced single and double prefix arguments
-;; - Started this Change Log
-
-;;; Code:
-
-(require 'org-table)
-(require 'cl)
-
-(defvar org-index--preferred-command nil)
-
-(defvar org-index--commands
- '(occur head ref link leave enter goto help + reorder fill sort update highlight unhighlight missing statistics)
- "List of commands known to org-index.")
-
-(defvar org-index--commands-some '(occur head ref link leave enter goto help +))
-
-
-(defvar org-index--columns nil)
-
-(defcustom org-index-id nil
- "Id of the Org-mode node, which contains the index table."
- :group 'org
- :group 'org-index)
-
-
-(defvar org-index--text-to-yank nil)
-(defvar org-index--last-action nil)
-(defvar org-index--ref-regex nil)
-(defvar org-index--ref-format nil)
-(defvar org-index--buffer nil "buffer of index table")
-(defvar org-index--point nil "position at start of headline of index table")
-(defvar org-index--below-hline nil "position of first cell in first line below hline")
-(defvar org-index--point-before nil "point in buffer with index table")
-
-
-(defun org-index (&optional ARG)
- "Mark and find your favorite things and org-locations easily:
-Create and update a lookup table of references and links. Often
-used entries bubble to the top; entering some keywords narrows
-down to matching entries only, so that the right one can be
-spotted easily.
-
-References are essentially small numbers (e.g. \"R237\" or \"-455-\"),
-which are created by this package; they are well suited to be used
-outside of org. Links are normal org-mode links.
-
-This is version 2.3.2 of org-index.
-
-The function `org-index' operates on a dedicated table, the index
-table, which lives within its own Org-mode node. The table and
-its node will be created, when you first invoke org-index.
-
-Each line in the index table contains:
-
- - A reference
-
- - A link
-
- - A number; counting, how often each reference has been
- used. This number is updated automatically and the table can
- be sorted after it, so that most frequently used references
- appear at the top of the table and can be spotted easily.
-
- - The creation date of the line.
-
- - Date and time of last access. This column can alternatively be
- used to sort the table.
-
- - A column for your own comments, which allows lines to be selected by
- keywords.
-
-The index table is found through the id of the containing
-node; this id is stored within `org-index-id'.
-
-
-The function `org-index' is the only interactive function of this
-package and its sole entry point; it offers several commands to
-create, find and look up these favorites (references and links).
-
-Commands known:
-
- occur: Incremental search, that after each keystroke shows
- matching lines from index table. You may enter a list of words
- seperated by comma (\",\"), to select lines that contain all
- of the given words.
-
- If you supply a number (e.g. \"237\"): Apply emacs standard
- multi-occur operation on all org-mode buffers to search for
- this specific reference.
-
- You may also read the note at the end of this help on saving
- the keystroke RET with this frequent default command.
-
- head: If invoked outside the index table, ask for a
- reference number and search for a heading containing it. If
- invoked within index table dont ask; rather use the reference or
- link from the current line.
-
- ref: Create a new reference, copy any previously selected text.
- If already within index table, fill in ref-column.
-
- link: Create a new line in index table with a link to the
- current node. Do not populate the ref column; this can later
- be populated by calling the \"fill\" command from within the
- index table.
-
- leave: Leave the index table. If the last command has
- been \"ref\", the new reference is copied and ready to yank.
- This \"org-mark-ring-goto\" and can be called several times
- in succession. If you invoke org-index with a prefix argument,
- this command \"leave\" is executed without further questions.
-
- enter: Just enter the node with the index table.
-
- goto: Search for a specific reference within the index table.
-
- help: Show this text.
-
- +: Show all commands including the less frequently used ones
- given below. If \"+\" is followd by enough letters of such a
- command (e.g. \"+fi\"), then this command is invoked
- directly.
-
- reorder: Temporarily reorder the index table, e.g. by
- count, reference or last access.
-
- fill: If either ref or link is missing, fill it.
-
- sort: Sort a set of lines (either the active region or the
- whole buffer) by the references found in each line.
-
- update: For the given reference, update the line in the
- index table.
-
- highlight: Highlight references in region or buffer.
-
- unhighlight: Remove highlights.
-
- missing : Search for missing reference numbers (which do not
- appear in the reference table). If requested, add additional
- lines for them, so that the command \"ref\" is able to reuse
- them.
-
- statistics : Show some statistics (e.g. minimum and maximum
- reference) about index table.
-
-
-
-Two ways to save keystrokes:
-
-When prompting for a command, org-index puts the most likely
-one (e.g. \"occur\" or \"ref\") in front of the list, so that
-you may just type RET.
-
-If this command needs additional input (like e.g. \"occur\"), you
-may supply this input right away, although you are still beeing
-prompted for the command. So, to do an occur for the string
-\"foo\", you can just enter \"foo\" RET, without even typing
-\"occur\".
-
-
-Another way to save keystrokes applies if you want to choose a
-command, that requrires a reference number (and would normally
-prompt for it): In that case you may just enter enough characters
-from your command, so that it appears first in the list of
-matches; then immediately enter the number of the reference you
-are searching for. So the input \"h237\" would execute the
-command \"head\" for reference \"237\" right away.
-
-"
-
- (interactive "P")
-
- (org-index-1 (if (equal ARG '(4)) 'leave nil) )
-)
-
-
-(defun org-index-1 (&optional what search search-is-link)
-"Do the actual worg for org-index; its optional arguments are:
-
- search : string to search for
- what : symbol of the command to invoke
- search-is-link : t, if argument search is actually a link
-
-An example would be:
-
- (org-index \"237\" 'head) ;; find heading with ref 237
-"
- (let (within-node ; True, if we are within node of the index table
- active-window-index ; active window with index table (if any)
- below-cursor ; word below cursor
- active-region ; active region (if any)
- link-id ; link of starting node, if required
- guarded-search ; with guard against additional digits
- search-is-ref ; true, if search is a reference
- commands ; currently active set of selectable commands
- what-adjusted ; True, if we had to adjust what
- what-input ; Input on what question (need not necessary be "what")
- trailing-digits ; any digits, that are are appended to what-input
- reorder-once ; Column to use for single time sorting
- parts ; Parts of a typical reference number (which
- ; need not be a plain number); these are:
- head ; Any header before number (e.g. "R")
- maxref ; Maximum number from reference table (e.g. "153")
- tail ; Tail after number (e.g. "}" or "")
- ref-regex ; Regular expression to match a reference
- has-reuse ; True, if table contains a line for reuse
- numcols ; Number of columns in index table
- kill-new-text ; Text that will be appended to kill ring
- message-text ; Text that will be issued as an explanation,
- ; what we have done
- initial-ref-or-link ; Initial position in index table
- )
-
- ;;
- ;; Examine current buffer and location, before turning to index table
- ;;
-
- (unless (boundp 'org-index-id)
- (setq org-index-id nil)
- (org-index--create-new-index
- t
- (format "No index table has been created yet." org-index-id)))
-
- ;; Bail out, if new index has been created
- (catch 'created-new-index
-
- ;; Get the content of the active region or the word under cursor
- (if (and transient-mark-mode
- mark-active)
- (setq active-region (buffer-substring (region-beginning) (region-end))))
- (setq below-cursor (thing-at-point 'symbol))
-
-
- ;; Find out, if we are within favable or not
- (setq within-node (string= (org-id-get) org-index-id))
-
-
- ;;
- ;; Get decoration of references and highest reference from index table
- ;;
-
-
- ;; Save initial ref or link
- (if (and within-node
- (org-at-table-p))
- (setq initial-ref-or-link
- (or (org-index--get-field 'ref)
- (org-index--get-field 'link))))
-
- ;; Find node
- (let ((marker (org-id-find org-index-id 'marker)) initial)
- (if marker
- (progn
- (setq org-index--buffer (marker-buffer marker)
- org-index--point (marker-position marker))
- (move-marker marker nil))
- (org-index--create-new-index
- t
- (format "Cannot find node with id \"%s\"" org-index-id))))
-
- ;; Check and remember, if active window contains buffer with index table
- (if (eq (window-buffer) org-index--buffer)
- (setq active-window-index (selected-window)))
-
- ;; Get configuration of index table; catch errors
- (let ((error-message
- (catch 'content-error
-
- (with-current-buffer org-index--buffer
- (unless org-index--point-before
- (setq org-index--point-before (point)))
-
- (unless (string= (org-id-get) org-index-id)
- (goto-char org-index--point))
-
- ;; parse table while still within buffer
- (setq parts (org-index--parse-and-adjust-table))
-
- ;; go back
- (goto-char org-index--point-before)
-
- nil))))
-
- (when error-message
- (org-pop-to-buffer-same-window org-index--buffer)
- (org-reveal)
- (error error-message)))
-
- ;; Give names to parts of configuration
- (setq head (nth 0 parts))
- (setq maxref (nth 1 parts))
- (setq tail (nth 2 parts))
- (setq numcols (nth 3 parts))
- (setq ref-regex (nth 4 parts))
- (setq has-reuse (nth 5 parts))
- (setq org-index--ref-regex ref-regex)
- (setq org-index--ref-format (concat head "%d" tail))
-
- ;;
- ;; Find out, what we are supposed to do
- ;;
-
- ;; Set preferred action, that will be the default choice
- (setq org-index--preferred-command
- (if within-node
- (if (memq org-index--last-action '(ref link))
- 'leave
- 'goto)
- (if active-region
- 'ref
- (if (and below-cursor (string-match ref-regex below-cursor))
- 'occur
- nil))))
-
- ;; Ask user, what to do
- (unless what
- (setq commands (copy-list org-index--commands-some))
- (while (let (completions starts-with-plus is-only-plus)
-
- (setq what-input
- (org-completing-read
- "Please choose: "
- (mapcar 'symbol-name
- ;; Construct unique list of commands with
- ;; preferred one at front
- (delq nil (delete-dups
- (append
- (list org-index--preferred-command)
- (copy-list commands)))))
- nil nil))
-
- ;; if input ends in digits, save them away and do completions on head of input
- ;; this allows input like "h224" to be accepted
- (when (string-match "^\\([^0-9]+\\)\\([0-9]+\\)\\s *$" what-input)
- ;; remember digits
- (setq trailing-digits (string-to-number (match-string 2 what-input)))
- ;; and use non-digits-part to find match
- (setq what-input (match-string 1 what-input)))
-
- ;; if input starts with "+", any command (not only some) may follow
- ;; this allows input like "+sort" to be accepted
- (when (string= (substring what-input 0 1) "+")
- ;; make all commands available for selection
- (setq commands (copy-list org-index--commands))
- (setq what-input (substring what-input 1))
- (setq starts-with-plus (> (length what-input) 0))
- (setq is-only-plus (not starts-with-plus)))
-
- ;; get list of possible completions for what-input; i.e.
- ;; all commands, that start with what-input
- (setq completions (delq nil (mapcar
- (lambda (x)
- (let ((where (search what-input (symbol-name x))))
- (if (and where
- (= where 0))
- x
- nil))) commands)))
-
- ;; if input starts with "+" and not just "+"
- (when starts-with-plus
- ;; use first completion, if unambigously
- (if (= (length completions) 1)
- (setq what-input (symbol-name (car completions)))
- (if completions
- (error "Input \"+%s\" matches multiple commands: %s"
- what-input
- (mapconcat 'symbol-name completions ", "))
- (error "Input \"+%s\" matches no commands" what-input))))
-
- ;; if input ends in digits, use first completion, even if ambigous
- ;; this allows input like "h224" to be accepted
- (when (and trailing-digits completions)
- ;; use first match as input, even if ambigously
- (setq org-index--preferred-command (first completions))
- (setq what-input (number-to-string trailing-digits)))
-
- ;; convert to symbol
- (setq what (intern what-input))
- (if is-only-plus (setq what '+))
-
- ;; user is not required to input one of the commands; if
- ;; not, take the first one and use the original input for
- ;; next question
- (if (memq what commands)
- ;; input matched one element of list, dont need original
- ;; input any more
- (setq what-input nil)
- ;; what-input will be used for next question, use first
- ;; command for what
- (setq what (or org-index--preferred-command
- (first commands)))
- ;; remove any trailing dot, that user might have added to
- ;; disambiguate his input
- (if (and (> (length what-input) 0)
- (equal (substring what-input -1) "."))
- ;; but do this only, if dot was really necessary to
- ;; disambiguate
- (let ((shortened-what-input (substring what-input 0 -1)))
- (unless (test-completion shortened-what-input
- (mapcar 'symbol-name
- commands))
- (setq what-input shortened-what-input)))))
-
- ;; ask for reorder in loop, because we have to ask for
- ;; what right again
- (if (eq what 'reorder)
- (setq reorder-once
- (intern
- (org-icompleting-read
- "Please choose column to reorder index table once: "
- (mapcar 'symbol-name '(ref count last-accessed))
- nil t))))
-
- ;; maybe ask initial question again
- (memq what '(reorder +)))))
-
-
- ;;
- ;; Get search, if required
- ;;
-
- ;; These actions need a search string:
- (when (memq what '(goto occur head update))
-
- ;; Maybe we've got a search string from the arguments
- (unless search
- (let (search-from-table
- search-from-cursor)
-
- ;; Search string can come from several sources:
- ;; From link or ref columns of table
- (when within-node
- (setq search-from-table (org-index--get-field 'link))
- (if search-from-table
- (setq search-is-link t)
- (setq search-from-table (org-index--get-field 'ref))))
-
- ;; From string below cursor
- (when (and (not within-node)
- below-cursor
- (string-match (concat "\\(" ref-regex "\\)")
- below-cursor))
- (setq search-from-cursor (match-string 1 below-cursor)))
-
- ;; Depending on requested action, get search from one of the sources above
- (cond ((eq what 'goto)
- (setq search (or what-input search-from-cursor)))
- ((memq what '(head occur))
- (setq search (or what-input search-from-table search-from-cursor))))))
-
-
- ;; If we still do not have a search string, ask user explicitly
- (unless search
- (unless (eq what 'occur)
-
- (if what-input
- (setq search what-input)
- (setq search (read-from-minibuffer
- (cond ((eq what 'head)
- "Text or reference number to search for: ")
- ((eq what 'goto)
- "Reference number to search for, or enter \".\" for id of current node: ")
- ((eq what 'update)
- "Reference number to update: ")))))
-
- (if (string-match "^\\s *[0-9]+\\s *$" search)
- (setq search (format "%s%s%s" head (org-trim search) tail))))))
-
- ;; Clean up and examine search string
- (when search
- (setq search (org-trim search))
- (if (string= search "") (setq search nil))
- (when search
- (if (string-match "^[0-9]+$" search)
- (setq search (concat head search tail)))
- (setq search-is-ref (string-match ref-regex search))))
-
- ;; Check for special case
- (when (and (memq what '(head goto))
- (string= search "."))
- (setq search (org-id-get))
- (setq search-is-link t))
-
- (when search-is-ref
- (setq guarded-search (org-index--make-guarded-search search)))
-
- ;;
- ;; Do some sanity checking before really starting
- ;;
-
- ;; Correct requested action, if nothing to search
- (when (and (not search)
- (memq what '(search head)))
- (setq what 'enter)
- (setq what-adjusted t))
-
- ;; For a proper reference as input, we do multi-occur
- (if (and search
- (string-match ref-regex search)
- (eq what 'occur))
- (setq what 'multi-occur))
-
- ;; Check for invalid combinations of arguments; try to be helpful
- (when (and (memq what '(head goto))
- (not search-is-link)
- (not search-is-ref))
- (error "Can do '%s' only for a reference or link (not '%s'), try 'occur' to search for text" what search))
-
-
- ;;
- ;; Prepare
- ;;
-
- ;; Get link if required before moving in
- (if (eq what 'link)
- (let ((org-id-link-to-org-use-id t))
- (setq link-id (org-id-get-create))))
-
- ;; Move into table, if outside
-
- ;; These commands enter index table only temporarily
- (when (memq what '(occur multi-occur statistics))
-
- ;; Switch to index table
- (set-buffer org-index--buffer)
- (goto-char org-index--point)
-
- ;; sort index table
- (org-index--sort-table reorder-once))
-
- ;; These commands will leave user in index table after they are finished
- (when (memq what '(enter ref link goto missing))
-
- ;; Support orgmode-standard of going back (buffer and position)
- (org-mark-ring-push)
-
- ;; Switch to index table
- (org-pop-to-buffer-same-window org-index--buffer)
- (goto-char org-index--point)
- (show-subtree)
- (org-show-context)
- (setq org-index--point-before nil) ;; dont want to go back
-
- ;; sort index table
- (org-index--sort-table reorder-once))
-
- ;; Goto back to initial ref, because reformatting of table above might
- ;; have moved point
- (when initial-ref-or-link
- (while (and (org-at-table-p)
- (not (or
- (string= initial-ref-or-link (org-index--get-field 'ref))
- (string= initial-ref-or-link (org-index--get-field 'link)))))
- (forward-line))
- ;; did not find ref, go back to top
- (if (not (org-at-table-p)) (goto-char org-index--point)))
-
-
- ;;
- ;; Actually do, what is requested
- ;;
-
- (cond
-
-
- ((eq what 'help)
-
- ;; bring up help-buffer for this function
- (describe-function 'org-index))
-
-
- ((eq what 'multi-occur)
-
- ;; Conveniently position cursor on number to search for
- (goto-char org-index--below-hline)
- (let (found (initial (point)))
- (while (and (not found)
- (forward-line)
- (org-at-table-p))
- (save-excursion
- (setq found (string= search
- (org-index--get-field 'ref)))))
- (if found
- (org-index--update-line nil)
- (goto-char initial)))
-
- ;; Construct list of all org-buffers
- (let (buff org-buffers)
- (dolist (buff (buffer-list))
- (set-buffer buff)
- (if (string= major-mode "org-mode")
- (setq org-buffers (cons buff org-buffers))))
-
- ;; Do multi-occur
- (multi-occur org-buffers guarded-search)
- (if (get-buffer "*Occur*")
- (progn
- (setq message-text (format "multi-occur for '%s'" search))
- (other-window 1)
- (toggle-truncate-lines 1))
- (setq message-text (format "Did not find '%s'" search)))))
-
-
- ((eq what 'head)
-
- (let (link)
- ;; link either from table or passed in as argument
-
- ;; try to get link
- (if search-is-link
- (setq link (org-trim search))
- (if (and within-node
- (org-at-table-p))
- (setq link (org-index--get-field 'link))))
-
- ;; use link if available
- (if (and link
- (not (string= link "")))
- (progn
- (org-index--update-line search)
- (org-id-goto link)
- (org-reveal)
- (if (eq (current-buffer) org-index--buffer)
- (setq org-index--point-before nil))
- (setq message-text "Followed link"))
-
- (message (format "Scanning headlines for '%s' ..." search))
- (org-index--update-line search)
- (let (buffer point)
- (if (catch 'found
- (progn
- ;; loop over all headlines, stop on first match
- (org-map-entries
- (lambda ()
- (when (looking-at (concat ".*" guarded-search))
- ;; If this is not an inlinetask ...
- (when (< (org-element-property :level (org-element-at-point))
- org-inlinetask-min-level)
- ;; ... remember location and bail out
- (setq buffer (current-buffer))
- (setq point (point))
- (throw 'found t))))
- nil 'agenda)
- nil))
-
- (progn
- (if (eq buffer org-index--buffer)
- (setq org-index--point-before nil))
- (setq message-text (format "Found '%s'" search))
- (org-pop-to-buffer-same-window buffer)
- (goto-char point)
- (org-reveal))
- (setq message-text (format "Did not find '%s'" search)))))))
-
-
- ((eq what 'leave)
-
- (setq kill-new-text org-index--text-to-yank)
- (setq org-index--text-to-yank nil)
-
- ;; If "leave" has been called two times in succession, make
- ;; org-mark-ring-goto believe it has been called two times too
- (if (eq org-index--last-action 'leave)
- (let ((this-command nil) (last-command nil))
- (org-mark-ring-goto 1))
- (org-mark-ring-goto)))
-
-
- ((eq what 'goto)
-
- ;; Go downward in table to requested reference
- (let (found (initial (point)))
- (goto-char org-index--below-hline)
- (while (and (not found)
- (forward-line)
- (org-at-table-p))
- (save-excursion
- (setq found
- (string= search
- (org-index--get-field
- (if search-is-link 'link 'ref))))))
- (if found
- (progn
- (setq message-text (format "Found '%s'" search))
- (org-index--update-line nil)
- (org-table-goto-column (org-index--column-num 'ref))
- (if (looking-back " ") (backward-char))
- ;; remember string to copy
- (setq org-index--text-to-yank
- (org-trim (org-table-get-field (org-index--column-num 'copy)))))
- (setq message-text (format "Did not find '%s'" search))
- (goto-char initial)
- (forward-line)
- (setq what 'missed))))
-
-
- ((eq what 'occur)
-
- (org-index--do-occur what-input))
-
-
- ((memq what '(ref link))
-
- ;; add a new row (or reuse existing one)
- (let (new)
-
- (when (eq what 'ref)
- ;; go through table to find first entry to be reused
- (when has-reuse
- (goto-char org-index--below-hline)
- ;; go through table
- (while (and (org-at-table-p)
- (not new))
- (when (string=
- (org-index--get-field 'count)
- ":reuse:")
- (setq new (org-index--get-field 'ref))
- (if new (org-table-kill-row)))
- (forward-line)))
-
- ;; no ref to reuse; construct new reference
- (unless new
- (setq new (format "%s%d%s" head (1+ maxref) tail)))
-
- ;; remember for org-mark-ring-goto
- (setq org-index--text-to-yank new))
-
- ;; insert ref or link as very first row
- (goto-char org-index--below-hline)
- (org-table-insert-row)
-
- ;; fill special columns with standard values
- (when (eq what 'ref)
- (org-table-goto-column (org-index--column-num 'ref))
- (insert new))
- (when (eq what 'link)
- (org-table-goto-column (org-index--column-num 'link))
- (insert link-id))
- (org-table-goto-column (org-index--column-num 'created))
- (org-insert-time-stamp nil nil t)
- (org-table-goto-column (org-index--column-num 'count))
- (insert "1")
-
- ;; goto copy-field or first empty one
- (if (org-index--column-num 'copy)
- (org-table-goto-column (org-index--column-num 'copy))
- (unless (catch 'empty
- (dotimes (col numcols)
- (org-table-goto-column (+ col 1))
- (if (string= (org-trim (org-table-get-field)) "")
- (throw 'empty t))))
- ;; none found, goto first
- (org-table-goto-column 1)))
-
- (org-table-align)
- (if active-region (setq kill-new-text active-region))
- (if (eq what 'ref)
- (setq message-text (format "Adding a new row with ref '%s'" new))
- (setq message-text (format "Adding a new row linked to '%s'" link-id)))))
-
-
- ((eq what 'enter)
-
- ;; simply go into table
- (goto-char org-index--below-hline)
- (show-subtree)
- (recenter)
- (if what-adjusted
- (setq message-text "Nothing to search for; at index table")
- (setq message-text "At index table")))
-
-
- ((eq what 'fill)
-
- ;; check, if within index table
- (unless (and within-node
- (org-at-table-p))
- (error "Not within index table"))
-
- ;; applies to missing refs and missing links alike
- (let ((ref (org-index--get-field 'ref))
- (link (org-index--get-field 'link)))
-
- (if (and (not ref)
- (not link))
- ;; have already checked this during parse, check here anyway
- (error "Columns ref and link are both empty in this line"))
-
- ;; fill in new ref
- (if (not ref)
- (progn
- (setq kill-new-text (format "%s%d%s" head (1+ maxref) tail))
- (org-index--get-field 'ref kill-new-text)
- ;; remember for org-mark-ring-goto
- (setq org-index--text-to-yank kill-new-text)
- (org-id-goto link)
- (setq message-text "Filled field of index table with new reference"))
-
- ;; fill in new link
- (if (not link)
- (progn
- (setq guarded-search (org-index--make-guarded-search ref))
- (message (format "Scanning headlines for '%s' ..." ref))
- (let (link)
- (if (catch 'found
- (org-map-entries
- (lambda ()
- (when (looking-at (concat ".*" guarded-search))
- (setq link (org-id-get-create))
- (throw 'found t)))
- nil 'agenda)
- nil)
-
- (progn
- (org-index--get-field 'link link)
- (setq message-text "Inserted link"))
-
- (setq message-text (format "Did not find reference '%s'" ref)))))
-
- ;; nothing is missing
- (setq message-text "Columns 'ref' and 'link' are already filled; nothing to do")))))
-
-
- ((eq what 'sort)
-
- ;; sort lines according to contained reference
- (let (begin end where)
- (catch 'aborted
- ;; either active region or whole buffer
- (if (and transient-mark-mode
- mark-active)
- ;; sort only region
- (progn
- (setq begin (region-beginning))
- (setq end (region-end))
- (setq where "region"))
- ;; sort whole buffer
- (setq begin (point-min))
- (setq end (point-max))
- (setq where "whole buffer")
- ;; make sure
- (unless (y-or-n-p "Sort whole buffer ")
- (setq message-text "Sort aborted")
- (throw 'aborted nil)))
-
- (save-excursion
- (save-restriction
- (goto-char (point-min))
- (narrow-to-region begin end)
- (sort-subr nil 'forward-line 'end-of-line
- (lambda ()
- (if (looking-at (concat ".*"
- (org-index--make-guarded-search ref-regex 'dont-quote)))
- (string-to-number (match-string 1))
- 0))))
- (highlight-regexp ref-regex 'isearch)
- (setq message-text (format "Sorted %s from character %d to %d, %d lines"
- where begin end
- (count-lines begin end)))))))
-
-
- ((eq what 'update)
-
- ;; simply update line in index table
- (save-excursion
- (let ((ref-or-link (if search-is-link "link" "reference")))
- (beginning-of-line)
- (if (org-index--update-line search)
- (setq message-text (format "Updated %s '%s'" ref-or-link search))
- (setq message-text (format "Did not find %s '%s'" ref-or-link search))))))
-
-
- ((eq what 'parse)
- ;; Just parse the index table, which is already done, so nothing to do
- )
-
-
- ((memq what '(highlight unhighlight))
-
- (let ((where "buffer"))
- (save-excursion
- (save-restriction
- (when (and transient-mark-mode
- mark-active)
- (narrow-to-region (region-beginning) (region-end))
- (setq where "region"))
-
- (if (eq what 'highlight)
- (progn
- (highlight-regexp ref-regex 'isearch)
- (setq message-text (format "Highlighted references in %s" where)))
- (unhighlight-regexp ref-regex)
- (setq message-text (format "Removed highlights for references in %s" where)))))))
-
-
- ((memq what '(missing statistics))
-
- (goto-char org-index--below-hline)
- (let (missing
- ref-field
- ref
- min
- max
- (total 0))
-
- ;; start with list of all references
- (setq missing (mapcar (lambda (x) (format "%s%d%s" head x tail))
- (number-sequence 1 maxref)))
-
- ;; go through table and remove all refs, that we see
- (while (and (forward-line)
- (org-at-table-p))
-
- ;; get ref-field and number
- (setq ref-field (org-index--get-field 'ref))
- (if (and ref-field
- (string-match ref-regex ref-field))
- (setq ref (string-to-number (match-string 1 ref-field))))
-
- ;; remove existing refs from list
- (if ref-field (setq missing (delete ref-field missing)))
-
- ;; record min and max
- (if (or (not min) (< ref min)) (setq min ref))
- (if (or (not max) (> ref max)) (setq max ref))
-
- ;; count
- (setq total (1+ total)))
-
- ;; insert them, if requested
- (forward-line -1)
- (if (eq what 'statistics)
-
- (setq message-text (format "Found %d references from %s to %s. %d references below highest do not appear in table. "
- total
- (format org-index--ref-format min)
- (format org-index--ref-format max)
- (length missing)))
-
- (if (y-or-n-p (format "Found %d missing references; do you wish to append them to the index table"
- (length missing)))
- (let (type)
- (setq type (org-icompleting-read
- "Insert new lines for reuse by command \"new\" or just as missing ? " '("reuse" "missing")))
- (mapc (lambda (x)
- (let (org-table-may-need-update) (org-table-insert-row t))
- (org-index--get-field 'ref x)
- (org-index--get-field 'count (format ":%s:" type)))
- missing)
- (org-table-align)
- (setq message-text (format "Inserted %d new lines for missing refernces" (length missing))))
- (setq message-text (format "%d missing references." (length missing)))))))
-
-
- (t (error "This is a bug: unmatched case '%s'" what)))
-
-
- ;; restore point in buffer or window with index table
- (if org-index--point-before
- ;; buffer displayed in window need to set point there first
- (if (eq (window-buffer active-window-index)
- org-index--buffer)
- (set-window-point active-window-index org-index--point-before)
- ;; set position in buffer in any case and second
- (with-current-buffer org-index--buffer
- (goto-char org-index--point-before)
- (setq org-index--point-before nil))))
-
-
- ;; remember what we have done for next time
- (setq org-index--last-action what)
-
- ;; tell, what we have done and what can be yanked
- (if kill-new-text (setq kill-new-text
- (substring-no-properties kill-new-text)))
- (if (string= kill-new-text "") (setq kill-new-text nil))
- (let ((m (concat
- message-text
- (if (and message-text kill-new-text)
- " and r"
- (if kill-new-text "R" ""))
- (if kill-new-text (format "eady to yank '%s'" kill-new-text) ""))))
- (unless (string= m "") (message m)))
- (if kill-new-text (kill-new kill-new-text)))))
-
-
-
-(defun org-index--parse-and-adjust-table ()
-
- (let ((maxref 0)
- top
- bottom
- ref-field
- link-field
- parts
- numcols
- head
- tail
- ref-regex
- has-reuse
- initial-point)
-
- (setq initial-point (point))
- (org-index--go-below-hline)
- (setq org-index--below-hline (point))
- (setq top (point))
-
- ;; count columns
- (org-table-goto-column 100)
- (setq numcols (- (org-table-current-column) 1))
-
- ;; get contents of columns
- (forward-line -2)
- (unless (org-at-table-p)
- (org-index--create-new-index
- nil
- "Index table starts with a hline"))
-
- ;; check for optional line consisting solely of width specifications
- (beginning-of-line)
- (if (looking-at "\\s *|\\(\\(\\s *|\\)\\|\\(\\s *<[0-9]+>\\s *|\\)\\)+\\s *$")
- (forward-line -1))
- (org-table-goto-column 1)
-
- (setq org-index--columns (org-index--parse-headings numcols))
-
- ;; Go beyond end of table
- (while (org-at-table-p) (forward-line 1))
-
- ;; Kill all empty rows at bottom
- (while (progn
- (forward-line -1)
- (org-table-goto-column 1)
- (and
- (not (org-index--get-field 'ref))
- (not (org-index--get-field 'link))))
- (org-table-kill-row))
- (forward-line)
- (setq bottom (point))
- (forward-line -1)
-
- ;; Retrieve any decorations around the number within the first nonempty ref-field
- (goto-char top)
- (while (and (org-at-table-p)
- (not (setq ref-field (org-index--get-field 'ref))))
- (forward-line))
-
- ;; Some Checking
- (unless ref-field
- (org-index--create-new-index
- nil
- "Reference column is empty"))
-
- (unless (string-match "^\\([^0-9]*\\)\\([0-9]+\\)\\([^0-9]*\\)$" ref-field)
- (org-index--create-new-index
- nil
- (format "First reference in index table ('%s') does not contain a number" ref-field)))
-
-
- ;; These are the decorations used within the first ref of index
- (setq head (match-string 1 ref-field))
- (setq tail (match-string 3 ref-field))
- (setq ref-regex (concat (regexp-quote head)
- "\\([0-9]+\\)"
- (regexp-quote tail)))
-
- ;; Go through table to find maximum number and do some checking
- (let ((ref 0))
-
- (while (org-at-table-p)
-
- (setq ref-field (org-index--get-field 'ref))
- (setq link-field (org-index--get-field 'link))
-
- (if (and (not ref-field)
- (not link-field))
- (throw 'content-error "Columns ref and link are both empty in this line"))
-
- (if ref-field
- (if (string-match ref-regex ref-field)
- ;; grab number
- (setq ref (string-to-number (match-string 1 ref-field)))
- (throw 'content-error "Column ref does not contain a number")))
-
- ;; check, if higher ref
- (if (> ref maxref) (setq maxref ref))
-
- ;; check if ref is ment for reuse
- (if (string= (org-index--get-field 'count) ":reuse:")
- (setq has-reuse 1))
-
- (forward-line 1)))
-
- ;; sort used to be here
-
- (setq parts (list head maxref tail numcols ref-regex has-reuse))
-
- ;; go back to top of table
- (goto-char top)
-
- parts))
-
-
-
-(defun org-index--sort-table (sort-column)
-
- (unless sort-column (setq sort-column (org-index--column-num 'sort)))
-
- (let (top
- bottom
- ref-field
- count-field
- count-special)
-
-
- ;; get boundaries of table
- (goto-char org-index--below-hline)
- (forward-line 0)
- (setq top (point))
- (while (org-at-table-p) (forward-line))
- (setq bottom (point))
-
- (save-restriction
- (narrow-to-region top bottom)
- (goto-char top)
- (sort-subr t
- 'forward-line
- 'end-of-line
- (lambda ()
- (let (ref
- (ref-field (or (org-index--get-field 'ref) ""))
- (count-field (or (org-index--get-field 'count) ""))
- (count-special 0))
-
- ;; get reference with leading zeroes, so it can be
- ;; sorted as text
- (string-match org-index--ref-regex ref-field)
- (setq ref (format
- "%06d"
- (string-to-number
- (or (match-string 1 ref-field)
- "0"))))
-
- ;; find out, if special token in count-column
- (setq count-special (format "%d"
- (- 2
- (length (member count-field '(":missing:" ":reuse:"))))))
-
- ;; Construct different sort-keys according to
- ;; requested sort column; prepend count-special to
- ;; sort special entries at bottom of table, append ref
- ;; as a secondary sort key
- (cond
-
- ((eq sort-column 'count)
- (concat count-special
- (format
- "%08d"
- (string-to-number (or (org-index--get-field 'count)
- "")))
- ref))
-
- ((eq sort-column 'last-accessed)
- (concat count-special
- (org-index--get-field 'last-accessed)
- " "
- ref))
-
- ((eq sort-column 'ref)
- (concat count-special
- ref))
-
- (t (error "This is a bug: unmatched case '%s'" sort-column)))))
-
- nil 'string<)))
-
- ;; align table
- (org-table-align))
-
-
-(defun org-index--go-below-hline ()
-
- ;; go to heading of node
- (while (not (org-at-heading-p)) (forward-line -1))
- (forward-line 1)
- ;; go to table within node, but make sure we do not get into another node
- (while (and (not (org-at-heading-p))
- (not (org-at-table-p))
- (not (eq (point) (point-max))))
- (forward-line 1))
-
- ;; check, if there really is a table
- (unless (org-at-table-p)
- (org-index--create-new-index
- t
- (format "Cannot find index table within node %s" org-index-id)))
-
- ;; go to first hline
- (while (and (not (org-at-table-hline-p))
- (org-at-table-p))
- (forward-line 1))
-
- ;; and check
- (unless (org-at-table-hline-p)
- (org-index--create-new-index
- nil
- "Cannot find hline within index table"))
-
- (forward-line 1)
- (org-table-goto-column 1))
-
-
-
-(defun org-index--parse-headings (numcols)
-
- (let (columns)
-
- ;; Associate names of special columns with column-numbers
- (setq columns (copy-tree '((ref . 0) (link . 0) (created . 0) (last-accessed . 0)
- (count . 0) (sort . nil) (copy . nil))))
-
- ;; For each column
- (dotimes (col numcols)
- (let* (field-flags ;; raw heading, consisting of file name and maybe
- ;; flags (seperated by ";")
- field ;; field name only
- field-symbol ;; and as a symbol
- flags ;; flags from field-flags
- found)
-
- ;; parse field-flags into field and flags
- (setq field-flags (org-trim (org-table-get-field (+ col 1))))
- (if (string-match "^\\([^;]*\\);\\([a-z]+\\)$" field-flags)
- (progn
- (setq field (downcase (or (match-string 1 field-flags) "")))
- ;; get flags as list of characters
- (setq flags (mapcar 'string-to-char
- (split-string
- (downcase (match-string 2 field-flags))
- "" t))))
- ;; no flags
- (setq field field-flags))
-
- (unless (string= field "") (setq field-symbol (intern (downcase field))))
-
- ;; Check, that no flags appear twice
- (mapc (lambda (x)
- (when (memq (car x) flags)
- (if (cdr (assoc (cdr x) columns))
- (org-index--create-new-index
- nil
- (format "More than one heading is marked with flag '%c'" (car x))))))
- '((?s . sort)
- (?c . copy)))
-
- ;; Process flags
- (if (memq ?s flags)
- (setcdr (assoc 'sort columns) field-symbol))
- (if (memq ?c flags)
- (setcdr (assoc 'copy columns) (+ col 1)))
-
- ;; Store columns in alist
- (setq found (assoc field-symbol columns))
- (when found
- (if (> (cdr found) 0)
- (org-index--create-new-index
- nil
- (format "'%s' appears two times as column heading" (downcase field))))
- (setcdr found (+ col 1)))))
-
- ;; check if all necessary informations have been specified
- (mapc (lambda (col)
- (unless (> (cdr (assoc col columns)) 0)
- (org-index--create-new-index
- nil
- (format "column '%s' has not been set" col))))
- '(ref link count created last-accessed))
-
- ;; use ref as a default sort-column
- (unless (cdr (assoc 'sort columns))
- (setcdr (assoc 'sort columns) 'ref))
- columns))
-
-
-
-(defun org-index--create-new-index (create-new-index reason)
- "Create a new empty index table with detailed explanation."
- (let (prompt buffer-name title firstref id)
-
- (setq prompt
- (if create-new-index
- (concat "There is this problem with the existing index table:\n\n " reason "\n\nThis assistant will guide you to create a new one.\n\nDo you want to proceed ?")
- (concat "The existing index table contains this error:\n\n " reason "\n\nYou need to correct this error manually before proceeding. However, this assistant will help you to create an new initial index table with detailed comments, so that you may fix the errors in your existing table more easily.\n\nDo you want to proceed ?")))
-
- (unless (y-or-n-p prompt)
- (message "Cannot proceed without a valid index table: %s" reason)
- ;; show existing index
- (when (and org-index--buffer
- org-index--point)
- (org-pop-to-buffer-same-window org-index--buffer)
- (goto-char org-index--point)
- (org-show-context)
- (show-subtree)
- (recenter 1)
- (delete-other-windows))
- (throw 'created-new-index nil))
-
- (setq buffer-name (org-completing-read "Please choose the buffer, where the new node for the index table should be created; the new node will be inserted at its end.\n\nBuffer: " (mapcar 'buffer-name (org-buffer-list)) nil nil))
-
- (setq title (read-from-minibuffer "Please enter the title of the index node: "))
-
- (while (progn
- (setq firstref (read-from-minibuffer "Please enter your first reference-number. This is a number preceeded by some non-digit chars and optionally followed by some more non-digit chars, e.g. 'R1', '-1-' or '#1#' (and your initial number does not need to be '1'). The format of your reference-numbers only needs to make sense for yourself, so that you can spot it easily in your texts or write it on a piece of paper; it should however not already appear to frequently within your existing notes, to avoid too many false hits when searching.\n\nPlease choose: "))
- (if (string-match "^[^0-9]+[0-9]+[^0-9]*$" firstref)
- nil
- (let (desc)
- ;; firstref not okay, report details
- (setq desc
- (cond ((string= firstref "") "is empty")
- ((not (string-match "^[^0-9]+" firstref)) "starts with a digit")
- ((not (string-match "^[^0-9]+[0-9]+" firstref)) "does not contain a number")
- ((not (string-match "^[^0-9]+[0-9]+[^0-9]*$" firstref)) "contains more than one sequence of digits")))
- (read-from-minibuffer (format "Your input '%s' does not meet the requirements because it %s. Please hit RET and try again " firstref desc)))
- t)))
-
- (with-current-buffer buffer-name
- (goto-char (point-max))
- (insert (format "\n\n* %s %s\n" firstref title))
- (insert "\n\n Below you find your initial index table, which will grow over time.\n"
- " Following that your may read its detailed explanation, which will help you,\n"
- " to adopt org-index to your needs. This however is optional reading and not\n"
- " required to start using org-index.\n\n")
-
- (setq id (org-id-get-create))
- (insert (format "
-
- | | | | | | comment |
- | ref | link | created | count;s | last-accessed | ;c |
- | | <4> | | | | |
- |-----+------+---------+---------+---------------+---------|
- | %s | %s | %s | | | %s |
-
-"
- firstref
- id
- (with-temp-buffer (org-insert-time-stamp nil nil t))
- "This node"))
-
-
- (insert "
-
- Detailed explanation:
-
-
- The index table above has three lines of headings above the first
- hline:
-
- - The first one is ignored by org-index, and you can use it to
- give meaningful names to columns. In the table above only one
- column has a name (\"comment\"). This line is optional.
-
- - The second line is the most important one, because it
- contains the configuration information for org-index; please
- read further below for its format.
-
- - The third line is again optional; it may only specify the
- widths of the individual columns (e.g. <4>).
-
- The columns get their meaning by the second line of headings;
- specifically by one of the keywords (e.g. \"ref\") or a flag
- seperated by a semicolon (e.g. \";s\").
-
-
-
- The keywords and flags are:
-
-
- - ref: This contains the reference, which consists of a decorated
- number, which is incremented for each new line. References are
- meant to be used in org-mode headlines or outside of org´,
- e.g. within folder names.
-
- - link: org-mode link pointing to the matching location within org.
-
- - created: When has this line been created ?
-
- - count: How many times has this line accessed ? The trailing
- flag \"s\" makes the table beeing sorted after
- this column, so that often used entries appear at the top of
- the table.
-
- - last-accessed: When has this line ben accessed
-
- - The last column above has no keyword, only the flag \"c\",
- which makes its content beeing copied under certain
- conditions. It is typically used for comments.
-
- The sequence of columns does not matter. You may reorder them any
- way you like. Columns are found by their name, which appears in
- the second line of headings.
-
- You can add further columns or even remove the last column. All
- other columns are required.
-
-
- Finally: This node needs not be a top level node; its name is
- completely at you choice; it is found through its ID only.
-
-")
-
-
- (while (not (org-at-table-p)) (forward-line -1))
- (org-table-align)
- (while (not (org-at-heading-p)) (forward-line -1))
-
- ;; present results to user
- (if (and (not create-new-index)
- org-index--buffer
- org-index--point)
-
- ;; we had an error with the existing table, so present old and new one
- (progn
- ;; show existing index
- (org-pop-to-buffer-same-window org-index--buffer)
- (goto-char org-index--point)
- (org-show-context)
- (show-subtree)
- (recenter 1)
- (delete-other-windows)
- ;; show new index
- (select-window (split-window-vertically))
- (org-pop-to-buffer-same-window buffer-name)
- (org-id-goto id)
- (org-show-context)
- (show-subtree)
- (recenter 1)
- (message "Please compare your existing index (upper window) and a temporary new one (lower window) to correct the previous error (\"%s\"); the explanations following the new index table should help." reason))
-
- ;; Only show the new index
- (org-pop-to-buffer-same-window buffer-name)
- (delete-other-windows)
- (org-id-goto id)
- (org-show-context)
- (show-subtree)
- (recenter 1)
- (setq org-index-id id)
- (if (y-or-n-p "This is your new index table; Do you want to save its id to make it permanent ? ")
- (progn
- (customize-save-variable 'org-index-id id)
- (message "Saved org-index-id '%s' to %s" org-index-id custom-file))
- (let (sq)
- (setq sq (format "(setq org-index-id \"%s\")" org-index-id))
- (kill-new sq)
- (message "Did not make the id of the new index permamanent; you may want to put\n\n %s\n\ninto your own initialization; it is copied already, just yank it." sq)))))
- ;; cannot handle this situation in higher code, but do not want to finish with an error
- (throw 'created-new-index nil)))
-
-
-
-
-(defun org-index--update-line (ref-or-link)
-
- (let (initial
- found
- count-field)
-
- (with-current-buffer org-index--buffer
-
- ;; search reference or link, if given (or assume, that we are already positioned right)
- (when ref-or-link
- (setq initial (point))
- (goto-char org-index--below-hline)
- (while (and (org-at-table-p)
- (not (or (string= ref-or-link (org-index--get-field 'ref))
- (string= ref-or-link (org-index--get-field 'link)))))
- (forward-line)))
-
- (if (not (org-at-table-p))
- (error "Did not find reference or link '%s'" ref-or-link)
- (setq count-field (org-index--get-field 'count))
-
- ;; update count field only if number or empty; leave :missing: and :reuse: as is
- (if (or (not count-field)
- (string-match "^[0-9]+$" count-field))
- (org-index--get-field 'count
- (number-to-string
- (+ 1 (string-to-number (or count-field "0"))))))
-
- ;; update timestamp
- (org-table-goto-column (org-index--column-num 'last-accessed))
- (org-table-blank-field)
- (org-insert-time-stamp nil t t)
-
- (setq found t))
-
- (if initial (goto-char initial))
-
- found)))
-
-
-
-(defun org-index--get-field (key &optional value)
- (let (field)
- (setq field (org-trim (org-table-get-field (cdr (assoc key org-index--columns)) value)))
- (if (string= field "") (setq field nil))
-
- field))
-
-
-(defun org-index--column-num (key)
- (cdr (assoc key org-index--columns)))
-
-
-(defun org-index--make-guarded-search (ref &optional dont-quote)
- (concat "\\b" (if dont-quote ref (regexp-quote ref)) "\\b"))
-
-
-(defun org-index-get-ref-regex-format ()
- "return cons-cell with regular expression and format for references"
- (unless org-index--ref-regex
- (org-index-1 'parse))
- (cons (org-index--make-guarded-search org-index--ref-regex 'dont-quote) org-index--ref-format))
-
-
-(defun org-index--do-occur (initial-search)
- (let (
- (occur-buffer-name "*org-index-occur*")
- (word "") ; last word to search for growing and shrinking on keystrokes
- (prompt "Search for: ")
- words ; list of other words that must match too
- occur-buffer
- lines-to-show ; number of lines to show in window
- start-of-lines ; position, where lines begin
- left-off-at ; stack of last positions in index table
- after-inserted ; in occur-buffer
- lines-visible ; in occur-buffer
- below-hline-bol ; below-hline and at bol
- exit-gracefully ; true if normal exit
- in-c-backspace ; true while processing C-backspace
- ret from to key)
-
- ;; clear buffer
- (if (get-buffer "*org-index-occur*")
- (kill-buffer occur-buffer-name))
- (setq occur-buffer (get-buffer-create "*org-index-occur*"))
-
- (with-current-buffer org-index--buffer
- (let ((initial (point)))
- (goto-char org-index--below-hline)
- (forward-line 0)
- (setq below-hline-bol (point))
- (goto-char initial)))
-
- (org-pop-to-buffer-same-window occur-buffer)
- (toggle-truncate-lines 1)
-
- (unwind-protect ; to reset cursor-shape even in case of errors
- (progn
-
- ;; fill in header
- (erase-buffer)
- (insert (concat "Incremental search, showing one window of matches.\n"
- "Use DEL and C-DEL to erase, cursor keys to move, RET to find heading.\n\n"))
- (setq start-of-lines (point))
- (setq cursor-type 'hollow)
-
- ;; get window size of occur-buffer as number of lines to be searched
- (setq lines-to-show (+ (- (window-body-height) (line-number-at-pos)) 1))
-
-
- ;; fill initially
- (setq ret (org-index--get-matching-lines nil lines-to-show below-hline-bol))
- (when (car ret)
- (insert (cdr ret))
- (setq left-off-at (cons (car ret) nil))
- (setq after-inserted (cons (point) nil)))
-
- ;; read keys
- (while
- (progn
- (goto-char start-of-lines)
- (setq lines-visible 0)
-
- ;; use initial-search (if present) to simulate keyboard input
- (if (and initial-search
- (> (length initial-search) 0))
- (progn
- (setq key (string-to-char (substring initial-search 0 1)))
- (if (length initial-search)
- (setq initial-search (substring initial-search 1))))
- (if in-c-backspace
- (setq key 'backspace)
- (setq key (read-event
- (format "%s %s"
- prompt
- (mapconcat 'identity (reverse (cons word words)) ","))))
-
- (setq exit-gracefully (memq key (list 'return 'up 'down 'left 'right)))))
-
- (not exit-gracefully))
-
- (cond
-
- ((eq key 'C-backspace)
-
- (setq in-c-backspace t))
-
- ((eq key 'backspace) ; erase last char
-
- (if (= (length word) 0)
-
- ;; nothing more to delete
- (setq in-c-backspace nil)
-
- ;; unhighlight longer match
- (let ((case-fold-search t))
- (unhighlight-regexp (regexp-quote word)))
-
- ;; chars left shorten word
- (setq word (substring word 0 -1))
- (when (= (length word) 0) ; when nothing left, use next word from list
- (setq word (car words))
- (setq words (cdr words))
- (setq in-c-backspace nil))
-
- ;; remove everything, that has been added for char just deleted
- (when (cdr after-inserted)
- (setq after-inserted (cdr after-inserted))
- (goto-char (car after-inserted))
- (delete-region (point) (point-max)))
-
- ;; back up last position in index table too
- (when (cdr left-off-at)
- (setq left-off-at (cdr left-off-at)))
-
- ;; go through buffer and check, if any invisible line should now be shown
- (goto-char start-of-lines)
- (while (< (point) (point-max))
- (if (outline-invisible-p)
- (progn
- (setq from (line-beginning-position)
- to (line-beginning-position 2))
-
- ;; check for matches
- (when (org-index--test-words (cons word words) (buffer-substring from to))
- (when (<= lines-visible lines-to-show) ; show, if more lines required
- (outline-flag-region from to nil)
- (incf lines-visible))))
-
- ;; already visible, just count
- (incf lines-visible))
-
- (forward-line 1))
-
- ;; highlight shorter word
- (unless (= (length word) 0)
- (let ((case-fold-search t))
- (highlight-regexp (regexp-quote word) 'isearch)))))
-
-
- ((eq key ?,) ; comma: enter an additional search word
-
- ;; push current word and clear, no need to change display
- (setq words (cons word words))
- (setq word ""))
-
-
- ((and (characterp key)
- (aref printable-chars key)) ; any other char: add to current search word
-
-
- ;; unhighlight short word
- (unless (= (length word) 0)
- (let ((case-fold-search t))
- (unhighlight-regexp (regexp-quote word))))
-
- ;; add to word
- (setq word (concat word (downcase (string key))))
-
- ;; hide lines, that do not match longer word any more
- (while (< (point) (point-max))
- (unless (outline-invisible-p)
- (setq from (line-beginning-position)
- to (line-beginning-position 2))
-
- ;; check for matches
- (if (org-index--test-words (list word) (buffer-substring from to))
- (incf lines-visible) ; count as visible
- (outline-flag-region from to t))) ; hide
-
- (forward-line 1))
-
- ;; duplicate top of stacks; eventually overwritten below
- (setq left-off-at (cons (car left-off-at) left-off-at))
- (setq after-inserted (cons (car after-inserted) after-inserted))
-
- ;; get new lines from index table
- (when (< lines-visible lines-to-show)
- (setq ret (org-index--get-matching-lines (cons word words)
- (- lines-to-show lines-visible)
- (car left-off-at)))
-
- (when (car ret)
- (insert (cdr ret))
- (setcar left-off-at (car ret))
- (setcar after-inserted (point))))
-
- ;; highlight longer word
- (let ((case-fold-search t))
- (highlight-regexp (regexp-quote word) 'isearch)))))
-
- ;; search is done collect and brush up results
- ;; remove any lines, that are still invisible
- (goto-char start-of-lines)
- (while (< (point) (point-max))
- (if (outline-invisible-p)
- (delete-region (line-beginning-position) (line-beginning-position 2))
- (forward-line 1)))
-
- ;; get all the rest
- (message "Getting all matches ...")
- (setq ret (org-index--get-matching-lines (cons word words) 0 (car left-off-at)))
- (message "done.")
- (insert (cdr ret)))
-
- ;; postprocessing even for non graceful exit
- (setq cursor-type t)
- ;; replace previous heading
- (let ((numlines (count-lines (point) start-of-lines)))
- (goto-char start-of-lines)
- (forward-line -1)
- (delete-region (point-min) (point))
- (insert (format (concat (if exit-gracefully
- "Search is done; showing all %d matches.\n"
- "Search aborted; showing only some matches.\n")
- "Use cursor keys to move, press RET to find heading.\n")
- numlines)))
- (forward-line))
-
- ;; install keyboard-shortcuts within occur-buffer
- (let ((keymap (make-sparse-keymap))
- fun-on-ret)
- (set-keymap-parent keymap text-mode-map)
-
- (setq fun-on-ret (lambda () (interactive)
- (let ((ref (org-index--get-field 'ref))
- (link (org-index--get-field 'link)))
- (org-index-1 'head
- (or link ref) ;; prefer link
- (if link t nil)))))
-
- (define-key keymap (kbd "RET") fun-on-ret)
- (use-local-map keymap)
-
- ;; perform action according to last char
- (cond
- ((eq key 'return)
- (funcall fun-on-ret))
-
- ((eq key 'up)
- (forward-line -1))
-
- ((eq key 'down)
- (forward-line 1))
-
- ((eq key 'left)
- (forward-char -1))
-
- ((eq key 'right)
- (forward-char 1))))))
-
-
-(defun org-index--get-matching-lines (words numlines start-from)
- (let ((numfound 0)
- pos
- initial line lines)
-
- (with-current-buffer org-index--buffer
-
- ;; remember initial pos and start at requested
- (setq initial (point))
- (goto-char start-from)
-
- ;; loop over buffer until we have found enough lines
- (while (and (or (< numfound numlines)
- (= numlines 0))
- (org-at-table-p))
-
- ;; check each word
- (setq line (buffer-substring (line-beginning-position) (line-beginning-position 2)))
- (when (org-index--test-words words line)
- (setq lines (concat lines line))
- (incf numfound))
- (forward-line 1)
- (setq pos (point)))
-
- ;; return to initial position
- (goto-char initial))
-
- (unless lines (setq lines ""))
- (cons pos lines)))
-
-
-(defun org-index--test-words (words line)
- (let ((found-all t))
- (setq line (downcase line))
- (catch 'not-found
- (dolist (w words)
- (or (search w line)
- (throw 'not-found nil)))
- t)))
-
-
-(defadvice org-mark-ring-goto (after org-index--advice-text-to-yank activate)
- "Make text from org-index available for yank."
- (when org-index--text-to-yank
- (kill-new org-index--text-to-yank)
- (message (format "Ready to yank '%s'" org-index--text-to-yank))
- (setq org-index--text-to-yank nil)))
-
-
-(provide 'org-index)
-
-;; Local Variables:
-;; fill-column: 75
-;; comment-column: 50
-;; End:
-
-;;; org-index.el ends here
+;;; org-index.el --- A personal index for org and beyond
+
+;; Copyright (C) 2011-2014 Free Software Foundation, Inc.
+
+;; Author: Marc Ihm <org-index@2484.de>
+;; Keywords: outlines, hypermedia, matching
+;; Requires: org
+;; Version: 2.4.2
+
+;; This file is not part of GNU Emacs.
+
+;;; 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. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Purpose:
+;;
+;; Mark and find your favorite org-locations and other points of interest
+;; easily; create and update a lookup table of references and links. When
+;; searching, frequently used entries appear at the the top and entering
+;; some keywords narrows down to matching entries only, so that the
+;; right one can be spotted easily.
+;;
+;; References are essentially small numbers (e.g. "R237" or "-455-"),
+;; which are created by this package; they are well suited to be used
+;; outside org. Links are normal org-mode links.
+;;
+;;
+;; Setup:
+;;
+;; - Add these lines to your .emacs:
+;;
+;; ;; use the real path from your org-installation
+;; (add-to-list 'load-path "~/path/to/orgdir/contrib/lisp" t)
+;; (require 'org-index)
+;;
+;; - Restart your emacs to make these lines effective
+;;
+;; - Invoke `org-index', which will assist in creating your index
+;; table. The variable org-index-id will be persisted within your
+;; customization file (typically .emacs).
+;;
+;;
+;; Further reading:
+;;
+;; See the documentation of `org-index', which can also be read
+;; by invoking `org-index' and and choosing the help-command.
+;;
+;; For more documentation and working examples, see:
+;;
+;; http://orgmode.org/worg/org-contrib/org-index.html
+;;
+;;
+;; Updates:
+;;
+;; The latest tested version of this file can always be found at:
+;;
+;; http://orgmode.org/w/org-mode.git?p=org-mode.git;a=blob_plain;f=contrib/lisp/org-index.el;hb=HEAD
+
+;;; Change Log:
+
+;; [2014-02-01 Sa] Version 2.4.2:
+;; - Follow mode in occur-buffer
+;; - Reorder for x-columns
+;;
+;; [2014-01-02 Th] Version 2.4.0:
+;; - New command "put" to store a nodes reference in a property
+;; - New functions org-index-new-line and org-index-get-line
+;; offer access to org-index from other lisp programs
+;; - New flag p, new columns x1,x2 and x3
+;; - Major Code refactoring
+;; - Regression tests with ert
+;; - Lots of bugfixes
+;;
+;; [2013-10-04 Fr] Version 2.3.2:
+;; - Bugfix: index-table created by assistant is found after
+;; restart of emacs instead of invoking assistent again
+;;
+;; [2013-07-20 Sa] Version 2.3.0:
+;; - Renamed from "org-favtable" to "org-index"
+;; - Added an assistent to set up the index table
+;; - occur is now incremental, searching as you type
+;; - simplified the documentation and help-system
+;; - Saving keystrokes, as "+g237" is now valid input
+;; - Many bugfixes
+;;
+;; [2013-02-28 Th] Version 2.2.0:
+;; - Allowed shortcuts like "h237" for command "head" with argument "237"
+;; - Integrated with org-mark-ring-goto
+;;
+;; [2013-01-25 Fr] Version 2.1.0:
+;; - Added full support for links
+;; - New commands "missing" and "statistics"
+;; - Renamed the package from "org-reftable" to "org-favtable"
+;; - Additional columns are required (e.g. "link"). Error messages will
+;; guide you
+;;
+;; [2012-12-07 Fr] Version 2.0.0:
+;; - The format of the table of favorites has changed ! You need to bring
+;; your existing table into the new format by hand (which however is
+;; easy and explained below)
+;; - Reference table can be sorted after usage count or date of last access
+;; - Ask user explicitly, which command to invoke
+;; - Renamed the package from "org-refer-by-number" to "org-reftable"
+;;
+;; [2012-09-22 Sa] Version 1.5.0:
+;; - New command "sort" to sort a buffer or region by reference number
+;; - New commands "highlight" and "unhighlight" to mark references
+;;
+;; [2012-07-13 Fr] Version 1.4.0:
+;; - New command "head" to find a headline with a reference number
+;;
+;; [2012-04-28 Sa] Version 1.3.0:
+;; - New commands occur and multi-occur
+;; - All commands can now be invoked explicitly
+;; - New documentation
+;; - Many bugfixes
+;;
+;; [2011-12-10 Sa] Version 1.2.0:
+;; - Fixed a bug, which lead to a loss of newly created reference numbers
+;; - Introduced single and double prefix arguments
+;; - Started this Change Log
+
+;;; Code:
+
+(require 'org-table)
+(require 'cl)
+
+(defcustom org-index-id nil
+ "Id of the Org-mode node, which contains the index table."
+ :group 'org
+ :group 'org-index)
+
+;; Variables to hold the configuration of the index table
+(defvar org-index--maxref) ; Maximum number from reference table (e.g. "153")
+(defvar org-index--head) ; Any header before number (e.g. "R")
+(defvar org-index--tail) ; Tail after number (e.g. "}" or "")
+(defvar org-index--numcols) ; Number of columns in index table
+(defvar org-index--ref-regex) ; Regular expression to match a reference
+(defvar org-index--has-reuse nil) ; True, if table contains a line for reuse
+(defvar org-index--ref-format) ; Format, that can print a reference
+(defvar org-index--columns nil) ; Columns of index-table
+(defvar org-index--special-columns nil) ; Columns with flags
+(defvar org-index--buffer) ; Buffer of index table
+(defvar org-index--point) ; Position at start of headline of index table
+(defvar org-index--below-hline) ; Position of first cell in first line below hline
+(defvar org-index--headings) ; Headlines of index-table as a string
+
+;; Variables to hold context and state
+(defvar org-index--last-action nil) ; Last action performed by org-index
+(defvar org-index--text-to-yank nil) ; Text, that can be yanked after call (mostly a reference)
+(defvar org-index--last-ref) ; Last reference created or visited
+(defvar org-index--point-before nil) ; Point in buffer with index table
+(defvar org-index--silent nil) ; t, if user should not be queried
+(defvar org-index--preferred-command) ; command, that is presented first
+(defvar org-index--active-region) ; Active region, initially. I.e. what has been marked
+(defvar org-index--below-cursor) ; Word below cursor
+(defvar org-index--within-node) ; True, if we are within node of the index table
+(defvar org-index--active-window-index nil) ; Active window with index table (if any)
+(defvar org-index--occur-follow-mode nil) ; True, if follow mode in occur-buffer is on
+
+(setq org-index--commands '(occur head ref link leave put enter goto help + reorder fill sort update highlight unhighlight missing statistics)) ; list of commands available
+
+(defun org-index (&optional ARG)
+ "Mark and find your favorite things and org-locations easily:
+Create and update a lookup table of references and links. Often
+used entries bubble to the top; entering some keywords narrows
+down to matching entries only, so that the right one can be
+spotted easily.
+
+References are essentially small numbers (e.g. \"R237\" or \"-455-\"),
+which are created by this package; they are well suited to be used
+outside of org. Links are normal org-mode links.
+
+This is version 2.4.0 of org-index.
+
+The function `org-index' operates on a dedicated table, the index
+table, which lives within its own Org-mode node. The table and
+its node will be created, when you first invoke org-index.
+
+Each line in the index table contains:
+
+ - A reference (e.g. \"R237\")
+
+ - An optional link to another location in org
+
+ - A number, counting, how often each reference has been
+ used. This number is updated automatically and the table can
+ be sorted after it, so that most frequently used references
+ appear at the top of the table and can be spotted easily.
+
+ - The creation date of the line
+
+ - Date and time of last access. This column can alternatively be
+ used to sort the table.
+
+ - A column for your own comments
+
+The index table is found through the id of the containing
+node; this id is stored within the variable `org-index-id'.
+
+
+The function `org-index' is the only interactive function of this
+package and its main entry point; it offers several commands to
+create, find and look up line within the index table.
+
+Commands known:
+
+ occur: Incremental search, that shows matching lines from the
+ index table, updated after every keystroke. You may enter a
+ list of words seperated by space or comma (\",\"), to select
+ lines that contain all of the given words.
+
+ If you supply a number (e.g. \"237\"): Apply emacs standard
+ multi-occur operation on all org-mode buffers to search for
+ this specific reference.
+
+ You may also read the note at the end of this help on saving
+ the keystroke RET with this frequent default command.
+
+ head: If invoked outside the index table, ask for a reference
+ number and search for an entry, which either has this
+ reference contained in its heading or within its property
+ org-index-ref. If invoked from within the index table dont
+ ask; rather use the reference or link from the current line.
+
+ ref: Create a new reference, copy any previously selected text.
+ If already within index table, fill in ref-column.
+
+ link: Create a new line in index table with a link to the
+ current node. Do not populate the ref column; this can later
+ be populated by calling the \"fill\" command from within the
+ index table.
+
+ leave: Leave the index table. If the last command has been
+ \"ref\", the new reference is copied and ready to yank. This
+ \"org-mark-ring-goto\" and can be called several times in
+ succession. If you invoke org-index with a prefix argument,
+ this command \"leave\" is executed without further questions.
+
+ put: Put the reference, that was created last, as the value of
+ property org-index-ref into the current node. That way it can
+ be found by a later call to \"head\".
+
+ enter: Just enter the node with the index table.
+
+ goto: Enter index table and go to a specific reference.
+
+ help: Show this text.
+
+ +: Show all commands including the less frequently used ones
+ given below. If \"+\" is followd by enough letters of such a
+ command (e.g. \"+fi\"), then this command (e.g. \"fill\") is
+ invoked directly.
+
+ reorder: Temporarily reorder the index table, e.g. by count,
+ reference or last access.
+
+ fill: If either ref or link is missing in current line of index
+ table, fill in the missing value.
+
+ sort: Sort a set of lines (either from the active region or the
+ whole buffer) by references found in each line.
+
+ update: For the given reference, update the line in the
+ index table, i.e. increment its count.
+
+ highlight: Highlight references in active region or buffer.
+
+ unhighlight: Remove those highlights.
+
+ missing : Search for missing reference numbers (which do not
+ appear in the reference table). If requested, add additional
+ lines for them, so that the command \"ref\" is able to reuse
+ them.
+
+ statistics : Show some statistics (e.g. minimum and maximum
+ reference) about index table.
+
+
+
+Two ways to save keystrokes:
+
+When prompting for a command, org-index puts the most likely
+one (e.g. \"occur\" or \"ref\") in front of the list, so that
+you may just type RET.
+
+If this first command in the list of commands needs additional
+input (like e.g. \"occur\"), you may supply this input right
+away, although you are still beeing prompted for the command. So,
+to do an occur for the string \"foo\", you can just enter \"foo\"
+RET, without even typing \"occur\".
+
+
+Another way to save keystrokes applies if you want to choose a
+command, that requrires a reference number and would normally
+prompt for it: In that case you may just enter enough characters
+from your command, so that it appears first in the list of
+matches; then immediately enter the number of the reference you
+are searching for. So the input \"h237\" would execute the
+command \"head\" for reference \"237\".
+
+"
+
+ (interactive "P")
+
+ (let ((org-index--silent nil) ; t, if user can be asked
+ link-id ; link of starting node, if required
+ what ; what to do
+ search ; what to search for
+ guarded-search ; with guard against additional digits
+ search-ref ; search, if search is a reference
+ search-link ; search, if search is a link
+ what-adjusted ; true, if we had to adjust what
+ what-input ; Input on what question (need not necessary be "what")
+ reorder-once ; column to use for single time sorting
+ kill-new-text ; text that will be appended to kill ring
+ message-text ; text that will be issued as an explanation
+ initial-ref-or-link ; initial position in index table
+ )
+
+
+ ;;
+ ;; Initialize and parse
+ ;;
+
+ ;; creates index table, if necessary
+ (org-index--verify-id)
+
+ ;; store context information
+ (org-index--retrieve-context)
+
+ ;; Get configuration of index table
+ (org-index--parse-table)
+
+
+ ;;
+ ;; Find out, what we are supposed to do
+ ;;
+
+ (if ARG
+ (if (equal ARG '(4))
+ (setq what 'leave)
+ (if (and (symbolp ARG)
+ (memq ARG org-index--commands))
+ (setq what ARG)
+ (error "Unknown command '%s' passed as argument, valid choices are a prefix argument or any of these symbols: %s"
+ ARG (mapconcat 'symbol-name org-index--commands ","))))
+
+ (let ((r (org-index--read-what what))) ; query user if not from argument
+ (setq what (nth 0 r))
+ (setq what-input (nth 1 r))
+ (setq reorder-once (nth 2 r))))
+
+
+ ;;
+ ;; Get search, if required
+ ;;
+
+ ;; These actions need a search string:
+ (when (memq what '(goto occur head update))
+ ;; Maybe we've got a search string from the arguments
+ (setq search (org-index--get-or-read-search search what what-input))
+
+ (when search
+ (when (string-match org-index--ref-regex search)
+ (setq search-ref search)
+ (setq guarded-search (org-index--make-guarded-search search)))
+ (when (string-match "^[a-fA-F0-9]\\{8\\}-[a-fA-F0-9]\\{4\\}-[a-fA-F0-9]\\{4\\}-[a-fA-F0-9]\\{4\\}-[a-fA-F0-9]\\{12\\}$" search)
+ (setq search-link search))))
+
+
+ ;;
+ ;; Do some sanity checking before really starting
+ ;;
+
+ ;; Correct requested action, if nothing to search
+ (when (and (not search)
+ (memq what '(search head)))
+ (setq what 'enter)
+ (setq what-adjusted t))
+
+ ;; For a proper reference as input, we do multi-occur
+ (if (and (eq what 'occur) search-ref)
+ (setq what 'multi-occur))
+
+ ;; Check for invalid combinations of arguments; try to be helpful
+ (when (and (memq what '(head goto))
+ (not search-ref)
+ (not search-link))
+ (error "Can do '%s' only for a reference or link (not '%s'), try 'occur' to search for text" what search))
+
+
+ ;;
+ ;; Sort and enter table
+ ;;
+
+ ;; Get link if required before moving in
+ (if (eq what 'link)
+ (let ((org-id-link-to-org-use-id t))
+ (setq link-id (org-id-get-create))))
+
+ ;; Save initial ref or link for later return
+ (if (and org-index--within-node
+ (org-at-table-p))
+ (setq initial-ref-or-link
+ (or (org-index--get-field :ref)
+ (org-index--get-field :link))))
+
+ ;; These commands enter index table only temporarily
+ (when (memq what '(occur multi-occur statistics))
+
+ (set-buffer org-index--buffer)
+ (goto-char org-index--point)
+
+ ;; Sort and align
+ (org-index--sort reorder-once)
+ (org-index--align))
+
+ ;; These commands will leave user in index table after they are finished
+ (when (memq what '(enter ref link goto missing))
+
+ ;; Support orgmode-standard of going back (buffer and position)
+ (org-mark-ring-push)
+
+ (org-pop-to-buffer-same-window org-index--buffer)
+ (goto-char org-index--point)
+ (show-subtree)
+ (org-show-context)
+
+ ;; Sort and align
+ (org-index--sort reorder-once)
+ (org-index--align))
+
+ ;; Return to initial position
+ (when initial-ref-or-link
+ (while (and (org-at-table-p)
+ (not (or
+ (string= initial-ref-or-link (org-index--get-field :ref))
+ (string= initial-ref-or-link (org-index--get-field :link)))))
+ (forward-line))
+ ;; did not find ref, go back to top
+ (if (not (org-at-table-p)) (goto-char org-index--point)))
+
+
+ ;;
+ ;; Actually do, what is requested
+ ;;
+
+ (cond
+
+
+ ((eq what 'help)
+
+ ;; bring up help-buffer for this function
+ (describe-function 'org-index))
+
+
+ ((eq what 'multi-occur)
+
+ ;; Position point in index buffer on reference to search for
+ (goto-char org-index--below-hline)
+ (let (found (initial (point)))
+ (while (and (not found)
+ (forward-line)
+ (org-at-table-p))
+ (save-excursion
+ (setq found (string= search
+ (org-index--get-field :ref)))))
+ (if found
+ (org-index--update-line nil)
+ (goto-char initial)))
+
+ ;; Construct list of all org-buffers
+ (let (buff org-buffers)
+ (dolist (buff (buffer-list))
+ (set-buffer buff)
+ (if (string= major-mode "org-mode")
+ (setq org-buffers (cons buff org-buffers))))
+
+ ;; Do multi-occur
+ (multi-occur org-buffers guarded-search)
+
+ ;; Present results
+ (if (get-buffer "*Occur*")
+ (progn
+ (setq message-text (format "multi-occur for '%s'" search))
+ (other-window 1)
+ (toggle-truncate-lines 1))
+ (setq message-text (format "Did not find '%s'" search)))))
+
+
+ ((eq what 'head)
+
+ (let (link)
+ (if (and org-index--within-node
+ (org-at-table-p))
+ (setq link (org-index--get-field :link))))
+
+ (setq message-text (org-index--do-head search-ref search-link)))
+
+
+ ((eq what 'leave)
+
+ (setq kill-new-text org-index--text-to-yank)
+ (setq org-index--text-to-yank nil)
+
+ ;; If "leave" has been called two times in succession, make
+ ;; org-mark-ring-goto believe it has been called two times too
+ (if (eq org-index--last-action 'leave)
+ (let ((this-command nil) (last-command nil))
+ (org-mark-ring-goto 1))
+ (org-mark-ring-goto))
+
+ ;; Return to saved position in index buffer
+ (when org-index--point-before
+ ;; buffer displayed in window need to set point there first
+ (if (eq (window-buffer org-index--active-window-index)
+ org-index--buffer)
+ (set-window-point org-index--active-window-index org-index--point-before))
+ ;; set position in buffer in any case and second
+ (with-current-buffer org-index--buffer
+ (goto-char org-index--point-before)))
+ (setq org-index--point-before nil))
+
+
+ ((eq what 'goto)
+
+ ;; Go downward in table to requested reference
+ (let (found (initial (point)))
+ (goto-char org-index--below-hline)
+ (while (and (not found)
+ (forward-line)
+ (org-at-table-p))
+ (save-excursion
+ (setq found
+ (string= search
+ (org-index--get-field
+ (if search-link :link :ref))))))
+ (if found
+ (progn
+ (setq message-text (format "Found '%s'" search))
+ (org-index--update-line nil)
+ (org-table-goto-column (org-index--column-num :ref))
+ (if (looking-back " ") (backward-char))
+ ;; remember string to copy
+ (setq org-index--text-to-yank
+ (org-trim (org-table-get-field (org-index--column-num :copy)))))
+ (setq message-text (format "Did not find '%s'" search))
+ (goto-char initial)
+ (forward-line)
+ (setq what 'missed))))
+
+
+ ((eq what 'occur)
+
+ (org-index--do-occur what-input))
+
+
+ ((memq what '(ref link))
+
+ (let (new)
+
+ ;; add a new row (or reuse existing one)
+ (setq new (org-index--do-new-line (eq what 'ref)))
+
+ ;; fill special columns with standard values
+ (when (eq what 'ref)
+ (org-table-goto-column (org-index--column-num :ref))
+ (insert new)
+ (setq org-index--last-ref new))
+ (when (eq what 'link)
+ (org-table-goto-column (org-index--column-num :link))
+ (insert link-id))
+
+ (org-index--align)
+
+ ;; goto point-field or copy-field or first empty one or first field
+ (if (org-index--special-column :point)
+ (org-table-goto-column (org-index--column-num (org-index--special-column :point)))
+ (if (org-index--special-column :copy)
+ (org-table-goto-column (org-index--column-num (org-index--special-column :copy)))
+ (unless (catch 'empty
+ (dotimes (col org-index--numcols)
+ (org-table-goto-column (+ col 1))
+ (if (string= (org-trim (org-table-get-field)) "")
+ (throw 'empty t))))
+ ;; none found, goto first
+ (org-table-goto-column 1))))
+
+ (if org-index--active-region (setq kill-new-text org-index--active-region))
+ (if (eq what 'ref)
+ (setq message-text (format "Adding a new row with ref '%s'" new))
+ (setq message-text (format "Adding a new row linked to '%s'" link-id)))))
+
+
+ ((eq what 'put)
+
+ ;; put latest reference into property
+
+
+ (if org-index--last-ref
+ (progn
+ (org-entry-put (point) "org-index-ref" org-index--last-ref)
+ (message "Reference '%s' has been stored in property org-index-ref" org-index--last-ref))
+ (setq org-index--last-ref
+ (read-from-minibuffer "Reference to be stored in this node: "))
+ (unless org-index--last-ref
+ (message "No reference has been given."))
+ ))
+
+
+ ((eq what 'enter)
+
+ ;; simply go into table
+ (goto-char org-index--below-hline)
+ (show-subtree)
+ (recenter)
+ (if what-adjusted
+ (setq message-text "Nothing to search for; at index table")
+ (setq message-text "At index table")))
+
+
+ ((eq what 'fill)
+
+ ;; check, if within index table
+ (unless (and org-index--within-node
+ (org-at-table-p))
+ (error "Not within index table"))
+
+ ;; applies to missing refs and missing links alike
+ (let ((ref (org-index--get-field :ref))
+ (link (org-index--get-field :link)))
+
+ (if (and (not ref)
+ (not link))
+ ;; have already checked this during parse, check here anyway
+ (error "Columns ref and link are both empty in this line"))
+
+ ;; fill in new ref
+ (if (not ref)
+ (progn
+ (setq kill-new-text (format "%s%d%s" org-index--head (1+ org-index--maxref) org-index--tail))
+ (org-index--get-field :ref kill-new-text)
+ ;; remember for org-mark-ring-goto
+ (setq org-index--text-to-yank kill-new-text)
+ (org-id-goto link)
+ (setq message-text "Filled field of index table with new reference"))
+
+ ;; fill in new link
+ (if (not link)
+ (progn
+ (setq guarded-search (org-index--make-guarded-search ref))
+ (message (format "Scanning headlines for '%s' ..." ref))
+ (let ((search (concat ".*" guarded-search))
+ link)
+ (if (catch 'found
+ (org-map-entries
+ (lambda ()
+ (when (looking-at search)
+ (setq link (org-id-get-create))
+ (throw 'found t)))
+ nil 'agenda)
+ nil)
+
+ (progn
+ (org-index--get-field :link link)
+ (setq message-text "Inserted link"))
+
+ (setq message-text (format "Did not find reference '%s'" ref)))))
+
+ ;; nothing is missing
+ (setq message-text "Columns ref and link are already filled; nothing to do")))))
+
+
+ ((eq what 'sort)
+
+ ;; sort lines according to contained reference
+ (let (begin end where)
+ (catch 'aborted
+ ;; either active region or whole buffer
+ (if (and transient-mark-mode
+ mark-active)
+ ;; sort only region
+ (progn
+ (setq begin (region-beginning))
+ (setq end (region-end))
+ (setq where "region"))
+ ;; sort whole buffer
+ (setq begin (point-min))
+ (setq end (point-max))
+ (setq where "whole buffer")
+ ;; make sure
+ (unless (y-or-n-p "Sort whole buffer ")
+ (setq message-text "Sort aborted")
+ (throw 'aborted nil)))
+
+ (save-excursion
+ (save-restriction
+ (goto-char (point-min))
+ (narrow-to-region begin end)
+ (sort-subr nil 'forward-line 'end-of-line
+ (lambda ()
+ (if (looking-at (concat ".*"
+ (org-index--make-guarded-search org-index--ref-regex 'dont-quote)))
+ (string-to-number (match-string 1))
+ 0))))
+ (highlight-regexp org-index--ref-regex 'isearch)
+ (setq message-text (format "Sorted %s from character %d to %d, %d lines"
+ where begin end
+ (count-lines begin end)))))))
+
+
+ ((eq what 'update)
+
+ ;; simply update line in index table
+ (save-excursion
+ (let ((ref-or-link (if search-link "link" "reference")))
+ (beginning-of-line)
+ (if (org-index--update-line search)
+ (setq message-text (format "Updated %s '%s'" ref-or-link search))
+ (setq message-text (format "Did not find %s '%s'" ref-or-link search))))))
+
+
+ ((memq what '(highlight unhighlight))
+
+ (let ((where "buffer"))
+ (save-excursion
+ (save-restriction
+ (when (and transient-mark-mode
+ mark-active)
+ (narrow-to-region (region-beginning) (region-end))
+ (setq where "region"))
+
+ (if (eq what 'highlight)
+ (progn
+ (highlight-regexp org-index--ref-regex 'isearch)
+ (setq message-text (format "Highlighted references in %s" where)))
+ (unhighlight-regexp org-index--ref-regex)
+ (setq message-text (format "Removed highlights for references in %s" where)))))))
+
+
+ ((memq what '(missing statistics))
+
+ (setq message-text (org-index--do-statistics what)))
+
+
+ (t (error "This is a bug: unmatched case '%s'" what)))
+
+
+ ;; remember what we have done for next time
+ (setq org-index--last-action what)
+
+ ;; tell, what we have done and what can be yanked
+ (if kill-new-text (setq kill-new-text
+ (substring-no-properties kill-new-text)))
+ (if (string= kill-new-text "") (setq kill-new-text nil))
+ (let ((m (concat
+ message-text
+ (if (and message-text kill-new-text)
+ " and r"
+ (if kill-new-text "R" ""))
+ (if kill-new-text (format "eady to yank '%s'" kill-new-text) ""))))
+ (unless (string= m "") (message m)))
+ (if kill-new-text (kill-new kill-new-text))))
+
+
+(defun org-index-new-line (&rest keys-values)
+ "Create a new line within the index table, returning its reference.
+
+The function takes a varying number of arguments pairs; each pair
+is a symbol for an existing column heading followed by its value.
+their values.
+
+Example:
+
+ (org-index-new-line :ref t :x1 \"foo\" :link \"7f480c3e\")
+
+Passing \":ref t\" will make the function create a new reference within the new line.
+
+"
+
+ (let ((org-index--silent t))
+
+ (save-excursion
+ (org-index--retrieve-context)
+ (with-current-buffer org-index--buffer
+ (goto-char org-index--point)
+ (org-index--parse-table)
+
+ ;; check arguments early
+ (let ((kvs keys-values)
+ k v)
+ (while kvs
+ (setq k (car kvs))
+ (setq v (cadr kvs))
+ (if (eq k :ref)
+ (unless (memq v '(t nil))
+ (error "Argument :ref accepts only t or nil"))
+ (if (or (not (symbolp k))
+ (symbolp v))
+ (error "Arguments must be alternation of key and value")))
+ (unless (> (org-index--column-num k) 0)
+ (error "Unknown column or column not defined in table: '%s'" (symbol-name k)))
+ (setq kvs (cddr kvs))))
+
+ (if (and (not (plist-get keys-values :ref))
+ (not (stringp (plist-get keys-values :link))))
+ (error "Need a link when not creating a ref"))
+
+ (let (new)
+ ;; create new line
+ (setq new (org-index--do-new-line (plist-get keys-values :ref)))
+ (plist-put keys-values :ref (or new ""))
+
+ ;; fill columns
+ (let ((kvs keys-values)
+ k v n)
+ (while kvs
+ (setq k (car kvs))
+ (setq v (cadr kvs))
+ (setq n (org-index--column-num k))
+ (org-table-goto-column n)
+ (insert v)
+ (setq kvs (cddr kvs))))
+
+ (org-index--sort)
+ new)))))
+
+
+(defun org-index-get-line (what value)
+ "Retrieve an existing line within the index table by ref or
+link and return its contents as a property list.
+
+The function `plist-get' may be used to retrieve specific values.
+
+Example:
+
+ (plist-get (org-index-get-line \"12\") :count)
+
+retrieves the value of the count-column for reference 12.
+
+"
+ (interactive)
+ (let ((org-index--silent t)
+ found)
+
+ ;; check arguments
+ (unless (memq what '(:ref :link))
+ (error "Argument what can only be :ref or :link"))
+
+ (save-excursion
+ (org-index--retrieve-context)
+ (with-current-buffer org-index--buffer
+ (goto-char org-index--point)
+ (org-index--parse-table)
+
+ (goto-char org-index--below-hline)
+ (while (and (not found)
+ (org-at-table-p))
+ (when (string= (org-index--get-field what)
+ value)
+ (mapc (lambda (x)
+ (if (and (numberp (cdr x))
+ (> (cdr x) 0))
+ (setq found (cons (car x) (cons (or (org-index--get-field (car x)) "") found)))
+ )) (reverse org-index--columns)))
+ (forward-line))
+ found))))
+
+
+(defun org-index--read-what (what)
+ "Find out, what we are supposed to do"
+
+ (let (commands ; currently active set of selectable commands
+ trailing-digits ; any digits, that are are appended to what-input
+ reorder-once ; Column to use for single time sorting
+ what-input) ; Input on what question (need not necessary be "what")
+
+ ;; Set preferred action, that will be the default choice
+ (setq org-index--preferred-command
+ (if org-index--within-node
+ (if (memq org-index--last-action '(ref link))
+ 'leave
+ 'goto)
+ (if org-index--active-region
+ 'ref
+ (if (and org-index--below-cursor (string-match org-index--ref-regex org-index--below-cursor))
+ 'occur
+ nil))))
+
+ ;; Ask user, what to do
+ (if what
+ (setq what-input (symbol-name what))
+ ;; subset of most common commands for initial selection, ie. up to first plus
+ (setq commands (copy-list org-index--commands))
+ (let ((c commands))
+ (while (and c (not (eq (car c) '+)))
+ (setq c (cdr c)))
+ (setcdr c nil))
+
+ (while (let (completions starts-with-plus is-only-plus)
+
+ (setq what-input
+ (org-completing-read
+ "Please choose: "
+ (mapcar 'symbol-name
+ ;; Construct unique list of commands with
+ ;; preferred one at front
+ (delq nil (delete-dups
+ (append
+ (list org-index--preferred-command)
+ (copy-list commands)))))
+ nil nil))
+
+ ;; if input ends in digits, save them away and do completions on head of input
+ ;; this allows input like "h224" to be accepted
+ (when (string-match "^\\([^0-9]+\\)\\([0-9]+\\)\\s *$" what-input)
+ ;; remember digits
+ (setq trailing-digits (string-to-number (match-string 2 what-input)))
+ ;; and use non-digits-part to find match
+ (setq what-input (match-string 1 what-input)))
+
+ ;; if input starts with "+", any command (not only some) may follow
+ ;; this allows input like "+sort" to be accepted
+ (when (and (> (length what-input) 0)
+ (string= (substring what-input 0 1) "+"))
+ ;; make all commands available for selection
+ (setq commands (copy-list org-index--commands))
+ (setq what-input (substring what-input 1))
+ (setq starts-with-plus (> (length what-input) 0))
+ (setq is-only-plus (not starts-with-plus)))
+
+ ;; get list of possible completions for what-input; i.e.
+ ;; all commands, that start with what-input
+ (setq completions (delq nil (mapcar
+ (lambda (x)
+ (let ((where (search what-input (symbol-name x))))
+ (if (and where
+ (= where 0))
+ x
+ nil))) commands)))
+
+ ;; if input starts with "+" and not just "+"
+ (when starts-with-plus
+ ;; use first completion, if unambigously
+ (if (= (length completions) 1)
+ (setq what-input (symbol-name (car completions)))
+ (if completions
+ (error "Input \"+%s\" matches multiple commands: %s"
+ what-input
+ (mapconcat 'symbol-name completions ", "))
+ (error "Input \"+%s\" matches no commands" what-input))))
+
+ ;; if input ends in digits, use first completion, even if ambigous
+ ;; this allows input like "h224" to be accepted
+ (when (and trailing-digits completions)
+ ;; use first match as input, even if ambigously
+ (setq org-index--preferred-command (first completions))
+ (setq what-input (number-to-string trailing-digits)))
+
+ ;; convert to symbol
+ (setq what (intern what-input))
+ (if is-only-plus (setq what '+))
+
+ ;; user is not required to input one of the commands; if
+ ;; not, take the first one and use the original input for
+ ;; next question
+ (if (memq what commands)
+ ;; input matched one element of list, dont need original
+ ;; input any more
+ (setq what-input nil)
+ ;; what-input will be used for next question, use first
+ ;; command for what
+ (setq what (or org-index--preferred-command
+ (first commands)))
+ ;; remove any trailing dot, that user might have added to
+ ;; disambiguate his input
+ (if (and (> (length what-input) 0)
+ (equal (substring what-input -1) "."))
+ ;; but do this only, if dot was really necessary to
+ ;; disambiguate
+ (let ((shortened-what-input (substring what-input 0 -1)))
+ (unless (test-completion shortened-what-input
+ (mapcar 'symbol-name
+ commands))
+ (setq what-input shortened-what-input)))))
+
+ ;; ask for reorder in loop, because we have to ask for
+ ;; what right again
+ (if (eq what 'reorder)
+ (setq reorder-once
+ (intern
+ (org-icompleting-read
+ "Please choose column to reorder index table once: "
+ (mapcar 'symbol-name
+ (append '(:ref :count :first :last)
+ (delq nil (mapcar (lambda (x) (if (> (cdr (assoc x org-index--columns)) 0) x nil))
+ '(:x1 :x2 :x3)))))
+ nil t))))
+
+ ;; maybe ask initial question again
+ (memq what '(reorder +)))))
+ (list what what-input reorder-once)))
+
+
+(defun org-index--get-or-read-search (search what what-input)
+ "Get search string, maybe read from user"
+
+ (let (search-from-table
+ search-from-cursor)
+
+ (unless search
+ ;; Search string can come from several sources:
+ ;; From link or ref columns of table
+ (when org-index--within-node
+ (setq search-from-table (or (org-index--get-field :link)
+ (org-index--get-field :ref))))
+
+ ;; From string below cursor
+ (when (and (not org-index--within-node)
+ org-index--below-cursor
+ (string-match (concat "\\(" org-index--ref-regex "\\)")
+ org-index--below-cursor))
+ (setq search-from-cursor (match-string 1 org-index--below-cursor)))
+
+ ;; Depending on requested action, get search from one of the sources above
+ (cond ((eq what 'goto)
+ (setq search (or what-input search-from-cursor)))
+ ((memq what '(head occur))
+ (setq search (or what-input search-from-table search-from-cursor)))))
+
+
+ ;; If we still do not have a search string, ask user explicitly
+ (unless search
+
+ (if org-index--silent (error "Need to specify search, if silence is required"))
+
+ (unless (eq what 'occur)
+
+ (if what-input
+ (setq search what-input)
+ (setq search (read-from-minibuffer
+ (cond ((eq what 'head)
+ "Text or reference number to search for: ")
+ ((eq what 'goto)
+ "Reference number to search for, or enter \".\" for id of current node: ")
+ ((eq what 'update)
+ "Reference number to update: ")))))
+
+ (if (string-match "^\\s *[0-9]+\\s *$" search)
+ (setq search (format "%s%s%s" org-index--head search org-index--tail)))))
+
+
+ ;; Clean up and examine search string
+ (when search
+ (setq search (org-trim search))
+ (if (string= search "") (setq search nil))
+ (when search
+ (if (string-match "^[0-9]+$" search)
+ (setq search (concat org-index--head search org-index--tail)))))
+
+ ;; Check for special case
+ (when (and (memq what '(head goto))
+ (string= search "."))
+ (setq search (org-id-get)))
+
+ search))
+
+
+(defun org-index--verify-id ()
+
+ ;; Check id
+ (unless org-index-id
+ (setq org-index-id (org-index--create-new-index
+ t
+ (format "No index table has been created yet." org-index-id))))
+
+ ;; Find node
+ (let (marker)
+ (setq marker (org-id-find org-index-id 'marker))
+ (unless marker (setq org-index-id (org-index--create-new-index
+ t
+ (format "Cannot find node with id \"%s\"" org-index-id))))
+ ; Try again with new node
+ (setq marker (org-id-find org-index-id 'marker))
+ (unless marker (error "Could not create node"))
+ (setq org-index--buffer (marker-buffer marker)
+ org-index--point (marker-position marker))
+ (move-marker marker nil)))
+
+
+(defun org-index--retrieve-context ()
+
+ ;; Get the content of the active region or the word under cursor
+ (setq org-index--active-region
+ (if (and transient-mark-mode mark-active)
+ (buffer-substring (region-beginning) (region-end))
+ nil))
+ (setq org-index--below-cursor (thing-at-point 'symbol))
+
+ ;; Find out, if we are within favable or not
+ (setq org-index--within-node (string= (org-id-get) org-index-id))
+
+ ;; Check and remember, if active window contains buffer with index table
+ (if (eq (window-buffer) org-index--buffer)
+ (setq org-index--active-window-index (selected-window)))
+
+ ;; get current position in index-buffer
+ (with-current-buffer org-index--buffer
+ (unless (string= (org-id-get) org-index-id)
+ (unless org-index--point-before
+ (setq org-index--point-before (point))))))
+
+
+(defun org-index--parse-table ()
+
+ (let (ref-field
+ link-field
+ initial-point
+ end-of-heading)
+
+ (with-current-buffer org-index--buffer
+
+ (setq org-index--maxref 0)
+ (setq initial-point (point))
+ (org-index--go-below-hline)
+ (setq org-index--below-hline (point))
+ (beginning-of-line)
+ (setq end-of-heading (point))
+ (while (org-at-table-p) (forward-line -1))
+ (forward-line)
+ (setq org-index--headings (buffer-substring (point) end-of-heading))
+ (goto-char org-index--below-hline)
+
+
+ ;; count columns
+ (org-table-goto-column 100)
+ (setq org-index--numcols (- (org-table-current-column) 1))
+
+ ;; get contents of columns
+ (forward-line -2)
+ (unless (org-at-table-p)
+ (org-index--create-new-index
+ nil
+ "Index table starts with a hline"))
+
+ ;; check for optional line consisting solely of width specifications
+ (beginning-of-line)
+ (if (looking-at "\\s *|\\(\\(\\s *|\\)\\|\\(\\s *<[0-9]+>\\s *|\\)\\)+\\s *$")
+ (forward-line -1))
+ (org-table-goto-column 1)
+
+ (org-index--parse-headings)
+
+ ;; Go beyond end of table
+ (while (org-at-table-p) (forward-line 1))
+
+ ;; Retrieve any decorations around the number within the first nonempty ref-field
+ (goto-char org-index--below-hline)
+ (while (and (org-at-table-p)
+ (not (setq ref-field (org-index--get-field :ref))))
+ (forward-line))
+
+ ;; Some Checking
+ (unless ref-field
+ (org-index--create-new-index
+ nil
+ "Reference column is empty"))
+
+ (unless (string-match "^\\([^0-9]*\\)\\([0-9]+\\)\\([^0-9]*\\)$" ref-field)
+ (org-index--create-new-index
+ nil
+ (format "First reference in index table ('%s') does not contain a number" ref-field)))
+
+
+ ;; These are the decorations used within the first ref of index
+ (setq org-index--head (match-string 1 ref-field))
+ (setq org-index--tail (match-string 3 ref-field))
+ (setq org-index--ref-regex (concat (regexp-quote org-index--head)
+ "\\([0-9]+\\)"
+ (regexp-quote org-index--tail)))
+ (setq org-index--ref-format (concat org-index--head "%d" org-index--tail))
+
+
+ ;; Go through table to find maximum number and do some checking
+ (let ((ref 0))
+
+ (while (org-at-table-p)
+
+ (setq ref-field (org-index--get-field :ref))
+ (setq link-field (org-index--get-field :link))
+
+ (when (and (not ref-field)
+ (not link-field))
+ (org-pop-to-buffer-same-window org-index--buffer)
+ (org-reveal)
+ (error "Columns ref and link are both empty in this line"))
+
+ (if ref-field
+ (if (string-match org-index--ref-regex ref-field)
+ ;; grab number
+ (setq ref (string-to-number (match-string 1 ref-field)))
+ (org-pop-to-buffer-same-window org-index--buffer)
+ (org-reveal)
+ (error "Column ref does not contain a number")))
+
+ ;; check, if higher ref
+ (if (> ref org-index--maxref) (setq org-index--maxref ref))
+
+ ;; check if ref is ment for reuse
+ (if (string= (org-index--get-field :count) ":reuse:")
+ (setq org-index--has-reuse t))
+
+ (forward-line 1)))
+
+ ;; go back to initial position
+ (goto-char initial-point))))
+
+
+(defun org-index--sort (&optional sort-column)
+
+ (unless sort-column (setq sort-column (org-index--special-column :sort)))
+
+ (let (top
+ bottom
+ ref-field
+ count-field
+ count-special)
+
+ (unless buffer-read-only
+
+ ;; get boundaries of table
+ (goto-char org-index--below-hline)
+ (forward-line 0)
+ (setq top (point))
+ (while (org-at-table-p) (forward-line))
+
+ ;; Kill all empty rows at bottom
+ (while (progn
+ (forward-line -1)
+ (org-table-goto-column 1)
+ (and
+ (not (org-index--get-field :ref))
+ (not (org-index--get-field :link))))
+ (org-table-kill-row))
+ (forward-line 1)
+ (setq bottom (point))
+
+ (save-restriction
+ (narrow-to-region top bottom)
+ (goto-char top)
+ (sort-subr t
+ 'forward-line
+ 'end-of-line
+ (lambda ()
+ (let (ref
+ (ref-field (or (org-index--get-field :ref) ""))
+ (count-field (or (org-index--get-field :count) ""))
+ (count-special 0))
+
+ ;; get reference with leading zeroes, so it can be
+ ;; sorted as text
+ (string-match org-index--ref-regex ref-field)
+ (setq ref (format
+ "%06d"
+ (string-to-number
+ (or (match-string 1 ref-field)
+ "0"))))
+
+ ;; find out, if special token in count-column
+ (setq count-special (format "%d"
+ (- 2
+ (length (member count-field '(":missing:" ":reuse:"))))))
+
+ ;; Construct different sort-keys according to
+ ;; requested sort column; prepend count-special to
+ ;; sort special entries at bottom of table, append ref
+ ;; as a secondary sort key
+ (cond
+
+ ((eq sort-column :count)
+ (concat count-special
+ (format
+ "%08d"
+ (string-to-number (or (org-index--get-field :count)
+ "")))
+ ref))
+
+ ((eq sort-column :ref)
+ (concat count-special
+ ref))
+
+ ((memq sort-column '(:last :x1 :x2 :x3))
+ (concat count-special
+ (org-index--get-field sort-column)
+ " "
+ ref))
+
+ (t (error "This is a bug: unmatched case '%s'" sort-column)))))
+
+ nil 'string<))
+
+ ;; sorting has moved point below hline
+ (org-index--go-below-hline)
+ (setq org-index--below-hline (point)))))
+
+
+(defun org-index--go-below-hline ()
+
+ (goto-char org-index--point)
+ ;; go to heading of node
+ (while (not (org-at-heading-p)) (forward-line -1))
+ (forward-line 1)
+ ;; go to table within node, but make sure we do not get into another node
+ (while (and (not (org-at-heading-p))
+ (not (org-at-table-p))
+ (not (eq (point) (point-max))))
+ (forward-line 1))
+
+ ;; check, if there really is a table
+ (unless (org-at-table-p)
+ (org-index--create-new-index
+ t
+ (format "Cannot find index table within node %s" org-index-id)))
+
+ ;; go to first hline
+ (while (and (not (org-at-table-hline-p))
+ (org-at-table-p))
+ (forward-line 1))
+
+ ;; and check
+ (unless (org-at-table-hline-p)
+ (org-index--create-new-index
+ nil
+ "Cannot find hline within index table"))
+
+ (forward-line 1)
+ (org-table-goto-column 1))
+
+
+(defun org-index--align ()
+ (unless buffer-read-only (org-table-align))
+ (org-index--go-below-hline)
+ (setq org-index--below-hline (point)))
+
+
+(defun org-index--parse-headings ()
+
+ ;; Associate names of special columns with column-numbers
+ (setq org-index--columns (copy-tree '((:ref . 0) (:link . 0) (:first . 0) (:last . 0)
+ (:count . 0) (:x1 . 0) (:x2 . 0) (:x3 . 0))))
+
+ ;; Associate names of special columns with names of columns
+ (setq org-index--special-columns (copy-tree '((:sort . nil) (:copy . nil) (:point . nil))))
+
+ ;; For each column
+ (dotimes (col org-index--numcols)
+ (let* (field-flags ;; raw heading, consisting of file name and maybe
+ ;; flags (seperated by ";")
+ field ;; field name only
+ field-symbol ;; and as a symbol
+ flags ;; flags from field-flags
+ found)
+
+ ;; parse field-flags into field and flags
+ (setq field-flags (org-trim (org-table-get-field (+ col 1))))
+ (if (string-match "^\\([^;]*\\);\\([a-z]+\\)$" field-flags)
+ (progn
+ (setq field (downcase (or (match-string 1 field-flags) "")))
+ ;; get flags as list of characters
+ (setq flags (mapcar 'string-to-char
+ (split-string
+ (downcase (match-string 2 field-flags))
+ "" t))))
+ ;; no flags
+ (setq field field-flags))
+
+ (unless (string= field "") (setq field-symbol (intern (concat ":" (downcase field)))))
+ ;; aliases for backward compatability
+ (if (eq field-symbol :last-accessed) (setq field-symbol :last))
+ (if (eq field-symbol :created) (setq field-symbol :first))
+
+ (if (and field-symbol
+ (not (assoc field-symbol org-index--columns)))
+ (error "Column %s is not a valid heading" (symbol-name field-symbol)))
+
+ ;; Check, that no flags appear twice
+ (mapc (lambda (x)
+ (when (memq (car x) flags)
+ (if (cdr (assoc (cdr x) org-index--columns))
+ (org-index--create-new-index
+ nil
+ (format "More than one heading is marked with flag '%c'" (car x))))))
+ '((?s . sort)
+ (?c . copy)))
+
+ ;; Process flags
+ (if (memq ?s flags)
+ (setcdr (assoc :sort org-index--special-columns) (or field-symbol (+ col 1))))
+ (if (memq ?c flags)
+ (setcdr (assoc :copy org-index--special-columns) (or field-symbol (+ col 1))))
+ (if (memq ?p flags)
+ (setcdr (assoc :point org-index--special-columns) (or field-symbol (+ col 1))))
+
+ ;; Store columns in alist
+ (setq found (assoc field-symbol org-index--columns))
+ (when found
+ (if (> (cdr found) 0)
+ (org-index--create-new-index
+ nil
+ (format "'%s' appears two times as column heading" (downcase field))))
+ (setcdr found (+ col 1)))))
+
+ ;; check if all necessary informations have been specified
+ (mapc (lambda (col)
+ (unless (> (cdr (assoc col org-index--columns)) 0)
+ (org-index--create-new-index
+ nil
+ (format "column '%s' has not been set" col))))
+ (list :ref :link :count :first :last))
+
+ ;; use count as a default sort-column
+ (unless (cdr (assoc :sort org-index--special-columns))
+ (setcdr (assoc :sort org-index--special-columns) :count)))
+
+
+(defun org-index--create-new-index (create-new-index reason)
+ "Create a new empty index table with detailed explanation."
+ (let (prompt buffer-name title firstref id)
+
+ ;; cannot proceed without querying user
+ (if org-index--silent (error "No valid index: %s" reason))
+
+ (setq prompt
+ (if create-new-index
+ (concat "There is this problem with the existing index table:\n\n " reason "\n\nThis assistant will guide you to create a new one.\n\nDo you want to proceed ?")
+ (concat "The existing index table contains this error:\n\n " reason "\n\nYou need to correct this error manually before trying again. However, this assistant will help you to create an new initial index table with detailed comments, so that you may fix the errors in your existing table more easily.\n\nDo you want to proceed ?")))
+ (unless (y-or-n-p prompt)
+ (error "Cannot proceed without a valid index table: %s" reason))
+
+ (setq buffer-name (org-completing-read "Please choose the buffer, where the new node for the index table should be created; the new node will be inserted at its end.\n\nBuffer: " (mapcar 'buffer-name (org-buffer-list)) nil nil))
+
+ (setq title (read-from-minibuffer "Please enter the title of the index node: "))
+
+ (while (progn
+ (setq firstref (read-from-minibuffer "Please enter your first reference-number. This is a number preceeded by some non-digit chars and optionally followed by some more non-digit chars, e.g. 'R1', '-1-' or '#1#' (and your initial number does not need to be '1'). The format of your reference-numbers only needs to make sense for yourself, so that you can spot it easily in your texts or write it on a piece of paper; it should however not already appear to frequently within your existing notes, to avoid too many false hits when searching.\n\nPlease choose: "))
+ (let (desc)
+ (unless (equal '(95 119) (sort (delete-dups (mapcar (lambda (x) (char-syntax x)) (concat "-1" firstref))) '<))
+ (setq desc "Contains other characters than those allowed in symbols"))
+ (unless (string-match "^[^0-9]+[0-9]+[^0-9]*$" firstref)
+ ;; firstref not okay, report details
+ (setq desc
+ (cond ((string= firstref "") "is empty")
+ ((not (string-match "^[^0-9]+" firstref)) "starts with a digit")
+ ((not (string-match "^[^0-9]+[0-9]+" firstref)) "does not contain a number")
+ ((not (string-match "^[^0-9]+[0-9]+[^0-9]*$" firstref)) "contains more than one sequence of digits")
+
+ )))
+ (if desc
+ (progn
+ (read-from-minibuffer (format "Your input '%s' does not meet the requirements because it %s. Please hit RET and try again" firstref desc))
+ t)
+ nil))))
+
+ (with-current-buffer buffer-name
+ (goto-char (point-max))
+ (insert (format "\n\n* %s %s\n" firstref title))
+ (insert "\n\n Below you find your initial index table, which will grow over time.\n"
+ " Following that your may read its detailed explanation, which will help you,\n"
+ " to adjust org-index to your needs. This however is optional reading and not\n"
+ " required to start using org-index.\n")
+
+ (setq id (org-id-get-create))
+ (insert (format "
+
+ | | | | | | comment |
+ | ref | link | first | count;s | last | ;c |
+ | | <4> | | | | |
+ |-----+------+-------+---------+------+---------|
+ | %s | %s | %s | | | %s |
+
+"
+ firstref
+ id
+ (with-temp-buffer (org-insert-time-stamp nil nil t))
+ "This node"))
+
+
+ (insert "
+
+ Detailed explanation:
+
+
+ The index table above has three lines of headings above the first
+ hline:
+
+ - The first one is ignored by org-index, and you can use it to
+ give meaningful names to columns. In the table above only one
+ column has a name (\"comment\"). This line is optional.
+
+ - The second line is the most important one, because it
+ contains the configuration information for org-index; please
+ read further below for its format.
+
+ - The third line is again optional; it may only specify the
+ widths of the individual columns (e.g. <4>).
+
+ The columns get their meaning by the second line of headings;
+ specifically by one of the keywords (e.g. \"ref\") or a flag
+ seperated by a semicolon (e.g. \";s\").
+
+
+
+ The keywords and flags are:
+
+
+ - ref: This contains the reference, which consists of a decorated
+ number, which is incremented for each new line. References are
+ meant to be used in org-mode headlines or outside of org,
+ e.g. within folder names.
+
+ - link: org-mode link pointing to the matching location within org.
+
+ - first: When has this line been first accessed (i.e. created) ?
+
+ - count: How many times has this line been accessed ? The
+ trailing flag \"s\" makes the table beeing sorted after this
+ column this column, so that often used entries appear at the
+ top of the table.
+
+ - last: When has this line been accessed last ?
+
+ - The last column above has no keyword, only the flag \"c\",
+ which makes its content beeing copied under certain
+ conditions. It is typically used for comments.
+
+ The sequence of columns does not matter. You may reorder them any
+ way you like. Columns are found by their name, which appears in
+ the second line of headings.
+
+ You can add further columns or even remove the last column. All
+ other columns are required.
+
+
+ Finally: This node needs not be a top level node; its name is
+ completely at you choice; it is found through its ID only.
+
+")
+
+
+ (while (not (org-at-table-p)) (forward-line -1))
+ (unless buffer-read-only (org-table-align))
+ (while (not (org-at-heading-p)) (forward-line -1))
+
+ ;; present results to user
+ (if create-new-index
+ (progn
+ ;; Only show the new index
+ (org-pop-to-buffer-same-window buffer-name)
+ (delete-other-windows)
+ (org-id-goto id)
+ (org-show-context)
+ (show-subtree)
+ (recenter 1)
+ (if (y-or-n-p "This is your new index table; Do you want to save its id to make it permanent ? ")
+ (progn
+ (customize-save-variable 'org-index-id id)
+ (message "Saved org-index-id '%s' to %s" org-index-id custom-file))
+ (let (sq)
+ (setq sq (format "(setq org-index-id \"%s\")" org-index-id))
+ (kill-new sq)
+ (message "Did not make the id of the new index permamanent; you may want to put\n\n %s\n\ninto your own initialization; it is copied already, just yank it." sq))
+ id))
+ ;; we had an error with the existing index table, so present old
+ ;; and new one together
+ ;; show existing index
+ (org-pop-to-buffer-same-window org-index--buffer)
+ (goto-char org-index--point)
+ (org-show-context)
+ (show-subtree)
+ (recenter 1)
+ (delete-other-windows)
+ ;; show new index
+ (select-window (split-window-vertically))
+ (org-pop-to-buffer-same-window buffer-name)
+ (org-id-goto id)
+ (org-show-context)
+ (show-subtree)
+ (recenter 1)
+ (error "Please compare your existing index (upper window) and a temporary new one (lower window) to correct the previous error (\"%s\"); the explanations following the new index table should help." reason)))))
+
+
+(defun org-index--update-line (ref-or-link)
+
+ (let (initial
+ found
+ count-field)
+
+ (with-current-buffer org-index--buffer
+ (unless buffer-read-only
+
+ ;; search reference or link, if given (or assume, that we are already positioned right)
+ (when ref-or-link
+ (setq initial (point))
+ (goto-char org-index--below-hline)
+ (while (and (org-at-table-p)
+ (not (or (string= ref-or-link (org-index--get-field :ref))
+ (string= ref-or-link (org-index--get-field :link)))))
+ (forward-line)))
+
+ (if (not (org-at-table-p))
+ (error "Did not find reference or link '%s'" ref-or-link)
+ (setq count-field (org-index--get-field :count))
+
+ ;; update count field only if number or empty; leave :missing: and :reuse: as is
+ (if (or (not count-field)
+ (string-match "^[0-9]+$" count-field))
+ (org-index--get-field :count
+ (number-to-string
+ (+ 1 (string-to-number (or count-field "0"))))))
+
+ ;; update timestamp
+ (org-table-goto-column (org-index--column-num :last))
+ (org-table-blank-field)
+ (org-insert-time-stamp nil t t)
+
+ (setq found t))
+
+ (if initial (goto-char initial))
+
+ found))))
+
+
+(defun org-index--get-field (key &optional value)
+ (let (field)
+ (setq field (org-trim (org-table-get-field (cdr (assoc key org-index--columns)) value)))
+ (if (string= field "") (setq field nil))
+
+ (org-no-properties field)))
+
+
+(defun org-index--column-num (key)
+ (if (numberp key)
+ key
+ (cdr (assoc key org-index--columns))))
+
+
+(defun org-index--special-column (key)
+ (cdr (assoc key org-index--special-columns)))
+
+
+(defun org-index--make-guarded-search (ref &optional dont-quote)
+ (concat "\\_<" (if dont-quote ref (regexp-quote ref)) "\\_>"))
+
+
+(defun org-index--do-statistics (what)
+ (let ((total 0)
+ missing
+ ref-field
+ ref
+ min
+ max
+ message-text)
+
+
+ ;; start with list of all references
+ (setq missing (mapcar (lambda (x) (format "%s%d%s" org-index--head x org-index--tail))
+ (number-sequence 1 org-index--maxref)))
+
+ ;; go through table and remove all refs, that we see
+ (goto-char org-index--below-hline)
+ (while (org-at-table-p)
+
+ ;; get ref-field and number
+ (setq ref-field (org-index--get-field :ref))
+ (if (and ref-field
+ (string-match org-index--ref-regex ref-field))
+ (setq ref (string-to-number (match-string 1 ref-field))))
+
+ ;; remove existing refs from list
+ (if ref-field (setq missing (delete ref-field missing)))
+
+ ;; record min and max
+ (if (or (not min) (< ref min)) (setq min ref))
+ (if (or (not max) (> ref max)) (setq max ref))
+
+ ;; count
+ (setq total (1+ total))
+
+ (forward-line))
+
+ ;; insert them, if requested
+ (forward-line -1)
+ (if (eq what 'statistics)
+
+ (setq message-text (format "Found %d references from %s to %s. %d references below highest do not appear in table. "
+ total
+ (format org-index--ref-format min)
+ (format org-index--ref-format max)
+ (length missing)))
+
+ (if (y-or-n-p (format "Found %d missing references; do you wish to append them to the index table"
+ (length missing)))
+ (let (type)
+ (setq type (org-icompleting-read
+ "Insert new lines for reuse by command \"new\" or just as missing ? " '("reuse" "missing")))
+ (mapc (lambda (x)
+ (let (org-table-may-need-update) (org-table-insert-row t))
+ (org-index--get-field :ref x)
+ (org-index--get-field :count (format ":%s:" type)))
+ missing)
+ (org-index--align)
+
+ (setq message-text (format "Inserted %d new lines for missing refernces" (length missing))))
+ (setq message-text (format "%d missing references." (length missing)))))
+ message-text))
+
+
+(defun org-index--do-head (ref link &optional other)
+
+ (if ref (setq org-index--last-ref ref))
+
+ (let (message-text)
+ ;; Use link if available
+ (if link
+ (progn
+ (org-index--update-line link)
+ (org-id-goto link)
+ (org-reveal)
+ (if (eq (current-buffer) org-index--buffer)
+ (setq org-index--point-before nil))
+ (setq message-text "Followed link"))
+
+ (message (format "Scanning headlines for '%s' ..." ref))
+ (org-index--update-line ref)
+ (let ((search (concat ".*" (org-index--make-guarded-search ref)))
+ (org-trust-scanner-tags t)
+ buffer point)
+ (if (catch 'found
+ (progn
+ ;; loop over all headlines, stop on first match
+ (org-map-entries
+ (lambda ()
+ (when (or (looking-at search)
+ (eq ref (org-entry-get (point) "org-index-ref")))
+ ;; If this is not an inlinetask ...
+ (when (< (org-element-property :level (org-element-at-point))
+ org-inlinetask-min-level)
+ ;; ... remember location and bail out
+ (setq buffer (current-buffer))
+ (setq point (point))
+ (throw 'found t))))
+ nil 'agenda)
+ nil))
+
+ (progn
+ (if (eq buffer org-index--buffer)
+ (setq org-index--point-before nil))
+ (setq message-text (format "Found '%s'" (or ref link)))
+ (if other
+ (progn
+ (pop-to-buffer buffer)
+ (goto-char point)
+ (org-reveal t)
+ (recenter)
+ (pop-to-buffer "*org-index-occur*"))
+ (org-pop-to-buffer-same-window buffer)
+ (goto-char point)
+ (org-reveal t)
+ (recenter)))
+ (setq message-text (format "Did not find '%s'" (or ref link))))))
+ message-text))
+
+
+(defun org-index--do-occur (initial-search)
+ (let ((occur-buffer-name "*org-index-occur*")
+ (word "") ; last word to search for growing and shrinking on keystrokes
+ (prompt "Search for: ")
+ (hint "")
+ words ; list of other words that must match too
+ occur-buffer
+ lines-to-show ; number of lines to show in window
+ start-of-lines ; position, where lines begin
+ start-of-help ; start of displayed help (if any)
+ left-off-at ; stack of last positions in index table
+ after-inserted ; in occur-buffer
+ at-end ; in occur-buffer
+ lines-visible ; in occur-buffer
+ below-hline-bol ; below-hline and at bol
+ exit-gracefully ; true if normal exit
+ in-c-backspace ; true while processing C-backspace
+ show-headings ; true, if headings should be shown
+ fun-on-ret ; function to be executed, if return is pressed
+ fun-on-tab ; function to be executed, if letter TAB is pressed
+ ret from to key)
+
+ ;; clear buffer
+ (if (get-buffer "*org-index-occur*")
+ (kill-buffer occur-buffer-name))
+ (setq occur-buffer (get-buffer-create "*org-index-occur*"))
+
+ ;; install keyboard-shortcuts within occur-buffer
+ (with-current-buffer occur-buffer
+ (let ((keymap (make-sparse-keymap)))
+
+ (set-keymap-parent keymap org-mode-map)
+ (setq fun-on-ret (lambda () (interactive) (org-index--occur-find-heading nil)))
+ (define-key keymap (kbd "RET") fun-on-ret)
+ (setq fun-on-tab (lambda () (interactive)
+ (org-index--occur-find-heading t)
+ (setq org-index--occur-follow-mode (not org-index--occur-follow-mode))))
+ (define-key keymap (kbd "<tab>") fun-on-tab)
+ (define-key keymap [(control ?i)] fun-on-tab)
+ (define-key keymap (kbd "<up>") (lambda () (interactive)
+ (forward-line -1)
+ (if org-index--occur-follow-mode (org-index--occur-find-heading t))))
+ (define-key keymap (kbd "<down>") (lambda () (interactive)
+ (forward-line 1)
+ (if org-index--occur-follow-mode (org-index--occur-find-heading t))))
+ (use-local-map keymap)))
+
+ (with-current-buffer org-index--buffer
+ (let ((initial (point)))
+ (goto-char org-index--below-hline)
+ (forward-line 0)
+ (setq below-hline-bol (point))
+ (goto-char initial)))
+
+ (org-pop-to-buffer-same-window occur-buffer)
+ (toggle-truncate-lines 1)
+
+ (unwind-protect ; to reset cursor-shape even in case of errors
+ (progn
+
+ ;; fill in header
+ (erase-buffer)
+ (insert (concat "Incremental search, showing one window of matches. '?' toggles help.\n\n"))
+ (setq start-of-lines (point))
+ (setq start-of-help start-of-lines)
+ (setq cursor-type 'hollow)
+
+ ;; get window size of occur-buffer as number of lines to be searched
+ (setq lines-to-show (+ (- (window-body-height) (line-number-at-pos)) 1))
+
+
+ ;; fill initially
+ (setq ret (org-index--get-matching-lines nil lines-to-show below-hline-bol))
+ (when (nth 0 ret)
+ (insert (nth 1 ret))
+ (setq left-off-at (cons (nth 0 ret) nil))
+ (setq after-inserted (cons (point) nil)))
+
+ ;; read keys
+ (while
+ (progn
+ (goto-char start-of-lines)
+ (setq lines-visible 0)
+
+ ;; use initial-search (if present) to simulate keyboard input
+ (if (and initial-search
+ (> (length initial-search) 0))
+ (progn
+ (setq key (string-to-char (substring initial-search 0 1)))
+ (if (length initial-search)
+ (setq initial-search (substring initial-search 1))))
+ (if in-c-backspace
+ (setq key 'backspace)
+ (let ((search-text (mapconcat 'identity (reverse (cons word words)) ",")))
+ (setq key (read-key
+ (format "%s%s%s%s"
+ prompt
+ search-text
+ (if (string= search-text "") "" " ")
+ hint))))
+ (setq hint "")
+ (setq exit-gracefully (member key (list 'up 'down 'left 'right 'RET ?\C-g ?\C-m 'C-return ?\C-i 'TAB)))))
+
+ (not exit-gracefully))
+
+ (cond
+
+ ((eq key 'C-backspace)
+
+ (setq in-c-backspace t))
+
+ ((member key (list 'backspace 'deletechar ?\C-?)) ; erase last char
+
+ (if (= (length word) 0)
+
+ ;; nothing more to delete from current word; try next
+ (progn
+ (setq word (car words))
+ (setq words (cdr words))
+ (setq in-c-backspace nil))
+
+ ;; unhighlight longer match
+ (let ((case-fold-search t))
+ (unhighlight-regexp (regexp-quote word)))
+
+ ;; some chars are left; shorten word
+ (setq word (substring word 0 -1))
+ (when (= (length word) 0) ; when nothing left, use next word from list
+ (setq word (car words))
+ (setq words (cdr words))
+ (setq in-c-backspace nil))
+
+ ;; remove everything, that has been added for char just deleted
+ (when (cdr after-inserted)
+ (setq after-inserted (cdr after-inserted))
+ (goto-char (car after-inserted))
+ (delete-region (point) (point-max)))
+
+ ;; back up last position in index table too
+ (when (cdr left-off-at)
+ (setq left-off-at (cdr left-off-at)))
+
+ ;; go through buffer and check, if any invisible line should now be shown
+ (goto-char start-of-lines)
+ (while (< (point) (point-max))
+ (if (outline-invisible-p)
+ (progn
+ (setq from (line-beginning-position)
+ to (line-beginning-position 2))
+
+ ;; check for matches
+ (when (org-index--test-words (cons word words) (buffer-substring from to))
+ (when (<= lines-visible lines-to-show) ; show, if more lines required
+ (outline-flag-region from to nil)
+ (incf lines-visible))))
+
+ ;; already visible, just count
+ (incf lines-visible))
+
+ (forward-line 1))
+
+ ;; highlight shorter word
+ (unless (= (length word) 0)
+ (let ((case-fold-search t))
+ (highlight-regexp (regexp-quote word) 'isearch)))))
+
+
+ ((member key (list ?\s ?,)) ; space or comma: enter an additional search word
+
+ ;; push current word and clear, no need to change display
+ (setq words (cons word words))
+ (setq word ""))
+
+
+ ((eq key ??) ; tab: toggle display of headlines and help
+ (setq show-headings (not show-headings))
+ (goto-char start-of-lines)
+ (if show-headings
+ (progn
+ (forward-line -1)
+ (kill-line)
+ (setq start-of-help (point))
+ (if (display-graphic-p)
+ (insert "<backspace> and <c-backspace> erase, cursor keys move. RET finds node, C-RET all matches.\nTAB finds in other window. Comma seperates words, any other key adds to search word.\n\n")
+ (insert "BACKSPACE to erase, to finish. Then cursor keys and RET to find node.\n\n"))
+ (insert org-index--headings))
+ (delete-region start-of-help start-of-lines)
+ (insert "\n"))
+ (setq start-of-lines (point)))
+
+
+ ((and (integerp key)
+ (aref printable-chars key)) ; any printable char: add to current search word
+
+ ;; unhighlight short word
+ (unless (= (length word) 0)
+ (let ((case-fold-search t))
+ (unhighlight-regexp (regexp-quote word))))
+
+ ;; add to word
+ (setq word (concat word (char-to-string key)))
+
+ ;; hide lines, that do not match longer word any more
+ (while (< (point) (point-max))
+ (unless (outline-invisible-p)
+ (setq from (line-beginning-position)
+ to (line-beginning-position 2))
+
+ ;; check for matches
+ (if (org-index--test-words (list word) (buffer-substring from to))
+ (incf lines-visible) ; count as visible
+ (outline-flag-region from to t))) ; hide
+
+ (forward-line 1))
+
+ ;; duplicate top of stacks; eventually overwritten below
+ (setq left-off-at (cons (car left-off-at) left-off-at))
+ (setq after-inserted (cons (car after-inserted) after-inserted))
+
+ ;; get new lines from index table
+ (when (< lines-visible lines-to-show)
+ (setq ret (org-index--get-matching-lines (cons word words)
+ (- lines-to-show lines-visible)
+ (car left-off-at)))
+
+ (when (nth 0 ret)
+ (insert (nth 1 ret))
+ (setq at-end (nth 2 ret))
+ (setcar left-off-at (nth 0 ret))
+ (setcar after-inserted (point))))
+
+ ;; highlight longer word
+ (let ((case-fold-search t))
+ (highlight-regexp (regexp-quote word) 'isearch)))
+
+
+ (t ; non-printable chars
+ (setq hint (format "(cannot search for key '%s', use %s to quit)"
+ (if (symbolp key)
+ key
+ (key-description (char-to-string key)))
+ (substitute-command-keys "\\[keyboard-quit]"))))))
+
+ ;; search is done collect and brush up results
+ ;; remove any lines, that are still invisible
+ (goto-char start-of-lines)
+ (while (< (point) (point-max))
+ (if (outline-invisible-p)
+ (delete-region (line-beginning-position) (line-beginning-position 2))
+ (forward-line 1)))
+
+ ;; get all the rest
+ (when (eq key (kbd "<c-return>"))
+ (message "Getting all matches ...")
+ (setq ret (org-index--get-matching-lines (cons word words) 0 (car left-off-at)))
+ (message "done.")
+ (insert (nth 1 ret))))
+
+ ;; postprocessing even for non graceful exit
+ (setq cursor-type t)
+ ;; replace previous heading
+ (let ((numlines (count-lines (point) start-of-lines)))
+ (goto-char start-of-lines)
+ (delete-region (point-min) (point))
+ (insert (format (concat (if exit-gracefully "Search is done;" "Search aborted;")
+ (if (or at-end (eq key 'C-return))
+ " showing all %d matches."
+ " showing only some matches.")
+ " Use cursor keys to move, press RET or TAB to find node.\n\n")
+ numlines))
+ (if show-headings (insert "\n\n" org-index--headings)))
+ (forward-line))
+
+ (setq buffer-read-only t)
+
+ ;; perform action according to last char
+ (forward-line -1)
+ (cond
+
+ ((member key (list 'RET ?\C-m))
+ (funcall fun-on-ret))
+
+ ((member key (list 'TAB ?\C-i))
+ (funcall fun-on-tab))
+
+ ((eq key 'up)
+ (forward-line -1))
+
+ ((eq key 'down)
+ (forward-line 1))
+
+ ((eq key 'left)
+ (forward-char -1))
+
+ ((eq key 'right)
+ (forward-char 1)))))
+
+(defun org-index--occur-find-heading (x)
+ "helper for keymap of occur"
+ (interactive)
+ (save-excursion
+ (let ((ref (org-index--get-field :ref))
+ (link (org-index--get-field :link)))
+ (message (org-index--do-head ref link x)))))
+
+
+(defun org-index--do-new-line (create-ref)
+ "Do the common work for org-index-new-line and org-index"
+
+ (let (new)
+
+ (when create-ref
+ ;; go through table to find first entry to be reused
+ (when org-index--has-reuse
+ (goto-char org-index--below-hline)
+ ;; go through table
+ (while (and (org-at-table-p)
+ (not new))
+ (when (string=
+ (org-index--get-field :count)
+ ":reuse:")
+ (setq new (org-index--get-field :ref))
+ (if new (org-table-kill-row)))
+ (forward-line)))
+
+ ;; no ref to reuse; construct new reference
+ (unless new
+ (setq new (format "%s%d%s" org-index--head (1+ org-index--maxref) org-index--tail)))
+
+ ;; remember for org-mark-ring-goto
+ (setq org-index--text-to-yank new))
+
+ ;; insert ref or link as very first row
+ (goto-char org-index--below-hline)
+ (org-table-insert-row)
+
+ ;; insert some of the standard values
+ (org-table-goto-column (org-index--column-num :first))
+ (org-insert-time-stamp nil nil t)
+ (org-table-goto-column (org-index--column-num :count))
+ (insert "1")
+
+ new))
+
+
+(defun org-index--get-matching-lines (words numlines start-from)
+ (let ((numfound 0)
+ pos
+ initial line lines at-end)
+
+ (with-current-buffer org-index--buffer
+
+ ;; remember initial pos and start at requested
+ (setq initial (point))
+ (goto-char start-from)
+
+ ;; loop over buffer until we have found enough lines
+ (while (and (or (< numfound numlines)
+ (= numlines 0))
+ (org-at-table-p))
+
+ ;; check each word
+ (setq line (buffer-substring (line-beginning-position) (line-beginning-position 2)))
+ (when (org-index--test-words words line)
+ (setq lines (concat lines line))
+ (incf numfound))
+ (forward-line 1)
+ (setq pos (point)))
+
+ (setq at-end (not (org-at-table-p)))
+
+ ;; return to initial position
+ (goto-char initial))
+
+ (unless lines (setq lines ""))
+ (list pos lines at-end)))
+
+
+(defun org-index--test-words (words line)
+ (let ((found-all t))
+ (setq line (downcase line))
+ (catch 'not-found
+ (dolist (w words)
+ (or (search w line)
+ (throw 'not-found nil)))
+ t)))
+
+
+(defun org-index--dump-variables ()
+ "Dump variables of org-index; mostly for debugging"
+ (interactive)
+ "Dump all variables of org-index for debugging"
+ (let ((buff (get-buffer-create "*org-index-dump-variables*"))
+ (maxlen 0)
+ vars name value)
+
+ (with-current-buffer buff
+ (erase-buffer)
+ (mapatoms (lambda (s) (when (and (boundp s)
+ (string-prefix-p "org-index-" (symbol-name s)))
+
+ (setq name (symbol-name s))
+ (setq value (symbol-value s))
+ (setq vars (cons (cons name value) vars))
+ (if (> (length name) maxlen)
+ (setq maxlen (length name))))))
+ (setq vars (sort vars (lambda (x y) (string< (car x) (car y)))))
+ (mapc (lambda (x) (insert (format (format "%%-%ds: %%s\n" (+ maxlen 1)) (car x) (cdr x))))
+ vars)
+ (pop-to-buffer buff))))
+
+
+(defadvice org-mark-ring-goto (after org-index--advice-text-to-yank activate)
+ "Make text from org-index available for yank."
+ (when org-index--text-to-yank
+ (kill-new org-index--text-to-yank)
+ (message (format "Ready to yank '%s'" org-index--text-to-yank))
+ (setq org-index--text-to-yank nil)))
+
+
+(provide 'org-index)
+
+;; Local Variables:
+;; fill-column: 75
+;; comment-column: 50
+;; End:
+
+;;; org-index.el ends here
+
diff --git a/contrib/lisp/org-interactive-query.el b/contrib/lisp/org-interactive-query.el
index 57665e2..644132c 100644
--- a/contrib/lisp/org-interactive-query.el
+++ b/contrib/lisp/org-interactive-query.el
@@ -1,6 +1,6 @@
;;; org-interactive-query.el --- Interactive modification of agenda query
;;
-;; Copyright 2007-2013 Free Software Foundation, Inc.
+;; Copyright 2007-2014 Free Software Foundation, Inc.
;;
;; Author: Christopher League <league at contrapunctus dot net>
;; Version: 1.0
diff --git a/contrib/lisp/org-invoice.el b/contrib/lisp/org-invoice.el
index 88ff48f..c1340a7 100644
--- a/contrib/lisp/org-invoice.el
+++ b/contrib/lisp/org-invoice.el
@@ -1,6 +1,6 @@
;;; org-invoice.el --- Help manage client invoices in OrgMode
;;
-;; Copyright (C) 2008-2013 pmade inc. (Peter Jones pjones@pmade.com)
+;; Copyright (C) 2008-2014 pmade inc. (Peter Jones pjones@pmade.com)
;;
;; This file is not part of GNU Emacs.
;;
diff --git a/contrib/lisp/org-jira.el b/contrib/lisp/org-jira.el
index 57128fb..43edd08 100644
--- a/contrib/lisp/org-jira.el
+++ b/contrib/lisp/org-jira.el
@@ -1,6 +1,6 @@
;;; org-jira.el --- add a jira:ticket protocol to Org
(defconst org-jira-version "0.1")
-;; Copyright (C) 2008-2013 Jonathan Arkell.
+;; Copyright (C) 2008-2014 Jonathan Arkell.
;; Author: Jonathan Arkell <jonnay@jonnay.net>
;; This file is not part of GNU Emacs.
diff --git a/contrib/lisp/org-learn.el b/contrib/lisp/org-learn.el
index 1f5e76c..1755e71 100644
--- a/contrib/lisp/org-learn.el
+++ b/contrib/lisp/org-learn.el
@@ -1,6 +1,6 @@
;;; org-learn.el --- Implements SuperMemo's incremental learning algorithm
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw at gnu dot org>
;; Keywords: outlines, hypermedia, calendar, wp
diff --git a/contrib/lisp/org-license.el b/contrib/lisp/org-license.el
index b452706..44a1ea7 100644
--- a/contrib/lisp/org-license.el
+++ b/contrib/lisp/org-license.el
@@ -35,27 +35,12 @@
;;
;; You can download the images from http://www.davidam/img/licenses.tar.gz
;;
-;; TODO: create a function to test all combinations of licenses
+;;; CHANGELOG:
+;; v 0.2 - add public domain functions
+;; v 0.1 - Initial release
-(defvar org-license-images-directory "")
-
-(defun my-org-switch-language ()
-"Switch language if a `#+LANGUAGE:' Org meta-tag is on top 8 lines."
-(save-excursion
- (let (lang
- (license-alist '(("br" . "brazilian")
- ("ca" . "catalan")
- ("de" . "deutsch")
- ("en" . "american")
- ("eo" . "esperanto")
- ("eu" . "euskera")
- ("es" . "spanish"))))
- (when (re-search-backward "#\\+LANGUAGE: +\\([[:alpha:]_]*\\)" 1 t)
- (setq lang (match-string 1))
-;; (message lang)
- (ispell-change-dictionary (cdr (assoc lang dico-alist)))))))
-(add-hook 'org-mode-hook 'my-org-switch-language)
+(defvar org-license-images-directory "")
(defun org-license-cc-by (language)
(interactive "MLanguage ( br | ca | de | en | es | eo | eu | fi | fr | gl | it | jp | nl | pt ): " language)
@@ -87,7 +72,6 @@ Testua [[" org-license-cc-url "][Aitortu 3.0 Espainia]] lizentziari jarraituz er
(setq org-license-cc-url "http://creativecommons.org/licenses/by/1.0/fi/deed.fi")
(insert (concat "* Lisenssi
Teksti on saatavilla [[" org-license-cc-url "][Nimeä 1.0 Suomi]] lisenssillä\n")))
-;;Nimeä 1.0 Suomi
((equal language "fr")
(setq org-license-cc-url "http://creativecommons.org/licenses/by/3.0/fr/deed.fr")
(insert (concat "* Licence
@@ -431,11 +415,41 @@ Copyright (C) 2013 " user-full-name
(insert "\n[[https://www.gnu.org/copyleft/fdl.html][file:https://upload.wikimedia.org/wikipedia/commons/thumb/4/42/GFDL_Logo.svg/200px-GFDL_Logo.svg.png]]\n")
(insert (concat "\n[[https://www.gnu.org/copyleft/fdl.html][file:" org-license-images-directory "/gfdl/gfdl.png]]\n"))))
+(defun org-license-publicdomain-zero (language)
+ (interactive "MLanguage ( en | es ): " language)
+ (setq org-license-pd-url "http://creativecommons.org/publicdomain/zero/1.0/")
+ (setq org-license-pd-file "zero/1.0/80x15.png")
+ (if (equal language "es")
+ (insert (concat "* Licencia
+Este documento está bajo una licencia [[" org-license-pd-url "][Public Domain Zero]]\n"))
+ (insert (concat "* License
+This documento is under a [[" org-license-pd-url "][Public Domain Zero]] license\n")))
+ (if (string= "" org-license-images-directory)
+ (insert (concat "\n[[" org-license-pd-url "][file:http://i.creativecommons.org/p/zero/1.0/80x15.png]]\n"))
+ (insert (concat "\n[[" org-license-pd-url "][file:" org-license-images-directory org-license-pd-file "]]\n"))))
+
+(defun org-license-publicdomain-mark (language)
+ (interactive "MLanguage ( en | es ): " language)
+ (setq org-license-pd-url "http://creativecommons.org/publicdomain/mark/1.0/")
+ (setq org-license-pd-file "mark/1.0/80x15.png")
+ (if (equal language "es")
+ (insert (concat "* Licencia
+Este documento está bajo una licencia [[" org-license-pd-url "][Etiqueta de Dominio Público 1.0]]\n"))
+ (insert (concat "* License
+This documento is under a [[" org-license-pd-url "][Public Domain Mark]] license\n")))
+ (if (string= "" org-license-images-directory)
+ (insert (concat "\n[[" org-license-pd-url "][file:http://i.creativecommons.org/p/mark/1.0/80x15.png]]\n"))
+ (insert (concat "\n[[" org-license-pd-url "][file:" org-license-images-directory org-license-pd-file "]]\n"))))
+
(defun org-license-print-all ()
"Print all combinations of licenses and languages, it's useful to find bugs"
(interactive)
(org-license-gfdl "es")
(org-license-gfdl "en")
+ (org-license-publicdomain-mark "es")
+ (org-license-publicdomain-mark "en")
+ (org-license-publicdomain-zero "es")
+ (org-license-publicdomain-zero "en")
(org-license-cc-by "br")
(org-license-cc-by "ca")
(org-license-cc-by "de")
@@ -521,3 +535,5 @@ Copyright (C) 2013 " user-full-name
(org-license-cc-by-nc-nd "nl")
(org-license-cc-by-nc-nd "pt")
)
+
+
diff --git a/contrib/lisp/org-mac-iCal.el b/contrib/lisp/org-mac-iCal.el
index afec84b..937b6dd 100644
--- a/contrib/lisp/org-mac-iCal.el
+++ b/contrib/lisp/org-mac-iCal.el
@@ -1,6 +1,6 @@
;;; org-mac-iCal.el --- Imports events from iCal.app to the Emacs diary
-;; Copyright (C) 2009-2013 Christopher Suckling
+;; Copyright (C) 2009-2014 Christopher Suckling
;; Author: Christopher Suckling <suckling at gmail dot com>
;; Version: 0.1057.104
diff --git a/contrib/lisp/org-mac-link.el b/contrib/lisp/org-mac-link.el
index ebcff75..d1687e0 100644
--- a/contrib/lisp/org-mac-link.el
+++ b/contrib/lisp/org-mac-link.el
@@ -1,15 +1,15 @@
;;; org-mac-link.el --- Grab links and url from various mac
;; Application and insert them as links into org-mode documents
;;
-;; Copyright (c) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (c) 2010-2014 Free Software Foundation, Inc.
;;
-;; Authors:
+;; Authors:
;; Anthony Lander <anthony.lander@gmail.com>
;; John Wiegley <johnw@gnu.org>
;; Christopher Suckling <suckling at gmail dot com>
;; Daniil Frumin <difrumin@gmail.com>
;;
-;;
+;;
;; Version: 1.1
;; Keywords: org, mac, hyperlink
;;
@@ -134,7 +134,7 @@ applications and inserting them in org documents"
:type 'boolean)
(defcustom org-mac-grab-Chrome-app-p t
- "Enable menu option [f]irefox to grab links from Google Chrome.app"
+ "Enable menu option [c]hrome to grab links from Google Chrome.app"
:tag "Grab Google Chrome.app links"
:group 'org-mac-link
:type 'boolean)
@@ -201,14 +201,14 @@ applications and inserting them in org documents"
("S" "kim" org-mac-skim-insert-page ,org-mac-grab-Skim-app-p)))
(menu-string (make-string 0 ?x))
input)
-
+
;; Create the menu string for the keymap
(mapc '(lambda (descriptor)
(when (elt descriptor 3)
(setf menu-string (concat menu-string "[" (elt descriptor 0) "]" (elt descriptor 1) " "))))
descriptors)
(setf (elt menu-string (- (length menu-string) 1)) ?:)
-
+
;; Prompt the user, and grab the link
(message menu-string)
(setq input (read-char-exclusive))
@@ -349,26 +349,18 @@ applications and inserting them in org documents"
(defun org-as-mac-chrome-get-frontmost-url ()
(let ((result (do-applescript
- (concat
- "set oldClipboard to the clipboard\n"
- "set frontmostApplication to path to frontmost application\n"
- "tell application \"Google Chrome\"\n"
- " activate\n"
- " delay 0.15\n"
- " tell application \"System Events\"\n"
- " keystroke \"l\" using command down\n"
- " keystroke \"c\" using command down\n"
- " end tell\n"
- " delay 0.15\n"
- " set theUrl to the clipboard\n"
- " set the clipboard to oldClipboard\n"
- " set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n"
- "end tell\n"
- "activate application (frontmostApplication as text)\n"
- "set links to {}\n"
- "copy theResult to the end of links\n"
- "return links as string\n"))))
- (car (split-string result "[\r\n]+" t))))
+ (concat
+ "set frontmostApplication to path to frontmost application\n"
+ "tell application \"Google Chrome\"\n"
+ " set theUrl to get URL of active tab of first window\n"
+ " set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n"
+ "end tell\n"
+ "activate application (frontmostApplication as text)\n"
+ "set links to {}\n"
+ "copy theResult to the end of links\n"
+ "return links as string\n"))))
+ (replace-regexp-in-string "^\"\\|\"$" ""
+ (car (split-string result "[\r\n]+" t)))))
(defun org-mac-chrome-get-frontmost-url ()
(interactive)
diff --git a/contrib/lisp/org-mairix.el b/contrib/lisp/org-mairix.el
index b08897d..a19719e 100644
--- a/contrib/lisp/org-mairix.el
+++ b/contrib/lisp/org-mairix.el
@@ -1,6 +1,6 @@
;;; org-mairix.el - Support for hooking mairix search into Org for different MUAs
;;
-;; Copyright (C) 2007-2013 Georg C. F. Greve
+;; Copyright (C) 2007-2014 Georg C. F. Greve
;; mutt support by Adam Spiers <orgmode at adamspiers dot org>
;;
;; This file is not part of GNU Emacs.
diff --git a/contrib/lisp/org-mew.el b/contrib/lisp/org-mew.el
index ca6a352..4482375 100644
--- a/contrib/lisp/org-mew.el
+++ b/contrib/lisp/org-mew.el
@@ -1,6 +1,6 @@
;;; org-mew.el --- Support for links to Mew messages from within Org-mode
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp>
;; Keywords: outlines, hypermedia, calendar, wp
diff --git a/contrib/lisp/org-mime.el b/contrib/lisp/org-mime.el
index ef2057c..b0007ac 100644
--- a/contrib/lisp/org-mime.el
+++ b/contrib/lisp/org-mime.el
@@ -1,6 +1,6 @@
;;; org-mime.el --- org html export for text/html MIME emails
-;; Copyright (C) 2010-2013 Eric Schulte
+;; Copyright (C) 2010-2014 Eric Schulte
;; Author: Eric Schulte
;; Keywords: mime, mail, email, html
diff --git a/contrib/lisp/org-mtags.el b/contrib/lisp/org-mtags.el
index dadcef7..5342184 100644
--- a/contrib/lisp/org-mtags.el
+++ b/contrib/lisp/org-mtags.el
@@ -1,6 +1,6 @@
;;; org-mtags.el --- Muse-like tags in Org-mode
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
diff --git a/contrib/lisp/org-notify.el b/contrib/lisp/org-notify.el
index 4047448..da2c96f 100644
--- a/contrib/lisp/org-notify.el
+++ b/contrib/lisp/org-notify.el
@@ -1,6 +1,6 @@
;;; org-notify.el --- Notifications for Org-mode
-;; Copyright (C) 2012, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2012, 2013, 2014 Free Software Foundation, Inc.
;; Author: Peter Münster <pmrb@free.fr>
;; Keywords: notification, todo-list, alarm, reminder, pop-up
diff --git a/contrib/lisp/org-notmuch.el b/contrib/lisp/org-notmuch.el
index c7f92fe..2ab5c17 100644
--- a/contrib/lisp/org-notmuch.el
+++ b/contrib/lisp/org-notmuch.el
@@ -1,6 +1,6 @@
;;; org-notmuch.el --- Support for links to notmuch messages from within Org-mode
-;; Copyright (C) 2010-2013 Matthieu Lemerre
+;; Copyright (C) 2010-2014 Matthieu Lemerre
;; Author: Matthieu Lemerre <racin@free.fr>
;; Keywords: outlines, hypermedia, calendar, wp
diff --git a/contrib/lisp/org-registry.el b/contrib/lisp/org-registry.el
index b0ee208..402ce30 100644
--- a/contrib/lisp/org-registry.el
+++ b/contrib/lisp/org-registry.el
@@ -1,6 +1,6 @@
;;; org-registry.el --- a registry for Org links
;;
-;; Copyright 2007-2013 Bastien Guerry
+;; Copyright 2007-2014 Bastien Guerry
;;
;; Emacs Lisp Archive Entry
;; Filename: org-registry.el
diff --git a/contrib/lisp/org-screen.el b/contrib/lisp/org-screen.el
index 3334a0f..6b870f2 100644
--- a/contrib/lisp/org-screen.el
+++ b/contrib/lisp/org-screen.el
@@ -1,6 +1,6 @@
;;; org-screen.el --- Integreate Org-mode with screen.
-;; Copyright (c) 2008-2013 Andrew Hyatt
+;; Copyright (c) 2008-2014 Andrew Hyatt
;;
;; Author: Andrew Hyatt <ahyatt at gmail dot com>
;; Maintainer: Carsten Dominik <carsten at orgmode dot org>
diff --git a/contrib/lisp/org-screenshot.el b/contrib/lisp/org-screenshot.el
index a54cb8f..6d10783 100644
--- a/contrib/lisp/org-screenshot.el
+++ b/contrib/lisp/org-screenshot.el
@@ -1,6 +1,6 @@
;;; org-screenshot.el --- Take and manage screenshots in Org-mode files
;;
-;; Copyright (C) 2009-2013
+;; Copyright (C) 2009-2014
;; Free Software Foundation, Inc.
;;
;; Author: Max Mikhanosha <max@openchat.com>
diff --git a/contrib/lisp/org-secretary.el b/contrib/lisp/org-secretary.el
index e98eb34..babfb75 100644
--- a/contrib/lisp/org-secretary.el
+++ b/contrib/lisp/org-secretary.el
@@ -1,5 +1,5 @@
;;; org-secretary.el --- Team management with org-mode
-;; Copyright (C) 2010-2013 Juan Reyero
+;; Copyright (C) 2010-2014 Juan Reyero
;;
;; Author: Juan Reyero <juan _at_ juanreyero _dot_ com>
;; Keywords: outlines, tasks, team, management
diff --git a/contrib/lisp/org-sudoku.el b/contrib/lisp/org-sudoku.el
index 2bf24d8..4b4a3ac 100644
--- a/contrib/lisp/org-sudoku.el
+++ b/contrib/lisp/org-sudoku.el
@@ -1,6 +1,6 @@
;;; org-sudoku.el --- Greate and solve SUDOKU games in Org tables
-;; Copyright (C) 2012, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2012, 2013, 2014 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp, games
diff --git a/contrib/lisp/org-toc.el b/contrib/lisp/org-toc.el
index 2d6c846..255b79e 100644
--- a/contrib/lisp/org-toc.el
+++ b/contrib/lisp/org-toc.el
@@ -1,6 +1,6 @@
;;; org-toc.el --- Table of contents for Org-mode buffer
-;; Copyright 2007-2013 Free Software Foundation, Inc.
+;; Copyright 2007-2014 Free Software Foundation, Inc.
;;
;; Author: Bastien Guerry <bzg@gnu.org>
;; Keywords: Org table of contents
diff --git a/contrib/lisp/org-track.el b/contrib/lisp/org-track.el
index 4a9d71d..434060b 100644
--- a/contrib/lisp/org-track.el
+++ b/contrib/lisp/org-track.el
@@ -1,6 +1,6 @@
;;; org-track.el --- Track the most recent Org-mode version available.
;;
-;; Copyright (C) 2009-2013
+;; Copyright (C) 2009-2014
;; Free Software Foundation, Inc.
;;
;; Author: Bastien Guerry <bzg@gnu.org>
diff --git a/contrib/lisp/org-velocity.el b/contrib/lisp/org-velocity.el
index fa41406..3631a59 100644
--- a/contrib/lisp/org-velocity.el
+++ b/contrib/lisp/org-velocity.el
@@ -1,6 +1,6 @@
;;; org-velocity.el --- something like Notational Velocity for Org.
-;; Copyright (C) 2010-2013 Paul M. Rodriguez
+;; Copyright (C) 2010-2014 Paul M. Rodriguez
;; Author: Paul M. Rodriguez <paulmrodriguez@gmail.com>
;; Created: 2010-05-05
diff --git a/contrib/lisp/org-vm.el b/contrib/lisp/org-vm.el
index f60c5bb..5d30f64 100644
--- a/contrib/lisp/org-vm.el
+++ b/contrib/lisp/org-vm.el
@@ -1,6 +1,6 @@
;;; org-vm.el --- Support for links to VM messages from within Org-mode
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2014 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
diff --git a/contrib/lisp/org-wikinodes.el b/contrib/lisp/org-wikinodes.el
index 4efc373..7f3e2e3 100644
--- a/contrib/lisp/org-wikinodes.el
+++ b/contrib/lisp/org-wikinodes.el
@@ -1,6 +1,6 @@
;;; org-wikinodes.el --- Wiki-like CamelCase links to outline nodes
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -82,8 +82,6 @@ to `directory'."
;; in heading - deactivate flyspell
(org-remove-flyspell-overlays-in (match-beginning 0)
(match-end 0))
- (add-text-properties (match-beginning 0) (match-end 0)
- '(org-no-flyspell t))
t)
;; this is a wiki link
(org-remove-flyspell-overlays-in (match-beginning 0)
@@ -270,7 +268,6 @@ If there is no such wiki target, return nil."
(car org-export-target-aliases))))
(push (caar target-alist) (cdr a)))))
-(defvar org-current-export-file)
(defun org-wikinodes-process-links-for-export ()
"Process Wiki links in the export preprocess buffer.
@@ -296,12 +293,6 @@ with working links."
((eq org-wikinodes-scope 'file)
;; No match in file, and other files are not allowed
(insert (format "%s" link)))
- ((setq file
- (and (org-string-nw-p org-current-export-file)
- (org-wikinodes-which-file
- link (file-name-directory org-current-export-file))))
- ;; Match in another file in the current directory
- (insert (format "[[file:%s::%s][%s]]" file link link)))
(t ;; No match for this link
(insert (format "%s" link)))))))))
diff --git a/contrib/lisp/org-wl.el b/contrib/lisp/org-wl.el
index 1128ef7..632c9e3 100644
--- a/contrib/lisp/org-wl.el
+++ b/contrib/lisp/org-wl.el
@@ -1,6 +1,6 @@
;;; org-wl.el --- Support for links to Wanderlust messages from within Org-mode
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2014 Free Software Foundation, Inc.
;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp>
;; David Maus <dmaus at ictsoc dot de>
diff --git a/contrib/lisp/orgtbl-sqlinsert.el b/contrib/lisp/orgtbl-sqlinsert.el
index b00c93d..ed8f915 100644
--- a/contrib/lisp/orgtbl-sqlinsert.el
+++ b/contrib/lisp/orgtbl-sqlinsert.el
@@ -1,6 +1,6 @@
;;; orgtbl-sqlinsert.el --- orgtbl to SQL insert statements.
-;; Copyright (C) 2008-2013 Free Software Foundation
+;; Copyright (C) 2008-2014 Free Software Foundation
;; Author: Jason Riedy <jason@acm.org>
;; Keywords: org, tables, sql
diff --git a/contrib/lisp/ox-bibtex.el b/contrib/lisp/ox-bibtex.el
index 29a97eb..9aa5b1f 100644
--- a/contrib/lisp/ox-bibtex.el
+++ b/contrib/lisp/ox-bibtex.el
@@ -1,6 +1,6 @@
;;; ox-bibtex.el --- Export bibtex fragments
-;; Copyright (C) 2009-2013 Taru Karttunen
+;; Copyright (C) 2009-2014 Taru Karttunen
;; Author: Taru Karttunen <taruti@taruti.net>
;; Nicolas Goaziou <n dot goaziou at gmail dot com>
@@ -23,11 +23,15 @@
;;; Commentary:
;;
-;; This is an utility to handle BibTeX export to both LaTeX and html
-;; exports. It uses the bibtex2html software from:
+;; This is an utility to handle BibTeX export to LaTeX, html and ascii
+;; exports. For HTML and ascii it uses the bibtex2html software from:
;;
;; http://www.lri.fr/~filliatr/bibtex2html/
;;
+;; For ascii it uses the pandoc software from:
+;;
+;; http://johnmacfarlane.net/pandoc/
+;;
;; It also introduces "cite" syntax for Org links.
;;
;; The usage is as follows:
@@ -38,6 +42,8 @@
;;
;; #+BIBLIOGRAPHY: foo plain option:-d
;;
+;; "stylename" can also be "nil", in which case no style will be used.
+;;
;; Optional options are of the form:
;;
;; option:-foobar pass '-foobar' to bibtex2html
@@ -71,14 +77,20 @@
;; 2) creates a foo.html and foo_bib.html,
;; 3) includes the contents of foo.html in the exported HTML file.
;;
+;; For ascii export it:
+;; 1) converts all \cite{foo} and [[cite:foo]] to links to the
+;; bibliography,
+;; 2) creates a foo.txt and foo_bib.html,
+;; 3) includes the contents of foo.txt in the exported ascii file.
+;;
;; For LaTeX export it:
;; 1) converts all [[cite:foo]] to \cite{foo}.
;; Initialization
(eval-when-compile (require 'cl))
-(org-add-link-type "cite" 'ebib)
-
+(let ((jump-fn (car (org-remove-if-not #'fboundp '(ebib obe-goto-citation)))))
+ (org-add-link-type "cite" jump-fn))
;;; Internal Functions
@@ -103,9 +115,9 @@ return nil instead."
(defun org-bibtex-get-arguments (keyword)
"Return \"bibtex2html\" arguments specified by the user.
KEYWORD is a \"BIBLIOGRAPHY\" keyword. Return value is a plist
-containing `:options' and `:limit' properties. The former
-contains a list of strings to be passed as options ot
-\"bibtex2html\" process. The latter contains a boolean."
+containing `:options' and `:limit' properties. The former
+contains a list of strings to be passed as options to
+\"bibtex2html\" process. The latter contains a boolean."
(let ((value (org-element-property :value keyword)))
(and value
(string-match "\\(\\S-+\\)[ \t]+\\(\\S-+\\)\\(.*\\)" value)
@@ -139,6 +151,149 @@ to `org-bibtex-citation-p' predicate."
+;;; Filters
+
+(defun org-bibtex-process-bib-files (tree backend info)
+ "Send each bibliography in parse tree to \"bibtex2html\" process.
+Return new parse tree."
+ (when (org-export-derived-backend-p backend 'ascii 'html)
+ ;; Initialize dynamically scoped variables. The first one
+ ;; contain an alist between keyword objects and their HTML
+ ;; translation. The second one will contain an alist between
+ ;; citation keys and names in the output (according to style).
+ (setq org-bibtex-html-entries-alist nil
+ org-bibtex-html-keywords-alist nil)
+ (org-element-map tree 'keyword
+ (lambda (keyword)
+ (when (equal (org-element-property :key keyword) "BIBLIOGRAPHY")
+ (let ((arguments (org-bibtex-get-arguments keyword))
+ (file (org-bibtex-get-file keyword))
+ temp-file)
+ ;; limit is set: collect citations throughout the document
+ ;; in TEMP-FILE and pass it to "bibtex2html" as "-citefile"
+ ;; argument.
+ (when (plist-get arguments :limit)
+ (let ((citations
+ (org-element-map tree '(latex-fragment link)
+ (lambda (object)
+ (and (org-bibtex-citation-p object)
+ (org-bibtex-get-citation-key object))))))
+ (with-temp-file (setq temp-file (make-temp-file "ox-bibtex"))
+ (insert (mapconcat 'identity citations "\n")))
+ (setq arguments
+ (plist-put arguments
+ :options
+ (append (plist-get arguments :options)
+ (list "-citefile" temp-file))))))
+ ;; Call "bibtex2html" on specified file.
+ (unless (eq 0 (apply
+ 'call-process
+ (append '("bibtex2html" nil nil nil)
+ '("-a" "-nodoc" "-noheader" "-nofooter")
+ (let ((style
+ (org-not-nil
+ (org-bibtex-get-style keyword))))
+ (and style (list "--style" style)))
+ (plist-get arguments :options)
+ (list (concat file ".bib")))))
+ (error "Executing bibtex2html failed"))
+ (and temp-file (delete-file temp-file))
+ ;; Open produced HTML file, and collect Bibtex key names
+ (with-temp-buffer
+ (insert-file-contents (concat file ".html"))
+ ;; Update `org-bibtex-html-entries-alist'.
+ (goto-char (point-min))
+ (while (re-search-forward
+ "a name=\"\\([-_a-zA-Z0-9:]+\\)\">\\(\\w+\\)" nil t)
+ (push (cons (match-string 1) (match-string 2))
+ org-bibtex-html-entries-alist)))
+ ;; Open produced HTML file, wrap references within a block and
+ ;; return it.
+ (with-temp-buffer
+ (cond
+ ((org-export-derived-backend-p backend 'html)
+ (insert (format "<div id=\"bibliography\">\n<h2>%s</h2>\n"
+ (org-export-translate "References" :html info)))
+ (insert-file-contents (concat file ".html"))
+ (insert "\n</div>"))
+ ((org-export-derived-backend-p backend 'ascii)
+ ;; convert HTML references to text w/pandoc
+ (unless (eq 0 (call-process "pandoc" nil nil nil
+ (concat file ".html")
+ "-o"
+ (concat file ".txt")))
+ (error "Executing pandoc failed"))
+ (insert
+ (format
+ "%s\n==========\n\n"
+ (org-export-translate
+ "References"
+ (intern (format ":%s" (plist-get info :ascii-charset)))
+ info)))
+ (insert-file-contents (concat file ".txt"))
+ (goto-char (point-min))
+ (while (re-search-forward
+ "\\[ \\[bib\\][^ ]+ \\(\\]\\||[\n\r]\\)" nil t)
+ (replace-match ""))
+ (goto-char (point-min))
+ (while (re-search-forward "\\( \\]\\| \\]\\| |\\)" nil t)
+ (replace-match ""))
+ (goto-char (point-min))
+ (while (re-search-forward "[\n\r]\\([\n\r][\n\r]\\)" nil t)
+ (replace-match "\\1"))))
+ ;; Update `org-bibtex-html-keywords-alist'.
+ (push (cons keyword (buffer-string))
+ org-bibtex-html-keywords-alist)))))))
+ ;; Return parse tree unchanged.
+ tree)
+
+(defun org-bibtex-merge-contiguous-citations (tree backend info)
+ "Merge all contiguous citation in parse tree.
+As a side effect, this filter will also turn all \"cite\" links
+into \"\\cite{...}\" LaTeX fragments."
+ (when (org-export-derived-backend-p backend 'html 'latex 'ascii)
+ (org-element-map tree '(link latex-fragment)
+ (lambda (object)
+ (when (org-bibtex-citation-p object)
+ (let ((new-citation (list 'latex-fragment
+ (list :value ""
+ :post-blank (org-element-property
+ :post-blank object)))))
+ ;; Insert NEW-CITATION right before OBJECT.
+ (org-element-insert-before new-citation object)
+ ;; Remove all subsequent contiguous citations from parse
+ ;; tree, keeping only their citation key.
+ (let ((keys (list (org-bibtex-get-citation-key object)))
+ next)
+ (while (and (setq next (org-export-get-next-element object info))
+ (or (and (stringp next)
+ (not (org-string-match-p "\\S-" next)))
+ (org-bibtex-citation-p next)))
+ (unless (stringp next)
+ (push (org-bibtex-get-citation-key next) keys))
+ (org-element-extract-element object)
+ (setq object next))
+ (org-element-extract-element object)
+ ;; Eventually merge all keys within NEW-CITATION. Also
+ ;; ensure NEW-CITATION has the same :post-blank property
+ ;; as the last citation removed.
+ (org-element-put-property
+ new-citation
+ :post-blank (org-element-property :post-blank object))
+ (org-element-put-property
+ new-citation
+ :value (format "\\cite{%s}"
+ (mapconcat 'identity (nreverse keys) ",")))))))))
+ tree)
+
+(eval-after-load 'ox
+ '(progn (add-to-list 'org-export-filter-parse-tree-functions
+ 'org-bibtex-process-bib-files)
+ (add-to-list 'org-export-filter-parse-tree-functions
+ 'org-bibtex-merge-contiguous-citations)))
+
+
+
;;; LaTeX Part
(defadvice org-latex-keyword (around bibtex-keyword)
@@ -148,22 +303,13 @@ Fallback to `latex' back-end for other keywords."
(if (not (equal (org-element-property :key keyword) "BIBLIOGRAPHY"))
ad-do-it
(let ((file (org-bibtex-get-file keyword))
- (style (org-bibtex-get-style keyword)))
+ (style (org-not-nil (org-bibtex-get-style keyword))))
(setq ad-return-value
(when file
(concat (and style (format "\\bibliographystyle{%s}\n" style))
(format "\\bibliography{%s}" file))))))))
-(defadvice org-latex-link (around bibtex-link)
- "Translate \"cite\" type links into LaTeX syntax.
-Fallback to `latex' back-end for other keywords."
- (let ((link (ad-get-arg 0)))
- (if (not (org-bibtex-citation-p link)) ad-do-it
- (setq ad-return-value
- (format "\\cite{%s}" (org-bibtex-get-citation-key link))))))
-
(ad-activate 'org-latex-keyword)
-(ad-activate 'org-latex-link)
@@ -190,103 +336,46 @@ Fallback to `html' back-end for other keywords."
(let ((fragment (ad-get-arg 0)))
(if (not (org-bibtex-citation-p fragment)) ad-do-it
(setq ad-return-value
- (mapconcat
- (lambda (key)
- (let ((key (org-trim key)))
- (format "[<a href=\"#%s\">%s</a>]"
- key
- (or (cdr (assoc key org-bibtex-html-entries-alist))
- key))))
- (org-split-string (org-bibtex-get-citation-key fragment) ",")
- "")))))
-
-(defadvice org-html-link (around bibtex-link)
- "Translate \"cite:\" type links into HTML syntax.
-Fallback to `html' back-end for other types."
- (let ((link (ad-get-arg 0)))
- (if (not (org-bibtex-citation-p link)) ad-do-it
- (setq ad-return-value
- (mapconcat
- (lambda (key)
- (format "[<a href=\"#%s\">%s</a>]"
- key
- (or (cdr (assoc key org-bibtex-html-entries-alist))
- key)))
- (org-split-string (org-bibtex-get-citation-key link)
- "[ \t]*,[ \t]*")
- "")))))
+ (format "[%s]"
+ (mapconcat
+ (lambda (key)
+ (format "<a href=\"#%s\">%s</a>"
+ key
+ (or (cdr (assoc key org-bibtex-html-entries-alist))
+ key)))
+ (org-split-string
+ (org-bibtex-get-citation-key fragment) ",") ","))))))
(ad-activate 'org-html-keyword)
(ad-activate 'org-html-latex-fragment)
-(ad-activate 'org-html-link)
+
+;;; Ascii Part
+(defadvice org-ascii-keyword (around bibtex-keyword)
+ "Translate \"BIBLIOGRAPHY\" keywords into ascii syntax.
+Fallback to `ascii' back-end for other keywords."
+ (let ((keyword (ad-get-arg 0)))
+ (if (not (equal (org-element-property :key keyword) "BIBLIOGRAPHY"))
+ ad-do-it
+ (setq ad-return-value
+ (cdr (assq keyword org-bibtex-html-keywords-alist))))))
-;;;; Filter
-
-(defun org-bibtex-process-bib-files (tree backend info)
- "Send each bibliography in parse tree to \"bibtex2html\" process.
-Return new parse tree. This function assumes current back-end is HTML."
- ;; Initialize dynamically scoped variables. The first one
- ;; contain an alist between keyword objects and their HTML
- ;; translation. The second one will contain an alist between
- ;; citation keys and names in the output (according to style).
- (setq org-bibtex-html-entries-alist nil
- org-bibtex-html-keywords-alist nil)
- (org-element-map tree 'keyword
- (lambda (keyword)
- (when (equal (org-element-property :key keyword) "BIBLIOGRAPHY")
- (let ((arguments (org-bibtex-get-arguments keyword))
- (file (org-bibtex-get-file keyword))
- temp-file)
- ;; limit is set: collect citations throughout the document
- ;; in TEMP-FILE and pass it to "bibtex2html" as "-citefile"
- ;; argument.
- (when (plist-get arguments :limit)
- (let ((citations
- (org-element-map tree '(latex-fragment link)
- (lambda (object)
- (and (org-bibtex-citation-p object)
- (org-bibtex-get-citation-key object))))))
- (with-temp-file (setq temp-file (make-temp-file "ox-bibtex"))
- (insert (mapconcat 'identity citations "\n")))
- (setq arguments
- (plist-put arguments
- :options
- (append (plist-get arguments :options)
- (list "-citefile" temp-file))))))
- ;; Call "bibtex2html" on specified file.
- (unless (eq 0 (apply 'call-process
- (append '("bibtex2html" nil nil nil)
- '("-a" "-nodoc" "-noheader" "-nofooter")
- (list "--style"
- (org-bibtex-get-style keyword))
- (plist-get arguments :options)
- (list (concat file ".bib")))))
- (error "Executing bibtex2html failed"))
- (and temp-file (delete-file temp-file))
- ;; Open produced HTML file, wrap references within a block and
- ;; return it.
- (with-temp-buffer
- (insert "<div id=\"bibliography\">\n<h2>References</h2>\n")
- (insert-file-contents (concat file ".html"))
- (insert "\n</div>")
- ;; Update `org-bibtex-html-keywords-alist'.
- (push (cons keyword (buffer-string))
- org-bibtex-html-keywords-alist)
- ;; Update `org-bibtex-html-entries-alist'.
- (goto-char (point-min))
- (while (re-search-forward
- "a name=\"\\([-_a-zA-Z0-9:]+\\)\">\\(\\w+\\)" nil t)
- (push (cons (match-string 1) (match-string 2))
- org-bibtex-html-entries-alist)))))))
- ;; Return parse tree unchanged.
- tree)
-
-(eval-after-load 'ox
- '(add-to-list 'org-export-filter-parse-tree-functions
- 'org-bibtex-process-bib-files))
-
+(defadvice org-ascii-latex-fragment (around bibtex-citation)
+ "Translate \"\\cite\" LaTeX fragments into ascii syntax.
+Fallback to `ascii' back-end for other keywords."
+ (let ((fragment (ad-get-arg 0)))
+ (if (not (org-bibtex-citation-p fragment)) ad-do-it
+ (setq ad-return-value
+ (format "[%s]"
+ (mapconcat
+ (lambda (key)
+ (or (cdr (assoc key org-bibtex-html-entries-alist))
+ key))
+ (org-split-string
+ (org-bibtex-get-citation-key fragment) ",") ","))))))
+(ad-activate 'org-ascii-keyword)
+(ad-activate 'org-ascii-latex-fragment)
(provide 'ox-bibtex)
diff --git a/contrib/lisp/ox-confluence.el b/contrib/lisp/ox-confluence.el
index c87c23e..9b96d5f 100644
--- a/contrib/lisp/ox-confluence.el
+++ b/contrib/lisp/ox-confluence.el
@@ -1,6 +1,6 @@
;;; ox-confluence --- Confluence Wiki Back-End for Org Export Engine
-;; Copyright (C) 2012 Sébastien Delafond
+;; Copyright (C) 2012, 2014 Sébastien Delafond
;; Author: Sébastien Delafond <sdelafond@gmail.com>
;; Keywords: outlines, confluence, wiki
diff --git a/contrib/lisp/ox-deck.el b/contrib/lisp/ox-deck.el
index 847f7af..0ebde41 100644
--- a/contrib/lisp/ox-deck.el
+++ b/contrib/lisp/ox-deck.el
@@ -1,6 +1,6 @@
;;; ox-deck.el --- deck.js Presentation Back-End for Org Export Engine
-;; Copyright (C) 2013 Rick Frankel
+;; Copyright (C) 2013, 2014 Rick Frankel
;; Author: Rick Frankel <emacs at rickster dot com>
;; Keywords: outlines, hypermedia, slideshow
@@ -55,7 +55,7 @@
(:html-link-up "HTML_LINK_UP" nil nil)
(:deck-postamble "DECK_POSTAMBLE" nil org-deck-postamble newline)
(:deck-preamble "DECK_PREAMBLE" nil org-deck-preamble newline)
- (:html-head-include-default-style "HTML_INCLUDE_DEFAULT_STYLE" nil nil)
+ (:html-head-include-default-style "HTML_INCLUDE_DEFAULT_STYLE" "html-style" nil)
(:html-head-include-scripts "HTML_INCLUDE_SCRIPTS" nil nil)
(:deck-base-url "DECK_BASE_URL" nil org-deck-base-url)
(:deck-theme "DECK_THEME" nil org-deck-theme)
@@ -319,7 +319,7 @@ and have the id \"title-slide\"."
(include (plist-get info :deck-include-extensions))
(exclude (plist-get info :deck-exclude-extensions))
(scripts '()) (sheets '()) (snippets '()))
- (add-to-list 'scripts (concat prefix "jquery-1.7.2.min.js"))
+ (add-to-list 'scripts (concat prefix "jquery.min.js"))
(add-to-list 'scripts (concat prefix "core/deck.core.js"))
(add-to-list 'scripts (concat prefix "modernizr.custom.js"))
(add-to-list 'sheets (concat prefix "core/deck.core.css"))
@@ -368,7 +368,7 @@ holding export options."
"Transcode an ITEM element from Org to HTML.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information.
-If the containing headline has the property :slide, then
+If the containing headline has the property :STEP, then
the \"slide\" class will be added to the to the list element,
which will make the list into a \"build\"."
(let ((text (org-html-item item contents info)))
@@ -378,7 +378,7 @@ the \"slide\" class will be added to the to the list element,
(defun org-deck-link (link desc info)
(replace-regexp-in-string "href=\"#" "href=\"#outline-container-"
- (org-html-link link desc info)))
+ (org-export-with-backend 'html link desc info)))
(defun org-deck-template (contents info)
"Return complete document string after HTML conversion.
diff --git a/contrib/lisp/ox-freemind.el b/contrib/lisp/ox-freemind.el
index 801bda1..39fb1cc 100644
--- a/contrib/lisp/ox-freemind.el
+++ b/contrib/lisp/ox-freemind.el
@@ -1,6 +1,6 @@
;;; ox-freemind.el --- Freemind Mindmap Back-End for Org Export Engine
-;; Copyright (C) 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2013, 2014 Free Software Foundation, Inc.
;; Author: Jambunathan K <kjambunathan at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp
diff --git a/contrib/lisp/ox-gfm.el b/contrib/lisp/ox-gfm.el
new file mode 100644
index 0000000..f7acc94
--- a/dev/null
+++ b/contrib/lisp/ox-gfm.el
@@ -0,0 +1,193 @@
+;;; ox-gfm.el --- Github Flavored Markdown Back-End for Org Export Engine
+
+;; Copyright (C) 2014 Lars Tveito
+
+;; Author: Lars Tveito
+;; Keywords: org, wp, markdown, github
+
+;; This file is not 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:
+
+;; This library implements a Markdown back-end (github flavor) for Org
+;; exporter, based on the `md' back-end.
+
+;;; Code:
+
+(require 'ox-md)
+
+
+
+;;; User-Configurable Variables
+
+(defgroup org-export-gfm nil
+ "Options specific to Markdown export back-end."
+ :tag "Org Github Flavored Markdown"
+ :group 'org-export
+ :version "24.4"
+ :package-version '(Org . "8.0"))
+
+(defcustom org-gfm-lang '(("emacs-lisp" . "lisp") ("elisp" . "lisp"))
+ "Alist of languages that are not recognized by Github, to
+ languages that are. Emacs lisp is a good example of this, where
+ we can use lisp as a nice replacement."
+ :group 'org-export-gfm)
+
+
+
+;;; Define Back-End
+
+(org-export-define-derived-backend 'gfm 'md
+ :export-block '("GFM" "GITHUB FLAVORED MARKDOWN")
+ :filters-alist '((:filter-parse-tree . org-md-separate-elements))
+ :menu-entry
+ '(?g "Export to Github Flavored Markdown"
+ ((?G "To temporary buffer"
+ (lambda (a s v b) (org-gfm-export-as-markdown a s v)))
+ (?g "To file" (lambda (a s v b) (org-gfm-export-to-markdown a s v)))
+ (?o "To file and open"
+ (lambda (a s v b)
+ (if a (org-gfm-export-to-markdown t s v)
+ (org-open-file (org-gfm-export-to-markdown nil s v)))))))
+ :translate-alist '((inner-template . org-gfm-inner-template)
+ (strike-through . org-gfm-strike-through)
+ (src-block . org-gfm-src-block)))
+
+
+
+;;; Transcode Functions
+
+;;;; Src Block
+
+(defun org-gfm-src-block (src-block contents info)
+ "Transcode SRC-BLOCK element into Github Flavored Markdown
+format. CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (let* ((lang (org-element-property :language src-block))
+ (lang (or (assoc-default lang org-gfm-lang) lang))
+ (code (org-export-format-code-default src-block info))
+ (prefix (concat "```" lang "\n"))
+ (suffix "```"))
+ (concat prefix code suffix)))
+
+
+;;;; Strike-Through
+
+(defun org-html-strike-through (strike-through contents info)
+ "Transcode STRIKE-THROUGH from Org to Markdown (GFM).
+CONTENTS is the text with strike-through markup. INFO is a plist
+holding contextual information."
+ (format "~~%s~~" contents))
+
+;;;; Table of contents
+
+(defun org-gfm-format-toc (headline)
+ "Return an appropriate table of contents entry for HEADLINE. INFO is a
+plist used as a communication channel."
+ (let* ((title (org-export-data
+ (org-export-get-alt-title headline info) info))
+ (level (1- (org-element-property :level headline)))
+ (indent (concat (make-string (* level 2) ? )))
+ (ref-str (replace-regexp-in-string " " "-" (downcase title))))
+ (concat indent "- [" title "]" "(#" ref-str ")")))
+
+
+;;;; Template
+
+(defun org-gfm-inner-template (contents info)
+ "Return body of document after converting it to Markdown syntax.
+CONTENTS is the transcoded contents string. INFO is a plist
+holding export options."
+ (let* ((depth (plist-get info :with-toc))
+ (headlines (and depth (org-export-collect-headlines info depth)))
+ (toc-string (or (mapconcat 'org-gfm-format-toc headlines "\n") ""))
+ (toc-tail (if headlines "\n\n" "")))
+ (concat toc-string toc-tail contents)))
+
+
+
+;;; Interactive function
+
+;;;###autoload
+(defun org-gfm-export-as-markdown (&optional async subtreep visible-only)
+ "Export current buffer to a Github Flavored Markdown buffer.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting buffer should be accessible
+through the `org-export-stack' interface.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+Export is done in a buffer named \"*Org GFM Export*\", which will
+be displayed when `org-export-show-temporary-export-buffer' is
+non-nil."
+ (interactive)
+ (org-export-to-buffer 'gfm "*Org GFM Export*"
+ async subtreep visible-only nil nil (lambda () (text-mode))))
+
+
+;;;###autoload
+(defun org-gfm-convert-region-to-md ()
+ "Assume the current region has org-mode syntax, and convert it
+to Github Flavored Markdown. This can be used in any buffer.
+For example, you can write an itemized list in org-mode syntax in
+a Markdown buffer and use this command to convert it."
+ (interactive)
+ (org-export-replace-region-by 'gfm))
+
+
+;;;###autoload
+(defun org-gfm-export-to-markdown (&optional async subtreep visible-only)
+ "Export current buffer to a Github Flavored Markdown file.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+Return output file's name."
+ (interactive)
+ (let ((outfile (org-export-output-file-name ".md" subtreep)))
+ (org-export-to-file 'gfm outfile async subtreep visible-only)))
+
+(provide 'ox-gfm)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; ox-gfm.el ends here
diff --git a/contrib/lisp/ox-groff.el b/contrib/lisp/ox-groff.el
index 245b67d..7974051 100644
--- a/contrib/lisp/ox-groff.el
+++ b/contrib/lisp/ox-groff.el
@@ -1,6 +1,6 @@
;;; ox-groff.el --- Groff Back-End for Org Export Engine
-;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2014 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
;; Author: Luis R Anaya <papoanaya aroba hot mail punto com>
@@ -77,7 +77,6 @@
(planning . org-groff-planning)
(property-drawer . org-groff-property-drawer)
(quote-block . org-groff-quote-block)
- (quote-section . org-groff-quote-section)
(radio-target . org-groff-radio-target)
(section . org-groff-section)
(special-block . org-groff-special-block)
@@ -1254,12 +1253,8 @@ INFO is a plist holding contextual information. See
(path (cond
((member type '("http" "https" "ftp" "mailto"))
(concat type ":" raw-path))
- ((string= type "file")
- (when (string-match "\\(.+\\)::.+" raw-path)
- (setq raw-path (match-string 1 raw-path)))
- (if (file-name-absolute-p raw-path)
- (concat "file://" (expand-file-name raw-path))
- (concat "file://" raw-path)))
+ ((and (string= type "file") (file-name-absolute-p raw-path))
+ (concat "file://" raw-path))
(t raw-path)))
protocol)
(cond
@@ -1275,7 +1270,8 @@ INFO is a plist holding contextual information. See
(let ((destination (org-export-resolve-radio-link link info)))
(when destination
(format "\\fI [%s] \\fP"
- (org-export-solidify-link-text path)))))
+ (org-export-solidify-link-text
+ (org-element-property :value destination))))))
;; Links pointing to a headline: find destination and build
;; appropriate referencing command.
@@ -1457,15 +1453,6 @@ holding contextual information."
quote-block
(format ".DS I\n.I\n%s\n.R\n.DE" contents)))
-;;; Quote Section
-
-(defun org-groff-quote-section (quote-section contents info)
- "Transcode a QUOTE-SECTION element from Org to Groff.
-CONTENTS is nil. INFO is a plist holding contextual information."
- (let ((value (org-remove-indentation
- (org-element-property :value quote-section))))
- (when value (format ".DS L\n\\fI%s\\fP\n.DE\n" value))))
-
;;; Radio Target
(defun org-groff-radio-target (radio-target text info)
diff --git a/contrib/lisp/ox-koma-letter.el b/contrib/lisp/ox-koma-letter.el
index 240de29..aa75ab8 100644
--- a/contrib/lisp/ox-koma-letter.el
+++ b/contrib/lisp/ox-koma-letter.el
@@ -1,6 +1,6 @@
;;; ox-koma-letter.el --- KOMA Scrlttr2 Back-End for Org Export Engine
-;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012, 2014 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou AT gmail DOT com>
;; Alan Schmitt <alan.schmitt AT polytechnique DOT org>
@@ -34,14 +34,14 @@
;; On top of buffer keywords supported by `latex' back-end (see
;; `org-latex-options-alist'), this back-end introduces the following
;; keywords:
-;; - "CLOSING" (see `org-koma-letter-closing'),
-;; - "FROM_ADDRESS" (see `org-koma-letter-from-address'),
-;; - "LCO" (see `org-koma-letter-class-option-file'),
-;; - "OPENING" (see `org-koma-letter-opening'),
-;; - "PHONE_NUMBER" (see `org-koma-letter-phone-number'),
-;; - "SIGNATURE" (see `org-koma-letter-signature')
-;; - "PLACE" (see `org-koma-letter-place')
-;; - and "TO_ADDRESS". If unspecified this is set to "\mbox{}".
+;; - CLOSING: see `org-koma-letter-closing',
+;; - FROM_ADDRESS: see `org-koma-letter-from-address',
+;; - LCO: see `org-koma-letter-class-option-file',
+;; - OPENING: see `org-koma-letter-opening',
+;; - PHONE_NUMBER: see `org-koma-letter-phone-number',
+;; - SIGNATURE: see `org-koma-letter-signature',
+;; - PLACE: see `org-koma-letter-place',
+;; - TO_ADDRESS: If unspecified this is set to "\mbox{}".
;;
;; TO_ADDRESS and FROM_ADDRESS can also be specified using heading
;; with the special tags specified in
@@ -67,8 +67,9 @@
;; (see `org-koma-letter-special-tags-after-letter').
;;
;; The following variables works differently from the main LaTeX class
-;; - "AUTHOR": default to user-full-name but may be disabled. (see org-koma-letter-author),
-;; - "EMAIL": same as AUTHOR, (see org-koma-letter-email),
+;; - AUTHOR: Default to user-full-name but may be disabled.
+;; (See also `org-koma-letter-author'),
+;; - EMAIL: Same as AUTHOR. (see also `org-koma-letter-email'),
;;
;; Headlines are in general ignored. However, headlines with special
;; tags can be used for specified contents like postscript (ps),
@@ -84,16 +85,10 @@
;; with information is present precedence is determined by
;; `org-koma-letter-prefer-special-headings'.
;;
-;; You will need to add an appropriate association in
-;; `org-latex-classes' in order to use the KOMA Scrlttr2 class.
-;; The easiest way to do this is by adding
-;;
-;; (eval-after-load "ox-koma-letter"
-;; '(org-koma-letter-plug-into-ox))
-;;
-;; to your init file. This will add a sparse scrlttr2 class and
-;; set it as the default `org-koma-latex-default-class'. You can also
-;; add you own letter class. For instace:
+;; You need an appropriate association in `org-latex-classes' in order
+;; to use the KOMA Scrlttr2 class. By default, a sparse scrlttr2
+;; class is provided: "default-koma-letter". You can also add you own
+;; letter class. For instance:
;;
;; (add-to-list 'org-latex-classes
;; '("my-letter"
@@ -111,16 +106,26 @@
;; \[EXTRA]"))
;;
;; Then, in your Org document, be sure to require the proper class
-;; with :
+;; with:
;;
;; #+LATEX_CLASS: my-letter
;;
;; Or by setting `org-koma-letter-default-class'.
+;;
+;; You may have to load (LaTeX) Babel as well, e.g., by adding
+;; it to `org-latex-packages-alist',
+;;
+;; (add-to-list 'org-latex-packages-alist '("AUTO" "babel" nil))
;;; Code:
(require 'ox-latex)
+;; Install a default letter class.
+(unless (assoc "default-koma-letter" org-latex-classes)
+ (add-to-list 'org-latex-classes
+ '("default-koma-letter" "\\documentclass[11pt]{scrlttr2}")))
+
;;; User-Configurable Variables
@@ -130,17 +135,20 @@
:group 'org-export)
(defcustom org-koma-letter-class-option-file "NF"
- "Letter Class Option File."
+ "Letter Class Option File.
+This option can also be set with the LCO keyword."
:group 'org-export-koma-letter
:type 'string)
(defcustom org-koma-letter-author 'user-full-name
- "The sender's name.
+ "Sender's name.
This variable defaults to calling the function `user-full-name'
-which just returns the current function `user-full-name'. Alternatively a
-string, nil or a function may be given. Functions must return a
-string."
+which just returns the current function `user-full-name'.
+Alternatively a string, nil or a function may be given.
+Functions must return a string.
+
+This option can also be set with the AUTHOR keyword."
:group 'org-export-koma-letter
:type '(radio (function-item user-full-name)
(string)
@@ -148,134 +156,219 @@ string."
(const :tag "Do not export author" nil)))
(defcustom org-koma-letter-email 'org-koma-letter-email
- "The sender's email address.
+ "Sender's email address.
This variable defaults to the value `org-koma-letter-email' which
-returns `user-mail-address'. Alternatively a string, nil or a
-function may be given. Functions must return a string."
+returns `user-mail-address'. Alternatively a string, nil or
+a function may be given. Functions must return a string.
+
+This option can also be set with the EMAIL keyword."
:group 'org-export-koma-letter
:type '(radio (function-item org-koma-letter-email)
(string)
(function)
(const :tag "Do not export email" nil)))
-(defcustom org-koma-letter-from-address nil
- "Sender's address, as a string."
+(defcustom org-koma-letter-from-address ""
+ "Sender's address, as a string.
+This option can also be set with one or more FROM_ADDRESS
+keywords."
:group 'org-export-koma-letter
:type 'string)
-(defcustom org-koma-letter-phone-number nil
- "Sender's phone number, as a string."
+(defcustom org-koma-letter-phone-number ""
+ "Sender's phone number, as a string.
+This option can also be set with the PHONE_NUMBER keyword."
:group 'org-export-koma-letter
:type 'string)
-(defcustom org-koma-letter-place nil
- "Place from which the letter is sent."
+(defcustom org-koma-letter-place ""
+ "Place from which the letter is sent, as a string.
+This option can also be set with the PLACE keyword."
:group 'org-export-koma-letter
:type 'string)
-(defcustom org-koma-letter-opening nil
+(defcustom org-koma-letter-opening ""
"Letter's opening, as a string.
-If (1) this value is nil; (2) the letter is started with a
-headline; and (3) `org-koma-letter-headline-is-opening-maybe' is
-t the value opening will be implicit set as the headline title."
+This option can also be set with the OPENING keyword. Moreover,
+when:
+ (1) this value is the empty string;
+ (2) there's no OPENING keyword or it is empty;
+ (3) `org-koma-letter-headline-is-opening-maybe' is non-nil;
+ (4) the letter contains a headline without a special
+ tag (e.g. \"to\" or \"ps\");
+then the opening will be implicitly set as the headline title."
:group 'org-export-koma-letter
:type 'string)
-(defcustom org-koma-letter-closing nil
- "Koma-Letter's closing, as a string."
+(defcustom org-koma-letter-closing ""
+ "Letter's closing, as a string.
+This option can also be set with the CLOSING keyword."
:group 'org-export-koma-letter
:type 'string)
-(defcustom org-koma-letter-prefer-special-headings nil
- "If TO and/or FROM is specified using both a heading and a keyword the heading value will be preferred if the variable is t."
+(defcustom org-koma-letter-signature ""
+ "Signature, as a string.
+This option can also be set with the SIGNATURE keyword."
:group 'org-export-koma-letter
- :type 'boolean)
+ :type 'string)
-(defcustom org-koma-letter-signature nil
- "String used as the signature."
+(defcustom org-koma-letter-prefer-special-headings nil
+ "Non-nil means prefer headlines over keywords for TO and FROM.
+This option can also be set with the OPTIONS keyword, e.g.:
+\"special-headings:t\"."
:group 'org-export-koma-letter
- :type 'string)
+ :type 'boolean)
(defcustom org-koma-letter-subject-format t
"Use the title as the subject of the letter.
-At this time the following values are allowed:
+When t, insert a subject using default options. When nil, do not
+insert a subject at all. It can also be a list of symbols among
+the following ones:
- - afteropening: subject after opening.
- - beforeopening: subject before opening.
- - centered: subject centered.
- - left:subject left-justified.
- - right: subject right-justified.
- - titled: add title/description to subject.
- - underlined: set subject underlined.
- - untitled: do not add title/description to subject.
- - No-export: do no insert a subject even if present.
+ `afteropening' Subject after opening
+ `beforeopening' Subject before opening
+ `centered' Subject centered
+ `left' Subject left-justified
+ `right' Subject right-justified
+ `titled' Add title/description to subject
+ `underlined' Set subject underlined
+ `untitled' Do not add title/description to subject
Please refer to the KOMA-script manual (Table 4.16. in the
-English manual of 2012-07-22)."
- :type '(radio
- (const :tag "No export" nil)
- (const :tag "Default options" t)
- (set :tag "selection"
- (const 'afteropening)
- (const 'beforeopening)
- (const 'centered)
- (const 'left)
- (const 'right)
- (const 'underlined)
- (const 'titled)
- (const 'untitled))
- (string))
+English manual of 2012-07-22).
+
+This option can also be set with the OPTIONS keyword, e.g.:
+\"subject:(underlined centered)\"."
+ :type
+ '(choice
+ (const :tag "No export" nil)
+ (const :tag "Default options" t)
+ (set :tag "Configure options"
+ (const :tag "Subject after opening" afteropening)
+ (const :tag "Subject before opening" beforeopening)
+ (const :tag "Subject centered" centered)
+ (const :tag "Subject left-justified" left)
+ (const :tag "Subject right-justified" right)
+ (const :tag "Add title or description to subject" underlined)
+ (const :tag "Set subject underlined" titled)
+ (const :tag "Do not add title or description to subject" untitled)))
:group 'org-export-koma-letter)
-
-
(defcustom org-koma-letter-use-backaddress nil
- "Print return address in small line above to address."
+ "Non-nil prints return address in line above to address.
+This option can also be set with the OPTIONS keyword, e.g.:
+\"backaddress:t\"."
:group 'org-export-koma-letter
:type 'boolean)
-(defcustom org-koma-letter-use-foldmarks "true"
- "Configure appearence of fold marks.
+(defcustom org-koma-letter-use-foldmarks t
+ "Configure appearance of folding marks.
+
+When t, activate default folding marks. When nil, do not insert
+folding marks at all. It can also be a list of symbols among the
+following ones:
+
+ `B' Activate upper horizontal mark on left paper edge
+ `b' Deactivate upper horizontal mark on left paper edge
+
+ `H' Activate all horizontal marks on left paper edge
+ `h' Deactivate all horizontal marks on left paper edge
+
+ `L' Activate left vertical mark on upper paper edge
+ `l' Deactivate left vertical mark on upper paper edge
+
+ `M' Activate middle horizontal mark on left paper edge
+ `m' Deactivate middle horizontal mark on left paper edge
+
+ `P' Activate punch or center mark on left paper edge
+ `p' Deactivate punch or center mark on left paper edge
+
+ `T' Activate lower horizontal mark on left paper edge
+ `t' Deactivate lower horizontal mark on left paper edge
-Accepts any valid value for the KOMA-Script `foldmarks' option.
+ `V' Activate all vertical marks on upper paper edge
+ `v' Deactivate all vertical marks on upper paper edge
-Use `foldmarks:true' to activate default fold marks or
-`foldmarks:nil' to deactivate fold marks."
+This option can also be set with the OPTIONS keyword, e.g.:
+\"foldmarks:(b l m t)\"."
:group 'org-export-koma-letter
- :type 'string)
+ :type '(choice
+ (const :tag "Activate default folding marks" t)
+ (const :tag "Deactivate folding marks" nil)
+ (set
+ :tag "Configure folding marks"
+ (const :tag "Activate upper horizontal mark on left paper edge" B)
+ (const :tag "Deactivate upper horizontal mark on left paper edge" b)
+ (const :tag "Activate all horizontal marks on left paper edge" H)
+ (const :tag "Deactivate all horizontal marks on left paper edge" h)
+ (const :tag "Activate left vertical mark on upper paper edge" L)
+ (const :tag "Deactivate left vertical mark on upper paper edge" l)
+ (const :tag "Activate middle horizontal mark on left paper edge" M)
+ (const :tag "Deactivate middle horizontal mark on left paper edge" m)
+ (const :tag "Activate punch or center mark on left paper edge" P)
+ (const :tag "Deactivate punch or center mark on left paper edge" p)
+ (const :tag "Activate lower horizontal mark on left paper edge" T)
+ (const :tag "Deactivate lower horizontal mark on left paper edge" t)
+ (const :tag "Activate all vertical marks on upper paper edge" V)
+ (const :tag "Deactivate all vertical marks on upper paper edge" v))))
(defcustom org-koma-letter-use-phone nil
- "Print sender's phone number."
+ "Non-nil prints sender's phone number.
+This option can also be set with the OPTIONS keyword, e.g.:
+\"phone:t\"."
:group 'org-export-koma-letter
:type 'boolean)
(defcustom org-koma-letter-use-email nil
- "Print sender's email address."
+ "Non-nil prints sender's email address.
+This option can also be set with the OPTIONS keyword, e.g.:
+\"email:t\"."
:group 'org-export-koma-letter
:type 'boolean)
(defcustom org-koma-letter-use-place t
- "Print the letter's place next to the date."
+ "Non-nil prints the letter's place next to the date.
+This option can also be set with the OPTIONS keyword, e.g.:
+\"place:nil\"."
:group 'org-export-koma-letter
:type 'boolean)
-(defcustom org-koma-letter-default-class nil
- "Default class for `org-koma-letter'.
+(defcustom org-koma-letter-use-title t
+ "Non-nil means use a title in the letter if present.
+This option can also be set with the OPTIONS keyword,
+e.g. \"title:nil\".
+
+See also `org-koma-letter-prefer-subject' for the handling of
+title versus subject."
+ :group 'org-export-koma-letter
+ :type 'boolean)
+(defcustom org-koma-letter-default-class "default-koma-letter"
+ "Default class for `org-koma-letter'.
The value must be a member of `org-latex-classes'."
:group 'org-export-koma-letter
:type 'string)
(defcustom org-koma-letter-headline-is-opening-maybe t
- "Whether a headline may be used as an opening.
+ "Non-nil means a headline may be used as an opening.
A headline is only used if #+OPENING is not set. See also
`org-koma-letter-opening'."
:group 'org-export-koma-letter
:type 'boolean)
+(defcustom org-koma-letter-prefer-subject nil
+ "Non-nil means title should be interpret as subject if subject is missing.
+This option can also be set with the OPTIONS keyword,
+e.g. \"title-subject:t\".
+
+This may be useful for older documents where the SUBJECT keyword
+was not present."
+ :group 'org-export-koma-letter
+ :type 'boolean)
+
(defconst org-koma-letter-special-tags-in-letter '(to from)
"Header tags related to the letter itself.")
@@ -294,41 +387,48 @@ A headline is only used if #+OPENING is not set. See also
(org-export-define-derived-backend 'koma-letter 'latex
:options-alist
- '((:lco "LCO" nil org-koma-letter-class-option-file)
- (:latex-class "LATEX_CLASS" nil (if org-koma-letter-default-class
- org-koma-letter-default-class
- org-latex-default-class) t)
+ '((:latex-class "LATEX_CLASS" nil org-koma-letter-default-class t)
+ (:lco "LCO" nil org-koma-letter-class-option-file)
(:author "AUTHOR" nil (org-koma-letter--get-value org-koma-letter-author) t)
- (:author-changed-in-buffer-p "AUTHOR" nil nil t)
(:from-address "FROM_ADDRESS" nil nil newline)
(:phone-number "PHONE_NUMBER" nil org-koma-letter-phone-number)
(:email "EMAIL" nil (org-koma-letter--get-value org-koma-letter-email) t)
- (:email-changed-in-buffer-p "EMAIL" nil nil t)
(:to-address "TO_ADDRESS" nil nil newline)
(:place "PLACE" nil org-koma-letter-place)
+ (:subject "SUBJECT" nil nil space)
(:opening "OPENING" nil org-koma-letter-opening)
(:closing "CLOSING" nil org-koma-letter-closing)
(:signature "SIGNATURE" nil org-koma-letter-signature newline)
+ (:special-headings nil "special-headings"
+ org-koma-letter-prefer-special-headings)
(:special-tags nil nil (append
org-koma-letter-special-tags-in-letter
org-koma-letter-special-tags-after-closing
org-koma-letter-special-tags-after-letter))
- (:special-headings nil "special-headings"
- org-koma-letter-prefer-special-headings)
(:with-after-closing nil "after-closing-order"
org-koma-letter-special-tags-after-closing)
(:with-after-letter nil "after-letter-order"
org-koma-letter-special-tags-after-letter)
(:with-backaddress nil "backaddress" org-koma-letter-use-backaddress)
- (:with-backaddress-changed-in-buffer-p nil "backaddress" nil)
+ (:with-email nil "email" org-koma-letter-use-email)
(:with-foldmarks nil "foldmarks" org-koma-letter-use-foldmarks)
- (:with-foldmarks-changed-in-buffer-p nil "foldmarks" "foldmarks-not-set")
(:with-phone nil "phone" org-koma-letter-use-phone)
- (:with-phone-changed-in-buffer-p nil "phone" nil)
- (:with-email nil "email" org-koma-letter-use-email)
- (:with-email-changed-in-buffer-p nil "email" nil)
(:with-place nil "place" org-koma-letter-use-place)
- (:with-subject nil "subject" org-koma-letter-subject-format))
+ (:with-subject nil "subject" org-koma-letter-subject-format)
+ (:with-title nil "title" org-koma-letter-use-title)
+ (:with-title-as-subject nil "title-subject" org-koma-letter-prefer-subject)
+ ;; Special properties non-nil when a setting happened in buffer.
+ ;; They are used to prioritize in-buffer settings over "lco"
+ ;; files. See `org-koma-letter-template'.
+ (:inbuffer-author "AUTHOR" nil 'koma-letter:empty)
+ (:inbuffer-email "EMAIL" nil 'koma-letter:empty)
+ (:inbuffer-phone-number "PHONE_NUMBER" nil 'koma-letter:empty)
+ (:inbuffer-place "PLACE" nil 'koma-letter:empty)
+ (:inbuffer-signature "SIGNATURE" nil 'koma-letter:empty)
+ (:inbuffer-with-backaddress nil "backaddress" 'koma-letter:empty)
+ (:inbuffer-with-email nil "email" 'koma-letter:empty)
+ (:inbuffer-with-foldmarks nil "foldmarks" 'koma-letter:empty)
+ (:inbuffer-with-phone nil "phone" 'koma-letter:empty))
:translate-alist '((export-block . org-koma-letter-export-block)
(export-snippet . org-koma-letter-export-snippet)
(headline . org-koma-letter-headline)
@@ -344,19 +444,8 @@ A headline is only used if #+OPENING is not set. See also
(if a (org-koma-letter-export-to-pdf t s v b)
(org-open-file (org-koma-letter-export-to-pdf nil s v b))))))))
-
-;;; Initialize class function
-
-(defun org-koma-letter-plug-into-ox ()
- "Add a sparse `default-koma-letter' to `org-latex-classes' and set `org-koma-letter-default-class' to `default-koma-letter'."
- (let ((class "default-koma-letter"))
- (eval-after-load "ox-latex"
- `(unless (member ,class 'org-latex-classes)
- (add-to-list 'org-latex-classes
- `(,class
- "\\documentclass[11pt]{scrlttr2}") ())
- (setq org-koma-letter-default-class class)))))
+
;;; Helper functions
(defun org-koma-letter-email ()
@@ -368,83 +457,64 @@ A headline is only used if #+OPENING is not set. See also
(defun org-koma-letter--get-tagged-contents (key)
"Get contents from a headline tagged with KEY.
-Technically, the contents is stored in `org-koma-letter-special-contents'."
+The contents is stored in `org-koma-letter-special-contents'."
(cdr (assoc (org-koma-letter--get-value key)
org-koma-letter-special-contents)))
(defun org-koma-letter--get-value (value)
- "Determines if VALUE is nil, a string, a function or a symbol and return a string or nil."
+ "Turn value into a string whenever possible.
+Determines if VALUE is nil, a string, a function or a symbol and
+return a string or nil."
(when value
(cond ((stringp value) value)
((functionp value) (funcall value))
((symbolp value) (symbol-name value))
(t value))))
+(defun org-koma-letter--special-contents-as-macro
+ (keywords &optional keep-newlines no-tag)
+ "Process KEYWORDS members of `org-koma-letter-special-contents'.
+KEYWORDS is a list of symbols. Return them as a string to be
+formatted.
-(defun org-koma-letter--special-contents-as-macro (a-list &optional keep-newlines no-tag)
- "Find members of `org-koma-letter-special-contents' corresponding to A-LIST.
-Return them as a string to be formatted.
-
-The function is used for inserting content of speciall headings
+The function is used for inserting content of special headings
such as PS.
If KEEP-NEWLINES is t newlines will not be removed. If NO-TAG is
-is t the content in `org-koma-letter-special-contents' will not
-be wrapped in a macro named whatever the members of A-LIST are
+t the content in `org-koma-letter-special-contents' will not be
+wrapped in a macro named whatever the members of KEYWORDS are
called."
- (let (output)
- (dolist (ac* a-list output)
- (let*
- ((ac (org-koma-letter--get-value ac*))
- (x (org-koma-letter--get-tagged-contents ac)))
- (when x
- (setq output
- (concat
- output "\n"
- ;; sometimes LaTeX complains about newlines
- ;; at the end or beginning of macros. Remove them.
- (org-koma-letter--format-string-as-macro
- (if keep-newlines x (org-koma-letter--normalize-string x))
- (unless no-tag ac)))))))))
-
-(defun org-koma-letter--format-string-as-macro (string &optional macro)
- "Format STRING as \"\\macro{string}\" if MACRO is given else as \"string\"."
- (if macro
- (format "\\%s{%s}" macro string)
- (format "%s" string)))
-
-(defun org-koma-letter--normalize-string (string)
- "Remove new lines in the beginning and end of `STRING'."
- (replace-regexp-in-string "\\`[ \n\t]+\\|[\n\t ]*\\'" "" string))
+ (mapconcat
+ #'(lambda (keyword)
+ (let* ((name (org-koma-letter--get-value keyword))
+ (value (org-koma-letter--get-tagged-contents name)))
+ (when value
+ (if no-tag (if keep-newlines value (org-trim value))
+ (format "\\%s{%s}\n"
+ name
+ (if keep-newlines value (org-trim value)))))))
+ keywords
+ ""))
(defun org-koma-letter--determine-to-and-from (info key)
"Given INFO determine KEY for the letter.
KEY should be `to' or `from'.
-`ox-koma-letter' allows two ways to specify to and from. If both
+`ox-koma-letter' allows two ways to specify TO and FROM. If both
are present return the preferred one as determined by
`org-koma-letter-prefer-special-headings'."
- (let* ((plist-alist '((from . :from-address)
- (to . :to-address)))
- (default-alist `((from ,org-koma-letter-from-address)
- (to "\\mbox{}")))
- (option-value (plist-get info (cdr-safe (assoc key plist-alist))))
- (head-value (org-koma-letter--get-tagged-contents key))
- (order (append
- (funcall
- (if (plist-get info :special-headings)
- 'reverse 'identity)
- `(,option-value ,head-value))
- (cdr-safe (assoc key default-alist))))
- tmp
- (adr (dolist (x order tmp)
- (when (and (not tmp) x)
- (setq tmp x)))))
- (when adr
+ (let ((option (plist-get info (if (eq key 'to) :to-address :from-address)))
+ (headline (org-koma-letter--get-tagged-contents key)))
(replace-regexp-in-string
"\n" "\\\\\\\\\n"
- (org-koma-letter--normalize-string adr)))))
+ (org-trim
+ (or (if (plist-get info :special-headings) (or headline option)
+ (or option headline))
+ ;; Fallback values.
+ (if (eq key 'to) "\\mbox{}" org-koma-letter-from-address))))))
+
+
;;; Transcode Functions
;;;; Export Block
@@ -473,12 +543,11 @@ CONTENTS is nil. INFO is a plist used as a communication
channel."
(let ((key (org-element-property :key keyword))
(value (org-element-property :value keyword)))
- ;; Handle specifically BEAMER and TOC (headlines only) keywords.
- ;; Otherwise, fallback to `latex' back-end.
+ ;; Handle specifically KOMA-LETTER keywords. Otherwise, fallback
+ ;; to `latex' back-end.
(if (equal key "KOMA-LETTER") value
(org-export-with-backend 'latex keyword contents info))))
-
;; Headline
(defun org-koma-letter-headline (headline contents info)
@@ -490,24 +559,19 @@ Note that if a headline is tagged with a tag from
`org-koma-letter-special-tags' it will not be exported, but
stored in `org-koma-letter-special-contents' and included at the
appropriate place."
- (let*
- ((tags (org-export-get-tags headline info))
- (tag* (car tags))
- (tag (when tag*
- (car (member-ignore-case
- tag*
- (mapcar 'symbol-name (plist-get info :special-tags)))))))
- (if tag
- (progn
- (push (cons tag contents)
- org-koma-letter-special-contents)
- nil)
- (unless (or (plist-get info :opening)
- (not org-koma-letter-headline-is-opening-maybe))
- (plist-put info :opening
- (org-export-data (org-element-property :title headline) info)))
- contents)))
-
+ (unless (let ((tag (car (org-export-get-tags headline info))))
+ (and tag
+ (member-ignore-case
+ tag (mapcar #'symbol-name (plist-get info :special-tags)))
+ ;; Store association for later use and bail out.
+ (push (cons tag contents) org-koma-letter-special-contents)))
+ ;; Opening is not defined yet: use headline's title.
+ (when (and org-koma-letter-headline-is-opening-maybe
+ (not (org-string-nw-p (plist-get info :opening))))
+ (plist-put info :opening
+ (org-export-data (org-element-property :title headline) info)))
+ ;; In any case, insert contents in letter's body.
+ contents))
;;;; Template
@@ -515,9 +579,6 @@ appropriate place."
"Return complete document string after KOMA Scrlttr2 conversion.
CONTENTS is the transcoded contents string. INFO is a plist
holding export options."
- ;; FIXME: instead of setq'ing org-koma-letter-special-contents and
- ;; callying varioues stuff it might be nice to put a big let* around the templace
- ;; as in org-groff...
(concat
;; Time-stamp.
(and (plist-get info :time-stamp-file)
@@ -544,94 +605,53 @@ holding export options."
(concat (org-element-normalize-string (plist-get info :latex-header))
(plist-get info :latex-header-extra)))))
info)))
- (let ((lco (plist-get info :lco))
- (author (plist-get info :author))
- (author-set (plist-get info :author-changed-in-buffer-p))
- (from-address (org-koma-letter--determine-to-and-from info 'from))
- (phone-number (plist-get info :phone-number))
- (email (plist-get info :email))
- (email-set (plist-get info :email-changed-in-buffer-p))
- (signature (plist-get info :signature)))
- (concat
- ;; author or email not set in file: may be overridden by lco
- (unless author-set
- (when author (format "\\setkomavar{fromname}{%s}\n"
- (org-export-data author info))))
- (unless email-set
- (when email (format "\\setkomavar{fromemail}{%s}\n" email)))
- ;; Letter Class Option File
- (when lco
- (let ((lco-files (split-string lco " "))
- (lco-def ""))
- (dolist (lco-file lco-files lco-def)
- (setq lco-def (format "%s\\LoadLetterOption{%s}\n" lco-def lco-file)))
- lco-def))
- ;; Define "From" data.
- (when (and author author-set) (format "\\setkomavar{fromname}{%s}\n"
- (org-export-data author info)))
- (when from-address (format "\\setkomavar{fromaddress}{%s}\n" from-address))
- (when phone-number
- (format "\\setkomavar{fromphone}{%s}\n" phone-number))
- (when (and email email-set) (format "\\setkomavar{fromemail}{%s}\n" email))
- (when signature (format "\\setkomavar{signature}{%s}\n" signature))))
+ ;; Settings. They can come from three locations, in increasing
+ ;; order of precedence: global variables, LCO files and in-buffer
+ ;; settings. Thus, we first insert settings coming from global
+ ;; variables, then we insert LCO files, and, eventually, we insert
+ ;; settings coming from buffer keywords.
+ (org-koma-letter--build-settings 'global info)
+ (mapconcat #'(lambda (file) (format "\\LoadLetterOption{%s}\n" file))
+ (org-split-string (or (plist-get info :lco) "") " ")
+ "")
+ (org-koma-letter--build-settings 'buffer info)
+ ;; From address.
+ (let ((from-address (org-koma-letter--determine-to-and-from info 'from)))
+ (when (org-string-nw-p from-address)
+ (format "\\setkomavar{fromaddress}{%s}\n" from-address)))
;; Date.
(format "\\date{%s}\n" (org-export-data (org-export-get-date info) info))
- ;; Place
- (let ((with-place (plist-get info :with-place))
- (place (plist-get info :place)))
- (when (or place (not with-place))
- (format "\\setkomavar{place}{%s}\n" (if with-place place ""))))
- ;; KOMA options
- (let ((with-backaddress (plist-get info :with-backaddress))
- (with-backaddress-set (plist-get info :with-backaddress-changed-in-buffer-p))
- (with-foldmarks (plist-get info :with-foldmarks))
- (with-foldmarks-set
- (not (string-equal (plist-get info :with-foldmarks-changed-in-buffer-p)
- "foldmarks-not-set")))
- (with-phone (plist-get info :with-phone))
- (with-phone-set (plist-get info :with-phone-changed-in-buffer-p))
- (with-email (plist-get info :with-email))
- (with-email-set (plist-get info :with-email-changed-in-buffer-p)))
- (concat
- (when with-backaddress-set
- (format "\\KOMAoption{backaddress}{%s}\n" (if with-backaddress "true" "false")))
- (when with-foldmarks-set
- (format "\\KOMAoption{foldmarks}{%s}\n" (if with-foldmarks with-foldmarks "false")))
- (when with-phone-set
- (format "\\KOMAoption{fromphone}{%s}\n" (if with-phone "true" "false")))
- (when with-email-set
- (format "\\KOMAoption{fromemail}{%s}\n" (if with-email "true" "false")))))
;; Document start
"\\begin{document}\n\n"
- ;; Subject
- (let* ((with-subject (plist-get info :with-subject))
- (subject-format (cond ((member with-subject '("true" "t" t)) nil)
- ((stringp with-subject) (list with-subject))
- ((symbolp with-subject)
- (list (symbol-name with-subject)))
- (t with-subject)))
- (subject (org-export-data (plist-get info :title) info))
- (l (length subject-format))
- (y ""))
- (concat
- (when (and with-subject subject-format)
- (concat
- "\\KOMAoption{subject}{"
- (apply 'format
- (dotimes (x l y)
- (setq y (concat (if (> x 0) "%s," "%s") y)))
- subject-format) "}\n"))
- (when (and subject with-subject)
- (format "\\setkomavar{subject}{%s}\n\n" subject))))
- ;; Letter start
+ ;; Subject and title
+ (let ((with-subject (plist-get info :with-subject)))
+ (when with-subject
+ (concat
+ (unless (eq with-subject t)
+ (format "\\KOMAoption{subject}{%s}\n"
+ (if (symbolp with-subject) with-subject
+ (mapconcat #'symbol-name with-subject ","))))
+ (let* ((title-as-subject (plist-get info :with-title-as-subject))
+ (subject* (org-string-nw-p
+ (org-export-data (plist-get info :subject) info)))
+ (title* (and (plist-get info :with-title)
+ (org-string-nw-p
+ (org-export-data (plist-get info :title) info))))
+ (subject (if title-as-subject (or subject* title*) subject*))
+ (title (if title-as-subject (and subject* title*) title*)))
+ (concat
+ (and subject (format "\\setkomavar{subject}{%s}\n" subject))
+ (and title (format "\\setkomavar{title}{%s}\n" title))
+ (when (or (org-string-nw-p title) (org-string-nw-p subject)) "\n"))))))
+ ;; Letter start.
(format "\\begin{letter}{%%\n%s}\n\n"
(org-koma-letter--determine-to-and-from info 'to))
;; Opening.
- (format "\\opening{%s}\n\n" (or (plist-get info :opening) ""))
+ (format "\\opening{%s}\n\n" (plist-get info :opening))
;; Letter body.
contents
;; Closing.
- (format "\n\\closing{%s}\n" (or (plist-get info :closing) ""))
+ (format "\n\\closing{%s}\n" (plist-get info :closing))
(org-koma-letter--special-contents-as-macro
(plist-get info :with-after-closing))
;; Letter end.
@@ -639,8 +659,65 @@ holding export options."
(org-koma-letter--special-contents-as-macro
(plist-get info :with-after-letter) t t)
;; Document end.
- "\n\\end{document}"
- ))
+ "\n\\end{document}"))
+
+(defun org-koma-letter--build-settings (scope info)
+ "Build settings string according to type.
+SCOPE is either `global' or `buffer'. INFO is a plist used as
+a communication channel."
+ (let ((check-scope
+ (function
+ ;; Non-nil value when SETTING was defined in SCOPE.
+ (lambda (setting)
+ (let ((property (intern (format ":inbuffer-%s" setting))))
+ (if (eq scope 'global)
+ (eq (plist-get info property) 'koma-letter:empty)
+ (not (eq (plist-get info property) 'koma-letter:empty))))))))
+ (concat
+ ;; Name.
+ (let ((author (plist-get info :author)))
+ (and author
+ (funcall check-scope 'author)
+ (format "\\setkomavar{fromname}{%s}\n"
+ (org-export-data author info))))
+ ;; Email.
+ (let ((email (plist-get info :email)))
+ (and email
+ (funcall check-scope 'email)
+ (format "\\setkomavar{fromemail}{%s}\n" email)))
+ (and (funcall check-scope 'with-email)
+ (format "\\KOMAoption{fromemail}{%s}\n"
+ (if (plist-get info :with-email) "true" "false")))
+ ;; Phone number.
+ (let ((phone-number (plist-get info :phone-number)))
+ (and (org-string-nw-p phone-number)
+ (funcall check-scope 'phone-number)
+ (format "\\setkomavar{fromphone}{%s}\n" phone-number)))
+ (and (funcall check-scope 'with-phone)
+ (format "\\KOMAoption{fromphone}{%s}\n"
+ (if (plist-get info :with-phone) "true" "false")))
+ ;; Signature.
+ (let ((signature (plist-get info :signature)))
+ (and (org-string-nw-p signature)
+ (funcall check-scope 'signature)
+ (format "\\setkomavar{signature}{%s}\n" signature)))
+ ;; Back address.
+ (and (funcall check-scope 'with-backaddress)
+ (format "\\KOMAoption{backaddress}{%s}\n"
+ (if (plist-get info :with-backaddress) "true" "false")))
+ ;; Place.
+ (and (funcall check-scope 'place)
+ (format "\\setkomavar{place}{%s}\n"
+ (if (plist-get info :with-place) (plist-get info :place) "")))
+ ;; Folding marks.
+ (and (funcall check-scope 'with-foldmarks)
+ (let ((foldmarks (plist-get info :with-foldmarks)))
+ (cond ((consp foldmarks)
+ (format "\\KOMAoptions{foldmarks=true,foldmarks=%s}\n"
+ (mapconcat #'symbol-name foldmarks "")))
+ (foldmarks "\\KOMAoptions{foldmarks=true}\n")
+ (t "\\KOMAoptions{foldmarks=false}\n")))))))
+
;;; Commands
diff --git a/contrib/lisp/ox-rss.el b/contrib/lisp/ox-rss.el
index 2de1dbc..c69a37b 100644
--- a/contrib/lisp/ox-rss.el
+++ b/contrib/lisp/ox-rss.el
@@ -1,6 +1,6 @@
;;; ox-rss.el --- RSS 2.0 Back-End for Org Export Engine
-;; Copyright (C) 2013 Bastien Guerry
+;; Copyright (C) 2013, 2014 Bastien Guerry
;; Author: Bastien Guerry <bzg@gnu.org>
;; Keywords: org, wp, blog, feed, rss
@@ -246,7 +246,11 @@ communication channel."
(org-time-string-to-time
(or (org-element-property :PUBDATE headline)
(error "Missing PUBDATE property"))))))
- (title (org-element-property :raw-value headline))
+ (title (replace-regexp-in-string
+ org-bracket-link-regexp
+ (lambda (m) (or (match-string 3 m)
+ (match-string 1 m)))
+ (org-element-property :raw-value headline)))
(publink
(or (and hl-perm (concat (or hl-home hl-pdir) hl-perm))
(concat
@@ -326,8 +330,8 @@ as a communication channel."
(ifile (plist-get info :input-file))
(publink
(concat (file-name-as-directory blogurl)
- (file-name-nondirectory
- (file-name-sans-extension ifile))
+ (file-name-nondirectory
+ (file-name-sans-extension ifile))
"." rssext)))
(format
"\n<title>%s</title>
diff --git a/contrib/lisp/ox-s5.el b/contrib/lisp/ox-s5.el
index d97a9b2..26e83a3 100644
--- a/contrib/lisp/ox-s5.el
+++ b/contrib/lisp/ox-s5.el
@@ -1,6 +1,6 @@
;;; ox-s5.el --- S5 Presentation Back-End for Org Export Engine
-;; Copyright (C) 2011-2013 Rick Frankel
+;; Copyright (C) 2011-2014 Rick Frankel
;; Author: Rick Frankel <emacs at rickster dot com>
;; Keywords: outlines, hypermedia, S5, wp
@@ -174,8 +174,8 @@ or an empty string."
(defcustom org-s5-title-slide-template
"<h1>%t</h1>
<h2>%a</h2>
-<h2>%e</h2>
-<h2>%d</h2>"
+<h3>%e</h3>
+<h4>%d</h4>"
"Format template to specify title page section.
See `org-html-postamble-format' for the valid elements which
can be included.
diff --git a/contrib/lisp/ox-taskjuggler.el b/contrib/lisp/ox-taskjuggler.el
index fe88b45..761e180 100644
--- a/contrib/lisp/ox-taskjuggler.el
+++ b/contrib/lisp/ox-taskjuggler.el
@@ -1,6 +1,6 @@
;;; ox-taskjuggler.el --- TaskJuggler Back-End for Org Export Engine
;;
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2014 Free Software Foundation, Inc.
;;
;; Emacs Lisp Archive Entry
;; Filename: ox-taskjuggler.el
diff --git a/doc/Makefile b/doc/Makefile
index 234ab7e..2c8a3c5 100644
--- a/doc/Makefile
+++ b/doc/Makefile
@@ -54,8 +54,9 @@ clean-install:
%: %.texi org-version.inc
$(MAKEINFO) --no-split $< -o $@
-%.pdf: LC_ALL=C # work around a bug in texi2dvi
-%.pdf: LANG=C # work around a bug in texi2dvi
+# the following two lines work around a bug in some versions of texi2dvi
+%.pdf: LC_ALL=C
+%.pdf: LANG=C
%.pdf: %.texi org-version.inc
$(TEXI2PDF) $<
%.pdf: %.tex
diff --git a/doc/doclicense.texi b/doc/doclicense.texi
index b0c97cd..aa9288e 100644
--- a/doc/doclicense.texi
+++ b/doc/doclicense.texi
@@ -5,7 +5,7 @@
@c hence no sectioning command or @node.
@display
-Copyright @copyright{} 2000, 2001, 2002, 2007, 2008, 2013 Free Software Foundation, Inc.
+Copyright @copyright{} 2000, 2001, 2002, 2007, 2008, 2013, 2014 Free Software Foundation, Inc.
@uref{http://fsf.org/}
Everyone is permitted to copy and distribute verbatim copies
diff --git a/doc/org.texi b/doc/org.texi
index 4aeae70..74b2dcc 100644
--- a/doc/org.texi
+++ b/doc/org.texi
@@ -5,17 +5,13 @@
@include org-version.inc
-@c Use proper quote and backtick for code sections in PDF output
-@c Cf. Texinfo manual 14.2
-@set txicodequoteundirected
-@set txicodequotebacktick
-
@c Version and Contact Info
@set MAINTAINERSITE @uref{http://orgmode.org,maintainers web page}
@set AUTHOR Carsten Dominik
@set MAINTAINER Carsten Dominik
@set MAINTAINEREMAIL @email{carsten at orgmode dot org}
@set MAINTAINERCONTACT @uref{mailto:carsten at orgmode dot org,contact the maintainer}
+@documentencoding UTF-8
@c %**end of header
@finalout
@@ -263,7 +259,7 @@
@copying
This manual is for Org version @value{VERSION}.
-Copyright @copyright{} 2004--2013 Free Software Foundation, Inc.
+Copyright @copyright{} 2004--2014 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -370,11 +366,6 @@ Visibility cycling
* Initial visibility:: Setting the initial visibility state
* Catching invisible edits:: Preventing mistakes when editing invisible parts
-Global and local cycling
-
-* Initial visibility:: Setting the initial visibility state
-* Catching invisible edits:: Preventing mistakes when editing invisible parts
-
Tables
* Built-in table editor:: Simple tables
@@ -591,9 +582,10 @@ Exporting
* @LaTeX{} and PDF export:: Exporting to @LaTeX{}, and processing to PDF
* Markdown export:: Exporting to Markdown
* OpenDocument text export:: Exporting to OpenDocument Text
+* Org export:: Exporting to Org
* iCalendar export:: Exporting to iCalendar
-* Other built-in back-ends:: Exporting to @code{Texinfo}, a man page, or Org
-* Export in foreign buffers:: Author tables in lists in Org syntax
+* Other built-in back-ends:: Exporting to @code{Texinfo} or a man page
+* Export in foreign buffers:: Author tables and lists in Org syntax
* Advanced configuration:: Fine-tuning the export output
HTML export
@@ -871,7 +863,11 @@ We @b{strongly recommend} to stick to a single installation method.
Recent Emacs distributions include a packaging system which lets you install
Elisp libraries. You can install Org with @kbd{M-x package-install RET org}.
-You need to do this in a session where no @code{.org} file has been visited.
+
+@noindent @b{Important}: you need to do this in a session where no @code{.org} file has
+been visited, i.e. where no Org built-in function have been loaded.
+Otherwise autoload Org functions will mess up the installation.
+
Then, to make sure your Org configuration is taken into account, initialize
the package system with @code{(package-initialize)} in your @file{.emacs}
before setting any Org option. If you want to use Org's package repository,
@@ -995,6 +991,8 @@ active region by using the mouse to select a region, or pressing
If you find problems with Org, or if you have questions, remarks, or ideas
about it, please mail to the Org mailing list @email{emacs-orgmode@@gnu.org}.
+You can subscribe to the list
+@uref{https://lists.gnu.org/mailman/listinfo/emacs-orgmode, on this web page}.
If you are not a member of the mailing list, your mail will be passed to the
list after a moderator has approved it@footnote{Please consider subscribing
to the mailing list, in order to minimize the work the mailing list
@@ -1273,6 +1271,9 @@ When @kbd{S-@key{TAB}} is called with a numeric prefix argument N, the
CONTENTS view up to headlines of level N will be shown. Note that inside
tables, @kbd{S-@key{TAB}} jumps to the previous field.
+@cindex set startup visibility, command
+@orgcmd{C-u C-u @key{TAB},org-set-startup-visibility}
+Switch back to the startup visibility of the buffer (@pxref{Initial visibility}).
@cindex show all, command
@orgcmd{C-u C-u C-u @key{TAB},show-all}
Show all, including drawers.
@@ -1310,11 +1311,6 @@ the previously used indirect buffer.
Copy the @i{visible} text in the region into the kill ring.
@end table
-@menu
-* Initial visibility:: Setting the initial visibility state
-* Catching invisible edits:: Preventing mistakes when editing invisible parts
-@end menu
-
@node Initial visibility
@subsection Initial visibility
@@ -1330,7 +1326,7 @@ When Emacs first visits an Org file, the global state is set to OVERVIEW,
i.e., only the top level headlines are visible@footnote{When
@code{org-agenda-inhibit-startup} is non-@code{nil}, Org will not honor the default
visibility state when first opening a file for the agenda (@pxref{Speeding up
-your agendas}).} This can be configured through the variable
+your agendas}).}. This can be configured through the variable
@code{org-startup-folded}, or on a per-file basis by adding one of the
following lines anywhere in the buffer:
@@ -2629,6 +2625,12 @@ table in that entry. REF is an absolute field or range reference as
described above for example @code{@@3$3} or @code{$somename}, valid in the
referenced table.
+Indirection of NAME-OR-ID: When NAME-OR-ID has the format @code{@@ROW$COLUMN}
+it will be substituted with the name or ID found in this field of the current
+table. For example @code{remote($1, @@>$2)} => @code{remote(year_2013,
+@@>$1)}. The format @code{B3} is not supported because it can not be
+distinguished from a plain table name or ID.
+
@node Formula syntax for Calc
@subsection Formula syntax for Calc
@cindex formula syntax, Calc
@@ -3872,7 +3874,7 @@ Jump to line 255.
Search for a link target @samp{<<My Target>>}, or do a text search for
@samp{my target}, similar to the search in internal links, see
@ref{Internal links}. In HTML export (@pxref{HTML export}), such a file
-link will become a HTML reference to the corresponding named anchor in
+link will become an HTML reference to the corresponding named anchor in
the linked file.
@item *My Target
In an Org file, restrict search to headlines.
@@ -5523,6 +5525,9 @@ of 5 to 20 days, representing what to expect if everything goes either
extremely well or extremely poorly. In contrast, @code{est+} estimates the
full job more realistically, at 10--15 days.
+Numbers are right-aligned when a format specifier with an explicit width like
+@code{%5d} or @code{%5.1f} is used.
+
Here is an example for a complete columns definition, along with allowed
values.
@@ -6534,6 +6539,8 @@ but you can specify your own function using the @code{:formatter} parameter.
:tcolumns @r{Number of columns to be used for times. If this is smaller}
@r{than @code{:maxlevel}, lower levels will be lumped into one column.}
:level @r{Should a level number column be included?}
+:sort @r{A cons cell like containing the column to sort and a sorting type.}
+ @r{E.g., @code{:sort (1 . ?a)} sorts the first column alphabetically.}
:compact @r{Abbreviation for @code{:level nil :indent t :narrow 40! :tcolumns 1}}
@r{All are overwritten except if there is an explicit @code{:narrow}}
:timestamp @r{A timestamp for the entry, when available. Look for SCHEDULED,}
@@ -7096,9 +7103,10 @@ narrow it so that you only see the new material.
@item :table-line-pos
Specification of the location in the table where the new line should be
-inserted. It should be a string like @code{"II-3"} meaning that the new
-line should become the third line before the second horizontal separator
-line.
+inserted. It can be a string, a variable holding a string or a function
+returning a string. The string should look like @code{"II-3"} meaning that
+the new line should become the third line before the second horizontal
+separator line.
@item :kill-buffer
If the target file was not yet visited when capture was invoked, kill the
@@ -7737,15 +7745,17 @@ current region/subtree.}. After pressing @kbd{< <}, you still need to press the
character selecting the command.
@item *
+@cindex agenda, sticky
@vindex org-agenda-sticky
Toggle sticky agenda views. By default, Org maintains only a single agenda
buffer and rebuilds it each time you change the view, to make sure everything
-is always up to date. If you switch between views often and the build time
-bothers you, you can turn on sticky agenda buffers (make this the default by
-customizing the variable @code{org-agenda-sticky}). With sticky agendas, the
-dispatcher only switches to the selected view, you need to update it by hand
-with @kbd{r} or @kbd{g}. You can toggle sticky agenda view any time with
-@code{org-toggle-sticky-agenda}.
+is always up to date. If you often switch between agenda views and the build
+time bothers you, you can turn on sticky agenda buffers or make this the
+default by customizing the variable @code{org-agenda-sticky}. With sticky
+agendas, the agenda dispatcher will not recreate agenda views from scratch,
+it will only switch to the selected one, and you need to update the agenda by
+hand with @kbd{r} or @kbd{g} when needed. You can toggle sticky agenda view
+any time with @code{org-toggle-sticky-agenda}.
@end table
You can also define custom commands that will be accessible through the
@@ -8051,7 +8061,7 @@ You may also test for properties (@pxref{Properties and columns}) at the same
time as matching tags. The properties may be real properties, or special
properties that represent other metadata (@pxref{Special properties}). For
example, the ``property'' @code{TODO} represents the TODO keyword of the
-entry and the ``propety'' @code{PRIORITY} represents the PRIORITY keyword of
+entry and the ``property'' @code{PRIORITY} represents the PRIORITY keyword of
the entry. The ITEM special property cannot currently be used in tags/property
searches@footnote{But @pxref{x-agenda-skip-entry-regexp,
,skipping entries based on regexp}.}.
@@ -9628,7 +9638,7 @@ or on a per-file basis with a line like
@end example
If you would like to move the table of contents to a different location, you
-should turn off the detault table using @code{org-export-with-toc} or
+should turn off the default table using @code{org-export-with-toc} or
@code{#+OPTIONS} and insert @code{#+TOC: headlines N} at the desired
location(s).
@@ -9725,8 +9735,8 @@ multiple footnotes side by side.
@vindex org-fontify-emphasized-text
@vindex org-emphasis-regexp-components
@vindex org-emphasis-alist
-You can make words @b{*bold*}, @i{/italic/}, _underlined_, @code{=code=}
-and @code{~verbatim~}, and, if you must, @samp{+strike-through+}. Text
+You can make words @b{*bold*}, @i{/italic/}, _underlined_, @code{=verbatim=}
+and @code{~code~}, and, if you must, @samp{+strike-through+}. Text
in the code and verbatim string is not processed for Org mode specific
syntax, it is exported verbatim.
@@ -9751,15 +9761,21 @@ a horizontal line.
@cindex #+BEGIN_COMMENT
Lines starting with zero or more whitespace characters followed by one
-@samp{#} and a whitespace are treated as comments and will never be exported.
-Also entire subtrees starting with the word @samp{COMMENT} will never be
-exported. Finally, regions surrounded by @samp{#+BEGIN_COMMENT}
-... @samp{#+END_COMMENT} will not be exported.
+@samp{#} and a whitespace are treated as comments and, as such, are not
+exported.
+
+Likewise, regions surrounded by @samp{#+BEGIN_COMMENT}
+... @samp{#+END_COMMENT} are not exported.
+
+Finally, a @samp{COMMENT} keyword at the beginning of an entry, but after any
+other keyword or priority cookie, comments out the entire subtree. In this
+case, the subtree is not exported and no code block within it is executed
+either. The command below helps changing the comment status of a headline.
@table @kbd
@kindex C-c ;
@item C-c ;
-Toggle the COMMENT keyword at the beginning of an entry.
+Toggle the @samp{COMMENT} keyword at the beginning of an entry.
@end table
@@ -9839,6 +9855,7 @@ Here is an example
@end example
@cindex formatting source code, markup rules
+@vindex org-latex-listings
If the example is source code from a programming language, or any other text
that can be marked up by font-lock in Emacs, you can ask for the example to
look like the fontified Emacs buffer@footnote{This works automatically for
@@ -9884,12 +9901,16 @@ Here is an example:
@example
#+BEGIN_SRC emacs-lisp -n -r
(save-excursion (ref:sc)
- (goto-char (point-min)) (ref:jump)
+ (goto-char (point-min))) (ref:jump)
#+END_SRC
In line [[(sc)]] we remember the current position. [[(jump)][Line (jump)]]
jumps to point-min.
@end example
+@cindex indentation, in source blocks
+Finally, you can use @code{-i} to preserve the indentation of a specific code
+block (@pxref{Editing source code}).
+
@vindex org-coderef-label-format
If the syntax for the label format conflicts with the language syntax, use a
@code{-l} switch to change the format, for example @samp{#+BEGIN_SRC pascal
@@ -9942,13 +9963,15 @@ include your @file{.emacs} file, you could use:
@noindent
The optional second and third parameter are the markup (e.g., @samp{quote},
@samp{example}, or @samp{src}), and, if the markup is @samp{src}, the
-language for formatting the contents. The markup is optional; if it is not
-given, the text will be assumed to be in Org mode format and will be
-processed normally.
+language for formatting the contents.
+
+If no markup is given, the text will be assumed to be in Org mode format and
+will be processed normally. However, footnote labels (@pxref{Footnotes}) in
+the file will be made local to that file.
Contents of the included file will belong to the same structure (headline,
item) containing the @code{INCLUDE} keyword. In particular, headlines within
-the file will become children of the current section. That behaviour can be
+the file will become children of the current section. That behavior can be
changed by providing an additional keyword parameter, @code{:minlevel}. In
that case, all headlines in the included file will be shifted so the one with
the lowest level reaches that specified level. For example, to make a file
@@ -10004,20 +10027,30 @@ You can define text snippets with
#+MACRO: name replacement text $1, $2 are arguments
@end example
-@noindent which can be referenced in
-paragraphs, verse blocks, table cells and some keywords with
-@code{@{@{@{name(arg1,arg2)@}@}@}}@footnote{Since commas separate arguments,
+@noindent which can be referenced
+@code{@{@{@{name(arg1, arg2)@}@}@}}@footnote{Since commas separate arguments,
commas within arguments have to be escaped with a backslash character.
Conversely, backslash characters before a comma, and only them, need to be
-escaped with another backslash character.}. In addition to defined macros,
-@code{@{@{@{title@}@}@}}, @code{@{@{@{author@}@}@}}, etc., will reference
-information set by the @code{#+TITLE:}, @code{#+AUTHOR:}, and similar lines.
-Also, @code{@{@{@{time(@var{FORMAT})@}@}@}} and
+escaped with another backslash character.}.
+
+These references, called macros, can be inserted anywhere Org markup is
+recognized: paragraphs, headlines, verse and example blocks, tables cells,
+lists and comments. They cannot be used within ordinary keywords (starting
+with @code{#+:}) but are allowed in @code{#+CAPTION}, @code{#+TITLE},
+@code{#+AUTHOR} and @code{#+EMAIL}.
+
+In addition to user-defined macros, a set of already defined macros can be
+used: @code{@{@{@{title@}@}@}}, @code{@{@{@{author@}@}@}}, etc., will
+reference information set by the @code{#+TITLE:}, @code{#+AUTHOR:}, and
+similar lines. Also, @code{@{@{@{time(@var{FORMAT})@}@}@}} and
@code{@{@{@{modification-time(@var{FORMAT})@}@}@}} refer to current date time
and to the modification time of the file being exported, respectively.
@var{FORMAT} should be a format string understood by
@code{format-time-string}.
+The surrounding brackets can be made invisible by setting
+@code{org-hide-macro-markers} to @code{t}.
+
Macro expansion takes place during export.
@@ -10130,19 +10163,13 @@ format sub- and superscripts in a WYSIWYM way.
Going beyond symbols and sub- and superscripts, a full formula language is
needed. Org mode can contain @LaTeX{} math fragments, and it supports ways
to process these for several export back-ends. When exporting to @LaTeX{},
-the code is obviously left as it is. When exporting to HTML, Org invokes the
-@uref{http://www.mathjax.org, MathJax library} (@pxref{Math formatting in
+the code is obviously left as it is. When exporting to HTML, Org can invoke
+the @uref{http://www.mathjax.org, MathJax library} (@pxref{Math formatting in
HTML export}) to process and display the math@footnote{If you plan to use
this regularly or on pages with significant page views, you should install
@file{MathJax} on your own server in order to limit the load of our server.}.
-Finally, it can also process the mathematical expressions into
-images@footnote{For this to work you need to be on a system with a working
-@LaTeX{} installation. You also need the @file{dvipng} program or the
-@file{convert}, respectively available at
-@url{http://sourceforge.net/projects/dvipng/} and from the @file{imagemagick}
-suite. The @LaTeX{} header that will be used when processing a fragment can
-be configured with the variable @code{org-format-latex-header}.} that can be
-displayed in a browser.
+It can also process the mathematical expressions into images that can be
+displayed in a browser (see @pxref{Previewing @LaTeX{} fragments}).
@LaTeX{} fragments don't need any special marking at all. The following
snippets will be identified as @LaTeX{} source code:
@@ -10200,11 +10227,21 @@ lines:
@cindex @LaTeX{} fragments, preview
@vindex org-latex-create-formula-image-program
-If you have @file{dvipng} or @file{imagemagick} installed@footnote{Choose the
-converter by setting the variable
+If you have a working @LaTeX{} installation and either @file{dvipng} or
+@file{convert} installed@footnote{These are respectively available at
+@url{http://sourceforge.net/projects/dvipng/} and from the @file{imagemagick}
+suite. Choose the converter by setting the variable
@code{org-latex-create-formula-image-program} accordingly.}, @LaTeX{}
-fragments can be processed to produce preview images of the typeset
-expressions:
+fragments can be processed to produce images of the typeset expressions to be
+used for inclusion while exporting to HTML (see @pxref{@LaTeX{} fragments}),
+or for inline previewing within Org mode.
+
+@vindex org-format-latex-options
+@vindex org-format-latex-header
+You can customize the variables @code{org-format-latex-options} and
+@code{org-format-latex-header} to influence some aspects of the preview. In
+particular, the @code{:scale} (and for HTML export, @code{:html-scale})
+property of the former can be used to adjust the size of the preview images.
@table @kbd
@kindex C-c C-x C-l
@@ -10220,12 +10257,6 @@ process the entire buffer.
Remove the overlay preview images.
@end table
-@vindex org-format-latex-options
-You can customize the variable @code{org-format-latex-options} to influence
-some aspects of the preview. In particular, the @code{:scale} (and for HTML
-export, @code{:html-scale}) property can be used to adjust the size of the
-preview images.
-
@vindex org-startup-with-latex-preview
You can turn on the previewing of all @LaTeX{} fragments in a file with
@@ -10308,12 +10339,19 @@ Org syntax includes pre-defined blocks (@pxref{Paragraphs} and @ref{Literal
examples}). It is also possible to create blocks containing raw code
targeted at a specific back-end (e.g., @samp{#+BEGIN_LATEX}).
-Any other block is a @emph{special block}. Each export back-end decides if
-they should be exported, and how. When the block is ignored, its contents
-are still exported, as if the block were not there. For example, when
-exporting a @samp{#+BEGIN_TEST} block, HTML back-end wraps its contents
-within @samp{<div name="test">} tag. Refer to back-end specific
-documentation for more information.
+Any other block is a @emph{special block}.
+
+For example, @samp{#+BEGIN_ABSTRACT} and @samp{#+BEGIN_VIDEO} are special
+blocks. The first one is useful when exporting to @LaTeX{}, the second one
+when exporting to HTML5.
+
+Each export back-end decides if they should be exported, and how. When the
+block is ignored, its contents are still exported, as if the opening and
+closing block lines were not there. For example, when exporting a
+@samp{#+BEGIN_TEST} block, HTML back-end wraps its contents within a
+@samp{<div name="test">} tag.
+
+Refer to back-end specific documentation for more information.
@node Exporting
@chapter Exporting
@@ -10345,9 +10383,10 @@ in the iCalendar format.
* @LaTeX{} and PDF export:: Exporting to @LaTeX{}, and processing to PDF
* Markdown export:: Exporting to Markdown
* OpenDocument text export:: Exporting to OpenDocument Text
+* Org export:: Exporting to Org
* iCalendar export:: Exporting to iCalendar
-* Other built-in back-ends:: Exporting to @code{Texinfo}, a man page, or Org
-* Export in foreign buffers:: Author tables in lists in Org syntax
+* Other built-in back-ends:: Exporting to @code{Texinfo} or a man page
+* Export in foreign buffers:: Author tables and lists in Org syntax
* Advanced configuration:: Fine-tuning the export output
@end menu
@@ -10394,7 +10433,7 @@ can be reached by calling the dispatcher with a double @kbd{C-u} prefix
argument, or with @kbd{&} key from the dispatcher.
@vindex org-export-in-background
-To make this behaviour the default, customize the variable
+To make this behavior the default, customize the variable
@code{org-export-in-background}.
@item C-b
@@ -10444,6 +10483,7 @@ Built-in back-ends include:
@item man (Man page format)
@item md (Markdown format)
@item odt (OpenDocument Text format)
+@item org (Org format)
@item texinfo (Texinfo format)
@end itemize
@@ -10523,7 +10563,8 @@ clocktable.
The tags that select a tree for export (@code{org-export-select-tags}). The
default value is @code{:export:}. Within a subtree tagged with
@code{:export:}, you can still exclude entries with @code{:noexport:} (see
-below).
+below). When headlines are selectively exported with @code{:export:}
+anywhere in a file, text before the first headline is ignored.
@item EXCLUDE_TAGS
@cindex #+EXCLUDE_TAGS
@@ -10531,7 +10572,8 @@ below).
The tags that exclude a tree from export (@code{org-export-exclude-tags}).
The default value is @code{:noexport:}. Entries with the @code{:noexport:}
tag will be unconditionally excluded from the export, even if they have an
-@code{:export:} tag.
+@code{:export:} tag. Code blocks contained in excluded subtrees will still
+be executed during export even though the subtree is not exported.
@item TITLE
@cindex #+TITLE
@@ -10688,7 +10730,7 @@ Toggle inclusion of tables (@code{org-export-with-tables}).
@cindex property, EXPORT_FILE_NAME
When exporting only a subtree, each of the previous keywords@footnote{With
-the exception of @samp{SETUPFILE}.} can be overriden locally by special node
+the exception of @samp{SETUPFILE}.} can be overridden locally by special node
properties. These begin with @samp{EXPORT_}, followed by the name of the
keyword they supplant. For example, @samp{DATE} and @samp{OPTIONS} keywords
become, respectively, @samp{EXPORT_DATE} and @samp{EXPORT_OPTIONS}
@@ -10869,7 +10911,7 @@ recognized. See @ref{@LaTeX{} and PDF export} for more information.
@cindex #+BEAMER_INNER_THEME
@cindex #+BEAMER_OUTER_THEME
Beamer export introduces a number of keywords to insert code in the
-document's header. Four control appearance of the presentantion:
+document's header. Four control appearance of the presentation:
@code{#+BEAMER_THEME}, @code{#+BEAMER_COLOR_THEME},
@code{#+BEAMER_FONT_THEME}, @code{#+BEAMER_INNER_THEME} and
@code{#+BEAMER_OUTER_THEME}. All of them accept optional arguments
@@ -10953,7 +10995,7 @@ Here is a simple example Org document that is intended for Beamer export.
@smallexample
#+TITLE: Example Presentation
#+AUTHOR: Carsten Dominik
-#+OPTIONS: H:2
+#+OPTIONS: H:2 toc:t num:t
#+LATEX_CLASS: beamer
#+LATEX_CLASS_OPTIONS: [presentation]
#+BEAMER_THEME: Madrid
@@ -10962,20 +11004,20 @@ Here is a simple example Org document that is intended for Beamer export.
* This is the first structural section
** Frame 1
-*** Thanks to Eric Fraga :B_block:BMCOL:
+*** Thanks to Eric Fraga :B_block:
:PROPERTIES:
:BEAMER_COL: 0.48
:BEAMER_ENV: block
:END:
for the first viable Beamer setup in Org
-*** Thanks to everyone else :B_block:BMCOL:
+*** Thanks to everyone else :B_block:
:PROPERTIES:
:BEAMER_COL: 0.48
:BEAMER_ACT: <2->
:BEAMER_ENV: block
:END:
for contributing to the discussion
-**** This will be formatted as a beamer note :B_note:
+**** This will be formatted as a beamer note :B_note:
:PROPERTIES:
:BEAMER_env: note
:END:
@@ -10988,7 +11030,7 @@ Here is a simple example Org document that is intended for Beamer export.
@section HTML export
@cindex HTML export
-Org mode contains a HTML (XHTML 1.0 strict) exporter with extensive
+Org mode contains an HTML (XHTML 1.0 strict) exporter with extensive
HTML formatting, in ways similar to John Gruber's @emph{markdown}
language, but with additional support for tables.
@@ -11011,11 +11053,11 @@ language, but with additional support for tables.
@table @kbd
@orgcmd{C-c C-e h h,org-html-export-to-html}
-Export as a HTML file. For an Org file @file{myfile.org},
+Export as an HTML file. For an Org file @file{myfile.org},
the HTML file will be @file{myfile.html}. The file will be overwritten
without warning.
@kbd{C-c C-e h o}
-Export as a HTML file and immediately open it with a browser.
+Export as an HTML file and immediately open it with a browser.
@orgcmd{C-c C-e h H,org-html-export-as-html}
Export to a temporary buffer. Do not create a file.
@end table
@@ -11042,7 +11084,7 @@ Export to a temporary buffer. Do not create a file.
Org can export to various (X)HTML flavors.
Setting the variable @code{org-html-doctype} allows you to export to different
-(X)HTML variants. The exported HTML will be adjusted according to the sytax
+(X)HTML variants. The exported HTML will be adjusted according to the syntax
requirements of that variant. You can either set this variable to a doctype
string directly, in which case the exporter will try to adjust the syntax
automatically, or you can use a ready-made doctype. The ready-made options
@@ -11118,12 +11160,12 @@ Becomes:
@end example
Special blocks that do not correspond to HTML5 elements (see
-@code{org-html-html5-elements}) will revert to the usual behavior,
-i.e. #+BEGIN_LEDERHOSEN will still export to <div class=''lederhosen''>.
+@code{org-html-html5-elements}) will revert to the usual behavior, i.e.,
+@code{#+BEGIN_LEDERHOSEN} will still export to @samp{<div class="lederhosen">}.
Headlines cannot appear within special blocks. To wrap a headline and its
-contents in e.g. <section> or <article> tags, set the @code{HTML_CONTAINER}
-property on the headline itself.
+contents in e.g., @samp{<section>} or @samp{<article>} tags, set the
+@code{HTML_CONTAINER} property on the headline itself.
@node HTML preamble and postamble
@subsection HTML preamble and postamble
@@ -11189,7 +11231,7 @@ includes automatic links created by radio targets (@pxref{Radio
targets}). Links to external files will still work if the target file is on
the same @i{relative} path as the published Org file. Links to other
@file{.org} files will be translated into HTML links under the assumption
-that a HTML version also exists of the linked file, at the same relative
+that an HTML version also exists of the linked file, at the same relative
path. @samp{id:} links can then be used to jump to specific entries across
files. For information related to linking files while publishing them to a
publishing directory see @ref{Publishing links}.
@@ -11222,10 +11264,39 @@ individual tables, place something like the following before the table:
#+ATTR_HTML: :border 2 :rules all :frame border
@end example
+You can also group columns in the HTML output (@pxref{Column groups}).
+
+Below is a list of options for customizing tables HTML export.
+
+@table @code
+@vindex org-html-table-align-individual-fields
+@item org-html-table-align-individual-fields
+Non-nil means attach style attributes for alignment to each table field.
+
+@vindex org-html-table-caption-above
+@item org-html-table-caption-above
+When non-nil, place caption string at the beginning of the table.
+
+@vindex org-html-table-data-tags
+@item org-html-table-data-tags
+The opening and ending tags for table data fields.
+
+@vindex org-html-table-default-attributes
+@item org-html-table-default-attributes
+Default attributes and values which will be used in table tags.
+
+@vindex org-html-table-header-tags
+@item org-html-table-header-tags
+The opening and ending tags for table header fields.
+
@vindex org-html-table-row-tags
-You can also modify the default tags used for each row by setting
-@code{org-html-table-row-tags}. See the docstring for an example on
-how to use this option.
+@item org-html-table-row-tags
+The opening and ending tags for table rows.
+
+@vindex org-html-table-use-header-tags-for-first-column
+@item org-html-table-use-header-tags-for-first-column
+Non-nil means format column one in tables with header tags.
+@end table
@node Images in HTML export
@subsection Images in HTML export
@@ -11640,10 +11711,13 @@ task, you can use @code{:caption} attribute instead. Its value should be raw
@LaTeX{} code. It has precedence over @code{#+CAPTION}.
@item :float
@itemx :placement
-Float environment for the table. Possible values are @code{sidewaystable},
+The @code{:float} specifies the float environment for the table. Possible
+values are @code{sideways}@footnote{Formerly, the value was
+@code{sidewaystable}. This is deprecated since Org 8.3.},
@code{multicolumn}, @code{t} and @code{nil}. When unspecified, a table with
-a caption will have a @code{table} environment. Moreover, @code{:placement}
-attribute can specify the positioning of the float.
+a caption will have a @code{table} environment. Moreover, the
+@code{:placement} attribute can specify the positioning of the float. Note:
+@code{:placement} is ignored for @code{:float sideways} tables.
@item :align
@itemx :font
@itemx :width
@@ -11746,6 +11820,11 @@ environment.
@code{wrap}: if you would like to let text flow around the image. It will
make the figure occupy the left half of the page.
@item
+@code{sideways}: if you would like the image to appear alone on a separate
+page rotated ninety degrees using the @code{sidewaysfigure}
+environment. Setting this @code{:float} option will ignore the
+@code{:placement} setting.
+@item
@code{nil}: if you need to avoid any floating environment, even when
a caption is provided.
@end itemize
@@ -11765,13 +11844,12 @@ the @LaTeX{} @code{\includegraphics} macro will be commented out.
@cindex plain lists, in @LaTeX{} export
Plain lists accept two optional attributes: @code{:environment} and
-@code{:options}. The first one allows the use of a non-standard
-environment (e.g., @samp{inparaenum}). The second one specifies
-optional arguments for that environment (square brackets may be
-omitted).
+@code{:options}. The first one allows the use of a non-standard environment
+(e.g., @samp{inparaenum}). The second one specifies additional arguments for
+that environment.
@example
-#+ATTR_LATEX: :environment compactitem :options $\circ$
+#+ATTR_LATEX: :environment compactitem :options [$\circ$]
- you need ``paralist'' package to reproduce this example.
@end example
@@ -11779,17 +11857,19 @@ omitted).
@cindex source blocks, in @LaTeX{} export
In addition to syntax defined in @ref{Literal examples}, names and captions
-(@pxref{Images and tables}), source blocks also accept a @code{:float}
-attribute. You may set it to:
+(@pxref{Images and tables}), source blocks also accept two additional
+attributes: @code{:float} and @code{:options}.
+
+You may set the former to
@itemize @minus
@item
@code{t}: if you want to make the source block a float. It is the default
value when a caption is provided.
@item
-@code{mulicolumn}: if you wish to include a source block which spans multiple
-colums in a page.
+@code{multicolumn}: if you wish to include a source block which spans multiple
+columns in a page.
@item
-@code{nil}: if you need to avoid any floating evironment, even when a caption
+@code{nil}: if you need to avoid any floating environment, even when a caption
is provided. It is useful for source code that may not fit in a single page.
@end itemize
@@ -11800,14 +11880,35 @@ Code that may not fit in a single page.
#+END_SRC
@end example
+@vindex org-latex-listings-options
+@vindex org-latex-minted-options
+The latter allows to specify options relative to the package used to
+highlight code in the output (e.g., @code{listings}). This is the local
+counterpart to @code{org-latex-listings-options} and
+@code{org-latex-minted-options} variables, which see.
+
+@example
+#+ATTR_LATEX: :options commentstyle=\bfseries
+#+BEGIN_SRC emacs-lisp
+ (defun Fib (n) ; Count rabbits.
+ (if (< n 2) n (+ (Fib (- n 1)) (Fib (- n 2)))))
+#+END_SRC
+@end example
+
@subsubheading Special blocks in @LaTeX{} export
@cindex special blocks, in @LaTeX{} export
+@cindex abstract, in @LaTeX{} export
+@cindex proof, in @LaTeX{} export
In @LaTeX{} back-end, special blocks become environments of the same name.
Value of @code{:options} attribute will be appended as-is to that
environment's opening string. For example:
@example
+#+BEGIN_ABSTRACT
+We demonstrate how to solve the Syracuse problem.
+#+END_ABSTRACT
+
#+ATTR_LATEX: :options [Proof of important theorem]
#+BEGIN_PROOF
...
@@ -11819,6 +11920,10 @@ Therefore, any even number greater than 2 is the sum of two primes.
becomes
@example
+\begin@{abstract@}
+We demonstrate how to solve the Syracuse problem.
+\end@{abstract@}
+
\begin@{proof@}[Proof of important theorem]
...
Therefore, any even number greater than 2 is the sum of two primes.
@@ -11851,7 +11956,7 @@ respectively, @code{:width} and @code{:thickness} attributes:
@section Markdown export
@cindex Markdown export
-@code{md} export back-end generates Markdown syntax@footnote{Vanilla flavour,
+@code{md} export back-end generates Markdown syntax@footnote{Vanilla flavor,
as defined at @url{http://daringfireball.net/projects/markdown/}.} for an Org
mode buffer.
@@ -12555,13 +12660,13 @@ file. The use of this feature is better illustrated with couple of examples.
@enumerate
@item Embedding ODT tags as part of regular text
-You can include simple OpenDocument tags by prefixing them with
-@samp{@@}. For example, to highlight a region of text do the following:
+You can inline OpenDocument syntax by enclosing it within
+@samp{@@@@odt:...@@@@} markup. For example, to highlight a region of text do
+the following:
@example
-@@<text:span text:style-name="Highlight">This is a
-highlighted text@@</text:span>. But this is a
-regular text.
+@@@@odt:<text:span text:style-name="Highlight">This is a highlighted
+text</text:span>@@@@. But this is a regular text.
@end example
@strong{Hint:} To see the above example in action, edit your
@@ -12797,6 +12902,27 @@ will take care of updating the @code{rng-schema-locating-files} for you.
@c end opendocument
+@node Org export
+@section Org export
+@cindex Org export
+
+@code{org} export back-end creates a normalized version of the Org document
+in current buffer. In particular, it evaluates Babel code (@pxref{Evaluating
+code blocks}) and removes other back-ends specific contents.
+
+@subheading Org export commands
+
+@table @kbd
+@orgcmd{C-c C-e O o,org-org-export-to-org}
+Export as an Org document. For an Org file, @file{myfile.org}, the resulting
+file will be @file{myfile.org.org}. The file will be overwritten without
+warning.
+@orgcmd{C-c C-e O O,org-org-export-as-org}
+Export to a temporary buffer. Do not create a file.
+@item C-c C-e O v
+Export to an Org file, then open it.
+@end table
+
@node iCalendar export
@section iCalendar export
@cindex iCalendar export
@@ -12871,12 +12997,11 @@ you are using. The FAQ covers this issue.
@cindex export back-ends, built-in
@vindex org-export-backends
-On top of the aforemetioned back-ends, Org comes with other built-in ones:
+On top of the aforementioned back-ends, Org comes with other built-in ones:
@itemize
@item @file{ox-man.el}: export to a man page.
@item @file{ox-texinfo.el}: export to @code{Texinfo} format.
-@item @file{ox-org.el}: export to an Org document.
@end itemize
To activate these export back-ends, customize @code{org-export-backends} or
@@ -12904,8 +13029,8 @@ Convert the selected region into @code{Texinfo}.
Convert the selected region into @code{MarkDown}.
@end table
-This is particularily useful for converting tables and lists in foreign
-buffers. E.g., in a HTML buffer, you can turn on @code{orgstruct-mode}, then
+This is particularly useful for converting tables and lists in foreign
+buffers. E.g., in an HTML buffer, you can turn on @code{orgstruct-mode}, then
use Org commands for editing a list, and finally select and convert the list
with @code{M-x org-html-convert-region-to-html RET}.
@@ -13099,9 +13224,9 @@ channel."
@end lisp
The @code{my-ascii-src-block} function looks at the attribute above the
-element. If it isn’t true, it gives hand to the @code{ascii} back-end.
+element. If it isn't true, it gives hand to the @code{ascii} back-end.
Otherwise, it creates a box around the code, leaving room for the language.
-A new back-end is then created. It only changes its behaviour when
+A new back-end is then created. It only changes its behavior when
translating @code{src-block} type element. Now, all it takes to use the new
back-end is calling the following from an Org buffer:
@@ -13343,10 +13468,13 @@ string of these options for details.
@end multitable
@vindex org-html-doctype
+@vindex org-html-container-element
+@vindex org-html-html5-fancy
@vindex org-html-xml-declaration
@vindex org-html-link-up
@vindex org-html-link-home
@vindex org-html-link-org-files-as-html
+@vindex org-html-link-use-abs-url
@vindex org-html-head
@vindex org-html-head-extra
@vindex org-html-inline-images
@@ -13354,21 +13482,26 @@ string of these options for details.
@vindex org-html-preamble
@vindex org-html-postamble
@vindex org-html-table-default-attributes
+@vindex org-html-table-row-tags
@vindex org-html-head-include-default-style
@vindex org-html-head-include-scripts
@multitable @columnfractions 0.32 0.68
@item @code{:html-doctype} @tab @code{org-html-doctype}
+@item @code{:html-container} @tab @code{org-html-container-element}
+@item @code{:html-html5-fancy} @tab @code{org-html-html5-fancy}
@item @code{:html-xml-declaration} @tab @code{org-html-xml-declaration}
@item @code{:html-link-up} @tab @code{org-html-link-up}
@item @code{:html-link-home} @tab @code{org-html-link-home}
@item @code{:html-link-org-as-html} @tab @code{org-html-link-org-files-as-html}
+@item @code{:html-link-use-abs-url} @tab @code{org-html-link-use-abs-url}
@item @code{:html-head} @tab @code{org-html-head}
@item @code{:html-head-extra} @tab @code{org-html-head-extra}
@item @code{:html-inline-images} @tab @code{org-html-inline-images}
@item @code{:html-extension} @tab @code{org-html-extension}
@item @code{:html-preamble} @tab @code{org-html-preamble}
@item @code{:html-postamble} @tab @code{org-html-postamble}
-@item @code{:html-table-attributes} @tab @code{org-html-table-default-attributes}
+@item @code{:html-table-attributes} @tab @code{org-html-table-default-attributes}
+@item @code{:html-table-row-tags} @tab @code{org-html-table-row-tags}
@item @code{:html-head-include-default-style} @tab @code{org-html-head-include-default-style}
@item @code{:html-head-include-scripts} @tab @code{org-html-head-include-scripts}
@end multitable
@@ -13750,8 +13883,14 @@ can be used to map arbitrary language names to existing major modes.
@item org-src-window-setup
Controls the way Emacs windows are rearranged when the edit buffer is created.
@item org-src-preserve-indentation
-This variable is especially useful for tangling languages such as
-Python, in which whitespace indentation in the output is critical.
+@cindex indentation, in source blocks
+By default, the value is @code{nil}, which means that when code blocks are
+evaluated during export or tangled, they are re-inserted into the code block,
+which may replace sequences of spaces with tab characters. When non-nil,
+whitespace in code blocks will be preserved during export or tangling,
+exactly as it appears. This variable is especially useful for tangling
+languages such as Python, in which whitespace indentation in the output is
+critical.
@item org-src-ask-before-returning-to-edit-buffer
By default, Org will ask before returning to an open edit buffer. Set this
variable to @code{nil} to switch without asking.
@@ -13774,7 +13913,8 @@ results of code block evaluation. For information on exporting code block
bodies, see @ref{Literal examples}.
The @code{:exports} header argument can be used to specify export
-behavior:
+behavior (note that these arguments are only relevant for code blocks, not
+inline code):
@subsubheading Header arguments:
@@ -13801,12 +13941,15 @@ ensure that no code blocks are evaluated as part of the export process. This
can be useful in situations where potentially untrusted Org mode files are
exported in an automated fashion, for example when Org mode is used as the
markup language for a wiki. It is also possible to set this variable to
-@code{‘inline-only}. In that case, only inline code blocks will be
+@code{inline-only}. In that case, only inline code blocks will be
evaluated, in order to insert their results. Non-inline code blocks are
assumed to have their results already inserted in the buffer by manual
evaluation. This setting is useful to avoid expensive recalculations during
export, not to provide security.
+Code blocks in commented subtrees (@pxref{Comment lines}) are never evaluated
+on export. However, code blocks in subtrees excluded from export
+(@pxref{Export settings}) may be evaluated on export.
@node Extracting source code
@section Extracting source code
@@ -13903,10 +14046,13 @@ its results into the Org mode buffer.
@cindex #+CALL
It is also possible to evaluate named code blocks from anywhere in an Org
-mode buffer or an Org mode table. Live code blocks located in the current
-Org mode buffer or in the ``Library of Babel'' (see @ref{Library of Babel})
-can be executed. Named code blocks can be executed with a separate
-@code{#+CALL:} line or inline within a block of text.
+mode buffer or an Org mode table. These named code blocks can be located in
+the current Org mode buffer or in the ``Library of Babel'' (see @ref{Library
+of Babel}). Named code blocks can be evaluated with a separate
+@code{#+CALL:} line or inline within a block of text. In both cases
+the result is wrapped according to the value of
+@var{org-babel-inline-result-wrap}, which by default is @code{"=%s="} for
+markup that produces verbatim text.
The syntax of the @code{#+CALL:} line is
@@ -14130,7 +14276,7 @@ looked up with inheritance, regardless of the value of
outermost call or source block.@footnote{The deprecated syntax for default
header argument properties, using the name of the header argument as a
property name directly, evaluates the property as seen by the corresponding
-source block definition. This behaviour has been kept for backwards
+source block definition. This behavior has been kept for backwards
compatibility.}
In the following example the value of
@@ -14774,7 +14920,8 @@ which the link does not point.
@cindex @code{:exports}, src header argument
The @code{:exports} header argument specifies what should be included in HTML
-or @LaTeX{} exports of the Org mode file.
+or @LaTeX{} exports of the Org mode file. Note that the @code{:exports}
+option is only relevant for code blocks, not inline code.
@itemize @bullet
@item @code{code}
@@ -14870,6 +15017,9 @@ during tangling. This has the effect of assigning values to variables
specified with @code{:var} (see @ref{var}), and of replacing ``noweb''
references (see @ref{Noweb reference syntax}) with their targets. The
@code{:no-expand} header argument can be used to turn off this behavior.
+Note: The @code{:no-expand} header argument has no impact on export,
+i.e. code blocks will irrespective of this header argument expanded for
+execution.
@node session
@subsubsection @code{:session}
@@ -15837,7 +15987,7 @@ The corresponding variable is @code{org-archive-location}.
This line sets the category for the agenda file. The category applies
for all subsequent lines until the next @samp{#+CATEGORY} line, or the
end of the file. The first such line also applies to any entries before it.
-@item #+COLUMNS: %25ITEM .....
+@item #+COLUMNS: %25ITEM ...
@cindex property, COLUMNS
Set the default format for columns view. This format applies when
columns view is invoked in locations where no @code{COLUMNS} property
@@ -15852,7 +16002,7 @@ The global version of this variable is
@item #+FILETAGS: :tag1:tag2:tag3:
Set tags that can be inherited by any entry in the file, including the
top-level entries.
-@item #+LINK: linkword replace
+@item #+LINK: linkword replace
@vindex org-link-abbrev-alist
These lines (several are allowed) specify link abbreviations.
@xref{Link abbreviations}. The corresponding variable is
@@ -16868,7 +17018,7 @@ Orgtbl mode how to translate this table and where to install it. For
example:
@cindex #+ORGTBL
@example
-#+ORGTBL: SEND table_name translation_function arguments....
+#+ORGTBL: SEND table_name translation_function arguments...
@end example
@noindent
@@ -17968,7 +18118,7 @@ inspired some of the early development, including HTML export. He also
asked for a way to narrow wide table columns.
@item
@i{Jason Dunsmore} has been maintaining the Org-Mode server at Rackspace for
-several years now. He also sponsered the hosting costs until Rackspace
+several years now. He also sponsored the hosting costs until Rackspace
started to host us for free.
@item
@i{Thomas S. Dye} contributed documentation on Worg and helped integrating
diff --git a/doc/orgcard.tex b/doc/orgcard.tex
index 69bf302..cf1e309 100644
--- a/doc/orgcard.tex
+++ b/doc/orgcard.tex
@@ -1,7 +1,7 @@
% Reference Card for Org Mode
-\def\orgversionnumber{8.0}
-\def\versionyear{2013} % latest update
-\def\year{2013} % latest copyright year
+\def\orgversionnumber{8.2}
+\def\versionyear{2014} % latest update
+\def\year{2014} % latest copyright year
%**start of header
\newcount\columnsperpage
@@ -17,7 +17,7 @@
\pdflayout=(0l)
% Nothing else needs to be changed below this line.
-% Copyright (C) 1987, 1993, 1996-1997, 2001-2013 Free Software
+% Copyright (C) 1987, 1993, 1996-1997, 2001-2014 Free Software
% Foundation, Inc.
% This file is part of GNU Emacs.
diff --git a/doc/orgguide.texi b/doc/orgguide.texi
index da4bbc5..f93b99a 100644
--- a/doc/orgguide.texi
+++ b/doc/orgguide.texi
@@ -39,7 +39,7 @@
@end macro
@copying
-Copyright @copyright{} 2010--2013 Free Software Foundation
+Copyright @copyright{} 2010--2014 Free Software Foundation
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -2169,10 +2169,14 @@ consisting of only dashes, and at least 5 of them.
@subheading Comment lines
Lines starting with zero or more whitespace characters followed by @samp{#}
-and a whitespace are treated as comments and will never be exported. Also
-entire subtrees starting with the word @samp{COMMENT} will never be exported.
-Finally, regions surrounded by @samp{#+BEGIN_COMMENT}
-... @samp{#+END_COMMENT} will not be exported.
+and a whitespace are treated as comments and, as such, are not exported.
+
+Likewise, regions surrounded by @samp{#+BEGIN_COMMENT}
+... @samp{#+END_COMMENT} are not exported.
+
+Finally, a @samp{COMMENT} keyword at the beginning of an entry, but after any
+other keyword or priority cookie, comments out the entire subtree. The
+command below helps changing the comment status of a headline.
@table @kbd
@item C-c ;
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 15e6a06..de7fa20 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -11,6 +11,12 @@ Please send Org bug reports to emacs-orgmode@gnu.org.
* Version 8.2
** Incompatible changes
+*** =ob-sh.el= renamed to =ob-shell=
+This may require two changes in user config.
+
+1. In =org-babel-do-load-languages=, change =(sh . t)= to =(shell . t)=.
+2. Edit =local.mk= files to change the value of =BTEST_OB_LANGUAGES=
+ to remove "sh" and include "shell".
*** Combine org-mac-message.el and org-mac-link-grabber into org-mac-link.el
@@ -101,7 +107,7 @@ of the list.
Add support for ell, imath, jmath, varphi, varpi, aleph, gimel, beth,
dalet, cdots, S (§), dag, ddag, colon, therefore, because, triangleq,
leq, geq, lessgtr, lesseqgtr, ll, lll, gg, ggg, prec, preceq,
-preccurleyeq, succ, succeq, succurleyeq, setminus, nexist(s), mho,
+preccurlyeq, succ, succeq, succurlyeq, setminus, nexist(s), mho,
check, frown, diamond. Changes loz, vert, checkmark, smile and tilde.
*** Anonymous export back-ends
@@ -146,7 +152,7 @@ This makes java executable configurable for ditaa blocks.
This enables SVG generation from latex code blocks.
-*** New option: [[doc:org-habit-show-done-alwyays-green][org-habit-show-done-alwyays-green]]
+*** New option: [[doc:org-habit-show-done-always-green][org-habit-show-done-always-green]]
See [[http://lists.gnu.org/archive/html/emacs-orgmode/2013-05/msg00214.html][this message]] from Max Mikhanosha.
@@ -171,6 +177,18 @@ then inline code snippets will be wrapped into the formatting string.
- =org-screenshot.el= by Max Mikhanosha :: an utility to handle
screenshots easily from Org, using the external tool [[http://freecode.com/projects/scrot][scrot]].
+** Miscellaneous
+
+*** "QUOTE" keywords in headlines are deprecated
+
+"QUOTE" keywords are an undocumented feature in Org. When a headline
+starts with the keyword "QUOTE", its contents are parsed as
+a ~quote-section~ and treated as an example block. You can achieve
+the same with example blocks.
+
+This feature is deprecated and will be removed in the next Org
+release.
+
* Version 8.0.1
** Installation
@@ -277,8 +295,8 @@ manual for details and check [[http://orgmode.org/worg/org-8.0.html][this Worg p
moved some contributions into the =contrib/= directory.
The rationale for deciding that these files should live in =contrib/=
- is either because they rely on third-part softwares that are not
- included in Emacs, or because they are not targetting a significant
+ is either because they rely on third-party software that is not
+ included in Emacs, or because they are not targeting a significant
user-base.
- org-colview-xemacs.el
@@ -395,7 +413,7 @@ Among the new/updated export options, three are of particular importance:
- [[doc:org-export-allow-bind-keywords][org-export-allow-bind-keywords]] :: This option replaces the old option
=org-export-allow-BIND= and the default value is =nil=, not =confirm=.
- You will need to explicitely set this to =t= in your initialization
+ You will need to explicitly set this to =t= in your initialization
file if you want to allow =#+BIND= keywords.
- [[doc:org-export-with-planning][org-export-with-planning]] :: This new option controls the export of
@@ -654,7 +672,7 @@ headlines and their content (but not subheadings) into the new file.
This is useful when you want to quickly share an agenda containing the full
list of notes.
-**** New commands to drag an agenda line forward (=M-<down>=) or backard (=M-<up>=)
+**** New commands to drag an agenda line forward (=M-<down>=) or backward (=M-<up>=)
It sometimes handy to move agenda lines around, just to quickly reorganize
your tasks, or maybe before saving the agenda to a file. Now you can use
@@ -717,7 +735,7 @@ string is important to keep the agenda alignment clean.
When [[doc:org-agenda-skip-scheduled-if-deadline-is-shown][org-agenda-skip-scheduled-if-deadline-is-shown]] is set to
=repeated-after-deadline=, the agenda will skip scheduled items if they are
-repeated beyond the current dealine.
+repeated beyond the current deadline.
**** New option for [[doc:org-agenda-skip-deadline-prewarning-if-scheduled][org-agenda-skip-deadline-prewarning-if-scheduled]]
@@ -757,7 +775,7 @@ check against the name of the buffer.
Using =#+TAGS: { Tag1 : Tag2 Tag3 }= will define =Tag1= as a /group tag/
(note the colon after =Tag1=). If you search for =Tag1=, it will return
-headlines containing either =Tag1=, =Tag2= or =Tag3= (or any combinaison
+headlines containing either =Tag1=, =Tag2= or =Tag3= (or any combination
of those tags.)
You can use group tags for sparse tree in an Org buffer, for creating
@@ -1069,7 +1087,7 @@ See http://orgmode.org/elpa/
| =k= | | [[doc::org-agenda-capture][org-agenda-capture]] |
| C-c , | , | [[doc::org-priority][org-priority]] |
-** New package and Babel langage
+** New package and Babel language
*** =org-eshell.el= by Konrad Hinsen is now in Org
diff --git a/etc/styles/README b/etc/styles/README
index 3343b88..d04f434 100644
--- a/etc/styles/README
+++ b/etc/styles/README
@@ -1,7 +1,7 @@
The files OrgOdtContentTemplate.xml and OrgOdtStyles.xml have the
following copyright information:
-Copyright (C) 2010-2013 Free Software Foundation, Inc.
+Copyright (C) 2010-2014 Free Software Foundation, Inc.
These files are part of GNU Emacs.
diff --git a/lisp/ob-C.el b/lisp/ob-C.el
index bac2920..bbd0525 100644
--- a/lisp/ob-C.el
+++ b/lisp/ob-C.el
@@ -1,8 +1,8 @@
;;; ob-C.el --- org-babel functions for C and similar languages
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
-;; Author: Eric Schulte
+;; Author: Eric Schulte, Thierry Banel
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
@@ -23,7 +23,7 @@
;;; Commentary:
-;; Org-Babel support for evaluating C code.
+;; Org-Babel support for evaluating C, C++, D code.
;;
;; very limited implementation:
;; - currently only support :results output
@@ -37,10 +37,11 @@
(declare-function org-entry-get "org"
(pom property &optional inherit literal-nil))
-
+(declare-function org-remove-indentation "org" (code &optional n))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("C++" . "cpp"))
+(add-to-list 'org-babel-tangle-lang-exts '("D" . "d"))
(defvar org-babel-default-header-args:C '())
@@ -52,8 +53,11 @@ executable.")
"Command used to compile a C++ source code file into an
executable.")
+(defvar org-babel-D-compiler "rdmd"
+ "Command used to compile and execute a D source code file.")
+
(defvar org-babel-c-variant nil
- "Internal variable used to hold which type of C (e.g. C or C++)
+ "Internal variable used to hold which type of C (e.g. C or C++ or D)
is currently being evaluated.")
(defun org-babel-execute:cpp (body params)
@@ -66,71 +70,100 @@ This function calls `org-babel-execute:C++'."
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)
- "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)))
+;;(defun org-babel-expand-body:C++ (body params) ;; unused
+;; "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)))
+
+(defun org-babel-execute:D (body params)
+ "Execute a block of D code with org-babel.
+This function is called by `org-babel-execute-src-block'."
+ (let ((org-babel-c-variant 'd)) (org-babel-C-execute body params)))
+
+;; (defun org-babel-expand-body:D (body params) ;; unused
+;; "Expand a block of D code with org-babel according to it's
+;;header arguments (calls `org-babel-C-expand')."
+;; (let ((org-babel-c-variant 'd)) (org-babel-C-expand 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 'c)) (org-babel-C-execute 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 'c)) (org-babel-C-expand body params)))
+;; (defun org-babel-expand-body:c (body params) ;; unused
+;; "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 'c)) (org-babel-C-expand body params)))
(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++' or `org-babel-execute:D'."
(let* ((tmp-src-file (org-babel-temp-file
"C-src-"
(cond
- ((equal org-babel-c-variant 'c) ".c")
- ((equal org-babel-c-variant 'cpp) ".cpp"))))
- (tmp-bin-file (org-babel-temp-file "C-bin-" org-babel-exeext))
- (cmdline (cdr (assoc :cmdline params)))
- (flags (cdr (assoc :flags params)))
- (full-body (org-babel-C-expand body params))
- (compile
- (progn
- (with-temp-file tmp-src-file (insert full-body))
- (org-babel-eval
- (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))
- (org-babel-process-file-name tmp-bin-file)
- (mapconcat 'identity
- (if (listp flags) flags (list flags)) " ")
- (org-babel-process-file-name tmp-src-file)) ""))))
+ ((equal org-babel-c-variant 'c ) ".c" )
+ ((equal org-babel-c-variant 'cpp) ".cpp")
+ ((equal org-babel-c-variant 'd ) ".d" ))))
+ (tmp-bin-file (org-babel-temp-file "C-bin-" org-babel-exeext)) ;; not used for D
+ (cmdline (cdr (assoc :cmdline params)))
+ (cmdline (if cmdline (concat " " cmdline) ""))
+ (flags (cdr (assoc :flags params)))
+ (flags (mapconcat 'identity
+ (if (listp flags) flags (list flags)) " "))
+ (full-body
+ (cond ((equal org-babel-c-variant 'c ) (org-babel-C-expand-C body params))
+ ((equal org-babel-c-variant 'cpp) (org-babel-C-expand-C++ body params))
+ ((equal org-babel-c-variant 'd ) (org-babel-C-expand-D body params)))))
+ (with-temp-file tmp-src-file (insert full-body))
+ (if (memq org-babel-c-variant '(c cpp)) ;; no separate compilation for D
+ (org-babel-eval
+ (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))
+ (org-babel-process-file-name tmp-bin-file)
+ flags
+ (org-babel-process-file-name tmp-src-file)) ""))
(let ((results
- (org-babel-trim
- (org-babel-eval
- (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))
+ (org-babel-trim
+ (org-remove-indentation
+ (org-babel-eval
+ (cond ((memq org-babel-c-variant '(c cpp))
+ (concat tmp-bin-file cmdline))
+ ((equal org-babel-c-variant 'd)
+ (format "%s %s %s %s"
+ org-babel-D-compiler
+ flags
+ (org-babel-process-file-name tmp-src-file)
+ cmdline)))
+ "")))))
(org-babel-reassemble-table
(org-babel-result-cond (cdr (assoc :result-params params))
(org-babel-read results t)
- (let ((tmp-file (org-babel-temp-file "c-")))
- (with-temp-file tmp-file (insert results))
- (org-babel-import-elisp-from-file tmp-file)))
+ (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-pick-name
- (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
- (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))
+ (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))
))
-(defun org-babel-C-expand (body params)
+(defun org-babel-C-expand-C++ (body params)
+ "Expand a block of C or C++ code with org-babel according to
+it's header arguments."
+ (org-babel-C-expand-C body params))
+
+(defun org-babel-C-expand-C (body params)
"Expand a block of C or C++ code with org-babel according to
it's header arguments."
(let ((vars (mapcar #'cdr (org-babel-get-header params :var)))
- (main-p (not (string= (cdr (assoc :main params)) "no")))
- (includes (or (cdr (assoc :includes params))
- (org-babel-read (org-entry-get nil "includes" t))))
- (defines (org-babel-read
- (or (cdr (assoc :defines params))
- (org-babel-read (org-entry-get nil "defines" t))))))
+ (main-p (not (string= (cdr (assoc :main params)) "no")))
+ (includes (or (cdr (assoc :includes params))
+ (org-babel-read (org-entry-get nil "includes" t))))
+ (defines (org-babel-read
+ (or (cdr (assoc :defines params))
+ (org-babel-read (org-entry-get nil "defines" t))))))
(mapconcat 'identity
(list
;; includes
@@ -148,6 +181,27 @@ it's header arguments."
(org-babel-C-ensure-main-wrap body)
body) "\n") "\n")))
+(defun org-babel-C-expand-D (body params)
+ "Expand a block of D code with org-babel according to
+it's header arguments."
+ (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))
+ (main-p (not (string= (cdr (assoc :main params)) "no")))
+ (imports (or (cdr (assoc :imports params))
+ (org-babel-read (org-entry-get nil "imports" t)))))
+ (mapconcat 'identity
+ (list
+ "module mmm;"
+ ;; imports
+ (mapconcat
+ (lambda (inc) (format "import %s;" inc))
+ (if (listp imports) imports (list imports)) "\n")
+ ;; variables
+ (mapconcat 'org-babel-C-var-to-C vars "\n")
+ ;; body
+ (if main-p
+ (org-babel-C-ensure-main-wrap body)
+ body) "\n") "\n")))
+
(defun org-babel-C-ensure-main-wrap (body)
"Wrap BODY in a \"main\" function call if none exists."
(if (string-match "^[ \t]*[intvod]+[ \t\n\r]*main[ \t]*(.*)" body)
@@ -188,17 +242,16 @@ FORMAT can be either a format string or a function which is called with VAL."
(format "[%d]%s"
(length val)
(car (org-babel-C-format-val type (elt val 0))))
- (concat "{ "
+ (concat (if (equal org-babel-c-variant 'd) "[ " "{ ")
(mapconcat (lambda (v)
(cdr (org-babel-C-format-val type v)))
val
", ")
- " }"))))))
+ (if (equal org-babel-c-variant 'd) " ]" " }")))))))
(t ;; treat unknown types as string
- '("char" (lambda (val)
- (let ((s (format "%s" val))) ;; convert to string for unknown types
- (cons (format "[%d]" (1+ (length s)))
- (concat "\"" s "\""))))))))
+ (list
+ (if (equal org-babel-c-variant 'd) "string" "const char*")
+ "\"%s\""))))
(defun org-babel-C-val-to-C-list-type (val)
"Determine the C array type of a VAL."
@@ -211,7 +264,7 @@ FORMAT can be either a format string or a function which is called with VAL."
(when (and type (not (string= type-name tmp-type-name)))
(if (and (member type-name '("int" "double" "int32_t"))
(member tmp-type-name '("int" "double" "int32_t")))
- (setq tmp-type '("double" "" "%f"))
+ (setq tmp-type '("double" "%f"))
(error "Only homogeneous lists are supported by C. You can not mix %s and %s"
type-name
tmp-type-name)))
@@ -224,11 +277,11 @@ FORMAT can be either a format string or a function which is called with VAL."
of the same value."
;; TODO list support
(let ((var (car pair))
- (val (cdr pair)))
+ (val (cdr pair)))
(when (symbolp val)
(setq val (symbol-name val))
(when (= (length val) 1)
- (setq val (string-to-char val))))
+ (setq val (string-to-char val))))
(let* ((type-data (org-babel-C-val-to-C-type val))
(type (car type-data))
(formated (org-babel-C-format-val type-data val))
diff --git a/lisp/ob-J.el b/lisp/ob-J.el
new file mode 100644
index 0000000..13ea3fe
--- a/dev/null
+++ b/lisp/ob-J.el
@@ -0,0 +1,179 @@
+;;; ob-J.el --- org-babel functions for J evaluation
+
+;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
+
+;; Author: Oleh Krehel
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; 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:
+
+;; Org-Babel support for evaluating J code.
+;;
+;; Session interaction depends on `j-console' from package `j-mode'
+;; (available in MELPA).
+
+;;; Code:
+(require 'ob)
+
+(declare-function org-trim "org" (S))
+(declare-function j-console-ensure-session "ext:j-console" ())
+
+(defun org-babel-expand-body:J (body params &optional processed-params)
+ "Expand BODY according to PARAMS, return the expanded body.
+PROCESSED-PARAMS isn't used yet."
+ (org-babel-J-interleave-echos-except-functions body))
+
+(defun org-babel-J-interleave-echos (body)
+ "Interleave echo',' between each source line of BODY."
+ (mapconcat #'identity (split-string body "\n") "\necho','\n"))
+
+(defun org-babel-J-interleave-echos-except-functions (body)
+ "Interleave echo',' between source lines of BODY that aren't functions."
+ (if (obj-string-match-m "\\(?:^\\|\n\\)[^\n]*\\(?:0\\|1\\|2\\|3\\|4\\|dyad\\) : 0\n.*\n)\\(?:\n\\|$\\)" body)
+ (let ((s1 (substring body 0 (match-beginning 0)))
+ (s2 (match-string 0 body))
+ (s3 (substring body (match-end 0))))
+ (concat
+ (if (string= s1 "")
+ ""
+ (concat (org-babel-J-interleave-echos s1)
+ "\necho','\n"))
+ s2
+ "\necho','\n"
+ (org-babel-J-interleave-echos-except-functions s3)))
+ (org-babel-J-interleave-echos body)))
+
+(defun org-babel-execute:J (body params)
+ "Execute a block of J code BODY.
+PARAMS are given by org-babel.
+This function is called by `org-babel-execute-src-block'"
+ (message "executing J source code block")
+ (let* ((processed-params (org-babel-process-params params))
+ (sessionp (cdr (assoc :session params)))
+ (session (org-babel-j-initiate-session sessionp))
+ (vars (second processed-params))
+ (result-params (third processed-params))
+ (result-type (fourth processed-params))
+ (full-body (org-babel-expand-body:J
+ body params processed-params))
+ (tmp-script-file (org-babel-temp-file "J-src")))
+ (org-babel-J-strip-whitespace
+ (if (string= sessionp "none")
+ (progn
+ (with-temp-file tmp-script-file
+ (insert full-body))
+ (org-babel-eval (format "jconsole < %s" tmp-script-file) ""))
+ (org-babel-J-eval-string full-body)))))
+
+(defun org-babel-J-eval-string (str)
+ "Sends STR to the `j-console-cmd' session and exectues it."
+ (let ((session (j-console-ensure-session)))
+ (with-current-buffer (process-buffer session)
+ (goto-char (point-max))
+ (insert (format "\n%s\n" str))
+ (let ((beg (point)))
+ (comint-send-input)
+ (sit-for .1)
+ (buffer-substring-no-properties
+ beg (point-max))))))
+
+(defun org-babel-J-strip-whitespace (str)
+ "Remove whitespace from jconsole output STR."
+ (mapconcat
+ #'identity
+ (delete "" (mapcar
+ #'org-babel-J-print-block
+ (split-string str "^ *,\n" t)))
+ "\n\n"))
+
+(defun obj-get-string-alignment (str)
+ "Return a number to describe STR alignment.
+STR represents a table.
+Positive/negative/zero result means right/left/undetermined.
+Don't trust first line."
+ (let* ((str (org-trim str))
+ (lines (split-string str "\n" t))
+ n1 n2)
+ (cond ((<= (length lines) 1)
+ 0)
+ ((= (length lines) 2)
+ ;; numbers are right-aligned
+ (if (and
+ (numberp (read (car lines)))
+ (numberp (read (cadr lines)))
+ (setq n1 (obj-match-second-space-right (nth 0 lines)))
+ (setq n2 (obj-match-second-space-right (nth 1 lines))))
+ n2
+ 0))
+ ((not (obj-match-second-space-left (nth 0 lines)))
+ 0)
+ ((and
+ (setq n1 (obj-match-second-space-left (nth 1 lines)))
+ (setq n2 (obj-match-second-space-left (nth 2 lines)))
+ (= n1 n2))
+ n1)
+ ((and
+ (setq n1 (obj-match-second-space-right (nth 1 lines)))
+ (setq n2 (obj-match-second-space-right (nth 2 lines)))
+ (= n1 n2))
+ (- n1))
+ (t 0))))
+
+(defun org-babel-J-print-block (x)
+ "Prettify jconsole output X."
+ (let* ((x (org-trim x))
+ (a (obj-get-string-alignment x))
+ (lines (split-string x "\n" t))
+ b)
+ (cond ((minusp a)
+ (setq b (obj-match-second-space-right (nth 0 lines)))
+ (concat (make-string (+ a b) ? ) x))
+ ((plusp a)
+ (setq b (obj-match-second-space-left (nth 0 lines)))
+ (concat (make-string (- a b) ? ) x))
+ (t x))))
+
+(defun obj-match-second-space-left (s)
+ "Return position of leftmost space in second space block of S or nil."
+ (and (string-match "^ *[^ ]+\\( \\)" s)
+ (match-beginning 1)))
+
+(defun obj-match-second-space-right (s)
+ "Return position of rightmost space in second space block of S or nil."
+ (and (string-match "^ *[^ ]+ *\\( \\)[^ ]" s)
+ (match-beginning 1)))
+
+(defun obj-string-match-m (regexp string &optional start)
+ "Call (string-match REGEXP STRING START).
+REGEXP is modified so that .* matches newlines as well."
+ (string-match
+ (replace-regexp-in-string "\\.\\*" "[\0-\377[:nonascii:]]*" regexp)
+ string
+ start))
+
+(defun org-babel-j-initiate-session (&optional session)
+ "Initiate a J session.
+SESSION is a parameter given by org-babel."
+ (unless (string= session "none")
+ (require 'j-console)
+ (j-console-ensure-session)))
+
+(provide 'ob-J)
+
+;;; ob-J.el ends here
diff --git a/lisp/ob-R.el b/lisp/ob-R.el
index d06b982..780d99f 100644
--- a/lisp/ob-R.el
+++ b/lisp/ob-R.el
@@ -1,6 +1,6 @@
;;; ob-R.el --- org-babel functions for R code evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Dan Davison
@@ -97,24 +97,15 @@ this variable.")
"Expand BODY according to PARAMS, return the expanded body."
(let ((graphics-file
(or graphics-file (org-babel-R-graphical-output-file params))))
- (mapconcat
- #'identity
- (let ((inside
- (append
- (when (cdr (assoc :prologue params))
- (list (cdr (assoc :prologue params))))
- (org-babel-variable-assignments:R params)
- (list body)
- (when (cdr (assoc :epilogue params))
- (list (cdr (assoc :epilogue params)))))))
- (if graphics-file
- (append
- (list (org-babel-R-construct-graphics-device-call
- graphics-file params))
- inside
- (list "dev.off()"))
- inside))
- "\n")))
+ (mapconcat #'identity
+ (append
+ (when (cdr (assoc :prologue params))
+ (list (cdr (assoc :prologue params))))
+ (org-babel-variable-assignments:R params)
+ (list body)
+ (when (cdr (assoc :epilogue params))
+ (list (cdr (assoc :epilogue params)))))
+ "\n")))
(defun org-babel-execute:R (body params)
"Execute a block of R code.
@@ -127,7 +118,18 @@ This function is called by `org-babel-execute-src-block'."
(colnames-p (cdr (assoc :colnames params)))
(rownames-p (cdr (assoc :rownames params)))
(graphics-file (org-babel-R-graphical-output-file params))
- (full-body (org-babel-expand-body:R body params graphics-file))
+ (full-body
+ (let ((inside
+ (list (org-babel-expand-body:R body params graphics-file))))
+ (mapconcat #'identity
+ (if graphics-file
+ (append
+ (list (org-babel-R-construct-graphics-device-call
+ graphics-file params))
+ inside
+ (list "},error=function(e){plot(x=-1:1, y=-1:1, type='n', xlab='', ylab='', axes=FALSE); text(x=0, y=0, labels=e$message, col='red'); paste('ERROR', e$message, sep=' : ')}); dev.off()"))
+ inside)
+ "\n")))
(result
(org-babel-R-evaluate
session full-body result-type result-params
@@ -295,7 +297,7 @@ Each member of this list is a list with three members:
(substring (symbol-name (car pair)) 1)
(cdr pair)) ""))
params ""))
- (format "%s(%s=\"%s\"%s%s%s)"
+ (format "%s(%s=\"%s\"%s%s%s); tryCatch({"
device filearg out-file args
(if extra-args "," "") (or extra-args ""))))
diff --git a/lisp/ob-asymptote.el b/lisp/ob-asymptote.el
index 4ea68df..21c0a17 100644
--- a/lisp/ob-asymptote.el
+++ b/lisp/ob-asymptote.el
@@ -1,6 +1,6 @@
;;; ob-asymptote.el --- org-babel functions for asymptote evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
diff --git a/lisp/ob-awk.el b/lisp/ob-awk.el
index a9215d0..ed98afd 100644
--- a/lisp/ob-awk.el
+++ b/lisp/ob-awk.el
@@ -1,6 +1,6 @@
;;; ob-awk.el --- org-babel functions for awk evaluation
-;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
diff --git a/lisp/ob-calc.el b/lisp/ob-calc.el
index b4201a1..cdb528a 100644
--- a/lisp/ob-calc.el
+++ b/lisp/ob-calc.el
@@ -1,6 +1,6 @@
;;; ob-calc.el --- org-babel functions for calc code evaluation
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
diff --git a/lisp/ob-clojure.el b/lisp/ob-clojure.el
index e18fa76..a3e6cbe 100644
--- a/lisp/ob-clojure.el
+++ b/lisp/ob-clojure.el
@@ -1,6 +1,6 @@
;;; ob-clojure.el --- org-babel functions for clojure evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Joel Boehland, Eric Schulte, Oleh Krehel
;;
@@ -48,13 +48,9 @@
(eval-when-compile
(require 'cl))
-(declare-function cider-current-ns "ext:cider-interaction" ())
(declare-function nrepl-send-string-sync "ext:nrepl-client" (input &optional ns session))
-(declare-function nrepl-current-tooling-session "ext:nrepl-client" ())
-
(declare-function nrepl-current-connection-buffer "ext:nrepl" ())
(declare-function nrepl-eval "ext:nrepl" (body))
-
(declare-function slime-eval "ext:slime" (sexp &optional package))
(defvar org-babel-tangle-lang-exts)
@@ -63,7 +59,10 @@
(defvar org-babel-default-header-args:clojure '())
(defvar org-babel-header-args:clojure '((package . :any)))
-(defcustom org-babel-clojure-backend 'nrepl
+(defcustom org-babel-clojure-backend
+ (cond ((featurep 'cider) 'cider)
+ ((featurep 'nrepl) 'nrepl)
+ (t 'slime))
"Backend used to evaluate Clojure code blocks."
:group 'org-babel
:type '(choice
@@ -85,50 +84,48 @@
vars "\n ")
"]\n" 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))))
+ (if (or (member "code" result-params)
+ (member "pp" result-params))
+ (format "(clojure.pprint/pprint (do %s))" body)
+ body)))
(defun org-babel-execute:clojure (body params)
"Execute a block of Clojure code with Babel."
- (let ((expanded (org-babel-expand-body:clojure body params)))
+ (let ((expanded (org-babel-expand-body:clojure body params))
+ result)
(case org-babel-clojure-backend
(cider
(require 'cider)
- (or (nth 1 (nrepl-send-string-sync
- (format "(clojure.pprint/pprint %s)" expanded)
- (cider-current-ns)
- (nrepl-current-tooling-session)))
- (error "nREPL not connected! Use M-x cider-jack-in RET")))
+ (let ((result-params (cdr (assoc :result-params params))))
+ (setq result
+ (plist-get
+ (nrepl-send-string-sync expanded)
+ (if (or (member "output" result-params)
+ (member "pp" result-params))
+ :stdout
+ :value)))))
(nrepl
(require 'nrepl)
- (if (nrepl-current-connection-buffer)
- (let* ((result (nrepl-eval expanded))
- (s (plist-get result :stdout))
- (r (plist-get result :value)))
- (if s (concat s "\n" r) r))
- (error "nREPL not connected! Use M-x nrepl-jack-in RET")))
+ (setq result
+ (if (nrepl-current-connection-buffer)
+ (let* ((result (nrepl-eval expanded))
+ (s (plist-get result :stdout))
+ (r (plist-get result :value)))
+ (if s (concat s "\n" r) r))
+ (error "nREPL not connected! Use M-x nrepl-jack-in RET"))))
(slime
(require 'slime)
(with-temp-buffer
(insert expanded)
- ((lambda (result)
- (let ((result-params (cdr (assoc :result-params params))))
- (org-babel-result-cond result-params
- result
- (condition-case nil (org-babel-script-escape result)
- (error result)))))
- (slime-eval
- `(swank:eval-and-grab-output
- ,(buffer-substring-no-properties (point-min) (point-max)))
- (cdr (assoc :package params)))))))))
+ (setq result
+ (slime-eval
+ `(swank:eval-and-grab-output
+ ,(buffer-substring-no-properties (point-min) (point-max)))
+ (cdr (assoc :package params)))))))
+ (org-babel-result-cond (cdr (assoc :result-params params))
+ result
+ (condition-case nil (org-babel-script-escape result)
+ (error result)))))
(provide 'ob-clojure)
diff --git a/lisp/ob-comint.el b/lisp/ob-comint.el
index 496c380..0b97424 100644
--- a/lisp/ob-comint.el
+++ b/lisp/ob-comint.el
@@ -1,6 +1,6 @@
;;; ob-comint.el --- org-babel functions for interaction with comint buffers
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, comint
diff --git a/lisp/ob-coq.el b/lisp/ob-coq.el
new file mode 100644
index 0000000..be3b9f6
--- a/dev/null
+++ b/lisp/ob-coq.el
@@ -0,0 +1,77 @@
+;;; ob-coq.el --- org-babel functions for Coq
+
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; 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:
+
+;; Rudimentary support for evaluating Coq code blocks. Currently only
+;; session evaluation is supported. Requires both coq.el and
+;; coq-inferior.el, both of which are distributed with Coq.
+;;
+;; http://coq.inria.fr/
+
+;;; Code:
+(require 'ob)
+
+(declare-function run-coq "ext:coq-inferior.el" (cmd))
+(declare-function coq-proc "ext:coq-inferior.el" ())
+
+(defvar org-babel-coq-buffer "*coq*"
+ "Buffer in which to evaluate coq code blocks.")
+
+(defvar org-babel-coq-eoe "org-babel-coq-eoe")
+
+(defun org-babel-coq-clean-prompt (string)
+ (if (string-match "^[^[:space:]]+ < " string)
+ (substring string 0 (match-beginning 0))
+ string))
+
+(defun org-babel-execute:coq (body params)
+ (let ((full-body (org-babel-expand-body:generic body params))
+ (session (org-babel-coq-initiate-session))
+ (pt (lambda ()
+ (marker-position
+ (process-mark (get-buffer-process (current-buffer)))))))
+ (org-babel-coq-clean-prompt
+ (org-babel-comint-in-buffer session
+ (let ((start (funcall pt)))
+ (with-temp-buffer
+ (insert full-body)
+ (comint-send-region (coq-proc) (point-min) (point-max))
+ (comint-send-string (coq-proc)
+ (if (string= (buffer-substring (- (point-max) 1) (point-max)) ".")
+ "\n"
+ ".\n")))
+ (while (equal start (funcall pt)) (sleep-for 0.1))
+ (buffer-substring start (funcall pt)))))))
+
+(defun org-babel-coq-initiate-session ()
+ "Initiate a coq session.
+If there is not a current inferior-process-buffer in SESSION then
+create one. Return the initialized session."
+ (unless (fboundp 'run-coq)
+ (error "`run-coq' not defined, load coq-inferior.el."))
+ (save-window-excursion (run-coq "coqtop"))
+ (sit-for 0.1)
+ (get-buffer org-babel-coq-buffer))
+
+(provide 'ob-coq)
diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index 85bd27d..0e8c57f 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -1,6 +1,6 @@
;;; ob-core.el --- working with code blocks in org-mode
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Authors: Eric Schulte
;; Dan Davison
@@ -38,6 +38,7 @@
(defvar org-src-lang-modes)
(defvar org-babel-library-of-babel)
(declare-function show-all "outline" ())
+(declare-function org-remove-indentation "org" (code &optional n))
(declare-function org-reduce "org" (CL-FUNC CL-SEQ &rest CL-KEYS))
(declare-function org-mark-ring-push "org" (&optional pos buffer))
(declare-function tramp-compat-make-temp-file "tramp-compat"
@@ -217,13 +218,13 @@ not match KEY should be returned."
(lambda (p) (when (funcall (if others #'not #'identity) (eq (car p) key)) p))
params)))
-(defun org-babel-get-inline-src-block-matches()
+(defun org-babel-get-inline-src-block-matches ()
"Set match data if within body of an inline source block.
Returns non-nil if match-data set"
(let ((src-at-0-p (save-excursion
(beginning-of-line 1)
(string= "src" (thing-at-point 'word))))
- (first-line-p (= 1 (line-number-at-pos)))
+ (first-line-p (= (line-beginning-position) (point-min)))
(orig (point)))
(let ((search-for (cond ((and src-at-0-p first-line-p "src_"))
(first-line-p "[[:punct:] \t]src_")
@@ -240,7 +241,7 @@ Returns non-nil if match-data set"
t ))))))
(defvar org-babel-inline-lob-one-liner-regexp)
-(defun org-babel-get-lob-one-liner-matches()
+(defun org-babel-get-lob-one-liner-matches ()
"Set match data if on line of an lob one liner.
Returns non-nil if match-data set"
(save-excursion
@@ -277,13 +278,18 @@ Returns a list
(setq name (org-no-properties (match-string 3)))))
;; inline source block
(when (org-babel-get-inline-src-block-matches)
+ (setq head (match-beginning 0))
(setq info (org-babel-parse-inline-src-block-match))))
;; resolve variable references and add summary parameters
(when (and info (not light))
(setf (nth 2 info) (org-babel-process-params (nth 2 info))))
(when info (append info (list name indent head)))))
-(defvar org-current-export-file) ; dynamically bound
+(defvar org-babel-exp-reference-buffer nil
+ "Buffer containing original contents of the exported buffer.
+This is used by Babel to resolve references in source blocks.
+Its value is dynamically bound during export.")
+
(defmacro org-babel-check-confirm-evaluate (info &rest body)
"Evaluate BODY with special execution confirmation variables set.
@@ -303,7 +309,7 @@ name of the code block."
(when (assoc :noeval ,headers) "no")))
(,eval-no (or (equal ,eval "no")
(equal ,eval "never")))
- (,export (org-bound-and-true-p org-current-export-file))
+ (,export org-babel-exp-reference-buffer)
(,eval-no-export (and ,export (or (equal ,eval "no-export")
(equal ,eval "never-export"))))
(noeval (or ,eval-no ,eval-no-export))
@@ -327,7 +333,7 @@ Do not query the user."
(message (format "Evaluation of this%scode-block%sis disabled."
code-block block-name))))))
- ;; dynamically scoped for asynchroneous export
+ ;; dynamically scoped for asynchronous export
(defvar org-babel-confirm-evaluate-answer-no)
(defsubst org-babel-confirm-evaluate (info)
@@ -579,7 +585,7 @@ can not be resolved.")
(defun org-babel-named-src-block-regexp-for-name (name)
"This generates a regexp used to match a src block named NAME."
(concat org-babel-src-name-regexp (regexp-quote name)
- "[ \t(]*[\r\n]\\(?:^#.*[\r\n]\\)*"
+ "[ \t(]*[\r\n]\\(?:^[[:space:]]*#.*[\r\n]\\)*"
(substring org-babel-src-block-regexp 1)))
(defun org-babel-named-data-regexp-for-name (name)
@@ -615,7 +621,10 @@ block."
(let* ((org-babel-current-src-block-location
(or org-babel-current-src-block-location
(nth 6 info)
- (org-babel-where-is-src-block-head)))
+ (org-babel-where-is-src-block-head)
+ ;; inline src block
+ (and (org-babel-get-inline-src-block-matches)
+ (match-beginning 0))))
(info (if info
(copy-tree info)
(org-babel-get-src-block-info)))
@@ -967,6 +976,7 @@ with a prefix argument then this is passed on to
(org-edit-src-code)
(funcall swap-windows)))
+;;;###autoload
(defmacro org-babel-do-in-edit-buffer (&rest body)
"Evaluate BODY in edit buffer if there is a code block at point.
Return t if a code block was found at point, nil otherwise."
@@ -1213,7 +1223,20 @@ the current subtree."
(member (car arg) '(:results :exports)))
(mapconcat #'identity (sort (funcall rm (split-string v))
#'string<) " "))
- (t v)))))))
+ (t v))))))
+ ;; expanded body
+ (lang (nth 0 info))
+ (params (nth 2 info))
+ (body (if (org-babel-noweb-p params :eval)
+ (org-babel-expand-noweb-references info) (nth 1 info)))
+ (expand-cmd (intern (concat "org-babel-expand-body:" lang)))
+ (assignments-cmd (intern (concat "org-babel-variable-assignments:"
+ lang)))
+ (expanded
+ (if (fboundp expand-cmd) (funcall expand-cmd body params)
+ (org-babel-expand-body:generic
+ body params (and (fboundp assignments-cmd)
+ (funcall assignments-cmd params))))))
(let* ((it (format "%s-%s"
(mapconcat
#'identity
@@ -1222,19 +1245,19 @@ the current subtree."
(when normalized
(format "%S" normalized))))
(nth 2 info))) ":")
- (nth 1 info)))
+ expanded))
(hash (sha1 it)))
(when (org-called-interactively-p 'interactive) (message hash))
hash))))
-(defun org-babel-current-result-hash ()
+(defun org-babel-current-result-hash (&optional info)
"Return the current in-buffer hash."
- (org-babel-where-is-src-block-result)
+ (org-babel-where-is-src-block-result nil info)
(org-no-properties (match-string 5)))
-(defun org-babel-set-current-result-hash (hash)
+(defun org-babel-set-current-result-hash (hash info)
"Set the current in-buffer hash to HASH."
- (org-babel-where-is-src-block-result)
+ (org-babel-where-is-src-block-result nil info)
(save-excursion (goto-char (match-beginning 5))
(mapc #'delete-overlay (overlays-at (point)))
(forward-char org-babel-hash-show)
@@ -1450,7 +1473,8 @@ specified in the properties of the current outline entry."
(append
(org-babel-params-from-properties lang)
(list (org-babel-parse-header-arguments
- (org-no-properties (or (match-string 4) "")))))))))
+ (org-no-properties (or (match-string 4) ""))))))
+ nil)))
(defun org-babel-balanced-split (string alts)
"Split STRING on instances of ALTS.
@@ -1920,29 +1944,30 @@ following the source block."
(progn (end-of-line 1)
(if (eobp) (insert "\n") (forward-char 1))
(setq end (point))
- (or (and
- (not name)
- (progn ;; unnamed results line already exists
- (catch 'non-comment
- (while (re-search-forward "[^ \f\t\n\r\v]" nil t)
- (beginning-of-line 1)
- (cond
- ((looking-at (concat org-babel-result-regexp "\n"))
- (throw 'non-comment t))
- ((and (looking-at "^[ \t]*#")
- (not (looking-at
- org-babel-lob-one-liner-regexp)))
- (end-of-line 1))
- (t (throw 'non-comment nil))))))
- (let ((this-hash (match-string 5)))
- (prog1 (point)
- ;; must remove and rebuild if hash!=old-hash
- (if (and hash (not (string= hash this-hash)))
- (prog1 nil
- (forward-line 1)
- (delete-region
- end (org-babel-result-end)))
- (setq end nil)))))))))))
+ (and
+ (not name)
+ (progn ;; unnamed results line already exists
+ (catch 'non-comment
+ (while (re-search-forward "[^ \f\t\n\r\v]" nil t)
+ (beginning-of-line 1)
+ (cond
+ ((looking-at (concat org-babel-result-regexp "\n"))
+ (throw 'non-comment t))
+ ((and (looking-at "^[ \t]*#")
+ (not (looking-at
+ org-babel-lob-one-liner-regexp)))
+ (end-of-line 1))
+ (t (throw 'non-comment nil))))))
+ (let ((this-hash (match-string 5)))
+ (prog1 (point)
+ ;; must remove and rebuild if hash!=old-hash
+ (if (and hash (not (string= hash this-hash)))
+ (progn
+ (setq end (point-at-bol))
+ (forward-line 1)
+ (delete-region end (org-babel-result-end))
+ (setq beg end))
+ (setq end nil))))))))))
(if (not (and insert end)) found
(goto-char end)
(unless beg
@@ -1970,7 +1995,7 @@ following the source block."
((org-at-table-p) (org-babel-read-table))
((org-at-item-p) (org-babel-read-list))
((looking-at org-bracket-link-regexp) (org-babel-read-link))
- ((looking-at org-block-regexp) (org-babel-trim (match-string 4)))
+ ((looking-at org-block-regexp) (org-remove-indentation (match-string 4)))
((or (looking-at "^[ \t]*: ") (looking-at "^[ \t]*:$"))
(setq result-string
(org-babel-trim
@@ -2198,7 +2223,7 @@ code ---- the results are extracted in the syntax of the source
(funcall wrap ":RESULTS:" ":END:" 'no-escape))
((and (not (funcall proper-list-p result))
(not (member "file" result-params)))
- (org-babel-examplize-region beg end results-switches)
+ (org-babel-examplify-region beg end results-switches)
(setq end (point)))))
;; possibly indent the results to match the #+results line
(when (and (not inlinep) (numberp indent) indent (> indent 0)
@@ -2227,6 +2252,15 @@ code ---- the results are extracted in the syntax of the source
(if keep-keyword (1+ (match-end 0)) (1- (match-beginning 0)))
(progn (forward-line 1) (org-babel-result-end))))))))
+(defun org-babel-remove-result-one-or-many (x)
+ "Remove the result of the current source block.
+If called with a prefix argument, remove all result blocks
+in the buffer."
+ (interactive "P")
+ (if x
+ (org-babel-map-src-blocks nil (org-babel-remove-result))
+ (org-babel-remove-result)))
+
(defun org-babel-result-end ()
"Return the point at the end of the current set of results."
(save-excursion
@@ -2263,18 +2297,27 @@ file's directory then expand relative links."
result)
(if description (concat "[" description "]") ""))))
-(defvar org-babel-capitalize-examplize-region-markers nil
+(defvar org-babel-capitalize-example-region-markers nil
"Make true to capitalize begin/end example markers inserted by code blocks.")
-(defun org-babel-examplize-region (beg end &optional results-switches)
+(define-obsolete-function-alias
+ 'org-babel-examplize-region
+ 'org-babel-examplify-region "24.5")
+
+(defun org-babel-examplify-region (beg end &optional results-switches)
"Comment out region using the inline '==' or ': ' org example quote."
(interactive "*r")
(let ((chars-between (lambda (b e)
- (not (string-match "^[\\s]*$" (buffer-substring b e)))))
- (maybe-cap (lambda (str) (if org-babel-capitalize-examplize-region-markers
- (upcase str) str))))
- (if (or (funcall chars-between (save-excursion (goto-char beg) (point-at-bol)) beg)
- (funcall chars-between end (save-excursion (goto-char end) (point-at-eol))))
+ (not (string-match "^[\\s]*$"
+ (buffer-substring b e)))))
+ (maybe-cap (lambda (str) (if org-babel-capitalize-example-region-markers
+ (upcase str) str)))
+ (beg-bol (save-excursion (goto-char beg) (point-at-bol)))
+ (end-bol (save-excursion (goto-char end) (point-at-bol)))
+ (end-eol (save-excursion (goto-char end) (point-at-eol))))
+ (if (and (not (= end end-bol))
+ (or (funcall chars-between beg-bol beg)
+ (funcall chars-between end end-eol)))
(save-excursion
(goto-char beg)
(insert (format org-babel-inline-result-wrap
@@ -2302,7 +2345,8 @@ file's directory then expand relative links."
(if (not (org-babel-where-is-src-block-head))
(error "Not in a source block")
(save-match-data
- (replace-match (concat (org-babel-trim new-body) "\n") nil t nil 5))
+ (replace-match (concat (org-babel-trim (org-remove-indentation new-body))
+ "\n") nil t nil 5))
(indent-rigidly (match-beginning 5) (match-end 5) 2)))
(defun org-babel-merge-params (&rest plists)
diff --git a/lisp/ob-css.el b/lisp/ob-css.el
index a1205f5..2fedb35 100644
--- a/lisp/ob-css.el
+++ b/lisp/ob-css.el
@@ -1,6 +1,6 @@
;;; ob-css.el --- org-babel functions for css evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
diff --git a/lisp/ob-ditaa.el b/lisp/ob-ditaa.el
index 36681d0..26f0e4f 100644
--- a/lisp/ob-ditaa.el
+++ b/lisp/ob-ditaa.el
@@ -1,6 +1,6 @@
;;; ob-ditaa.el --- org-babel functions for ditaa evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
diff --git a/lisp/ob-dot.el b/lisp/ob-dot.el
index 7504264..1e399e7 100644
--- a/lisp/ob-dot.el
+++ b/lisp/ob-dot.el
@@ -1,6 +1,6 @@
;;; ob-dot.el --- org-babel functions for dot evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -55,7 +55,9 @@
(replace-regexp-in-string
(concat "\$" (regexp-quote name))
(if (stringp value) value (format "%S" value))
- body))))
+ body
+ t
+ t))))
vars)
body))
diff --git a/lisp/ob-emacs-lisp.el b/lisp/ob-emacs-lisp.el
index e8a5f2f..ec73e17 100644
--- a/lisp/ob-emacs-lisp.el
+++ b/lisp/ob-emacs-lisp.el
@@ -1,6 +1,6 @@
;;; ob-emacs-lisp.el --- org-babel functions for emacs-lisp code evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
diff --git a/lisp/ob-eval.el b/lisp/ob-eval.el
index 85a8c4e..057590f 100644
--- a/lisp/ob-eval.el
+++ b/lisp/ob-eval.el
@@ -1,6 +1,6 @@
;;; ob-eval.el --- org-babel functions for external code evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, comint
diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el
index 2f63590..220a3c3 100644
--- a/lisp/ob-exp.el
+++ b/lisp/ob-exp.el
@@ -1,6 +1,6 @@
;;; ob-exp.el --- Exportation of org-babel source blocks
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Authors: Eric Schulte
;; Dan Davison
@@ -27,7 +27,6 @@
(eval-when-compile
(require 'cl))
-(defvar org-current-export-file)
(defvar org-babel-lob-one-liner-regexp)
(defvar org-babel-ref-split-regexp)
(defvar org-list-forbidden-blocks)
@@ -38,12 +37,13 @@
(start-re end-re &optional lim-up lim-down))
(declare-function org-get-indentation "org" (&optional line))
(declare-function org-heading-components "org" ())
+(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
(declare-function org-in-block-p "org" (names))
(declare-function org-in-verbatim-emphasis "org" ())
(declare-function org-link-search "org" (s &optional type avoid-pos stealth))
(declare-function org-fill-template "org" (template alist))
(declare-function org-split-string "org" (string &optional separators))
-(declare-function org-element-at-point "org-element" (&optional keep-trail))
+(declare-function org-element-at-point "org-element" ())
(declare-function org-element-context "org-element" ())
(declare-function org-element-property "org-element" (property element))
(declare-function org-element-type "org-element" (element))
@@ -61,27 +61,18 @@ be executed."
(const :tag "Always" t)))
(put 'org-export-babel-evaluate 'safe-local-variable (lambda (x) (eq x nil)))
-(defun org-babel-exp-get-export-buffer ()
- "Return the current export buffer if possible."
- (cond
- ((bufferp org-current-export-file) org-current-export-file)
- (org-current-export-file (get-file-buffer org-current-export-file))
- ('otherwise
- (error "Requested export buffer when `org-current-export-file' is nil"))))
-
(defvar org-link-search-inhibit-query)
-
(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))))
(export-buffer (current-buffer))
- (original-buffer (org-babel-exp-get-export-buffer)) results)
- (when original-buffer
- ;; resolve parameters in the original file so that
- ;; headline and file-wide parameters are included, attempt
- ;; to go to the same heading in the original file
- (set-buffer original-buffer)
+ results)
+ (when org-babel-exp-reference-buffer
+ ;; Resolve parameters in the original file so that headline and
+ ;; file-wide parameters are included, attempt to go to the same
+ ;; heading in the original file
+ (set-buffer org-babel-exp-reference-buffer)
(save-restriction
(when heading
(condition-case nil
@@ -152,165 +143,145 @@ this template."
:type 'string)
(defvar org-babel-default-lob-header-args)
-(defun org-babel-exp-non-block-elements (start end)
- "Process inline source and call lines between START and END for export."
- (interactive)
- (save-excursion
- (goto-char start)
- (unless (markerp end)
- (let ((m (make-marker)))
- (set-marker m end (current-buffer))
- (setq end m)))
- (let ((rx (concat "\\(?:" org-babel-inline-src-block-regexp
- "\\|" org-babel-lob-one-liner-regexp "\\)")))
- (while (re-search-forward rx end t)
- (save-excursion
- (let* ((element (save-excursion
- ;; If match is inline, point is at its
- ;; end. Move backward so
- ;; `org-element-context' can get the
- ;; object, not the following one.
- (backward-char)
- (save-match-data (org-element-context))))
- (type (org-element-type element)))
- (when (memq type '(babel-call inline-babel-call inline-src-block))
- (let ((beg-el (org-element-property :begin element))
- (end-el (org-element-property :end element)))
- (case type
- (inline-src-block
- (let* ((info (org-babel-parse-inline-src-block-match))
- (params (nth 2 info)))
- (setf (nth 1 info)
- (if (and (cdr (assoc :noweb params))
- (string= "yes" (cdr (assoc :noweb params))))
- (org-babel-expand-noweb-references
- info (org-babel-exp-get-export-buffer))
- (nth 1 info)))
- (goto-char beg-el)
- (let ((replacement (org-babel-exp-do-export info 'inline)))
- (if (equal replacement "")
- ;; Replacement code is empty: completely
- ;; remove inline src block, including extra
- ;; white space that might have been created
- ;; when inserting results.
- (delete-region beg-el
- (progn (goto-char end-el)
- (skip-chars-forward " \t")
- (point)))
- ;; Otherwise: remove inline src block but
- ;; preserve following white spaces. Then
- ;; insert value.
- (delete-region beg-el
- (progn (goto-char end-el)
- (skip-chars-backward " \t")
- (point)))
- (insert replacement)))))
- ((babel-call inline-babel-call)
- (let* ((lob-info (org-babel-lob-get-info))
- (results
- (org-babel-exp-do-export
- (list "emacs-lisp" "results"
- (apply #'org-babel-merge-params
- org-babel-default-header-args
- org-babel-default-lob-header-args
- (append
- (org-babel-params-from-properties)
- (list
- (org-babel-parse-header-arguments
- (org-no-properties
- (concat
- ":var results="
- (mapconcat 'identity
- (butlast lob-info 2)
- " ")))))))
- "" (nth 3 lob-info) (nth 2 lob-info))
- 'lob))
- (rep (org-fill-template
- org-babel-exp-call-line-template
- `(("line" . ,(nth 0 lob-info))))))
- ;; If replacement is empty, completely remove the
- ;; object/element, including any extra white space
- ;; that might have been created when including
- ;; results.
- (if (equal rep "")
- (delete-region
- beg-el
- (progn (goto-char end-el)
- (if (not (eq type 'babel-call))
- (progn (skip-chars-forward " \t") (point))
- (skip-chars-forward " \r\t\n")
- (line-beginning-position))))
- ;; Otherwise, preserve following white
- ;; spaces/newlines and then, insert replacement
- ;; string.
- (goto-char beg-el)
- (delete-region beg-el
- (progn (goto-char end-el)
- (skip-chars-backward " \r\t\n")
- (point)))
- (insert rep)))))))))))))
-
-(defvar org-src-preserve-indentation) ; From org-src.el
-(defun org-babel-exp-process-buffer ()
- "Execute all blocks in visible part of buffer."
+(defun org-babel-exp-process-buffer (reference-buffer)
+ "Execute all Babel blocks in current buffer.
+REFERENCE-BUFFER is the buffer containing a pristine copy of the
+buffer being processed. It is used to properly resolve
+references in source blocks, as modifications in current buffer
+may make them unreachable."
(interactive)
(save-window-excursion
- (let ((case-fold-search t)
- (pos (point-min)))
- (goto-char pos)
- (while (re-search-forward "^[ \t]*#\\+BEGIN_SRC" nil t)
- (let ((element (save-match-data (org-element-at-point))))
- (when (eq (org-element-type element) 'src-block)
- (let* ((match-start (copy-marker (match-beginning 0)))
- (begin (copy-marker (org-element-property :begin element)))
- ;; Make sure we don't remove any blank lines after
- ;; the block when replacing it.
- (block-end (save-excursion
- (goto-char (org-element-property :end element))
- (skip-chars-backward " \r\t\n")
- (copy-marker (line-end-position))))
- (ind (org-get-indentation))
- (headers
- (cons
- (org-element-property :language element)
- (let ((params (org-element-property :parameters element)))
- (and params (org-split-string params "[ \t]+"))))))
- ;; Execute all non-block elements between POS and
- ;; current block.
- (org-babel-exp-non-block-elements pos begin)
- ;; Take care of matched block: compute replacement
- ;; string. In particular, a nil REPLACEMENT means the
- ;; block should be left as-is while an empty string
- ;; should remove the block.
- (let ((replacement (progn (goto-char match-start)
- (org-babel-exp-src-block headers))))
- (cond ((not replacement) (goto-char block-end))
- ((equal replacement "")
- (delete-region begin
- (progn (goto-char block-end)
- (skip-chars-forward " \r\t\n")
- (if (eobp) (point)
- (line-beginning-position)))))
- (t
- (goto-char match-start)
- (delete-region (point) block-end)
- (insert replacement)
- (if (org-element-property :preserve-indent element)
- ;; Indent only the code block markers.
- (save-excursion (skip-chars-backward " \r\t\n")
- (indent-line-to ind)
- (goto-char match-start)
- (indent-line-to ind))
- ;; Indent everything.
- (indent-rigidly match-start (point) ind)))))
- (setq pos (line-beginning-position))
- ;; Cleanup markers.
- (set-marker match-start nil)
+ (save-excursion
+ (let ((case-fold-search t)
+ (org-babel-exp-reference-buffer reference-buffer)
+ (regexp (concat org-babel-inline-src-block-regexp "\\|"
+ org-babel-lob-one-liner-regexp "\\|"
+ "^[ \t]*#\\+BEGIN_SRC")))
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (unless (save-match-data (org-in-commented-heading-p))
+ (let* ((element (save-excursion
+ ;; If match is inline, point is at its
+ ;; end. Move backward so
+ ;; `org-element-context' can get the
+ ;; object, not the following one.
+ (backward-char)
+ (save-match-data (org-element-context))))
+ (type (org-element-type element))
+ (begin (copy-marker (org-element-property :begin element)))
+ (end (copy-marker
+ (save-excursion
+ (goto-char (org-element-property :end element))
+ (skip-chars-backward " \r\t\n")
+ (point)))))
+ (case type
+ (inline-src-block
+ (let* ((info (org-babel-parse-inline-src-block-match))
+ (params (nth 2 info)))
+ (setf (nth 1 info)
+ (if (and (cdr (assoc :noweb params))
+ (string= "yes" (cdr (assoc :noweb params))))
+ (org-babel-expand-noweb-references
+ info org-babel-exp-reference-buffer)
+ (nth 1 info)))
+ (goto-char begin)
+ (let ((replacement (org-babel-exp-do-export info 'inline)))
+ (if (equal replacement "")
+ ;; Replacement code is empty: remove inline
+ ;; source block, including extra white space
+ ;; that might have been created when
+ ;; inserting results.
+ (delete-region begin
+ (progn (goto-char end)
+ (skip-chars-forward " \t")
+ (point)))
+ ;; Otherwise: remove inline src block but
+ ;; preserve following white spaces. Then
+ ;; insert value.
+ (delete-region begin end)
+ (insert replacement)))))
+ ((babel-call inline-babel-call)
+ (let* ((lob-info (org-babel-lob-get-info))
+ (results
+ (org-babel-exp-do-export
+ (list "emacs-lisp" "results"
+ (apply #'org-babel-merge-params
+ org-babel-default-header-args
+ org-babel-default-lob-header-args
+ (append
+ (org-babel-params-from-properties)
+ (list
+ (org-babel-parse-header-arguments
+ (org-no-properties
+ (concat
+ ":var results="
+ (mapconcat 'identity
+ (butlast lob-info 2)
+ " ")))))))
+ "" (nth 3 lob-info) (nth 2 lob-info))
+ 'lob))
+ (rep (org-fill-template
+ org-babel-exp-call-line-template
+ `(("line" . ,(nth 0 lob-info))))))
+ ;; If replacement is empty, completely remove the
+ ;; object/element, including any extra white space
+ ;; that might have been created when including
+ ;; results.
+ (if (equal rep "")
+ (delete-region
+ begin
+ (progn (goto-char end)
+ (if (not (eq type 'babel-call))
+ (progn (skip-chars-forward " \t") (point))
+ (skip-chars-forward " \r\t\n")
+ (line-beginning-position))))
+ ;; Otherwise, preserve following white
+ ;; spaces/newlines and then, insert replacement
+ ;; string.
+ (goto-char begin)
+ (delete-region begin end)
+ (insert rep))))
+ (src-block
+ (let* ((match-start (copy-marker (match-beginning 0)))
+ (ind (org-get-indentation))
+ (headers
+ (cons
+ (org-element-property :language element)
+ (let ((params (org-element-property :parameters
+ element)))
+ (and params (org-split-string params "[ \t]+"))))))
+ ;; Take care of matched block: compute replacement
+ ;; string. In particular, a nil REPLACEMENT means
+ ;; the block should be left as-is while an empty
+ ;; string should remove the block.
+ (let ((replacement
+ (progn (goto-char match-start)
+ (org-babel-exp-src-block headers))))
+ (cond ((not replacement) (goto-char end))
+ ((equal replacement "")
+ (goto-char end)
+ (skip-chars-forward " \r\t\n")
+ (beginning-of-line)
+ (delete-region begin (point)))
+ (t
+ (goto-char match-start)
+ (delete-region (point)
+ (save-excursion (goto-char end)
+ (line-end-position)))
+ (insert replacement)
+ (if (or org-src-preserve-indentation
+ (org-element-property :preserve-indent
+ element))
+ ;; Indent only the code block markers.
+ (save-excursion (skip-chars-backward " \r\t\n")
+ (indent-line-to ind)
+ (goto-char match-start)
+ (indent-line-to ind))
+ ;; Indent everything.
+ (indent-rigidly match-start (point) ind)))))
+ (set-marker match-start nil))))
(set-marker begin nil)
- (set-marker block-end nil)))))
- ;; Eventually execute all non-block Babel elements between last
- ;; src-block and end of buffer.
- (org-babel-exp-non-block-elements pos (point-max)))))
+ (set-marker end nil))))))))
(defun org-babel-in-example-or-verbatim ()
"Return true if point is in example or verbatim code.
@@ -340,7 +311,7 @@ The function respects the value of the :exports header argument."
(org-babel-exp-code info)))))
(defcustom org-babel-exp-code-template
- "#+BEGIN_SRC %lang%flags\n%body\n#+END_SRC"
+ "#+BEGIN_SRC %lang%switches%flags\n%body\n#+END_SRC"
"Template used to export the body of code blocks.
This template may be customized to include additional information
such as the code block name, or the values of particular header
@@ -350,6 +321,7 @@ and the following %keys may be used.
lang ------ the language of the code block
name ------ the name of the code block
body ------ the body of the code block
+ switches -- the switches associated to the code block
flags ----- the flags passed to the code block
In addition to the keys mentioned above, every header argument
@@ -366,17 +338,20 @@ replaced with its value."
(org-babel-noweb-wrap) "" (nth 1 info))
(if (org-babel-noweb-p (nth 2 info) :export)
(org-babel-expand-noweb-references
- info (org-babel-exp-get-export-buffer))
+ info org-babel-exp-reference-buffer)
(nth 1 info))))
(org-fill-template
org-babel-exp-code-template
`(("lang" . ,(nth 0 info))
("body" . ,(org-escape-code-in-string (nth 1 info)))
+ ("switches" . ,(let ((f (nth 3 info)))
+ (and (org-string-nw-p f) (concat " " f))))
+ ("flags" . ,(let ((f (assq :flags (nth 2 info))))
+ (and f (concat " " (cdr f)))))
,@(mapcar (lambda (pair)
(cons (substring (symbol-name (car pair)) 1)
(format "%S" (cdr pair))))
(nth 2 info))
- ("flags" . ,(let ((f (nth 3 info))) (when f (concat " " f))))
("name" . ,(or (nth 4 info) "")))))
(defun org-babel-exp-results (info type &optional silent hash)
@@ -392,7 +367,7 @@ inhibit insertion of results into the buffer."
(let ((lang (nth 0 info))
(body (if (org-babel-noweb-p (nth 2 info) :eval)
(org-babel-expand-noweb-references
- info (org-babel-exp-get-export-buffer))
+ info org-babel-exp-reference-buffer)
(nth 1 info)))
(info (copy-sequence info))
(org-babel-current-src-block-location (point-marker)))
diff --git a/lisp/ob-fortran.el b/lisp/ob-fortran.el
index 61cb19a..baeb4ba 100644
--- a/lisp/ob-fortran.el
+++ b/lisp/ob-fortran.el
@@ -1,6 +1,6 @@
;;; ob-fortran.el --- org-babel functions for fortran
-;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2014 Free Software Foundation, Inc.
;; Authors: Sergey Litvinov
;; Eric Schulte
@@ -33,6 +33,7 @@
(declare-function org-entry-get "org"
(pom property &optional inherit literal-nil))
(declare-function org-every "org" (pred seq))
+(declare-function org-remove-indentation "org" (code &optional n))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("fortran" . "F90"))
@@ -62,8 +63,9 @@
(org-babel-process-file-name tmp-src-file)) ""))))
(let ((results
(org-babel-trim
- (org-babel-eval
- (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))
+ (org-remove-indentation
+ (org-babel-eval
+ (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))))
(org-babel-reassemble-table
(org-babel-result-cond (cdr (assoc :result-params params))
(org-babel-read results)
diff --git a/lisp/ob-gnuplot.el b/lisp/ob-gnuplot.el
index 2b699c7..7d7db2a 100644
--- a/lisp/ob-gnuplot.el
+++ b/lisp/ob-gnuplot.el
@@ -1,6 +1,6 @@
;;; ob-gnuplot.el --- org-babel functions for gnuplot evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -85,10 +85,15 @@ code."
(lambda (pair)
(cons
(car pair) ;; variable name
- (if (listp (cdr pair)) ;; variable value
- (org-babel-gnuplot-table-to-data
- (cdr pair) (org-babel-temp-file "gnuplot-") params)
- (cdr pair))))
+ (let* ((val (cdr pair)) ;; variable value
+ (lp (listp val)))
+ (if lp
+ (org-babel-gnuplot-table-to-data
+ (let* ((first (car val))
+ (tablep (or (listp first) (symbolp first))))
+ (if tablep val (mapcar 'list val)))
+ (org-babel-temp-file "gnuplot-") params)
+ val))))
(mapcar #'cdr (org-babel-get-header params :var)))))
(defun org-babel-expand-body:gnuplot (body params)
@@ -250,7 +255,7 @@ then create one. Return the initialized session. The current
(org-babel-gnuplot-quote-timestamp-field s)
(if (zerop (length s))
(or *org-babel-gnuplot-missing* s)
- (if (string-match "[ \"]" "?")
+ (if (string-match "[ \"]" s)
(concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"")
"\"")
s)))))
diff --git a/lisp/ob-groovy.el b/lisp/ob-groovy.el
new file mode 100644
index 0000000..9bb17e6
--- a/dev/null
+++ b/lisp/ob-groovy.el
@@ -0,0 +1,120 @@
+;;; ob-groovy.el --- org-babel functions for Groovy evaluation
+
+;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
+
+;; Author: Miro Bezjak
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; 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 only supports the external execution. No session support yet.
+
+;;; Requirements:
+;; - Groovy language :: http://groovy.codehaus.org
+;; - Groovy major mode :: Can be installed from MELPA or
+;; https://github.com/russel/Emacs-Groovy-Mode
+
+;;; Code:
+(require 'ob)
+(eval-when-compile (require 'cl))
+
+(defvar org-babel-tangle-lang-exts) ;; Autoloaded
+(add-to-list 'org-babel-tangle-lang-exts '("groovy" . "groovy"))
+(defvar org-babel-default-header-args:groovy '())
+(defvar org-babel-groovy-command "groovy"
+ "Name of the command to use for executing Groovy code.")
+
+(defun org-babel-execute:groovy (body params)
+ "Execute a block of Groovy code with org-babel. This function is
+called by `org-babel-execute-src-block'"
+ (message "executing Groovy source code block")
+ (let* ((processed-params (org-babel-process-params params))
+ (session (org-babel-groovy-initiate-session (nth 0 processed-params)))
+ (vars (nth 1 processed-params))
+ (result-params (nth 2 processed-params))
+ (result-type (cdr (assoc :result-type params)))
+ (full-body (org-babel-expand-body:generic
+ body params))
+ (result (org-babel-groovy-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-groovy-table-or-string (results)
+ "Convert RESULTS into an appropriate elisp value.
+If RESULTS look like a table, then convert them into an
+Emacs-lisp table, otherwise return the results as a string."
+ (org-babel-script-escape results))
+
+
+(defvar org-babel-groovy-wrapper-method
+
+ "class Runner extends Script {
+ def out = new PrintWriter(new ByteArrayOutputStream())
+ def run() { %s }
+}
+
+println(new Runner().run())
+")
+
+
+(defun org-babel-groovy-evaluate
+ (session body &optional result-type result-params)
+ "Evaluate BODY in external Groovy process.
+If RESULT-TYPE equals 'output then return standard output as a string.
+If RESULT-TYPE equals 'value then return the value of the last statement
+in BODY as elisp."
+ (when session (error "Sessions are not (yet) supported for Groovy"))
+ (case result-type
+ (output
+ (let ((src-file (org-babel-temp-file "groovy-")))
+ (progn (with-temp-file src-file (insert body))
+ (org-babel-eval
+ (concat org-babel-groovy-command " " src-file) ""))))
+ (value
+ (let* ((src-file (org-babel-temp-file "groovy-"))
+ (wrapper (format org-babel-groovy-wrapper-method body)))
+ (with-temp-file src-file (insert wrapper))
+ (let ((raw (org-babel-eval
+ (concat org-babel-groovy-command " " src-file) "")))
+ (org-babel-result-cond result-params
+ raw
+ (org-babel-groovy-table-or-string raw)))))))
+
+
+(defun org-babel-prep-session:groovy (session params)
+ "Prepare SESSION according to the header arguments specified in PARAMS."
+ (error "Sessions are not (yet) supported for Groovy"))
+
+(defun org-babel-groovy-initiate-session (&optional session)
+ "If there is not a current inferior-process-buffer in SESSION
+then create. Return the initialized session. Sessions are not
+supported in Groovy."
+ nil)
+
+(provide 'ob-groovy)
+
+
+
+;;; ob-groovy.el ends here
diff --git a/lisp/ob-haskell.el b/lisp/ob-haskell.el
index 6c9fed1..22240ad 100644
--- a/lisp/ob-haskell.el
+++ b/lisp/ob-haskell.el
@@ -1,6 +1,6 @@
;;; ob-haskell.el --- org-babel functions for haskell evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
diff --git a/lisp/ob-io.el b/lisp/ob-io.el
index 5368ff5..971b37f 100644
--- a/lisp/ob-io.el
+++ b/lisp/ob-io.el
@@ -1,6 +1,6 @@
;;; ob-io.el --- org-babel functions for Io evaluation
-;; Copyright (C) 2012-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2014 Free Software Foundation, Inc.
;; Author: Andrzej Lichnerowicz
;; Keywords: literate programming, reproducible research
diff --git a/lisp/ob-java.el b/lisp/ob-java.el
index 37ac8da..22f8785 100644
--- a/lisp/ob-java.el
+++ b/lisp/ob-java.el
@@ -1,6 +1,6 @@
;;; ob-java.el --- org-babel functions for java evaluation
-;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
diff --git a/lisp/ob-js.el b/lisp/ob-js.el
index 78914bc..7789449 100644
--- a/lisp/ob-js.el
+++ b/lisp/ob-js.el
@@ -1,6 +1,6 @@
;;; ob-js.el --- org-babel functions for Javascript
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, js
diff --git a/lisp/ob-keys.el b/lisp/ob-keys.el
index 6cc7387..dc1f437 100644
--- a/lisp/ob-keys.el
+++ b/lisp/ob-keys.el
@@ -1,6 +1,6 @@
;;; ob-keys.el --- key bindings for org-babel
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -89,6 +89,7 @@ functions which are assigned key bindings, and see
("h" . org-babel-describe-bindings)
("\C-x" . org-babel-do-key-sequence-in-edit-buffer)
("x" . org-babel-do-key-sequence-in-edit-buffer)
+ ("k" . org-babel-remove-result-one-or-many)
("\C-\M-h" . org-babel-mark-block))
"Alist of key bindings and interactive Babel functions.
This list associates interactive Babel functions
diff --git a/lisp/ob-latex.el b/lisp/ob-latex.el
index 85918e6..35b6650 100644
--- a/lisp/ob-latex.el
+++ b/lisp/ob-latex.el
@@ -1,6 +1,6 @@
;;; ob-latex.el --- org-babel functions for latex "evaluation"
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -59,7 +59,7 @@
'("[usenames]{color}" "{tikz}" "{color}" "{listings}" "{amsmath}")
"Packages to use for htlatex export."
:group 'org-babel
- :type '(list (string)))
+ :type '(repeat (string)))
(defun org-babel-expand-body:latex (body params)
"Expand BODY according to PARAMS, return the expanded body."
diff --git a/lisp/ob-ledger.el b/lisp/ob-ledger.el
index 17911cc..806fec6 100644
--- a/lisp/ob-ledger.el
+++ b/lisp/ob-ledger.el
@@ -1,6 +1,6 @@
;;; ob-ledger.el --- org-babel functions for ledger evaluation
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Author: Eric S Fraga
;; Keywords: literate programming, reproducible research, accounting
diff --git a/lisp/ob-lilypond.el b/lisp/ob-lilypond.el
index a58a443..9b57546 100644
--- a/lisp/ob-lilypond.el
+++ b/lisp/ob-lilypond.el
@@ -1,6 +1,6 @@
;;; ob-lilypond.el --- org-babel functions for lilypond evaluation
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Author: Martyn Jago
;; Keywords: babel language, literate programming
diff --git a/lisp/ob-lisp.el b/lisp/ob-lisp.el
index 3f156d0..9e10340 100644
--- a/lisp/ob-lisp.el
+++ b/lisp/ob-lisp.el
@@ -1,6 +1,6 @@
;;; ob-lisp.el --- org-babel functions for common lisp evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Authors: Joel Boehland
;; Eric Schulte
@@ -91,10 +91,10 @@ current directory string."
(point-min) (point-max)))))
(cdr (assoc :package params)))))))
(org-babel-result-cond (cdr (assoc :result-params params))
- (car result)
+ result
(condition-case nil
- (read (org-babel-lisp-vector-to-list (cadr result)))
- (error (cadr result)))))
+ (read (org-babel-lisp-vector-to-list result))
+ (error result))))
(org-babel-pick-name (cdr (assoc :colname-names params))
(cdr (assoc :colnames params)))
(org-babel-pick-name (cdr (assoc :rowname-names params))
diff --git a/lisp/ob-lob.el b/lisp/ob-lob.el
index d37940a..6480468 100644
--- a/lisp/ob-lob.el
+++ b/lisp/ob-lob.el
@@ -1,6 +1,6 @@
;;; ob-lob.el --- functions supporting the Library of Babel
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Authors: Eric Schulte
;; Dan Davison
@@ -40,14 +40,13 @@ files to `org-babel-lob-files'.")
To add files to this list use the `org-babel-lob-ingest' command."
:group 'org-babel
:version "24.1"
- :type 'list)
+ :type '(repeat file))
(defvar org-babel-default-lob-header-args '((:exports . "results"))
"Default header arguments to use when exporting #+lob/call lines.")
(defun org-babel-lob-ingest (&optional file)
- "Add all named source-blocks defined in FILE to
-`org-babel-library-of-babel'."
+ "Add all named source blocks defined in FILE to `org-babel-library-of-babel'."
(interactive "fFile: ")
(let ((lob-ingest-count 0))
(org-babel-map-src-blocks file
@@ -71,8 +70,8 @@ To add files to this list use the `org-babel-lob-ingest' command."
(defconst org-babel-inline-lob-one-liner-regexp
(concat
- "\\([^\n]*?\\)call_\\([^\(\)\n]+?\\)\\(\\[\\(.*?\\)\\]\\|\\(\\)\\)"
- "\(\\([^\n]*?\\)\)\\(\\[\\(.*?\\)\\]\\)?")
+ "\\([^\n]*?\\)call_\\([^\(\)[:space:]\n]+?\\)\\(\\[\\(.*?\\)\\]\\|\\(\\)\\)"
+ "\(\\(.*?\\)\)\\(\\[\\(.*?\\)\\]\\)?")
"Regexp to match inline calls to predefined source block functions.")
(defconst org-babel-lob-one-liner-regexp
@@ -143,18 +142,32 @@ if so then run the appropriate source block from the Library."
(pre-info (funcall mkinfo pre-params))
(cache-p (and (cdr (assoc :cache pre-params))
(string= "yes" (cdr (assoc :cache pre-params)))))
- (new-hash (when cache-p (org-babel-sha1-hash pre-info)))
- (old-hash (when cache-p (org-babel-current-result-hash)))
+ (new-hash (when cache-p
+ (org-babel-sha1-hash
+ ;; Do *not* pre-process params for call line
+ ;; hash evaluation, since for a call line :var
+ ;; extension *is* execution.
+ (let* ((params (nth 2 pre-info))
+ (sha1-nth2 (list
+ (cons
+ (cons :c-var (cdr (assoc :var params)))
+ (assq-delete-all :var (copy-tree params)))))
+ (sha1-info (copy-tree pre-info)))
+ (prog1 sha1-info
+ (setcar (cddr sha1-info) sha1-nth2))))))
+ (old-hash (when cache-p (org-babel-current-result-hash pre-info)))
(org-babel-current-src-block-location (point-marker)))
(if (and cache-p (equal new-hash old-hash))
- (save-excursion (goto-char (org-babel-where-is-src-block-result))
+ (save-excursion (goto-char (org-babel-where-is-src-block-result
+ nil pre-info))
(forward-line 1)
(message "%S" (org-babel-read-result)))
(prog1 (let* ((proc-params (org-babel-process-params pre-params))
org-confirm-babel-evaluate)
(org-babel-execute-src-block nil (funcall mkinfo proc-params)))
;; update the hash
- (when new-hash (org-babel-set-current-result-hash new-hash))))))
+ (when new-hash
+ (org-babel-set-current-result-hash new-hash pre-info))))))
(provide 'ob-lob)
diff --git a/lisp/ob-makefile.el b/lisp/ob-makefile.el
index 517b5a6..af7e66e 100644
--- a/lisp/ob-makefile.el
+++ b/lisp/ob-makefile.el
@@ -1,8 +1,9 @@
;;; ob-makefile.el --- org-babel functions for makefile evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
-;; Author: Eric Schulte and Thomas S. Dye
+;; Author: Eric Schulte
+;; Thomas S. Dye
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
diff --git a/lisp/ob-matlab.el b/lisp/ob-matlab.el
index 481ed24..ef77de3 100644
--- a/lisp/ob-matlab.el
+++ b/lisp/ob-matlab.el
@@ -1,6 +1,6 @@
;;; ob-matlab.el --- org-babel support for matlab evaluation
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Author: Dan Davison
;; Keywords: literate programming, reproducible research
diff --git a/lisp/ob-maxima.el b/lisp/ob-maxima.el
index 5be378e..7435f1d 100644
--- a/lisp/ob-maxima.el
+++ b/lisp/ob-maxima.el
@@ -1,6 +1,6 @@
;;; ob-maxima.el --- org-babel functions for maxima evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric S Fraga
;; Eric Schulte
@@ -43,7 +43,8 @@
(defcustom org-babel-maxima-command
(if (boundp 'maxima-command) maxima-command "maxima")
"Command used to call maxima on the shell."
- :group 'org-babel)
+ :group 'org-babel
+ :type 'string)
(defun org-babel-maxima-expand (body params)
"Expand a block of Maxima code according to its header arguments."
diff --git a/lisp/ob-mscgen.el b/lisp/ob-mscgen.el
index 209ad7d..4a4dc05 100644
--- a/lisp/ob-mscgen.el
+++ b/lisp/ob-mscgen.el
@@ -1,6 +1,6 @@
;;; ob-msc.el --- org-babel functions for mscgen evaluation
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Author: Juan Pechiar
;; Keywords: literate programming, reproducible research
diff --git a/lisp/ob-ocaml.el b/lisp/ob-ocaml.el
index 25f79c5..7f0e298 100644
--- a/lisp/ob-ocaml.el
+++ b/lisp/ob-ocaml.el
@@ -1,6 +1,6 @@
;;; ob-ocaml.el --- org-babel functions for ocaml evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -79,16 +79,25 @@
(progn (setq out nil) line)
(when (string-match re line)
(progn (setq out t) nil))))
- (mapcar #'org-babel-trim (reverse raw))))))))
+ (mapcar #'org-babel-trim (reverse raw)))))))
+ (raw (org-babel-trim clean))
+ (result-params (cdr (assoc :result-params params)))
+ (parsed
+ (string-match
+ "\\(\\(.*\n\\)*\\)[^:\n]+ : \\([^=\n]+\\) =\\(\n\\| \\)\\(.+\\)$"
+ raw))
+ (output (match-string 1 raw))
+ (type (match-string 3 raw))
+ (value (match-string 5 raw)))
(org-babel-reassemble-table
- (let ((raw (org-babel-trim clean))
- (result-params (cdr (assoc :result-params params))))
- (org-babel-result-cond result-params
- ;; strip type information from output unless verbatim is specified
- (if (and (not (member "verbatim" result-params))
- (string-match "= \\(.+\\)$" raw))
- (match-string 1 raw) raw)
- (org-babel-ocaml-parse-output raw)))
+ (org-babel-result-cond result-params
+ (cond
+ ((member "verbatim" result-params) raw)
+ ((member "output" result-params) output)
+ (t raw))
+ (if (and value type)
+ (org-babel-ocaml-parse-output value type)
+ raw))
(org-babel-pick-name
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
@@ -121,21 +130,20 @@
(concat "[|" (mapconcat #'org-babel-ocaml-elisp-to-ocaml val "; ") "|]")
(format "%S" val)))
-(defun org-babel-ocaml-parse-output (output)
- "Parse OUTPUT.
-OUTPUT is string output from an ocaml process."
- (let ((regexp "[^:]+ : %s = \\(.+\\)$"))
- (cond
- ((string-match (format regexp "string") output)
- (org-babel-read (match-string 1 output)))
- ((or (string-match (format regexp "int") output)
- (string-match (format regexp "float") output))
- (string-to-number (match-string 1 output)))
- ((string-match (format regexp "list") output)
- (org-babel-ocaml-read-list (match-string 1 output)))
- ((string-match (format regexp "array") output)
- (org-babel-ocaml-read-array (match-string 1 output)))
- (t (message "don't recognize type of %s" output) output))))
+(defun org-babel-ocaml-parse-output (value type)
+ "Parse VALUE of type TYPE.
+VALUE and TYPE are string output from an ocaml process."
+ (cond
+ ((string= "string" type)
+ (org-babel-read value))
+ ((or (string= "int" type)
+ (string= "float" type))
+ (string-to-number value))
+ ((string-match "list" type)
+ (org-babel-ocaml-read-list value))
+ ((string-match "array" type)
+ (org-babel-ocaml-read-array value))
+ (t (message "don't recognize type %s" type) value)))
(defun org-babel-ocaml-read-list (results)
"Convert RESULTS into an elisp table or string.
diff --git a/lisp/ob-octave.el b/lisp/ob-octave.el
index 40bedfd..8cc66b6 100644
--- a/lisp/ob-octave.el
+++ b/lisp/ob-octave.el
@@ -1,6 +1,6 @@
;;; ob-octave.el --- org-babel functions for octave and matlab evaluation
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Author: Dan Davison
;; Keywords: literate programming, reproducible research
diff --git a/lisp/ob-org.el b/lisp/ob-org.el
index 892c56c..bc02f23 100644
--- a/lisp/ob-org.el
+++ b/lisp/ob-org.el
@@ -1,6 +1,6 @@
;;; ob-org.el --- org-babel functions for org code block evaluation
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
diff --git a/lisp/ob-perl.el b/lisp/ob-perl.el
index d374e47..ff4cbea 100644
--- a/lisp/ob-perl.el
+++ b/lisp/ob-perl.el
@@ -1,6 +1,6 @@
;;; ob-perl.el --- org-babel functions for perl evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Authors: Dan Davison
;; Eric Schulte
diff --git a/lisp/ob-picolisp.el b/lisp/ob-picolisp.el
index 279cd7b..b240138 100644
--- a/lisp/ob-picolisp.el
+++ b/lisp/ob-picolisp.el
@@ -1,6 +1,6 @@
;;; ob-picolisp.el --- org-babel functions for picolisp evaluation
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Authors: Thorsten Jolitz
;; Eric Schulte
diff --git a/lisp/ob-plantuml.el b/lisp/ob-plantuml.el
index f992d04..ebc5a10 100644
--- a/lisp/ob-plantuml.el
+++ b/lisp/ob-plantuml.el
@@ -1,6 +1,6 @@
;;; ob-plantuml.el --- org-babel functions for plantuml evaluation
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Author: Zhang Weize
;; Keywords: literate programming, reproducible research
diff --git a/lisp/ob-python.el b/lisp/ob-python.el
index 2f91b53..baa5764 100644
--- a/lisp/ob-python.el
+++ b/lisp/ob-python.el
@@ -1,6 +1,6 @@
;;; ob-python.el --- org-babel functions for python evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Authors: Eric Schulte
;; Dan Davison
@@ -137,7 +137,7 @@ specifying a variable of the same value."
org-babel-python-hline-to
(format
(if (and (stringp var) (string-match "[\n\r]" var)) "\"\"%S\"\"" "%S")
- var))))
+ (if (stringp var) (substring-no-properties var) var)))))
(defun org-babel-python-table-or-string (results)
"Convert RESULTS into an appropriate elisp value.
@@ -156,14 +156,14 @@ Emacs-lisp table, otherwise return the results as a string."
"Return the buffer associated with SESSION."
(cdr (assoc session org-babel-python-buffers)))
-(defun org-babel-python-with-earmufs (session)
+(defun org-babel-python-with-earmuffs (session)
(let ((name (if (stringp session) session (format "%s" session))))
(if (and (string= "*" (substring name 0 1))
(string= "*" (substring name (- (length name) 1))))
name
(format "*%s*" name))))
-(defun org-babel-python-without-earmufs (session)
+(defun org-babel-python-without-earmuffs (session)
(let ((name (if (stringp session) session (format "%s" session))))
(if (and (string= "*" (substring name 0 1))
(string= "*" (substring name (- (length name) 1))))
@@ -190,9 +190,9 @@ then create. Return the initialized session."
(if (not (version< "24.1" emacs-version))
(run-python cmd)
(unless python-buffer
- (setq python-buffer (org-babel-python-with-earmufs session)))
+ (setq python-buffer (org-babel-python-with-earmuffs session)))
(let ((python-shell-buffer-name
- (org-babel-python-without-earmufs python-buffer)))
+ (org-babel-python-without-earmuffs python-buffer)))
(run-python cmd))))
((and (eq 'python-mode org-babel-python-mode)
(fboundp 'py-shell)) ; python-mode.el
@@ -208,7 +208,7 @@ then create. Return the initialized session."
(concat "Python-" (symbol-name session))))
(py-which-bufname bufname))
(py-shell)
- (setq python-buffer (org-babel-python-with-earmufs bufname))))
+ (setq python-buffer (org-babel-python-with-earmuffs bufname))))
(t
(error "No function available for running an inferior Python")))
(setq org-babel-python-buffers
diff --git a/lisp/ob-ref.el b/lisp/ob-ref.el
index ed48010..6172895 100644
--- a/lisp/ob-ref.el
+++ b/lisp/ob-ref.el
@@ -1,6 +1,6 @@
;;; ob-ref.el --- org-babel functions for referencing external data
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Authors: Eric Schulte
;; Dan Davison
@@ -129,98 +129,99 @@ the variable."
(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 id)
- ;; if ref is indexed grab the indices -- beware nested indices
- (when (and (string-match "\\[\\([^\\[]+\\)\\]$" ref)
- (let ((str (substring ref 0 (match-beginning 0))))
- (= (org-count ?( str) (org-count ?) str))))
- (setq index (match-string 1 ref))
- (setq ref (substring ref 0 (match-beginning 0))))
- ;; assign any arguments to pass to source block
- (when (string-match
- "^\\(.+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)\(\\(.*\\)\)$" ref)
- (setq new-refere (match-string 1 ref))
- (setq new-header-args (match-string 3 ref))
- (setq new-referent (match-string 5 ref))
- (when (> (length new-refere) 0)
- (when (> (length new-referent) 0)
- (setq args (mapcar (lambda (ref) (cons :var ref))
- (org-babel-ref-split-args new-referent))))
- (when (> (length new-header-args) 0)
- (setq args (append (org-babel-parse-header-arguments
- new-header-args) args)))
- (setq ref new-refere)))
- (when (string-match "^\\(.+\\):\\(.+\\)$" ref)
- (setq split-file (match-string 1 ref))
- (setq split-ref (match-string 2 ref))
- (find-file split-file) (setq ref split-ref))
- (save-restriction
- (widen)
- (goto-char (point-min))
- (if (let ((src-rx (org-babel-named-src-block-regexp-for-name ref))
- (res-rx (org-babel-named-data-regexp-for-name ref)))
- ;; goto ref in the current buffer
- (or
- ;; check for code blocks
- (re-search-forward src-rx nil t)
- ;; check for named data
- (re-search-forward res-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 (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))
- (cond
- (lob-info (setq type 'lob))
- (id (setq type 'id))
- ((and (looking-at org-babel-src-name-regexp)
- (save-excursion
- (forward-line 1)
- (or (looking-at org-babel-src-block-regexp)
- (looking-at org-babel-multi-line-header-regexp))))
- (setq type 'source-block))
- ((and (looking-at org-babel-src-name-regexp)
- (save-excursion
- (forward-line 1)
- (looking-at org-babel-lob-one-liner-regexp)))
- (setq type 'call-line))
- (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))
- (source-block (org-babel-execute-src-block
- nil nil (if org-babel-update-intermediate
- nil params)))
- (call-line (save-excursion
- (forward-line 1)
- (org-babel-lob-execute
- (org-babel-lob-get-info))))
- (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)))))))
+ (with-current-buffer (or org-babel-exp-reference-buffer (current-buffer))
+ (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 id)
+ ;; if ref is indexed grab the indices -- beware nested indices
+ (when (and (string-match "\\[\\([^\\[]+\\)\\]$" ref)
+ (let ((str (substring ref 0 (match-beginning 0))))
+ (= (org-count ?( str) (org-count ?) str))))
+ (setq index (match-string 1 ref))
+ (setq ref (substring ref 0 (match-beginning 0))))
+ ;; assign any arguments to pass to source block
+ (when (string-match
+ "^\\(.+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)\(\\(.*\\)\)$" ref)
+ (setq new-refere (match-string 1 ref))
+ (setq new-header-args (match-string 3 ref))
+ (setq new-referent (match-string 5 ref))
+ (when (> (length new-refere) 0)
+ (when (> (length new-referent) 0)
+ (setq args (mapcar (lambda (ref) (cons :var ref))
+ (org-babel-ref-split-args new-referent))))
+ (when (> (length new-header-args) 0)
+ (setq args (append (org-babel-parse-header-arguments
+ new-header-args) args)))
+ (setq ref new-refere)))
+ (when (string-match "^\\(.+\\):\\(.+\\)$" ref)
+ (setq split-file (match-string 1 ref))
+ (setq split-ref (match-string 2 ref))
+ (find-file split-file) (setq ref split-ref))
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (if (let ((src-rx (org-babel-named-src-block-regexp-for-name ref))
+ (res-rx (org-babel-named-data-regexp-for-name ref)))
+ ;; goto ref in the current buffer
+ (or
+ ;; check for code blocks
+ (re-search-forward src-rx nil t)
+ ;; check for named data
+ (re-search-forward res-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 (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))
+ (cond
+ (lob-info (setq type 'lob))
+ (id (setq type 'id))
+ ((and (looking-at org-babel-src-name-regexp)
+ (save-excursion
+ (forward-line 1)
+ (or (looking-at org-babel-src-block-regexp)
+ (looking-at org-babel-multi-line-header-regexp))))
+ (setq type 'source-block))
+ ((and (looking-at org-babel-src-name-regexp)
+ (save-excursion
+ (forward-line 1)
+ (looking-at org-babel-lob-one-liner-regexp)))
+ (setq type 'call-line))
+ (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))
+ (source-block (org-babel-execute-src-block
+ nil nil (if org-babel-update-intermediate
+ nil params)))
+ (call-line (save-excursion
+ (forward-line 1)
+ (org-babel-lob-execute
+ (org-babel-lob-get-info))))
+ (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))))))))
(defun org-babel-ref-index-list (index lis)
"Return the subset of LIS indexed by INDEX.
diff --git a/lisp/ob-ruby.el b/lisp/ob-ruby.el
index cee9b0f..fd59ef4 100644
--- a/lisp/ob-ruby.el
+++ b/lisp/ob-ruby.el
@@ -1,6 +1,6 @@
;;; ob-ruby.el --- org-babel functions for ruby evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
diff --git a/lisp/ob-sass.el b/lisp/ob-sass.el
index cdb75be..78c0c95 100644
--- a/lisp/ob-sass.el
+++ b/lisp/ob-sass.el
@@ -1,6 +1,6 @@
;;; ob-sass.el --- org-babel functions for the sass css generation language
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
diff --git a/lisp/ob-scala.el b/lisp/ob-scala.el
index f778361..0584342 100644
--- a/lisp/ob-scala.el
+++ b/lisp/ob-scala.el
@@ -1,6 +1,6 @@
;;; ob-scala.el --- org-babel functions for Scala evaluation
-;; Copyright (C) 2012-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2014 Free Software Foundation, Inc.
;; Author: Andrzej Lichnerowicz
;; Keywords: literate programming, reproducible research
diff --git a/lisp/ob-scheme.el b/lisp/ob-scheme.el
index f979640..b7117e9 100644
--- a/lisp/ob-scheme.el
+++ b/lisp/ob-scheme.el
@@ -1,8 +1,9 @@
;;; ob-scheme.el --- org-babel functions for Scheme
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
-;; Authors: Eric Schulte, Michael Gauland
+;; Authors: Eric Schulte
+;; Michael Gauland
;; Keywords: literate programming, reproducible research, scheme
;; Homepage: http://orgmode.org
diff --git a/lisp/ob-screen.el b/lisp/ob-screen.el
index f263376..2acbbeb 100644
--- a/lisp/ob-screen.el
+++ b/lisp/ob-screen.el
@@ -1,6 +1,6 @@
;;; ob-screen.el --- org-babel support for interactive terminal
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Benjamin Andresen
;; Keywords: literate programming, interactive shell
diff --git a/lisp/ob-sh.el b/lisp/ob-shell.el
index 4984ff9..474a8f2 100644
--- a/lisp/ob-sh.el
+++ b/lisp/ob-shell.el
@@ -1,6 +1,6 @@
-;;; ob-sh.el --- org-babel functions for shell evaluation
+;;; ob-shell.el --- org-babel functions for shell evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -38,9 +38,12 @@
(defvar org-babel-default-header-args:sh '())
-(defvar org-babel-sh-command "sh"
+(defcustom org-babel-sh-command shell-file-name
"Command used to invoke a shell.
-This will be passed to `shell-command-on-region'")
+Set by default to the value of `shell-file-name'. This will be
+passed to `shell-command-on-region'"
+ :group 'org-babel
+ :type 'string)
(defcustom org-babel-sh-var-quote-fmt
"$(cat <<'BABEL_TABLE'\n%s\nBABEL_TABLE\n)"
@@ -48,7 +51,23 @@ This will be passed to `shell-command-on-region'")
:group 'org-babel
:type 'string)
-(defun org-babel-execute:sh (body params)
+(defcustom org-babel-shell-names
+ '("sh" "bash" "csh" "ash" "dash" "ksh" "mksh" "posh")
+ "List of names of shell supported by babel shell code blocks."
+ :group 'org-babel
+ :type 'string
+ :initialize
+ (lambda (symbol value)
+ (set-default symbol (second value))
+ (mapc
+ (lambda (name)
+ (eval `(defun ,(intern (concat "org-babel-execute:" name)) (body params)
+ ,(format "Execute a block of %s commands with Babel." name)
+ (let ((org-babel-sh-command ,name))
+ (org-babel-execute:shell body params)))))
+ (second value))))
+
+(defun org-babel-execute:shell (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
@@ -56,10 +75,11 @@ This function is called by `org-babel-execute-src-block'."
(stdin (let ((stdin (cdr (assoc :stdin params))))
(when stdin (org-babel-sh-var-to-string
(org-babel-ref-resolve stdin)))))
+ (cmdline (cdr (assoc :cmdline 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 params stdin)
+ (org-babel-sh-evaluate session full-body params stdin cmdline)
(org-babel-pick-name
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
@@ -85,29 +105,74 @@ This function is called by `org-babel-execute-src-block'."
buffer)))
;; helper functions
+(defun org-babel-variable-assignments:sh-generic
+ (varname values &optional sep hline)
+ "Returns a list of statements declaring the values as a generic variable."
+ (format "%s=%s" varname (org-babel-sh-var-to-sh values sep hline)))
+
+(defun org-babel-variable-assignments:bash_array
+ (varname values &optional sep hline)
+ "Returns a list of statements declaring the values as a bash array."
+ (format "unset %s\ndeclare -a %s=( \"%s\" )"
+ varname varname
+ (mapconcat 'identity
+ (mapcar
+ (lambda (value) (org-babel-sh-var-to-sh value sep hline))
+ values)
+ "\" \"")))
+
+(defun org-babel-variable-assignments:bash_assoc
+ (varname values &optional sep hline)
+ "Returns a list of statements declaring the values as bash associative array."
+ (format "unset %s\ndeclare -A %s\n%s"
+ varname varname
+ (mapconcat 'identity
+ (mapcar
+ (lambda (items)
+ (format "%s[\"%s\"]=%s"
+ varname
+ (org-babel-sh-var-to-sh (car items) sep hline)
+ (org-babel-sh-var-to-sh (cdr items) sep hline)))
+ values)
+ "\n")))
+
+(defun org-babel-variable-assignments:bash (varname values &optional sep hline)
+ "Represents the parameters as useful Bash shell variables."
+ (if (listp values)
+ (if (and (listp (car values)) (= 1 (length (car values))))
+ (org-babel-variable-assignments:bash_array varname values sep hline)
+ (org-babel-variable-assignments:bash_assoc varname values sep hline))
+ (org-babel-variable-assignments:sh-generic varname values sep hline)))
(defun org-babel-variable-assignments:sh (params)
"Return list of shell statements assigning the block's variables."
- (let ((sep (cdr (assoc :separator params))))
+ (let ((sep (cdr (assoc :separator params)))
+ (hline (when (string= "yes" (cdr (assoc :hlines params)))
+ (or (cdr (assoc :hline-string params))
+ "hline"))))
(mapcar
(lambda (pair)
- (format "%s=%s"
- (car pair)
- (org-babel-sh-var-to-sh (cdr pair) sep)))
+ (if (string= org-babel-sh-command "bash")
+ (org-babel-variable-assignments:bash
+ (car pair) (cdr pair) sep hline)
+ (org-babel-variable-assignments:sh-generic
+ (car pair) (cdr pair) sep hline)))
(mapcar #'cdr (org-babel-get-header params :var)))))
-(defun org-babel-sh-var-to-sh (var &optional sep)
+(defun org-babel-sh-var-to-sh (var &optional sep hline)
"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."
- (format org-babel-sh-var-quote-fmt (org-babel-sh-var-to-string var sep)))
+ (format org-babel-sh-var-quote-fmt
+ (org-babel-sh-var-to-string var sep hline)))
-(defun org-babel-sh-var-to-string (var &optional sep)
+(defun org-babel-sh-var-to-string (var &optional sep hline)
"Convert an elisp value to a string."
(let ((echo-var (lambda (v) (if (stringp v) v (format "%S" v)))))
(cond
((and (listp var) (or (listp (car var)) (equal (car var) 'hline)))
- (orgtbl-to-generic var (list :sep (or sep "\t") :fmt echo-var)))
+ (orgtbl-to-generic var (list :sep (or sep "\t") :fmt echo-var
+ :hline hline)))
((listp var)
(mapconcat echo-var var "\n"))
(t (funcall echo-var var)))))
@@ -130,14 +195,14 @@ 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 params stdin)
+(defun org-babel-sh-evaluate (session body &optional params stdin cmdline)
"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
return the value of the last statement in BODY."
(let ((results
(cond
- (stdin ; external shell script w/STDIN
+ ((or stdin cmdline) ; external shell script w/STDIN
(let ((script-file (org-babel-temp-file "sh-script-"))
(stdin-file (org-babel-temp-file "sh-stdin-"))
(shebang (cdr (assoc :shebang params)))
@@ -147,14 +212,14 @@ return the value of the last statement in BODY."
(when padline (insert "\n"))
(insert body))
(set-file-modes script-file #o755)
- (with-temp-file stdin-file (insert stdin))
+ (with-temp-file stdin-file (insert (or stdin "")))
(with-temp-buffer
(call-process-shell-command
(if shebang
script-file
(format "%s %s" org-babel-sh-command script-file))
stdin-file
- (current-buffer))
+ (current-buffer) nil cmdline)
(buffer-string))))
(session ; session evaluation
(mapconcat
@@ -205,8 +270,8 @@ return the value of the last statement in BODY."
(setq string (substring string (match-end 0))))
string)
-(provide 'ob-sh)
+(provide 'ob-shell)
-;;; ob-sh.el ends here
+;;; ob-shell.el ends here
diff --git a/lisp/ob-shen.el b/lisp/ob-shen.el
index 68169da..e40e45c 100644
--- a/lisp/ob-shen.el
+++ b/lisp/ob-shen.el
@@ -1,6 +1,6 @@
;;; ob-shen.el --- org-babel functions for Shen
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, shen
diff --git a/lisp/ob-sql.el b/lisp/ob-sql.el
index d17dd8a..7b85df8 100644
--- a/lisp/ob-sql.el
+++ b/lisp/ob-sql.el
@@ -1,6 +1,6 @@
;;; ob-sql.el --- org-babel functions for sql evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -123,7 +123,8 @@ This function is called by `org-babel-execute-src-block'."
(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"
+ "psql --set=\"ON_ERROR_STOP=1\" %s -A -P footer=off -F \"\t\" -f %s -o %s %s"
+ (if colnames-p "" "-t")
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)
(or cmdline "")))
diff --git a/lisp/ob-sqlite.el b/lisp/ob-sqlite.el
index fcfdb8e..098626f 100644
--- a/lisp/ob-sqlite.el
+++ b/lisp/ob-sqlite.el
@@ -1,6 +1,6 @@
;;; ob-sqlite.el --- org-babel functions for sqlite database interaction
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
diff --git a/lisp/ob-table.el b/lisp/ob-table.el
index c71bb87..831e352 100644
--- a/lisp/ob-table.el
+++ b/lisp/ob-table.el
@@ -1,6 +1,6 @@
;;; ob-table.el --- support for calling org-babel functions from tables
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -24,7 +24,7 @@
;;; Commentary:
;; Should allow calling functions from org-mode tables using the
-;; function `sbe' as so...
+;; function `org-sbe' as so...
;; #+begin_src emacs-lisp :results silent
;; (defun fibbd (n) (if (< n 2) 1 (+ (fibbd (- n 1)) (fibbd (- n 2)))))
@@ -47,7 +47,7 @@
;; | 7 | |
;; | 8 | |
;; | 9 | |
-;; #+TBLFM: $2='(sbe 'fibbd (n $1))
+;; #+TBLFM: $2='(org-sbe 'fibbd (n $1))
;;; Code:
(require 'ob-core)
@@ -60,14 +60,14 @@ character and replace it with ellipses."
(concat (substring string 0 (match-beginning 0))
(if (match-string 1 string) "...")) string))
-(defmacro sbe (source-block &rest variables) ;FIXME: Namespace prefix!
+(defmacro org-sbe (source-block &rest variables)
"Return the results of calling SOURCE-BLOCK with VARIABLES.
Each element of VARIABLES should be a two
element list, whose first element is the name of the variable and
second element is a string of its value. The following call to
-`sbe' would be equivalent to the following source code block.
+`org-sbe' would be equivalent to the following source code block.
- (sbe 'source-block (n $2) (m 3))
+ (org-sbe 'source-block (n $2) (m 3))
#+begin_src emacs-lisp :var results=source-block(n=val_at_col_2, m=3) :results silent
results
@@ -84,7 +84,7 @@ the header argument which can then be passed before all variables
as shown in the example below.
| 1 | 2 | :file nothing.png | nothing.png |
-#+TBLFM: @1$4='(sbe test-sbe $3 (x $1) (y $2))"
+#+TBLFM: @1$4='(org-sbe test-sbe $3 (x $1) (y $2))"
(declare (debug (form form)))
(let* ((header-args (if (stringp (car variables)) (car variables) ""))
(variables (if (stringp (car variables)) (cdr variables) variables)))
diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el
index 7b06c39..be7e9a6 100644
--- a/lisp/ob-tangle.el
+++ b/lisp/ob-tangle.el
@@ -1,6 +1,6 @@
;;; ob-tangle.el --- extract source code from org-mode files
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -37,10 +37,13 @@
(declare-function org-fill-template "org" (template alist))
(declare-function org-babel-update-block-body "org" (new-body))
(declare-function org-up-heading-safe "org" ())
+(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
(declare-function make-directory "files" (dir &optional parents))
+(declare-function org-before-first-heading-p "org" ())
(defcustom org-babel-tangle-lang-exts
- '(("emacs-lisp" . "el"))
+ '(("emacs-lisp" . "el")
+ ("elisp" . "el"))
"Alist mapping languages to their file extensions.
The key is the language name, the value is the string that should
be inserted as the extension commonly used to identify files
@@ -106,11 +109,11 @@ controlled by the :comments header argument."
:version "24.1"
:type 'string)
-(defcustom org-babel-process-comment-text #'org-babel-trim
+(defcustom org-babel-process-comment-text #'org-remove-indentation
"Function called to process raw Org-mode text collected to be
inserted as comments in tangled source-code files. The function
should take a single string argument and return a string
-result. The default value is `org-babel-trim'."
+result. The default value is `org-remove-indentation'."
:group 'org-babel
:version "24.1"
:type 'function)
@@ -355,16 +358,6 @@ that the appropriate major-mode is set. SPEC has the form:
insert-comment
(org-fill-template org-babel-tangle-comment-format-end link-data)))))
-(defvar org-comment-string) ;; Defined in org.el
-(defun org-babel-under-commented-heading-p ()
- "Return t if currently under a commented heading."
- (if (let ((hd (nth 4 (org-heading-components))))
- (and hd (string-match (concat "^" org-comment-string) hd)))
- t
- (save-excursion
- (and (org-up-heading-safe)
- (org-babel-under-commented-heading-p)))))
-
(defun org-babel-tangle-collect-blocks (&optional language tangle-file)
"Collect source blocks in the current Org-mode file.
Return an association list of source-code block specifications of
@@ -388,7 +381,7 @@ can be used to limit the collected code blocks by target file."
(let* ((info (org-babel-get-src-block-info 'light))
(src-lang (nth 0 info))
(src-tfile (cdr (assoc :tangle (nth 2 info)))))
- (unless (or (org-babel-under-commented-heading-p)
+ (unless (or (org-in-commented-heading-p)
(string= (cdr (assoc :tangle (nth 2 info))) "no")
(and tangle-file (not (equal tangle-file src-tfile))))
(unless (and language (not (string= language src-lang)))
diff --git a/lisp/ob.el b/lisp/ob.el
index 827dd04..87657fe 100644
--- a/lisp/ob.el
+++ b/lisp/ob.el
@@ -1,6 +1,6 @@
;;; ob.el --- working with code blocks in org-mode
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Authors: Eric Schulte
;; Keywords: literate programming, reproducible research
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index 1936df1..184209b 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -1,6 +1,6 @@
;;; org-agenda.el --- Dynamic task and appointment lists for Org
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2014 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -329,11 +329,11 @@ the daily/weekly agenda, see `org-agenda-skip-function'.")
(string))
(list :tag "Number of days in agenda"
(const org-agenda-span)
- (choice (const :tag "Day" 'day)
- (const :tag "Week" 'week)
- (const :tag "Fortnight" 'fortnight)
- (const :tag "Month" 'month)
- (const :tag "Year" 'year)
+ (choice (const :tag "Day" day)
+ (const :tag "Week" week)
+ (const :tag "Fortnight" fortnight)
+ (const :tag "Month" month)
+ (const :tag "Year" year)
(integer :tag "Custom")))
(list :tag "Fixed starting date"
(const org-agenda-start-day)
@@ -391,32 +391,32 @@ the daily/weekly agenda, see `org-agenda-skip-function'.")
(repeat :inline t :tag "Conditions for skipping"
(choice
:tag "Condition type"
- (list :tag "Regexp matches" :inline t (const :format "" 'regexp) (regexp))
- (list :tag "Regexp does not match" :inline t (const :format "" 'notregexp) (regexp))
+ (list :tag "Regexp matches" :inline t (const :format "" regexp) (regexp))
+ (list :tag "Regexp does not match" :inline t (const :format "" notregexp) (regexp))
(list :tag "TODO state is" :inline t
- (const 'todo)
+ (const todo)
(choice
- (const :tag "any not-done state" 'todo)
- (const :tag "any done state" 'done)
- (const :tag "any state" 'any)
+ (const :tag "any not-done state" todo)
+ (const :tag "any done state" done)
+ (const :tag "any state" any)
(list :tag "Keyword list"
(const :format "" quote)
(repeat (string :tag "Keyword")))))
(list :tag "TODO state is not" :inline t
- (const 'nottodo)
+ (const nottodo)
(choice
- (const :tag "any not-done state" 'todo)
- (const :tag "any done state" 'done)
- (const :tag "any state" 'any)
+ (const :tag "any not-done state" todo)
+ (const :tag "any done state" done)
+ (const :tag "any state" any)
(list :tag "Keyword list"
(const :format "" quote)
(repeat (string :tag "Keyword")))))
- (const :tag "scheduled" 'scheduled)
- (const :tag "not scheduled" 'notscheduled)
- (const :tag "deadline" 'deadline)
- (const :tag "no deadline" 'notdeadline)
- (const :tag "timestamp" 'timestamp)
- (const :tag "no timestamp" 'nottimestamp))))))
+ (const :tag "scheduled" scheduled)
+ (const :tag "not scheduled" notscheduled)
+ (const :tag "deadline" deadline)
+ (const :tag "no deadline" notdeadline)
+ (const :tag "timestamp" timestamp)
+ (const :tag "no timestamp" nottimestamp))))))
(list :tag "Non-standard skipping condition"
:value (org-agenda-skip-function)
(const org-agenda-skip-function)
@@ -765,7 +765,7 @@ to make his option also apply to the tags-todo list."
(integer :tag "Ignore if N or more days in past(-) or future(+).")))
(defcustom org-agenda-todo-ignore-deadlines nil
- "Non-nil means ignore some deadlined TODO items when making TODO list.
+ "Non-nil means ignore some deadline TODO items when making TODO list.
There are different motivations for using different values, please think
carefully when configuring this variable.
@@ -864,7 +864,7 @@ When set to the symbol `not-today', skip scheduled previously,
but not scheduled today.
When set to the symbol `repeated-after-deadline', skip scheduled
-items if they are repeated beyond the current dealine."
+items if they are repeated beyond the current deadline."
:group 'org-agenda-skip
:group 'org-agenda-daily/weekly
:type '(choice
@@ -1358,12 +1358,12 @@ explanations on the possible values."
:group 'org-agenda-startup
:group 'org-agenda-daily/weekly
:type '(choice (const :tag "Don't show log items" nil)
- (const :tag "Show only log items" 'only)
- (const :tag "Show all possible log items" 'clockcheck)
+ (const :tag "Show only log items" only)
+ (const :tag "Show all possible log items" clockcheck)
(repeat :tag "Choose among possible values for `org-agenda-log-mode-items'"
- (choice (const :tag "Show closed log items" 'closed)
- (const :tag "Show clocked log items" 'clock)
- (const :tag "Show all logged state changes" 'state)))))
+ (choice (const :tag "Show closed log items" closed)
+ (const :tag "Show clocked log items" clock)
+ (const :tag "Show all logged state changes" state)))))
(defcustom org-agenda-start-with-clockreport-mode nil
"The initial value of clockreport-mode in a newly created agenda window."
@@ -1806,7 +1806,7 @@ When set to nil, never show inherited tags in agenda lines."
:version "24.3"
:type '(choice
(const :tag "Show inherited tags when available" t)
- (const :tag "Always show inherited tags" 'always)
+ (const :tag "Always show inherited tags" always)
(repeat :tag "Show inherited tags only in selected agenda types"
(symbol :tag "Agenda type"))))
@@ -2145,6 +2145,7 @@ The following commands are available:
;; Keep global-font-lock-mode from turning on font-lock-mode
(org-set-local 'font-lock-global-modes (list 'not major-mode))
(setq mode-name "Org-Agenda")
+ (setq indent-tabs-mode nil)
(use-local-map org-agenda-mode-map)
(easy-menu-add org-agenda-menu)
(if org-startup-truncated (setq truncate-lines t))
@@ -2318,6 +2319,10 @@ The following commands are available:
(org-defkey org-agenda-mode-map [mouse-2] 'org-agenda-goto-mouse)
(org-defkey org-agenda-mode-map [mouse-3] 'org-agenda-show-mouse)
+
+(define-key org-agenda-mode-map [remap forward-paragraph] 'org-agenda-forward-block)
+(define-key org-agenda-mode-map [remap backward-paragraph] 'org-agenda-backward-block)
+
(when org-agenda-mouse-1-follows-link
(org-defkey org-agenda-mode-map [follow-link] 'mouse-face))
(easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu"
@@ -2534,7 +2539,7 @@ For example, if you have a custom agenda command \"p\" and you
want this command to be accessible only from plain text files,
use this:
- '((\"p\" ((in-file . \"\\.txt\"))))
+ '((\"p\" ((in-file . \"\\\\.txt\\\\'\"))))
Here are the available contexts definitions:
@@ -2552,7 +2557,7 @@ accessible if there is at least one valid check.
You can also bind a key to another agenda custom command
depending on contextual rules.
- '((\"p\" \"q\" ((in-file . \"\\.txt\"))))
+ '((\"p\" \"q\" ((in-file . \"\\\\.txt\\\\'\"))))
Here it means: in .txt files, use \"p\" as the key for the
agenda command otherwise associated with \"q\". (The command
@@ -3583,7 +3588,7 @@ the global options and expect it to be applied to the entire view.")
(defvar org-agenda-regexp-filter-preset nil
"A preset of the regexp filter used for secondary agenda filtering.
-This must be a list of strings, each string must be a single category
+This must be a list of strings, each string must be a single regexp
preceded by \"+\" or \"-\".
This variable should not be set directly, but agenda custom commands can
bind it in the options section. The preset filter is a global property of
@@ -3720,12 +3725,7 @@ generating a new one."
(org-agenda-fontify-priorities))
(when (and org-agenda-dim-blocked-tasks org-blocker-hook)
(org-agenda-dim-blocked-tasks))
- ;; We need to widen when `org-agenda-finalize' is called from
- ;; `org-agenda-change-all-lines' (e.g. in `org-agenda-clock-in')
- (when org-clock-current-task
- (save-restriction
- (widen)
- (org-agenda-mark-clocking-task)))
+ (org-agenda-mark-clocking-task)
(when org-agenda-entry-text-mode
(org-agenda-entry-text-hide)
(org-agenda-entry-text-show))
@@ -3752,30 +3752,44 @@ generating a new one."
(delete-dups
(mapcar 'downcase (org-get-tags-at))))))))))
(run-hooks 'org-agenda-finalize-hook)
- (when (or org-agenda-tag-filter (get 'org-agenda-tag-filter :preset-filter))
+ (when org-agenda-tag-filter
(org-agenda-filter-apply org-agenda-tag-filter 'tag))
- (when (or org-agenda-category-filter (get 'org-agenda-category-filter :preset-filter))
+ (when (get 'org-agenda-tag-filter :preset-filter)
+ (org-agenda-filter-apply
+ (get 'org-agenda-tag-filter :preset-filter) 'tag))
+ (when org-agenda-category-filter
(org-agenda-filter-apply org-agenda-category-filter 'category))
- (when (or org-agenda-regexp-filter (get 'org-agenda-regexp-filter :preset-filter))
+ (when (get 'org-agenda-category-filter :preset-filter)
+ (org-agenda-filter-apply
+ (get 'org-agenda-category-filter :preset-filter) 'category))
+ (when org-agenda-regexp-filter
(org-agenda-filter-apply org-agenda-regexp-filter 'regexp))
+ (when (get 'org-agenda-regexp-filter :preset-filter)
+ (org-agenda-filter-apply
+ (get 'org-agenda-regexp-filter :preset-filter) 'regexp))
(org-add-hook 'kill-buffer-hook 'org-agenda-reset-markers 'append 'local)))))
(defun org-agenda-mark-clocking-task ()
"Mark the current clock entry in the agenda if it is present."
- (org-agenda-unmark-clocking-task)
- (when (marker-buffer org-clock-hd-marker)
- (save-excursion
- (goto-char (point-min))
- (let (s ov)
- (while (setq s (next-single-property-change (point) 'org-hd-marker))
- (goto-char s)
- (when (equal (org-get-at-bol 'org-hd-marker)
- org-clock-hd-marker)
- (setq ov (make-overlay (point-at-bol) (1+ (point-at-eol))))
- (overlay-put ov 'type 'org-agenda-clocking)
- (overlay-put ov 'face 'org-agenda-clocking)
- (overlay-put ov 'help-echo
- "The clock is running in this item")))))))
+ ;; We need to widen when `org-agenda-finalize' is called from
+ ;; `org-agenda-change-all-lines' (e.g. in `org-agenda-clock-in')
+ (when org-clock-current-task
+ (save-restriction
+ (widen)
+ (org-agenda-unmark-clocking-task)
+ (when (marker-buffer org-clock-hd-marker)
+ (save-excursion
+ (goto-char (point-min))
+ (let (s ov)
+ (while (setq s (next-single-property-change (point) 'org-hd-marker))
+ (goto-char s)
+ (when (equal (org-get-at-bol 'org-hd-marker)
+ org-clock-hd-marker)
+ (setq ov (make-overlay (point-at-bol) (1+ (point-at-eol))))
+ (overlay-put ov 'type 'org-agenda-clocking)
+ (overlay-put ov 'face 'org-agenda-clocking)
+ (overlay-put ov 'help-echo
+ "The clock is running in this item")))))))))
(defun org-agenda-unmark-clocking-task ()
"Unmark the current clocking task."
@@ -3853,11 +3867,12 @@ dimming them."
e (point-at-eol)
ov (make-overlay b e))
(if invis1
- (overlay-put ov 'invisible t)
+ (progn (overlay-put ov 'invisible t)
+ (overlay-put ov 'intangible t))
(overlay-put ov 'face 'org-agenda-dimmed-todo-face))
(overlay-put ov 'org-type 'org-blocked-todo))))))
- (when (org-called-interactively-p 'interactive)
- (message "Dim or hide blocked tasks...done")))
+ (when (org-called-interactively-p 'interactive)
+ (message "Dim or hide blocked tasks...done")))
(defvar org-agenda-skip-function nil
"Function to be called at each match during agenda construction.
@@ -4919,7 +4934,7 @@ See `org-agenda-skip-if' for details."
(org-agenda-skip-if nil conditions))
(defun org-agenda-skip-subtree-if (&rest conditions)
- "Skip entry if any of CONDITIONS is true.
+ "Skip subtree if any of CONDITIONS is true.
See `org-agenda-skip-if' for details."
(org-agenda-skip-if t conditions))
@@ -5088,6 +5103,7 @@ of what a project is and how to check if it stuck, customize the variable
(mapconcat 'identity re-list "\\|")
(error "No information how to identify unstuck projects")))
(org-tags-view nil matcher)
+ (setq org-agenda-buffer-name (buffer-name))
(with-current-buffer org-agenda-buffer-name
(setq org-agenda-redo-command
`(org-agenda-list-stuck-projects ,current-prefix-arg)))))
@@ -5455,7 +5471,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
;;;###autoload
(defun org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item
- (&optional end)
+ (&optional end)
"Do we have a reason to ignore this TODO entry because it has a time stamp?"
(when (or org-agenda-todo-ignore-with-date
org-agenda-todo-ignore-scheduled
@@ -5692,10 +5708,10 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(setq txt "SEXP entry returned empty string"))
(setq txt (org-agenda-format-item extra txt level category tags 'time))
(org-add-props txt props 'org-marker marker
- 'org-category category 'date date 'todo-state todo-state
- 'org-category-position category-pos 'tags tags
- 'level level
- 'type "sexp" 'warntime warntime)
+ 'org-category category 'date date 'todo-state todo-state
+ 'org-category-position category-pos 'tags tags
+ 'level level
+ 'type "sexp" 'warntime warntime)
(push txt ee)))))
(nreverse ee)))
@@ -6246,6 +6262,7 @@ an hour specification like [h]h:mm."
category-pos (get-text-property (point) 'org-category-position))
(if (and (eq org-agenda-skip-scheduled-if-deadline-is-shown
'repeated-after-deadline)
+ (org-get-deadline-time (point))
(<= 0 (- d2 (time-to-days (org-get-deadline-time (point))))))
(throw :skip nil))
(if (not (re-search-backward "^\\*+[ \t]+" nil t))
@@ -7005,7 +7022,7 @@ When TYPE is \"scheduled\", \"deadline\", \"timestamp\" or
\"timestamp_ia\", compare within each of these type. When TYPE
is the empty string, compare all timestamps without respect of
their type."
- (let* ((def (if org-sort-agenda-notime-is-late 9901 -1))
+ (let* ((def (if org-sort-agenda-notime-is-late most-positive-fixnum -1))
(ta (or (and (string-match type (or (get-text-property 1 'type a) ""))
(get-text-property 1 'ts-date a)) def))
(tb (or (and (string-match type (or (get-text-property 1 'type b) ""))
@@ -7372,7 +7389,7 @@ With two prefix arguments, remove the regexp filters."
(read-from-minibuffer
(if (equal strip '(4))
"Filter out entries matching regexp: "
- "Narrow to entries matching regexp: ")))))
+ "Narrow to entries matching regexp: ")))))
(push flt org-agenda-regexp-filter)
(org-agenda-filter-apply org-agenda-regexp-filter 'regexp))
(org-agenda-filter-show-all-re)
@@ -7647,7 +7664,7 @@ When NO-OPERATOR is non-nil, do not add the + operator to returned tags."
(let* ((pos (org-get-at-bol 'org-hd-marker))
(tophl (and pos (org-find-top-headline pos))))
(if (and tophl (funcall (if negative 'identity 'not)
- (string= hl tophl)))
+ (string= hl tophl)))
(org-agenda-filter-hide-line 'category)))
(beginning-of-line 2)))
(if (get-char-property (point) 'invisible)
@@ -7657,10 +7674,11 @@ When NO-OPERATOR is non-nil, do not add the + operator to returned tags."
(defun org-agenda-filter-hide-line (type)
"Hide lines with TYPE in the agenda buffer."
- (let (ov)
- (setq ov (make-overlay (max (point-min) (1- (point-at-bol)))
- (point-at-eol)))
+ (let* ((b (max (point-min) (1- (point-at-bol))))
+ (e (point-at-eol))
+ (ov (make-overlay b e)))
(overlay-put ov 'invisible t)
+ (overlay-put ov 'intangible t)
(overlay-put ov 'type type)
(cond ((eq type 'tag) (push ov org-agenda-tag-filter-overlays))
((eq type 'category) (push ov org-agenda-cat-filter-overlays))
@@ -7808,27 +7826,40 @@ Negative selection means regexp must not match for selection of an entry."
(text-property-any (point-min) (point-max) 'org-today t)
(text-property-any (point-min) (point-max) 'org-agenda-type 'agenda)
(and (get-text-property (min (1- (point-max)) (point)) 'org-series)
- (org-agenda-goto-block-beginning))
+ (org-agenda-backward-block))
(point-min))))
-(defun org-agenda-goto-block-beginning ()
- "Go the agenda block beginning."
+(defun org-agenda-backward-block ()
+ "Move backward by one agenda block."
(interactive)
- (if (not (derived-mode-p 'org-agenda-mode))
- (error "Cannot execute this command outside of org-agenda-mode buffers")
- (let (dest)
- (save-excursion
- (unless (looking-at "\\'")
- (forward-char))
- (let* ((prop 'org-agenda-structural-header)
- (p (previous-single-property-change (point) prop))
- (n (next-single-property-change (or (and (looking-at "\\`") 1)
- (1- (point))) prop)))
- (setq dest (cond ((eq n (point-at-eol)) (1- n)) (p (1- p))))))
- (if (not dest)
- (error "Cannot find the beginning of the blog")
- (goto-char dest)
- (move-beginning-of-line 1)))))
+ (org-agenda-forward-block 'backward))
+
+(defun org-agenda-forward-block (&optional backward)
+ "Move forward by one agenda block.
+When optional argument BACKWARD is set, go backward"
+ (interactive)
+ (cond ((not (derived-mode-p 'org-agenda-mode))
+ (user-error
+ "Cannot execute this command outside of org-agenda-mode buffers"))
+ ((looking-at (if backward "\\`" "\\'"))
+ (message "Already at the %s block" (if backward "first" "last")))
+ (t (let ((pos (prog1 (point)
+ (ignore-errors (if backward (backward-char 1)
+ (move-end-of-line 1)))))
+ (f (if backward
+ 'previous-single-property-change
+ 'next-single-property-change))
+ moved dest)
+ (while (and (setq dest (funcall
+ f (point) 'org-agenda-structural-header))
+ (not (get-text-property
+ (point) 'org-agenda-structural-header)))
+ (setq moved t)
+ (goto-char dest))
+ (if moved (move-beginning-of-line 1)
+ (goto-char (if backward (point-min) (point-max)))
+ (move-beginning-of-line 1)
+ (message "No %s block" (if backward "previous" "further")))))))
(defun org-agenda-later (arg)
"Go forward in time by the current span.
@@ -8484,7 +8515,8 @@ It also looks at the text of the entry itself."
(org-get-at-bol 'org-marker)))
(buffer (and marker (marker-buffer marker)))
(prefix (buffer-substring (point-at-bol) (point-at-eol)))
- (lkall (org-offer-links-in-entry buffer marker arg prefix))
+ (lkall (and buffer (org-offer-links-in-entry
+ buffer marker arg prefix)))
(lk0 (car lkall))
(lk (if (stringp lk0) (list lk0) lk0))
(lkend (cdr lkall))
@@ -8540,6 +8572,7 @@ It also looks at the text of the entry itself."
(and delete-other-windows (delete-other-windows))
(widen)
(goto-char pos)
+ (org-back-to-heading t)
(when (derived-mode-p 'org-mode)
(org-show-context 'agenda)
(save-excursion
@@ -8786,8 +8819,12 @@ the same tree node, and the headline of the tree node in the Org-mode file."
(org-back-to-heading)
(move-marker org-last-heading-marker (point))))
(beginning-of-line 1)
- (save-excursion
+ (save-window-excursion
(org-agenda-change-all-lines newhead hdmarker 'fixface just-one))
+ (when (org-bound-and-true-p org-clock-out-when-done)
+ (string-match (concat "^" (regexp-opt org-done-keywords-for-agenda))
+ newhead)
+ (org-agenda-unmark-clocking-task))
(org-move-to-column col))))
(defun org-agenda-add-note (&optional arg)
@@ -8924,7 +8961,8 @@ Called with a universal prefix arg, show the priority instead of setting it."
(unless org-enable-priority-commands
(error "Priority commands are disabled"))
(org-agenda-check-no-diary)
- (let* ((marker (or (org-get-at-bol 'org-marker)
+ (let* ((col (current-column))
+ (marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
(hdmarker (org-get-at-bol 'org-hd-marker))
(buffer (marker-buffer hdmarker))
@@ -8943,7 +8981,7 @@ Called with a universal prefix arg, show the priority instead of setting it."
(end-of-line 1)
(setq newhead (org-get-heading)))
(org-agenda-change-all-lines newhead hdmarker)
- (beginning-of-line 1)))))
+ (org-move-to-column col)))))
;; FIXME: should fix the tags property of the agenda line.
(defun org-agenda-set-tags (&optional tag onoff)
@@ -9152,7 +9190,9 @@ Called with a universal prefix arg, show the priority instead of setting it."
(goto-char (point-max))
(while (not (bobp))
(when (equal marker (org-get-at-bol 'org-marker))
- (org-move-to-column (- (window-width) (length stamp)) t nil t)
+ (remove-text-properties (point-at-bol) (point-at-eol) '(display))
+ (org-move-to-column (- (window-width) (length stamp)) t)
+
(org-agenda-fix-tags-filter-overlays-at (point))
(if (featurep 'xemacs)
;; Use `duplicable' property to trigger undo recording
@@ -9163,7 +9203,7 @@ Called with a universal prefix arg, show the priority instead of setting it."
ex (list 'invisible t 'end-glyph gl 'duplicable t))
(insert-extent ex (1- (point)) (point-at-eol)))
(add-text-properties
- (1- (point)) (point-at-eol)
+ (1- (point)) (point-at-eol)
(list 'display (org-add-props stamp nil
'face 'secondary-selection))))
(beginning-of-line 1))
@@ -9914,31 +9954,43 @@ current HH:MM time."
;;; Dragging agenda lines forward/backward
-(defun org-agenda-drag-line-forward (arg)
- "Drag an agenda line forward by ARG lines."
+(defun org-agenda-reapply-filters ()
+ "Re-apply all agenda filters."
+ (mapcar
+ (lambda(f) (when (car f) (org-agenda-filter-apply (car f) (cadr f))))
+ `((,org-agenda-tag-filter tag)
+ (,org-agenda-category-filter category)
+ (,org-agenda-regexp-filter regexp)
+ (,(get 'org-agenda-tag-filter :preset-filter) tag)
+ (,(get 'org-agenda-category-filter :preset-filter) category)
+ (,(get 'org-agenda-regexp-filter :preset-filter) regexp))))
+
+(defun org-agenda-drag-line-forward (arg &optional backward)
+ "Drag an agenda line forward by ARG lines.
+When the optional argument `backward' is non-nil, move backward."
(interactive "p")
- (let ((inhibit-read-only t) lst)
+ (let ((inhibit-read-only t) lst line)
(if (or (not (get-text-property (point) 'txt))
(save-excursion
(dotimes (n arg)
- (move-beginning-of-line 2)
+ (move-beginning-of-line (if backward 0 2))
(push (not (get-text-property (point) 'txt)) lst))
(delq nil lst)))
(message "Cannot move line forward")
- (org-drag-line-forward arg))))
+ (let ((end (save-excursion (move-beginning-of-line 2) (point))))
+ (move-beginning-of-line 1)
+ (setq line (buffer-substring (point) end))
+ (delete-region (point) end)
+ (move-beginning-of-line (funcall (if backward '1- '1+) arg))
+ (insert line)
+ (org-agenda-reapply-filters)
+ (org-agenda-mark-clocking-task)
+ (move-beginning-of-line 0)))))
(defun org-agenda-drag-line-backward (arg)
"Drag an agenda line backward by ARG lines."
(interactive "p")
- (let ((inhibit-read-only t) lst)
- (if (or (not (get-text-property (point) 'txt))
- (save-excursion
- (dotimes (n arg)
- (move-beginning-of-line 0)
- (push (not (get-text-property (point) 'txt)) lst))
- (delq nil lst)))
- (message "Cannot move line backward")
- (org-drag-line-backward arg))))
+ (org-agenda-drag-line-forward arg t))
;;; Flagging notes
diff --git a/lisp/org-archive.el b/lisp/org-archive.el
index 3dc52c1..700e59b 100644
--- a/lisp/org-archive.el
+++ b/lisp/org-archive.el
@@ -1,6 +1,6 @@
;;; org-archive.el --- Archiving for Org-mode
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2014 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -121,7 +121,7 @@ information."
(defun org-get-local-archive-location ()
"Get the archive location applicable at point."
- (let ((re "^#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$")
+ (let ((re "^[ \t]*#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$")
prop)
(save-excursion
(save-restriction
@@ -158,7 +158,7 @@ archive file is."
(save-restriction
(goto-char (point-min))
(while (re-search-forward
- "^\\(#\\+\\|[ \t]*:\\)ARCHIVE:[ \t]+\\(.*\\)"
+ "^[ \t]*\\(#\\+\\|:\\)ARCHIVE:[ \t]+\\(.*\\)"
nil t)
(setq file (org-extract-archive-file
(org-match-string-no-properties 2)))
diff --git a/lisp/org-attach.el b/lisp/org-attach.el
index 898d911..0412b63 100644
--- a/lisp/org-attach.el
+++ b/lisp/org-attach.el
@@ -1,6 +1,6 @@
;;; org-attach.el --- Manage file attachments to org-mode tasks
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@newartisans.com>
;; Keywords: org data task
@@ -41,8 +41,7 @@
(require 'cl))
(require 'org-id)
(require 'org)
-
-(declare-function vc-git-root "vc-git" (file))
+(require 'vc-git)
(defgroup org-attach nil
"Options concerning entry attachments in Org-mode."
@@ -266,7 +265,7 @@ This checks for the existence of a \".git\" directory in that directory."
(let* ((dir (expand-file-name org-attach-directory))
(git-dir (vc-git-root dir))
(changes 0))
- (when git-dir
+ (when (and git-dir (executable-find "git"))
(with-temp-buffer
(cd dir)
(let ((have-annex
@@ -418,15 +417,15 @@ This can be used after files have been added externally."
(and files (org-attach-tag))
(when org-attach-file-list-property
(dolist (file files)
- (unless (string-match "^\\." file)
+ (unless (string-match "^\\.\\.?\\'" file)
(org-entry-add-to-multivalued-property
(point) org-attach-file-list-property file))))))))
(defun org-attach-file-list (dir)
"Return a list of files in the attachment directory.
-This ignores files starting with a \".\", and files ending in \"~\"."
+This ignores files ending in \"~\"."
(delq nil
- (mapcar (lambda (x) (if (string-match "^\\." x) nil x))
+ (mapcar (lambda (x) (if (string-match "^\\.\\.?\\'" x) nil x))
(directory-files dir nil "[^~]\\'"))))
(defun org-attach-reveal (&optional if-exists)
diff --git a/lisp/org-bbdb.el b/lisp/org-bbdb.el
index f122b67..b9841a6 100644
--- a/lisp/org-bbdb.el
+++ b/lisp/org-bbdb.el
@@ -1,6 +1,6 @@
;;; org-bbdb.el --- Support for links to BBDB entries from within Org-mode
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2014 Free Software Foundation, Inc.
;; Authors: Carsten Dominik <carsten at orgmode dot org>
;; Thomas Baumann <thomas dot baumann at ch dot tum dot de>
diff --git a/lisp/org-bibtex.el b/lisp/org-bibtex.el
index 5264399..ed645e5 100644
--- a/lisp/org-bibtex.el
+++ b/lisp/org-bibtex.el
@@ -1,6 +1,6 @@
;;; org-bibtex.el --- Org links to BibTeX entries
;;
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2014 Free Software Foundation, Inc.
;;
;; Authors: Bastien Guerry <bzg@gnu.org>
;; Carsten Dominik <carsten dot dominik at gmail dot com>
@@ -44,7 +44,7 @@
;; Here is an example of a capture template that use some of this
;; information (:author :year :title :journal :pages):
;;
-;; (setq org-capure-templates
+;; (setq org-capture-templates
;; '((?b "* READ %?\n\n%a\n\n%:author (%:year): %:title\n \
;; In %:journal, %:pages.")))
;;
@@ -613,7 +613,8 @@ This uses `bibtex-parse-entry'."
(strip-delim
(lambda (str) ; strip enclosing "..." and {...}
(dolist (pair '((34 . 34) (123 . 125) (123 . 125)))
- (when (and (= (aref str 0) (car pair))
+ (when (and (> (length str) 1)
+ (= (aref str 0) (car pair))
(= (aref str (1- (length str))) (cdr pair)))
(setf str (substring str 1 (1- (length str)))))) str)))
(push (mapcar
@@ -630,7 +631,7 @@ This uses `bibtex-parse-entry'."
(defun org-bibtex-read-buffer (buffer)
"Read all bibtex entries in BUFFER and save to `org-bibtex-entries'.
Return the number of saved entries."
- (interactive "bbuffer: ")
+ (interactive "bBuffer: ")
(let ((start-length (length org-bibtex-entries)))
(with-current-buffer buffer
(save-excursion
@@ -640,12 +641,12 @@ Return the number of saved entries."
(org-bibtex-read)
(bibtex-beginning-of-entry))))
(let ((added (- (length org-bibtex-entries) start-length)))
- (message "parsed %d entries" added)
+ (message "Parsed %d entries" added)
added)))
(defun org-bibtex-read-file (file)
"Read FILE with `org-bibtex-read-buffer'."
- (interactive "ffile: ")
+ (interactive "fFile: ")
(org-bibtex-read-buffer (find-file-noselect file 'nowarn 'rawfile)))
(defun org-bibtex-write ()
@@ -691,7 +692,7 @@ Return the number of saved entries."
(defun org-bibtex-import-from-file (file)
"Read bibtex entries from FILE and insert as Org-mode headlines after point."
- (interactive "ffile: ")
+ (interactive "fFile: ")
(dotimes (_ (org-bibtex-read-file file))
(save-excursion (org-bibtex-write))
(re-search-forward org-property-end-re)
diff --git a/lisp/org-capture.el b/lisp/org-capture.el
index 39804ac..cf6c9e2 100644
--- a/lisp/org-capture.el
+++ b/lisp/org-capture.el
@@ -1,6 +1,6 @@
;;; org-capture.el --- Fast note taking in Org-mode
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -741,7 +741,8 @@ captured item after finalizing."
(pos (org-capture-get :initial-target-position))
(ipt (org-capture-get :insertion-point))
(size (org-capture-get :captured-entry-size)))
- (when reg
+ (if (not reg)
+ (widen)
(cond ((< ipt (car reg))
;; insertion point is before the narrowed region
(narrow-to-region (+ size (car reg)) (+ size (cdr reg))))
@@ -811,7 +812,8 @@ already gone. Any prefix argument will be passed to the refile command."
"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")
+ (plist-get org-bookmark-names-plist
+ :last-capture))
(message "This is the last note stored by a capture process"))
;;; Supporting functions for handling the process
@@ -821,7 +823,7 @@ already gone. Any prefix argument will be passed to the refile command."
(org-capture-put
:initial-target-region
;; Check if the buffer is currently narrowed
- (when (/= (buffer-size) (- (point-max) (point-min)))
+ (when (org-buffer-narrowed-p)
(cons (point-min) (point-max))))
;; store the current point
(org-capture-put :initial-target-position (point)))
@@ -1021,9 +1023,9 @@ may have been stored before."
(target-entry-p (org-capture-get :target-entry-p))
level beg end file)
+ (and (org-capture-get :exact-position)
+ (goto-char (org-capture-get :exact-position)))
(cond
- ((org-capture-get :exact-position)
- (goto-char (org-capture-get :exact-position)))
((not target-entry-p)
;; Insert as top-level entry, either at beginning or at end of file
(setq level 1)
@@ -1147,6 +1149,9 @@ may have been stored before."
;; Check if the template is good
(if (not (string-match org-table-dataline-regexp txt))
(setq txt "| %?Bad template |\n"))
+ (if (functionp table-line-pos)
+ (setq table-line-pos (funcall table-line-pos))
+ (setq table-line-pos (eval table-line-pos)))
(cond
((and table-line-pos
(string-match "\\(I+\\)\\([-+][0-9]\\)" table-line-pos))
diff --git a/lisp/org-clock.el b/lisp/org-clock.el
index c0a8254..c4a5ba1 100644
--- a/lisp/org-clock.el
+++ b/lisp/org-clock.el
@@ -1,6 +1,6 @@
;;; org-clock.el --- The time clocking code for Org-mode
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2014 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -36,6 +36,7 @@
(declare-function notifications-notify "notifications" (&rest params))
(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label))
(declare-function org-refresh-properties "org" (dprop tprop))
+(declare-function org-table-goto-line "org-table" (n))
(defvar org-time-stamp-formats)
(defvar org-ts-what)
(defvar org-frame-title-format-backup frame-title-format)
@@ -424,7 +425,7 @@ to add an effort property.")
"Hook run when stopping the current clock.")
(defvar org-clock-cancel-hook nil
- "Hook run when cancelling the current clock.")
+ "Hook run when canceling the current clock.")
(defvar org-clock-goto-hook nil
"Hook run when selecting the currently clocked-in entry.")
(defvar org-clock-has-been-used nil
@@ -441,7 +442,7 @@ to add an effort property.")
(defvar org-clock-start-time "")
(defvar org-clock-leftover-time nil
- "If non-nil, user cancelled a clock; this is when leftover time started.")
+ "If non-nil, user canceled a clock; this is when leftover time started.")
(defvar org-clock-effort ""
"Effort estimate of the currently clocking task.")
@@ -667,7 +668,7 @@ previous clocking intervals."
VALUE can be a number of minutes, or a string with format hh:mm or mm.
When the string starts with a + or a - sign, the current value of the effort
property will be changed by that amount. If the effort value is expressed
-as an `org-effort-durations' (e.g. \"3h\"), the modificied value will be
+as an `org-effort-durations' (e.g. \"3h\"), the modified value will be
converted to a hh:mm duration.
This command will update the \"Effort\" property of the currently
@@ -1782,6 +1783,8 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes."
(save-excursion
(save-match-data (funcall headline-filter))))))
(setq level (- (match-end 1) (match-beginning 1)))
+ (when (>= level lmax)
+ (setq ltimes (vconcat ltimes (make-vector lmax 0)) lmax (* 2 lmax)))
(when (or (> t1 0) (> (aref ltimes level) 0))
(when (or headline-included headline-forced)
(if headline-included
@@ -1833,38 +1836,36 @@ Use \\[org-clock-remove-overlays] to remove the subtree times."
(point) :org-clock-minutes)))
(goto-char p)
(when (setq time (get-text-property p :org-clock-minutes))
- (org-clock-put-overlay time (funcall outline-level))))
+ (org-clock-put-overlay time)))
(setq h (/ org-clock-file-total-minutes 60)
m (- org-clock-file-total-minutes (* 60 h)))
;; Arrange to remove the overlays upon next change.
(when org-remove-highlights-with-change
(org-add-hook 'before-change-functions 'org-clock-remove-overlays
nil 'local))))
- (message (concat "Total file time: "
- (org-minutes-to-clocksum-string org-clock-file-total-minutes)
- " (%d hours and %d minutes)") h m)))
+ (message (concat "Total file time: "
+ (org-minutes-to-clocksum-string org-clock-file-total-minutes)
+ " (%d hours and %d minutes)") h m)))
(defvar org-clock-overlays nil)
(make-variable-buffer-local 'org-clock-overlays)
-(defun org-clock-put-overlay (time &optional level)
+(defun org-clock-put-overlay (time)
"Put an overlays on the current line, displaying TIME.
-If LEVEL is given, prefix time with a corresponding number of stars.
This creates a new overlay and stores it in `org-clock-overlays', so that it
will be easy to remove."
(let* ((c 60) (h (floor (/ time 60))) (m (- time (* 60 h)))
- (l (if level (org-get-valid-level level 0) 0))
- (off 0)
ov tx)
(org-move-to-column c)
(unless (eolp) (skip-chars-backward "^ \t"))
(skip-chars-backward " \t")
- (setq ov (make-overlay (point-at-bol) (point-at-eol))
- tx (concat (buffer-substring (point-at-bol) (point))
- (make-string (+ off (max 0 (- c (current-column)))) ?.)
- (org-add-props (concat (make-string l ?*) " "
- (org-minutes-to-clocksum-string time)
- (make-string (- 16 l) ?\ ))
+ (setq ov (make-overlay (1- (point-at-eol)) (point-at-eol))
+ tx (concat (buffer-substring (1- (point)) (point))
+ (make-string
+ (max 0 (- (- c (current-column))
+ (length (org-get-at-bol 'line-prefix)))) ? )
+ (org-add-props
+ (format " %9s " (org-minutes-to-clocksum-string time))
(list 'face 'org-clock-overlay))
""))
(if (not (featurep 'xemacs))
@@ -2337,6 +2338,7 @@ from the dynamic block definition."
org-clock-clocktable-language-setup))
(multifile (plist-get params :multifile))
(block (plist-get params :block))
+ (sort (plist-get params :sort))
(ts (plist-get params :tstart))
(te (plist-get params :tend))
(header (plist-get params :header))
@@ -2543,6 +2545,11 @@ from the dynamic block definition."
(when org-hide-emphasis-markers
;; we need to align a second time
(org-table-align))
+ (when sort
+ (save-excursion
+ (org-table-goto-line 3)
+ (org-table-goto-column (car sort))
+ (org-table-sort-lines nil (cdr sort))))
(when recalc
(if (eq formula '%)
(save-excursion
@@ -2707,9 +2714,13 @@ TIME: The sum of all time spend in this tree, in minutes. This time
(format "file:%s::%s"
(buffer-file-name)
(save-match-data
- (org-make-org-heading-search-string
- (match-string 2))))
- (match-string 2)))
+ (match-string 2)))
+ (org-make-org-heading-search-string
+ (replace-regexp-in-string
+ org-bracket-link-regexp
+ (lambda (m) (or (match-string 3 m)
+ (match-string 1 m)))
+ (match-string 2)))))
tsp (when timestamp
(setq props (org-entry-properties (point)))
(or (cdr (assoc "SCHEDULED" props))
diff --git a/lisp/org-colview.el b/lisp/org-colview.el
index 361560d..41ee0c1 100644
--- a/lisp/org-colview.el
+++ b/lisp/org-colview.el
@@ -1,6 +1,6 @@
;;; org-colview.el --- Column View in Org-mode
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2014 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -174,7 +174,7 @@ This is the compiled version of the format.")
(face (list color font 'org-column ref-face))
(face1 (list color font 'org-agenda-column-dateline ref-face))
(cphr (get-text-property (point-at-bol) 'org-complex-heading-regexp))
- pom property ass width f string ov column val modval s2 title calc)
+ pom property ass width f fc string fm ov column val modval s2 title calc)
;; Check if the entry is in another buffer.
(unless props
(if (eq major-mode 'org-agenda-mode)
@@ -204,6 +204,8 @@ This is the compiled version of the format.")
(nth 2 column)
(length property))
f (format "%%-%d.%ds | " width width)
+ fm (nth 4 column)
+ fc (nth 5 column)
calc (nth 7 column)
val (or (cdr ass) "")
modval (cond ((and org-columns-modify-value-for-display-function
@@ -215,13 +217,14 @@ This is the compiled version of the format.")
(org-columns-cleanup-item
val org-columns-current-fmt-compiled
(or org-complex-heading-regexp cphr)))
+ (fc (org-columns-number-to-string
+ (org-columns-string-to-number val fm) fm fc))
((and calc (functionp calc)
(not (string= val ""))
(not (get-text-property 0 'org-computed val)))
(org-columns-number-to-string
(funcall calc (org-columns-string-to-number
- val (nth 4 column)))
- (nth 4 column)))))
+ val fm)) fm))))
(setq s2 (org-columns-add-ellipses (or modval val) width))
(setq string (format f s2))
;; Create the overlay
@@ -897,7 +900,7 @@ display, or in the #+COLUMNS line of the current buffer."
(org-entry-put nil "COLUMNS" fmt)
(goto-char (point-min))
;; Overwrite all #+COLUMNS lines....
- (while (re-search-forward "^#\\+COLUMNS:.*" nil t)
+ (while (re-search-forward "^[ \t]*#\\+COLUMNS:.*" nil t)
(setq cnt (1+ cnt))
(replace-match (concat "#+COLUMNS: " fmt) t t))
(unless (> cnt 0)
@@ -1121,7 +1124,7 @@ display, or in the #+COLUMNS line of the current buffer."
(defun org-columns-uncompile-format (cfmt)
"Turn the compiled columns format back into a string representation."
- (let ((rtn "") e s prop title op op-match width fmt printf fun calc)
+ (let ((rtn "") e s prop title op op-match width fmt printf fun calc ee map)
(while (setq e (pop cfmt))
(setq prop (car e)
title (nth 1 e)
@@ -1131,8 +1134,10 @@ display, or in the #+COLUMNS line of the current buffer."
printf (nth 5 e)
fun (nth 6 e)
calc (nth 7 e))
- (when (setq op-match (rassoc (list fmt fun calc) org-columns-compile-map))
- (setq op (car op-match)))
+ (setq map (copy-sequence org-columns-compile-map))
+ (while (setq ee (pop map))
+ (if (equal fmt (nth 1 ee))
+ (setq op (car ee) map nil)))
(if (and op printf) (setq op (concat op ";" printf)))
(if (equal title prop) (setq title nil))
(setq s (concat "%" (if width (number-to-string width))
@@ -1196,8 +1201,6 @@ containing the title row and all other rows. Each row is a list
of fields."
(save-excursion
(let* ((title (mapcar 'cadr org-columns-current-fmt-compiled))
- (re-comment (format org-heading-keyword-regexp-format
- org-comment-string))
(re-archive (concat ".*:" org-archive-tag ":"))
(n (length title)) row tbl)
(goto-char (point-min))
@@ -1209,9 +1212,9 @@ of fields."
(/ (1+ (length (match-string 1))) 2)
(length (match-string 1)))))
(get-char-property (match-beginning 0) 'org-columns-key))
- (when (save-excursion
- (goto-char (point-at-bol))
- (or (looking-at re-comment)
+ (when (or (org-in-commented-heading-p t)
+ (save-excursion
+ (beginning-of-line)
(looking-at re-archive)))
(org-end-of-subtree t)
(throw 'next t))
diff --git a/lisp/org-compat.el b/lisp/org-compat.el
index b714f13..70c41d5 100644
--- a/lisp/org-compat.el
+++ b/lisp/org-compat.el
@@ -1,6 +1,6 @@
;;; org-compat.el --- Compatibility code for Org-mode
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2014 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -190,10 +190,12 @@ If DELETE is non-nil, delete all those overlays."
found))
(defun org-get-x-clipboard (value)
- "Get the value of the x clipboard, compatible with XEmacs, and GNU Emacs 21."
- (if (eq window-system 'x)
- (let ((x (org-get-x-clipboard-compat value)))
- (if x (org-no-properties x)))))
+ "Get the value of the x or Windows clipboard, compatible with XEmacs, and GNU Emacs 21."
+ (cond ((eq window-system 'x)
+ (let ((x (org-get-x-clipboard-compat value)))
+ (if x (org-no-properties x))))
+ ((and (eq window-system 'w32) (fboundp 'w32-get-clipboard-data))
+ (w32-get-clipboard-data))))
(defsubst org-decompose-region (beg end)
"Decompose from BEG to END."
@@ -258,6 +260,12 @@ ignored in this case."
next (+ from (* n inc)))))
(nreverse seq)))))
+;; `set-transient-map' is only in Emacs >= 24.4
+(defalias 'org-set-transient-map
+ (if (fboundp 'set-transient-map)
+ 'set-transient-map
+ 'set-temporary-overlay-map))
+
;; Region compatibility
(defvar org-ignore-region nil
@@ -335,10 +343,25 @@ Works on both Emacs and XEmacs."
(org-xemacs-without-invisibility (indent-line-to column))
(indent-line-to column)))
-(defun org-move-to-column (column &optional force buffer ignore-invisible)
- (let ((buffer-invisibility-spec ignore-invisible))
+(defun org-move-to-column (column &optional force buffer)
+ "Move to column COLUMN.
+Pass COLUMN and FORCE to `move-to-column'.
+Pass BUFFER to the XEmacs version of `move-to-column'."
+ (let* ((with-bracket-link
+ (save-excursion
+ (forward-line 0)
+ (looking-at (concat "^.*" org-bracket-link-regexp))))
+ (buffer-invisibility-spec
+ (cond
+ ((or (not (derived-mode-p 'org-mode))
+ (and with-bracket-link (org-invisible-p2)))
+ (remove '(org-link) buffer-invisibility-spec))
+ (with-bracket-link
+ (remove t buffer-invisibility-spec))
+ (t buffer-invisibility-spec))))
(if (featurep 'xemacs)
- (org-xemacs-without-invisibility (move-to-column column force buffer))
+ (org-xemacs-without-invisibility
+ (move-to-column column force buffer))
(move-to-column column force))))
(defun org-get-x-clipboard-compat (value)
diff --git a/lisp/org-crypt.el b/lisp/org-crypt.el
index b02a7ce..46fd3e6 100644
--- a/lisp/org-crypt.el
+++ b/lisp/org-crypt.el
@@ -1,6 +1,6 @@
;;; org-crypt.el --- Public key encryption for org-mode entries
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2014 Free Software Foundation, Inc.
;; Emacs Lisp Archive Entry
;; Filename: org-crypt.el
@@ -73,6 +73,8 @@
compress-algorithm))
(declare-function epg-encrypt-string "epg"
(context plain recipients &optional sign always-trust))
+(defvar epg-context)
+
(defgroup org-crypt nil
"Org Crypt."
@@ -161,8 +163,8 @@ See `org-crypt-disable-auto-save'."
(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)))))
+ (set (make-local-variable '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."
@@ -170,11 +172,11 @@ See `org-crypt-disable-auto-save'."
(require 'epg)
(save-excursion
(org-back-to-heading t)
+ (set (make-local-variable 'epg-context) (epg-make-context nil t t))
(let ((start-heading (point)))
(forward-line)
(when (not (looking-at "-----BEGIN PGP MESSAGE-----"))
(let ((folded (outline-invisible-p))
- (epg-context (epg-make-context nil t t))
(crypt-key (org-crypt-key-for-heading))
(beg (point))
end encrypted-text)
@@ -206,11 +208,11 @@ See `org-crypt-disable-auto-save'."
(forward-line)
(when (looking-at "-----BEGIN PGP MESSAGE-----")
(org-crypt-check-auto-save)
+ (set (make-local-variable 'epg-context) (epg-make-context nil t t))
(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
diff --git a/lisp/org-ctags.el b/lisp/org-ctags.el
index 9d8ed6c..41775bd 100644
--- a/lisp/org-ctags.el
+++ b/lisp/org-ctags.el
@@ -1,6 +1,6 @@
;;; org-ctags.el - Integrate Emacs "tags" facility with org mode.
;;
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2014 Free Software Foundation, Inc.
;; Author: Paul Sexton <eeeickythump@gmail.com>
diff --git a/lisp/org-datetree.el b/lisp/org-datetree.el
index dd4b1b0..0646c3b 100644
--- a/lisp/org-datetree.el
+++ b/lisp/org-datetree.el
@@ -1,6 +1,6 @@
;;; org-datetree.el --- Create date entries in a tree
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
diff --git a/lisp/org-docview.el b/lisp/org-docview.el
index 8e61c8a..b907262 100644
--- a/lisp/org-docview.el
+++ b/lisp/org-docview.el
@@ -1,6 +1,6 @@
;;; org-docview.el --- support for links to doc-view-mode buffers
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Jan Böcker <jan.boecker at jboecker dot de>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -66,13 +66,14 @@
(t path)))))
(defun org-docview-open (link)
- (when (string-match "\\(.*\\)::\\([0-9]+\\)$" link)
- (let* ((path (match-string 1 link))
- (page (string-to-number (match-string 2 link))))
- (org-open-file path 1) ;; let org-mode open the file (in-emacs = 1)
- ;; to ensure org-link-frame-setup is respected
- (doc-view-goto-page page)
- )))
+ (string-match "\\(.*?\\)\\(?:::\\([0-9]+\\)\\)?$" link)
+ (let ((path (match-string 1 link))
+ (page (and (match-beginning 2)
+ (string-to-number (match-string 2 link)))))
+ ;; Let Org mode open the file (in-emacs = 1) to ensure
+ ;; org-link-frame-setup is respected.
+ (org-open-file path 1)
+ (when page (doc-view-goto-page page))))
(defun org-docview-store-link ()
"Store a link to a docview buffer."
diff --git a/lisp/org-element.el b/lisp/org-element.el
index 57e26ff..e9f0b2c 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -1,6 +1,6 @@
;;; org-element.el --- Parser And Applications for Org syntax
-;; Copyright (C) 2012-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2014 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -31,13 +31,12 @@
;;
;; An element always starts and ends at the beginning of a line. With
;; a few exceptions (`clock', `headline', `inlinetask', `item',
-;; `planning', `node-property', `quote-section' `section' and
-;; `table-row' types), it can also accept a fixed set of keywords as
-;; attributes. Those are called "affiliated keywords" to distinguish
-;; them from other keywords, which are full-fledged elements. Almost
-;; all affiliated keywords are referenced in
-;; `org-element-affiliated-keywords'; the others are export attributes
-;; and start with "ATTR_" prefix.
+;; `planning', `node-property', `section' and `table-row' types), it
+;; can also accept a fixed set of keywords as attributes. Those are
+;; called "affiliated keywords" to distinguish them from other
+;; keywords, which are full-fledged elements. Almost all affiliated
+;; keywords are referenced in `org-element-affiliated-keywords'; the
+;; others are export attributes and start with "ATTR_" prefix.
;;
;; Element containing other elements (and only elements) are called
;; greater elements. Concerned types are: `center-block', `drawer',
@@ -48,10 +47,9 @@
;; Other element types are: `babel-call', `clock', `comment',
;; `comment-block', `diary-sexp', `example-block', `export-block',
;; `fixed-width', `horizontal-rule', `keyword', `latex-environment',
-;; `node-property', `paragraph', `planning', `quote-section',
-;; `src-block', `table', `table-row' and `verse-block'. Among them,
-;; `paragraph' and `verse-block' types can contain Org objects and
-;; plain text.
+;; `node-property', `paragraph', `planning', `src-block', `table',
+;; `table-row' and `verse-block'. Among them, `paragraph' and
+;; `verse-block' types can contain Org objects and plain text.
;;
;; Objects are related to document's contents. Some of them are
;; recursive. Associated types are of the following: `bold', `code',
@@ -62,7 +60,7 @@
;; `table-cell', `target', `timestamp', `underline' and `verbatim'.
;;
;; Some elements also have special properties whose value can hold
-;; objects themselves (i.e. an item tag or a headline name). Such
+;; objects themselves (e.g. an item tag or a headline name). Such
;; values are called "secondary strings". Any object belongs to
;; either an element or a secondary string.
;;
@@ -111,14 +109,15 @@
;;
;; The library ends by furnishing `org-element-at-point' function, and
;; a way to give information about document structure around point
-;; with `org-element-context'. A simple cache mechanism is also
-;; provided for these functions.
+;; with `org-element-context'. A cache mechanism is also provided for
+;; these functions.
;;; Code:
(eval-when-compile (require 'cl))
(require 'org)
+(require 'avl-tree)
@@ -144,10 +143,12 @@
"$" "\\|"
;; Tables (any type).
"\\(?:|\\|\\+-[-+]\\)" "\\|"
- ;; Blocks (any type), Babel calls, drawers (any type),
- ;; fixed-width areas and keywords. Note: this is only an
- ;; indication and need some thorough check.
- "[#:]" "\\|"
+ ;; Blocks (any type), Babel calls and keywords. Note: this
+ ;; is only an indication and need some thorough check.
+ "#\\(?:[+ ]\\|$\\)" "\\|"
+ ;; Drawers (any type) and fixed-width areas. This is also
+ ;; only an indication.
+ ":" "\\|"
;; Horizontal rules.
"-\\{5,\\}[ \t]*$" "\\|"
;; LaTeX environments.
@@ -175,7 +176,7 @@ is not sufficient to know if point is at a paragraph ending. See
dynamic-block example-block export-block fixed-width
footnote-definition headline horizontal-rule inlinetask item
keyword latex-environment node-property paragraph plain-list
- planning property-drawer quote-block quote-section section
+ planning property-drawer quote-block section
special-block src-block table table-row verse-block)
"Complete list of element types.")
@@ -185,23 +186,6 @@ is not sufficient to know if point is at a paragraph ending. See
special-block table)
"List of recursive element types aka Greater Elements.")
-(defconst org-element-all-successors
- '(export-snippet footnote-reference inline-babel-call inline-src-block
- latex-or-entity line-break link macro plain-link radio-target
- statistics-cookie sub/superscript table-cell target
- text-markup timestamp)
- "Complete list of successors.")
-
-(defconst org-element-object-successor-alist
- '((subscript . sub/superscript) (superscript . sub/superscript)
- (bold . text-markup) (code . text-markup) (italic . text-markup)
- (strike-through . text-markup) (underline . text-markup)
- (verbatim . text-markup) (entity . latex-or-entity)
- (latex-fragment . latex-or-entity))
- "Alist of translations between object type and successor name.
-Sharing the same successor comes handy when, for example, the
-regexp matching one object can also match the other object.")
-
(defconst org-element-all-objects
'(bold code entity export-snippet footnote-reference inline-babel-call
inline-src-block italic line-break latex-fragment link macro
@@ -235,22 +219,9 @@ application to open them.")
'("CAPTION" "DATA" "HEADER" "HEADERS" "LABEL" "NAME" "PLOT" "RESNAME" "RESULT"
"RESULTS" "SOURCE" "SRCNAME" "TBLNAME")
"List of affiliated keywords as strings.
-By default, all keywords setting attributes (i.e. \"ATTR_LATEX\")
+By default, all keywords setting attributes (e.g., \"ATTR_LATEX\")
are affiliated keywords and need not to be in this list.")
-(defconst org-element--affiliated-re
- (format "[ \t]*#\\+%s:"
- ;; Regular affiliated keywords.
- (format "\\(%s\\|ATTR_[-_A-Za-z0-9]+\\)\\(?:\\[\\(.*\\)\\]\\)?"
- (regexp-opt org-element-affiliated-keywords)))
- "Regexp matching any affiliated keyword.
-
-Keyword name is put in match group 1. Moreover, if keyword
-belongs to `org-element-dual-keywords', put the dual value in
-match group 2.
-
-Don't modify it, set `org-element-affiliated-keywords' instead.")
-
(defconst org-element-keyword-translation-alist
'(("DATA" . "NAME") ("LABEL" . "NAME") ("RESNAME" . "NAME")
("SOURCE" . "NAME") ("SRCNAME" . "NAME") ("TBLNAME" . "NAME")
@@ -268,7 +239,7 @@ returned as the value of the property.
This list is checked after translations have been applied. See
`org-element-keyword-translation-alist'.
-By default, all keywords setting attributes (i.e. \"ATTR_LATEX\")
+By default, all keywords setting attributes (e.g., \"ATTR_LATEX\")
allow multiple occurrences and need not to be in this list.")
(defconst org-element-parsed-keywords '("CAPTION")
@@ -297,9 +268,33 @@ This list is checked after translations have been applied. See
Any keyword in this list will have its value parsed and stored as
a secondary string.")
+(defconst org-element--affiliated-re
+ (format "[ \t]*#\\+\\(?:%s\\):\\(?: \\|$\\)"
+ (concat
+ ;; Dual affiliated keywords.
+ (format "\\(?1:%s\\)\\(?:\\[\\(.*\\)\\]\\)?"
+ (regexp-opt org-element-dual-keywords))
+ "\\|"
+ ;; Regular affiliated keywords.
+ (format "\\(?1:%s\\)"
+ (regexp-opt
+ (org-remove-if
+ #'(lambda (keyword)
+ (member keyword org-element-dual-keywords))
+ org-element-affiliated-keywords)))
+ "\\|"
+ ;; Export attributes.
+ "\\(?1:ATTR_[-_A-Za-z0-9]+\\)"))
+ "Regexp matching any affiliated keyword.
+
+Keyword name is put in match group 1. Moreover, if keyword
+belongs to `org-element-dual-keywords', put the dual value in
+match group 2.
+
+Don't modify it, set `org-element-affiliated-keywords' instead.")
+
(defconst org-element-object-restrictions
- (let* ((standard-set
- (remq 'plain-link (remq 'table-cell org-element-all-successors)))
+ (let* ((standard-set (remq 'table-cell org-element-all-objects))
(standard-set-no-line-break (remq 'line-break standard-set)))
`((bold ,@standard-set)
(footnote-reference ,@standard-set)
@@ -310,30 +305,34 @@ a secondary string.")
(keyword ,@standard-set)
;; Ignore all links excepted plain links in a link description.
;; Also ignore radio-targets and line breaks.
- (link export-snippet inline-babel-call inline-src-block latex-or-entity
- macro plain-link statistics-cookie sub/superscript text-markup)
+ (link bold code entity export-snippet inline-babel-call inline-src-block
+ italic latex-fragment macro plain-link statistics-cookie
+ strike-through subscript superscript underline verbatim)
(paragraph ,@standard-set)
;; Remove any variable object from radio target as it would
;; prevent it from being properly recognized.
- (radio-target latex-or-entity sub/superscript)
+ (radio-target bold code entity italic latex-fragment strike-through
+ subscript superscript underline superscript)
(strike-through ,@standard-set)
(subscript ,@standard-set)
(superscript ,@standard-set)
;; Ignore inline babel call and inline src block as formulas are
;; possible. Also ignore line breaks and statistics cookies.
- (table-cell export-snippet footnote-reference latex-or-entity link macro
- radio-target sub/superscript target text-markup timestamp)
+ (table-cell bold code entity export-snippet footnote-reference italic
+ latex-fragment link macro radio-target strike-through
+ subscript superscript target timestamp underline verbatim)
(table-row table-cell)
(underline ,@standard-set)
(verse-block ,@standard-set)))
"Alist of objects restrictions.
-CAR is an element or object type containing objects and CDR is
-a list of successors that will be called within an element or
-object of such type.
+key is an element or object type containing objects and value is
+a list of types that can be contained within an element or object
+of such type.
For example, in a `radio-target' object, one can only find
-entities, latex-fragments, subscript and superscript.
+entities, latex-fragments, subscript, superscript and text
+markup.
This alist also applies to secondary string. For example, an
`headline' type element doesn't directly contain objects, but
@@ -359,10 +358,15 @@ These variables are copied to the temporary buffer created by
;; `org-element-contents' and `org-element-restriction'.
;;
;; Setter functions allow to modify elements by side effect. There is
-;; `org-element-put-property', `org-element-set-contents',
-;; `org-element-set-element' and `org-element-adopt-element'. Note
-;; that `org-element-set-element' and `org-element-adopt-elements' are
-;; higher level functions since also update `:parent' property.
+;; `org-element-put-property', `org-element-set-contents'. These
+;; low-level functions are useful to build a parse tree.
+;;
+;; `org-element-adopt-element', `org-element-set-element',
+;; `org-element-extract-element' and `org-element-insert-before' are
+;; high-level functions useful to modify a parse tree.
+;;
+;; `org-element-secondary-p' is a predicate used to know if a given
+;; object belongs to a secondary string.
(defsubst org-element-type (element)
"Return type of ELEMENT.
@@ -409,22 +413,15 @@ Return modified element."
((cdr element) (setcdr (cdr element) contents))
(t (nconc element contents))))
-(defsubst org-element-set-element (old new)
- "Replace element or object OLD with element or object NEW.
-The function takes care of setting `:parent' property for NEW."
- ;; Since OLD is going to be changed into NEW by side-effect, first
- ;; make sure that every element or object within NEW has OLD as
- ;; parent.
- (mapc (lambda (blob) (org-element-put-property blob :parent old))
- (org-element-contents new))
- ;; Transfer contents.
- (apply 'org-element-set-contents old (org-element-contents new))
- ;; Ensure NEW has same parent as OLD, then overwrite OLD properties
- ;; with NEW's.
- (org-element-put-property new :parent (org-element-property :parent old))
- (setcar (cdr old) (nth 1 new))
- ;; Transfer type.
- (setcar old (car new)))
+(defun org-element-secondary-p (object)
+ "Non-nil when OBJECT belongs to a secondary string.
+Return value is the property name, as a keyword, or nil."
+ (let* ((parent (org-element-property :parent object))
+ (property (cdr (assq (org-element-type parent)
+ org-element-secondary-value-alist))))
+ (and property
+ (memq object (org-element-property property parent))
+ property)))
(defsubst org-element-adopt-elements (parent &rest children)
"Append elements to the contents of another element.
@@ -447,6 +444,77 @@ Return parent element."
;; Return modified PARENT element.
(or parent children))
+(defun org-element-extract-element (element)
+ "Extract ELEMENT from parse tree.
+Remove element from the parse tree by side-effect, and return it
+with its `:parent' property stripped out."
+ (let ((parent (org-element-property :parent element))
+ (secondary (org-element-secondary-p element)))
+ (if secondary
+ (org-element-put-property
+ parent secondary
+ (delq element (org-element-property secondary parent)))
+ (apply #'org-element-set-contents
+ parent
+ (delq element (org-element-contents parent))))
+ ;; Return ELEMENT with its :parent removed.
+ (org-element-put-property element :parent nil)))
+
+(defun org-element-insert-before (element location)
+ "Insert ELEMENT before LOCATION in parse tree.
+LOCATION is an element, object or string within the parse tree.
+Parse tree is modified by side effect."
+ (let* ((parent (org-element-property :parent location))
+ (property (org-element-secondary-p location))
+ (siblings (if property (org-element-property property parent)
+ (org-element-contents parent)))
+ ;; Special case: LOCATION is the first element of an
+ ;; independent secondary string (e.g. :title property). Add
+ ;; ELEMENT in-place.
+ (specialp (and (not property)
+ (eq siblings parent)
+ (eq (car parent) location))))
+ ;; Install ELEMENT at the appropriate POSITION within SIBLINGS.
+ (cond (specialp)
+ ((or (null siblings) (eq (car siblings) location))
+ (push element siblings))
+ ((null location) (nconc siblings (list element)))
+ (t (let ((previous (cadr (memq location (reverse siblings)))))
+ (if (not previous)
+ (error "No location found to insert element")
+ (let ((next (memq previous siblings)))
+ (setcdr next (cons element (cdr next))))))))
+ ;; Store SIBLINGS at appropriate place in parse tree.
+ (cond
+ (specialp (setcdr parent (copy-sequence parent)) (setcar parent element))
+ (property (org-element-put-property parent property siblings))
+ (t (apply #'org-element-set-contents parent siblings)))
+ ;; Set appropriate :parent property.
+ (org-element-put-property element :parent parent)))
+
+(defun org-element-set-element (old new)
+ "Replace element or object OLD with element or object NEW.
+The function takes care of setting `:parent' property for NEW."
+ ;; Ensure OLD and NEW have the same parent.
+ (org-element-put-property new :parent (org-element-property :parent old))
+ (if (or (memq (org-element-type old) '(plain-text nil))
+ (memq (org-element-type new) '(plain-text nil)))
+ ;; We cannot replace OLD with NEW since one of them is not an
+ ;; object or element. We take the long path.
+ (progn (org-element-insert-before new old)
+ (org-element-extract-element old))
+ ;; Since OLD is going to be changed into NEW by side-effect, first
+ ;; make sure that every element or object within NEW has OLD as
+ ;; parent.
+ (dolist (blob (org-element-contents new))
+ (org-element-put-property blob :parent old))
+ ;; Transfer contents.
+ (apply #'org-element-set-contents old (org-element-contents new))
+ ;; Overwrite OLD's properties with NEW's.
+ (setcar (cdr old) (nth 1 new))
+ ;; Transfer type.
+ (setcar old (car new))))
+
;;; Greater elements
@@ -714,12 +782,14 @@ Return a list whose CAR is `headline' and CDR is a plist
containing `:raw-value', `:title', `:alt-title', `:begin',
`:end', `:pre-blank', `:contents-begin' and `:contents-end',
`:level', `:priority', `:tags', `:todo-keyword',`:todo-type',
-`:scheduled', `:deadline', `:closed', `:quotedp', `:archivedp',
-`:commentedp' and `:footnote-section-p' keywords.
+`:scheduled', `:deadline', `:closed', `:archivedp', `:commentedp'
+and `:footnote-section-p' keywords.
The plist also contains any property set in the property drawer,
with its name in upper cases and colons added at the
-beginning (i.e. `:CUSTOM_ID').
+beginning (e.g., `:CUSTOM_ID').
+
+LIMIT is a buffer position bounding the search.
When RAW-SECONDARY-P is non-nil, headline's title will not be
parsed as a secondary string, but as a plain string instead.
@@ -734,10 +804,6 @@ Assume point is at beginning of the headline."
(tags (let ((raw-tags (nth 5 components)))
(and raw-tags (org-split-string raw-tags ":"))))
(raw-value (or (nth 4 components) ""))
- (quotedp
- (let ((case-fold-search nil))
- (string-match (format "^%s\\( \\|$\\)" org-quote-string)
- raw-value)))
(commentedp
(let ((case-fold-search nil))
(string-match (format "^%s\\( \\|$\\)" org-comment-string)
@@ -777,7 +843,7 @@ Assume point is at beginning of the headline."
(t (setq plist (plist-put plist :closed time))))))
plist))))
(begin (point))
- (end (save-excursion (goto-char (org-end-of-subtree t t))))
+ (end (min (save-excursion (org-end-of-subtree t t)) limit))
(pos-after-head (progn (forward-line) (point)))
(contents-begin (save-excursion
(skip-chars-forward " \r\t\n" end)
@@ -787,14 +853,12 @@ Assume point is at beginning of the headline."
(skip-chars-backward " \r\t\n")
(forward-line)
(point)))))
- ;; Clean RAW-VALUE from any quote or comment string.
- (when (or quotedp commentedp)
+ ;; Clean RAW-VALUE from any comment string.
+ (when commentedp
(let ((case-fold-search nil))
(setq raw-value
(replace-regexp-in-string
- (concat
- (regexp-opt (list org-quote-string org-comment-string))
- "\\(?: \\|$\\)")
+ (concat (regexp-quote org-comment-string) "\\(?: \\|$\\)")
""
raw-value))))
;; Clean TAGS from archive tag, if any.
@@ -816,15 +880,11 @@ Assume point is at beginning of the headline."
:todo-keyword todo
:todo-type todo-type
:post-blank (count-lines
- (if (not contents-end) pos-after-head
- (goto-char contents-end)
- (forward-line)
- (point))
+ (or contents-end pos-after-head)
end)
:footnote-section-p footnote-section-p
:archivedp archivedp
- :commentedp commentedp
- :quotedp quotedp)
+ :commentedp commentedp)
time-props
standard-props))))
(let ((alt-title (org-element-property :ALT_TITLE headline)))
@@ -855,11 +915,9 @@ CONTENTS is the contents of the element."
(and tag-list
(format ":%s:" (mapconcat 'identity tag-list ":")))))
(commentedp (org-element-property :commentedp headline))
- (quotedp (org-element-property :quotedp headline))
(pre-blank (or (org-element-property :pre-blank headline) 0))
(heading (concat (make-string (org-reduced-level level) ?*)
(and todo (concat " " todo))
- (and quotedp (concat " " org-quote-string))
(and commentedp (concat " " org-comment-string))
(and priority
(format " [#%s]" (char-to-string priority)))
@@ -900,7 +958,7 @@ containing `:title', `:begin', `:end', `:contents-begin' and
The plist also contains any property set in the property drawer,
with its name in upper cases and colons added at the
-beginning (i.e. `:CUSTOM_ID').
+beginning (e.g., `:CUSTOM_ID').
When optional argument RAW-SECONDARY-P is non-nil, inline-task's
title will not be parsed as a secondary string, but as a plain
@@ -950,8 +1008,9 @@ Assume point is at beginning of the inline task."
plist))))
(task-end (save-excursion
(end-of-line)
- (and (re-search-forward "^\\*+ END" limit t)
- (match-beginning 0))))
+ (and (re-search-forward org-outline-regexp-bol limit t)
+ (org-looking-at-p "END[ \t]*$")
+ (line-beginning-position))))
(contents-begin (progn (forward-line)
(and task-end (< (point) task-end) (point))))
(contents-end (and contents-begin task-end))
@@ -1194,7 +1253,7 @@ CONTENTS is the contents of the element."
(forward-line)
(let ((origin (point)))
(when (re-search-forward inlinetask-re limit t)
- (if (looking-at "^\\*+ END[ \t]*$") (forward-line)
+ (if (org-looking-at-p "END[ \t]*$") (forward-line)
(goto-char origin)))))
;; At some text line. Check if it ends any previous item.
(t
@@ -1212,8 +1271,7 @@ CONTENTS is the contents of the element."
(cond
((and (looking-at "#\\+BEGIN\\(:\\|_\\S-+\\)")
(re-search-forward
- (format "^[ \t]*#\\+END%s[ \t]*$"
- (org-match-string-no-properties 1))
+ (format "^[ \t]*#\\+END%s[ \t]*$" (match-string 1))
limit t)))
((and (looking-at org-drawer-regexp)
(re-search-forward "^[ \t]*:END:[ \t]*$" limit t))))
@@ -1946,7 +2004,10 @@ Return a list whose CAR is `keyword' and CDR is a plist
containing `:key', `:value', `:begin', `:end', `:post-blank' and
`:post-affiliated' keywords."
(save-excursion
- (let ((begin (car affiliated))
+ ;; An orphaned affiliated keyword is considered as a regular
+ ;; keyword. In this case AFFILIATED is nil, so we take care of
+ ;; this corner case.
+ (let ((begin (or (car affiliated) (point)))
(post-affiliated (point))
(key (progn (looking-at "[ \t]*#\\+\\(\\S-+*\\):")
(upcase (org-match-string-no-properties 1))))
@@ -2078,8 +2139,8 @@ Assume point is at the beginning of the paragraph."
;; A matching `org-element-paragraph-separate' is not
;; necessarily the end of the paragraph. In
;; particular, lines starting with # or : as a first
- ;; non-space character are ambiguous. We have check
- ;; if they are valid Org syntax (i.e. not an
+ ;; non-space character are ambiguous. We have to
+ ;; check if they are valid Org syntax (e.g., not an
;; incomplete keyword).
(beginning-of-line)
(while (not
@@ -2208,37 +2269,6 @@ CONTENTS is nil."
" "))
-;;;; Quote Section
-
-(defun org-element-quote-section-parser (limit)
- "Parse a quote section.
-
-LIMIT bounds the search.
-
-Return a list whose CAR is `quote-section' and CDR is a plist
-containing `:begin', `:end', `:value' and `:post-blank' keywords.
-
-Assume point is at beginning of the section."
- (save-excursion
- (let* ((begin (point))
- (end (progn (org-with-limited-levels (outline-next-heading))
- (point)))
- (pos-before-blank (progn (skip-chars-backward " \r\t\n")
- (forward-line)
- (point)))
- (value (buffer-substring-no-properties begin pos-before-blank)))
- (list 'quote-section
- (list :begin begin
- :end end
- :value value
- :post-blank (count-lines pos-before-blank end))))))
-
-(defun org-element-quote-section-interpreter (quote-section contents)
- "Interpret QUOTE-SECTION element as Org syntax.
-CONTENTS is nil."
- (org-element-property :value quote-section))
-
-
;;;; Src Block
(defun org-element-src-block-parser (limit affiliated)
@@ -2511,104 +2541,75 @@ CONTENTS is verse block contents."
;;; Objects
;;
-;; Unlike to elements, interstices can be found between objects.
-;; That's why, along with the parser, successor functions are provided
-;; for each object. Some objects share the same successor (i.e. `code'
-;; and `verbatim' objects).
-;;
-;; A successor must accept a single argument bounding the search. It
-;; will return either a cons cell whose CAR is the object's type, as
-;; a symbol, and CDR the position of its next occurrence, or nil.
+;; Unlike to elements, raw text can be found between objects. Hence,
+;; `org-element--object-lex' is provided to find the next object in
+;; buffer.
;;
-;; Successors follow the naming convention:
-;; org-element-NAME-successor, where NAME is the name of the
-;; successor, as defined in `org-element-all-successors'.
-;;
-;; Some object types (i.e. `italic') are recursive. Restrictions on
+;; Some object types (e.g., `italic') are recursive. Restrictions on
;; object types they can contain will be specified in
;; `org-element-object-restrictions'.
;;
-;; Adding a new type of object is simple. Implement a successor,
-;; a parser, and an interpreter for it, all following the naming
-;; convention. Register type in `org-element-all-objects' and
-;; successor in `org-element-all-successors'. Maybe tweak
-;; restrictions about it, and that's it.
-
+;; Creating a new type of object requires to alter
+;; `org-element--object-regexp' and `org-element--object-lex', add the
+;; new type in `org-element-all-objects', and possibly add
+;; restrictions in `org-element-object-restrictions'.
;;;; Bold
(defun org-element-bold-parser ()
- "Parse bold object at point.
+ "Parse bold object at point, if any.
-Return a list whose CAR is `bold' and CDR is a plist with
-`:begin', `:end', `:contents-begin' and `:contents-end' and
-`:post-blank' keywords.
+When at a bold object, return a list whose car is `bold' and cdr
+is a plist with `:begin', `:end', `:contents-begin' and
+`:contents-end' and `:post-blank' keywords. Otherwise, return
+nil.
Assume point is at the first star marker."
(save-excursion
(unless (bolp) (backward-char 1))
- (looking-at org-emph-re)
- (let ((begin (match-beginning 2))
- (contents-begin (match-beginning 4))
- (contents-end (match-end 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'bold
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank)))))
+ (when (looking-at org-emph-re)
+ (let ((begin (match-beginning 2))
+ (contents-begin (match-beginning 4))
+ (contents-end (match-end 4))
+ (post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'bold
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank))))))
(defun org-element-bold-interpreter (bold contents)
"Interpret BOLD object as Org syntax.
CONTENTS is the contents of the object."
(format "*%s*" contents))
-(defun org-element-text-markup-successor ()
- "Search for the next text-markup object.
-
-Return value is a cons cell whose CAR is a symbol among `bold',
-`italic', `underline', `strike-through', `code' and `verbatim'
-and CDR is beginning position."
- (save-excursion
- (unless (bolp) (backward-char))
- (when (re-search-forward org-emph-re nil t)
- (let ((marker (match-string 3)))
- (cons (cond
- ((equal marker "*") 'bold)
- ((equal marker "/") 'italic)
- ((equal marker "_") 'underline)
- ((equal marker "+") 'strike-through)
- ((equal marker "~") 'code)
- ((equal marker "=") 'verbatim)
- (t (error "Unknown marker at %d" (match-beginning 3))))
- (match-beginning 2))))))
-
;;;; Code
(defun org-element-code-parser ()
- "Parse code object at point.
+ "Parse code object at point, if any.
-Return a list whose CAR is `code' and CDR is a plist with
-`:value', `:begin', `:end' and `:post-blank' keywords.
+When at a code object, return a list whose car is `code' and cdr
+is a plist with `:value', `:begin', `:end' and `:post-blank'
+keywords. Otherwise, return nil.
Assume point is at the first tilde marker."
(save-excursion
(unless (bolp) (backward-char 1))
- (looking-at org-emph-re)
- (let ((begin (match-beginning 2))
- (value (org-match-string-no-properties 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'code
- (list :value value
- :begin begin
- :end end
- :post-blank post-blank)))))
+ (when (looking-at org-emph-re)
+ (let ((begin (match-beginning 2))
+ (value (org-match-string-no-properties 4))
+ (post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'code
+ (list :value value
+ :begin begin
+ :end end
+ :post-blank post-blank))))))
(defun org-element-code-interpreter (code contents)
"Interpret CODE object as Org syntax.
@@ -2619,35 +2620,37 @@ CONTENTS is nil."
;;;; Entity
(defun org-element-entity-parser ()
- "Parse entity at point.
+ "Parse entity at point, if any.
-Return a list whose CAR is `entity' and CDR a plist with
-`:begin', `:end', `:latex', `:latex-math-p', `:html', `:latin1',
-`:utf-8', `:ascii', `:use-brackets-p' and `:post-blank' as
-keywords.
+When at an entity, return a list whose car is `entity' and cdr
+a plist with `:begin', `:end', `:latex', `:latex-math-p',
+`:html', `:latin1', `:utf-8', `:ascii', `:use-brackets-p' and
+`:post-blank' as keywords. Otherwise, return nil.
Assume point is at the beginning of the entity."
- (save-excursion
- (looking-at "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)")
- (let* ((value (org-entity-get (match-string 1)))
- (begin (match-beginning 0))
- (bracketsp (string= (match-string 2) "{}"))
- (post-blank (progn (goto-char (match-end 1))
- (when bracketsp (forward-char 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'entity
- (list :name (car value)
- :latex (nth 1 value)
- :latex-math-p (nth 2 value)
- :html (nth 3 value)
- :ascii (nth 4 value)
- :latin1 (nth 5 value)
- :utf-8 (nth 6 value)
- :begin begin
- :end end
- :use-brackets-p bracketsp
- :post-blank post-blank)))))
+ (catch 'no-object
+ (when (looking-at "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)")
+ (save-excursion
+ (let* ((value (or (org-entity-get (match-string 1))
+ (throw 'no-object nil)))
+ (begin (match-beginning 0))
+ (bracketsp (string= (match-string 2) "{}"))
+ (post-blank (progn (goto-char (match-end 1))
+ (when bracketsp (forward-char 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'entity
+ (list :name (car value)
+ :latex (nth 1 value)
+ :latex-math-p (nth 2 value)
+ :html (nth 3 value)
+ :ascii (nth 4 value)
+ :latin1 (nth 5 value)
+ :utf-8 (nth 6 value)
+ :begin begin
+ :end end
+ :use-brackets-p bracketsp
+ :post-blank post-blank)))))))
(defun org-element-entity-interpreter (entity contents)
"Interpret ENTITY object as Org syntax.
@@ -2656,59 +2659,37 @@ CONTENTS is nil."
(org-element-property :name entity)
(when (org-element-property :use-brackets-p entity) "{}")))
-(defun org-element-latex-or-entity-successor ()
- "Search for the next latex-fragment or entity object.
-
-Return value is a cons cell whose CAR is `entity' or
-`latex-fragment' and CDR is beginning position."
- (save-excursion
- (unless (bolp) (backward-char))
- (let ((matchers (cdr org-latex-regexps))
- ;; ENTITY-RE matches both LaTeX commands and Org entities.
- (entity-re
- "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)"))
- (when (re-search-forward
- (concat (mapconcat #'cadr matchers "\\|") "\\|" entity-re) nil t)
- (goto-char (match-beginning 0))
- (if (looking-at entity-re)
- ;; Determine if it's a real entity or a LaTeX command.
- (cons (if (org-entity-get (match-string 1)) 'entity 'latex-fragment)
- (match-beginning 0))
- ;; No entity nor command: point is at a LaTeX fragment.
- ;; Determine its type to get the correct beginning position.
- (cons 'latex-fragment
- (catch 'return
- (dolist (e matchers)
- (when (looking-at (nth 1 e))
- (throw 'return (match-beginning (nth 2 e)))))
- (point))))))))
-
;;;; Export Snippet
(defun org-element-export-snippet-parser ()
"Parse export snippet at point.
-Return a list whose CAR is `export-snippet' and CDR a plist with
-`:begin', `:end', `:back-end', `:value' and `:post-blank' as
-keywords.