ndwarshuis
/
org-mode
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge 8.0

This commit is contained in:
Bastien Guerry 2013-04-18 18:00:30 +02:00
parent a5435fa883 1e3cb91ccb
commit 01d71f50ef
218 changed files with 46117 additions and 53919 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
README
View File

@ -1,9 +1,11 @@
The is a distribution of Org, a plain text notes and project planning The is a distribution of Org, a plain text notes and project planning
tool for Emacs. tool for Emacs.
The version of this release is: 7.9.1 The homepage of Org is at:
http://orgmode.org
The homepage of Org is at http://orgmode.org The installations instructions are at:
http://orgmode.org/org.html#Installation
This distribution contains: This distribution contains:

8
README_ELPA
View File

@ -1,11 +1,15 @@
This is the Emacs Org project, an Emacs library for organizing your life. This is the Emacs Org project, an Emacs library for organizing your life.
The homepage of Org is at http://orgmode.org The homepage of Org is at:
http://orgmode.org
Installations instructions are at:
http://orgmode.org/org.html#Installation
This distribution contains an ELPA packaged version of Org. This distribution contains an ELPA packaged version of Org.
"ELPA" stands for the "Emacs Lisp Package Archive". "ELPA" stands for the "Emacs Lisp Package Archive".
The GNU ELPA is here:
The GNU ELPA is at:
http://elpa.gnu.org http://elpa.gnu.org
It contains the org-*.tar package, containing only the org files It contains the org-*.tar package, containing only the org files

109
README_maintainer
View File

@ -1,6 +1,6 @@
# -*- mode:org -*- # -*- mode:org -*-
#+TITLE: Maintainer tasks #+TITLE: Org maintainer tasks
#+STARTUP: noindent #+STARTUP: noindent
This document describes the tasks the Org-mode maintainer has to do This document describes the tasks the Org-mode maintainer has to do
@ -37,7 +37,7 @@ branch back into maint to synchronize the two.
** Minor release ** Minor release
The release number for minor releases look like this: =7.13.01= The release number for minor releases look like this: =7.13.1=
Minor releases are small amends to main releases. Usually they fix Minor releases are small amends to main releases. Usually they fix
critical bugs discovered in a main release. Minor bugs are usually critical bugs discovered in a main release. Minor bugs are usually
@ -50,8 +50,8 @@ maint then merged in master.
** Tagging the release ** Tagging the release
When doing a major and a minor release, after all necessary merging When doing a major and a minor release, after all necessary merging is
is done, tag the _maint_ branch for the release with: done, tag the _maint_ branch for the release with:
git tag -a "Adding release tag" release_7.9.1 git tag -a "Adding release tag" release_7.9.1
@ -59,6 +59,10 @@ and push tags with
git push --tags git push --tags
We also encourage you to sign release tags like this:
git tag -a "Adding release tag" -s release_7.9.1
** Uploading the release files from the orgmode.org server ** Uploading the release files from the orgmode.org server
Log on the orgmode.org server as the emacs user and cd to Log on the orgmode.org server as the emacs user and cd to
@ -72,92 +76,6 @@ From there do
to create the .tar.gz and .zip files, the documentation, and to to create the .tar.gz and .zip files, the documentation, and to
upload everything at the right place. upload everything at the right place.
* Working with patchwork
John Wiegley is running a patchwork server that looks at the
emacs-orgmode mailing list and extracts patches. The maintainer and
his helpers should work through such patches, give feedback on them
and apply the ones which are good and done. A task for the maintainer
is to every now and then try to get old stuff out of that list, by
asking some helpers to investigate the patch, by rejecting or
accepting it.
I have found that the best workflow for this is using the pw script by
Nate Case, with the modifications for Org-mode made by John Wiegley
and Carsten Dominik. The correct version of this script that should
be used with Org mode is distributed in the =mk/= directory of the Org
mode distribution. Here is the basic workflow for this.
** Access to the patchwork server
If you want to work on patchwork patches, you need write access at the
patchwork server. You need to contact John Wiegley to get this
access.
There is a web interface to look at the patches and to change the
status of patches. This interface is self-explanatory. There is also
a command line script which can be very convenient to use.
** Testing patches
To start testing a patch, first assign it to yourself
: pw update -s "Under Review" -d DELEGATE-NAME NNN
where =NNN= is a patch number and =DELEGATE-NAME= is your user name on
the patchwork server.
The get the patch into a branch:
: pw branch NNN
This will create a local topic branch in your git repository with the
name =t/patchNNN=. You will also be switched to the branch so that
you can immediately start testing it. Quite often small amends need
to be made, or documentation has to be added. Also, many contributors
do not yet provide the proper ChangeLog-like entries in the commit
message for the patch. As a maintainer, you have two options here.
Either ask the contributor to make the changes and resubmit the patch,
or fix it yourself. In principle, asking to contributor to change the
patch until it is complete is the best route, because it will educate
the contributor and minimize the work for the maintainer. However,
sometimes it can be less hassle to fix things directly and commit the
changes to the same branch =t/patchNNN=.
If you ask the contributor to make the changes, the patch should be
marked on the patchwork server as "changes requested".
: pw update -s "Changes Requested" -m "What to change" NNN
This will send an email to the contributor and the mailing list with a
request for changes. The =-m= message should not be more than one
sentence and describe the requested changes. If you need to explain
in more detail, write a separate email to the contributor.
When a new version of the patch arrives, you mark the old one as
superseded
: pw update -s "Superseded" NNN
and start working at the new one.
** Merging a final patch
Once the patch has been iterated and is final (including the
ChangeLog-like entries in the commit message), it should be merged.
The assumption here is that the final version of the patch is given by
the HEAD state in the branch =t/patchNNN=. To merge, do this:
: pw merge -m "maintainer comment" NNN
This will merge the patch into master, switch back to master and send
an email to both contributor and mailing list stating that this change
has been accepted, along with the comment given in the =-m= message.
At some point you might then want to remove the topic branch
: git branch -d t/patchNNN
* Synchonization with Emacs * Synchonization with Emacs
This is still a significant headache. Some hand work is needed here. This is still a significant headache. Some hand work is needed here.
@ -253,16 +171,19 @@ So the way I have been doing things with Emacs is this:
* Copyright assignments * Copyright assignments
The maintainer needs to keep track of copyright assignments. Even The maintainer needs to keep track of copyright assignments.
better, find a volunteer to do this. Even better, find a volunteer to do this.
The assignment form is included in the repository as a file that
you can send to contributors: =request-assign-future.txt=
The list of all contributors from who we have the papers is kept on The list of all contributors from who we have the papers is kept on
Worg at http://orgmode.org/worg/org-contribute.php, so that Worg at http://orgmode.org/worg/org-contribute.html, so that
committers can check if a patch can go into the core. committers can check if a patch can go into the core.
The assignment process does not allways go smoothly, and it has The assignment process does not allways go smoothly, and it has
happened several times that it gets stuck or forgotten at the FSF. happened several times that it gets stuck or forgotten at the FSF.
The contact at the FSF for this is: copyright-clerk@fsf.org The contact at the FSF for this is: mailto:copyright-clerk@fsf.org
Emails from the paper submitter have been ignored in the past, but Emails from the paper submitter have been ignored in the past, but
an email from me (Carsten) as the maintainer of Org mode has usually an email from me (Carsten) as the maintainer of Org mode has usually

93
contrib/README
View File

@ -1,34 +1,36 @@
This directory contains add-ons to Org-mode. This directory contains add-ons to Org-mode.
These contributions are not part of GNU Emacs or of the official Org-mode These contributions are not part of GNU Emacs or of the official
package. But the git repository for Org-mode is glad to provide useful way Org-mode package. But the git repository for Org-mode is glad to
to distribute and develop them as long as they are distributed under a free provide useful way to distribute and develop them as long as they
software license. are distributed under a free software license.
Please put your contribution in one of these directories: Please put your contribution in one of these directories:
LISP (emacs-lisp code) LISP (Emacs Lisp)
====================== =================
htmlize.el --- Convert buffer text and decorations to HTML
org2rem.el --- Convert org appointments into reminders Org utils
~~~~~~~~~
org-annotate-file.el --- Annotate a file with org syntax org-annotate-file.el --- Annotate a file with org syntax
org-bibtex-extras.el --- Extras for working with org-bibtex entries org-bibtex-extras.el --- Extras for working with org-bibtex entries
org-bookmark.el --- Links to bookmarks org-bookmark.el --- Links to bookmarks
org-bullets.el --- Show bullets in org-mode as UTF-8 characters
org-checklist.el --- org functions for checklist handling org-checklist.el --- org functions for checklist handling
org-choose.el --- Use TODO keywords to mark decision states org-choose.el --- Use TODO keywords to mark decision states
org-collector.el --- Collect properties into tables org-collector.el --- Collect properties into tables
org-contacts --- Contacts management org-colview-xemacs.el --- Column View in Org-mode, XEmacs-specific version
org-contacts.el --- Contacts management
org-contribdir.el --- Dummy file to mark the org contrib Lisp directory org-contribdir.el --- Dummy file to mark the org contrib Lisp directory
org-depend.el --- TODO dependencies for Org-mode org-depend.el --- TODO dependencies for Org-mode
org-drill.el --- Self-testing with org-learn org-drill.el --- Self-testing with org-learn
org-element.el --- Parser and applications for Org syntax org-element.el --- Parser and applications for Org syntax
org-elisp-symbol.el --- Org links to emacs-lisp symbols org-elisp-symbol.el --- Org links to emacs-lisp symbols
org-eval.el --- The <lisp> tag, adapted from Muse
org-eval-light.el --- Evaluate in-buffer code on demand org-eval-light.el --- Evaluate in-buffer code on demand
org-exp-bibtex.el --- Export citations to LaTeX and HTML org-eval.el --- The <lisp> tag, adapted from Muse
org-expiry.el --- Expiry mechanism for Org entries org-expiry.el --- Expiry mechanism for Org entries
org-export.el --- Generic Export Engine For Org
org-export-generic.el --- Export framework for configurable backends org-export-generic.el --- Export framework for configurable backends
org-favtable.el --- Lookup table of favorite references and links
org-git-link.el --- Provide org links to specific file version org-git-link.el --- Provide org links to specific file version
org-interactive-query.el --- Interactive modification of tags query org-interactive-query.el --- Interactive modification of tags query
org-invoice.el --- Help manage client invoices in OrgMode org-invoice.el --- Help manage client invoices in OrgMode
@ -36,8 +38,10 @@ org-jira.el --- Add a jira:ticket protocol to Org
org-learn.el --- SuperMemo's incremental learning algorithm org-learn.el --- SuperMemo's incremental learning algorithm
org-mac-iCal.el --- Imports events from iCal.app to the Emacs diary 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-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-mairix.el --- Hook mairix search into Org for different MUAs org-mairix.el --- Hook mairix search into Org for different MUAs
org-man.el --- Support for links to manpages in Org-mode org-man.el --- Support for links to manpages in Org-mode
org-mew.el --- Support for links to Mew messages
org-mime.el --- org html export for text/html MIME emails org-mime.el --- org html export for text/html MIME emails
org-mtags.el --- Support for some Muse-like tags in Org-mode org-mtags.el --- Support for some Muse-like tags in Org-mode
org-notify.el --- Notifications for Org-mode org-notify.el --- Notifications for Org-mode
@ -48,49 +52,48 @@ org-screen.el --- Visit screen sessions through Org-mode links
org-secretary.el --- Team management with org-mode org-secretary.el --- Team management with org-mode
org-static-mathjax.el --- Muse-like tags in Org-mode org-static-mathjax.el --- Muse-like tags in Org-mode
org-sudoku.el --- Create and solve SUDOKU puzzles in Org tables org-sudoku.el --- Create and solve SUDOKU puzzles in Org tables
orgtbl-sqlinsert.el --- Convert Org-mode tables to SQL insertions
org-toc.el --- Table of contents for Org-mode buffer org-toc.el --- Table of contents for Org-mode buffer
org-track.el --- Keep up with Org development org-track.el --- Keep up with Org development
org-velocity.el --- something like Notational Velocity for Org org-velocity.el --- something like Notational Velocity for Org
org-vm.el --- Support for links to VM messages
org-w3m.el --- Support link/copy/paste from w3m to Org-mode
org-wikinodes.el --- CamelCase wiki-like links for Org org-wikinodes.el --- CamelCase wiki-like links for Org
org-wl.el --- Support for links to Wanderlust messages
orgtbl-sqlinsert.el --- Convert Org-mode tables to SQL insertions
Org exporters
~~~~~~~~~~~~~
ox-confluence.el --- Confluence Wiki exporter
ox-deck.el --- deck.js presentations exporter
ox-groff.el --- Groff exporter
ox-koma-letter.el --- KOMA Scrlttr2 exporter
ox-rss.el --- RSS 2.0 exporter
ox-s5.el --- S5 presentations exporter
ox-taskjuggler.el --- TaskJuggler exporter
EXPORT ENGINE AND BACKENDS (emacs-lisp code) Org Babel languages
============================================ ~~~~~~~~~~~~~~~~~~~
ob-eukleides.el --- Org-babel functions for eukleides evaluation
ob-fomus.el --- Org-babel functions for fomus evaluation
ob-julia.el --- Org-babel functions for julia evaluation
ob-mathomatic.el --- Org-babel functions for mathomatic evaluation
ob-oz.el --- Org-babel functions for Oz evaluation
ob-tcl.el --- Org-babel functions for tcl evaluation
org-export.el --- the new export engine External libraries
org-e-latex.el --- LaTeX export backend ~~~~~~~~~~~~~~~~~~
org-e-ascii.el --- ASCII export backend htmlize.el --- Convert buffer text and decorations to HTML
org-e-beamer.el --- Beamer export backend
org-e-groff.el --- Groff export backend
org-e-html.el --- HTML export backend
org-e-man.el --- man pages export backend
org-e-odt.el --- ODT export backend
org-e-texinfo.el --- TeXinfo export backend
org-md.el --- MarkDown export backend
BABEL
=====
library-of-babel.org --- Documentation for the library of babel
langs/ob-fomus.el --- Org-babel functions for fomus evaluation
langs/ob-oz.el --- Org-babel functions for Oz evaluation
ODT (OpenDocumentText)
======================
README.org --- Legacy documentation for Org ODT exporter
SCRIPTS (shell, bash, etc.) SCRIPTS (shell, bash, etc.)
=========================== ===========================
StartOzServer.oz --- implements the Oz-side of the Org-babel Oz interface
dir2org.zsh --- Org compatible fs structure output dir2org.zsh --- Org compatible fs structure output
ditaa.jar --- ASCII to PNG converter by Stathis Sideris, GPL ditaa.jar --- ASCII to PNG converter by Stathis Sideris, GPL
org2hpda --- Generate hipster pda style printouts from Org-mode org-docco.org --- docco side-by-side annotated code export to HTML
org-docco.org --- docco side-by-side annotated code export to HTML org2hpda --- Generate hipster pda style printouts from Org-mode
StartOzServer.oz --- implements the Oz-side of the Org-babel Oz interface staticmathjax --- XULRunner application to process MathJax statically
staticmathjax --- XULRunner application to process MathJax statically x11idle.c --- get the idle time of your X session
This directory also contains supporting files for the following This directory also contains supporting files for the following
packages: ob-oz.el, org-docco.org, and org-static-mathjax.el. packages: ob-oz.el, org-docco.org, and org-static-mathjax.el.

1244
contrib/lisp/htmlize.el
View File

File diff suppressed because it is too large Load Diff

98
contrib/lisp/ob-eukleides.el Normal file
View File

@ -0,0 +1,98 @@
;;; ob-eukleides.el --- Org-babel functions for eukleides evaluation
;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
;; Author: Luis Anaya
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; 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 of the License, 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:
;; Org-Babel support for evaluating eukleides script.
;;
;; Inspired by Ian Yang's org-export-blocks-format-eukleides
;; http://www.emacswiki.org/emacs/org-export-blocks-format-eukleides.el
;;; Requirements:
;; eukleides | http://eukleides.org
;; eukleides | `org-eukleides-path' should point to the eukleides executablexs
;;; Code:
(require 'ob)
(require 'ob-eval)
(defvar org-babel-default-header-args:eukleides
'((:results . "file") (:exports . "results"))
"Default arguments for evaluating a eukleides source block.")
(defcustom org-eukleides-path nil
"Path to the eukleides executable file."
:group 'org-babel
:type 'string)
(defcustom org-eukleides-eps-to-raster nil
"Command used to convert EPS to raster. Nil for no conversion."
:group 'org-babel
:type '(choice
(repeat :tag "Shell Command Sequence" (string :tag "Shell Command"))
(const :tag "sam2p" "a=%s;b=%s;sam2p ${a} ${b}" )
(const :tag "NetPNM" "a=%s;b=%s;pstopnm -stdout ${a} | pnmtopng > ${b}" )
(const :tag "None" nil)))
(defun org-babel-execute:eukleides (body params)
"Execute a block of eukleides code with org-babel.
This function is called by `org-babel-execute-src-block'."
(let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
(out-file (or (cdr (assoc :file params))
(error "Eukleides requires a \":file\" header argument")))
(cmdline (cdr (assoc :cmdline params)))
(in-file (org-babel-temp-file "eukleides-"))
(java (or (cdr (assoc :java params)) ""))
(cmd (if (not org-eukleides-path)
(error "`org-eukleides-path' is not set")
(concat (expand-file-name org-eukleides-path)
" -b --output="
(org-babel-process-file-name
(concat
(file-name-sans-extension out-file) ".eps"))
" "
(org-babel-process-file-name in-file)))))
(unless (file-exists-p org-eukleides-path)
(error "Could not find eukleides at %s" org-eukleides-path))
(if (string= (file-name-extension out-file) "png")
(if org-eukleides-eps-to-raster
(shell-command (format org-eukleides-eps-to-raster
(concat (file-name-sans-extension out-file) ".eps")
(concat (file-name-sans-extension out-file) ".png")))
(error "Conversion to PNG not supported. use a file with an EPS name")))
(with-temp-file in-file (insert body))
(message "%s" cmd) (org-babel-eval cmd "")
nil)) ;; signal that output has already been written to file
(defun org-babel-prep-session:eukleides (session params)
"Return an error because eukleides does not support sessions."
(error "Eukleides does not support sessions"))
(provide 'ob-eukleides)
;;; ob-eukleides.el ends here

5
contrib/babel/langs/ob-fomus.el → contrib/lisp/ob-fomus.el
View File

@ -1,13 +1,12 @@
;;; ob-fomus.el --- org-babel functions for fomus evaluation ;;; ob-fomus.el --- Org-babel functions for fomus evaluation
;; Copyright (C) 2011-2013 Torsten Anders ;; Copyright (C) 2011-2013 Torsten Anders
;; Author: Torsten Anders ;; Author: Torsten Anders
;; Keywords: literate programming, reproducible research ;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org ;; Homepage: http://orgmode.org
;; Version:
;;; License: ;; This file is not part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify ;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by ;; it under the terms of the GNU General Public License as published by

302
contrib/lisp/ob-julia.el Normal file
View File

@ -0,0 +1,302 @@
;;; ob-julia.el --- org-babel functions for julia code evaluation
;; Copyright (C) 2013 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.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; The file provides Org-Babel support for evaluating julia code.
;;
;; See https://github.com/gjkerns/ob-julia/blob/master/ob-julia-doc.org
;; for detailed instructions on how to get started. The git repository
;; contains more documentation: git://github.com/gjkerns/ob-julia.git
;;; Code:
(require 'ob)
(eval-when-compile (require 'cl))
(declare-function orgtbl-to-csv "org-table" (table params))
(declare-function julia "ext:ess-julia" (&optional start-args))
(declare-function inferior-ess-send-input "ext:ess-inf" ())
(declare-function ess-make-buffer-current "ext:ess-inf" ())
(declare-function ess-eval-buffer "ext:ess-inf" (vis))
(declare-function org-number-sequence "org-compat" (from &optional to inc))
(declare-function org-remove-if-not "org" (predicate seq))
(defconst org-babel-header-args:julia
'((width . :any)
(horizontal . :any)
(results . ((file list vector table scalar verbatim)
(raw org html latex code pp wrap)
(replace silent append prepend)
(output value graphics))))
"julia-specific header arguments.")
(add-to-list 'org-babel-tangle-lang-exts '("julia" . "jl"))
(defvar org-babel-default-header-args:julia '())
(defcustom org-babel-julia-command inferior-julia-program-name
"Name of command to use for executing julia code."
:group 'org-babel
:version "24.4"
:package-version '(Org . "8.0")
:type 'string)
(defvar ess-local-process-name) ; dynamically scoped
(defun org-babel-edit-prep:julia (info)
(let ((session (cdr (assoc :session (nth 2 info)))))
(when (and session (string-match "^\\*\\(.+?\\)\\*$" session))
(save-match-data (org-babel-julia-initiate-session session nil)))))
(defun org-babel-expand-body:julia (body params &optional graphics-file)
"Expand BODY according to PARAMS, return the expanded body."
(let ((graphics-file
(or graphics-file (org-babel-julia-graphical-output-file params))))
(mapconcat
#'identity
((lambda (inside)
(if graphics-file
inside
inside))
(append (org-babel-variable-assignments:julia params)
(list body))) "\n")))
(defun org-babel-execute:julia (body params)
"Execute a block of julia code.
This function is called by `org-babel-execute-src-block'."
(save-excursion
(let* ((result-params (cdr (assoc :result-params params)))
(result-type (cdr (assoc :result-type params)))
(session (org-babel-julia-initiate-session
(cdr (assoc :session params)) params))
(colnames-p (cdr (assoc :colnames params)))
(rownames-p (cdr (assoc :rownames params)))
(graphics-file (org-babel-julia-graphical-output-file params))
(full-body (org-babel-expand-body:julia body params graphics-file))
(result
(org-babel-julia-evaluate
session full-body result-type result-params
(or (equal "yes" colnames-p)
(org-babel-pick-name
(cdr (assoc :colname-names params)) colnames-p))
(or (equal "yes" rownames-p)
(org-babel-pick-name
(cdr (assoc :rowname-names params)) rownames-p)))))
(if graphics-file nil result))))
(defun org-babel-prep-session:julia (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(let* ((session (org-babel-julia-initiate-session session params))
(var-lines (org-babel-variable-assignments:julia params)))
(org-babel-comint-in-buffer session
(mapc (lambda (var)
(end-of-line 1) (insert var) (comint-send-input nil t)
(org-babel-comint-wait-for-output session)) var-lines))
session))
(defun org-babel-load-session:julia (session body params)
"Load BODY into SESSION."
(save-window-excursion
(let ((buffer (org-babel-prep-session:julia session params)))
(with-current-buffer buffer
(goto-char (process-mark (get-buffer-process (current-buffer))))
(insert (org-babel-chomp body)))
buffer)))
;; helper functions
(defun org-babel-variable-assignments:julia (params)
"Return list of julia statements assigning the block's variables."
(let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
(mapcar
(lambda (pair)
(org-babel-julia-assign-elisp
(car pair) (cdr pair)
(equal "yes" (cdr (assoc :colnames params)))
(equal "yes" (cdr (assoc :rownames params)))))
(mapcar
(lambda (i)
(cons (car (nth i vars))
(org-babel-reassemble-table
(cdr (nth i vars))
(cdr (nth i (cdr (assoc :colname-names params))))
(cdr (nth i (cdr (assoc :rowname-names params)))))))
(org-number-sequence 0 (1- (length vars)))))))
(defun org-babel-julia-quote-csv-field (s)
"Quote field S for export to julia."
(if (stringp s)
(concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"")
(format "%S" s)))
(defun org-babel-julia-assign-elisp (name value colnames-p rownames-p)
"Construct julia code assigning the elisp VALUE to a variable named NAME."
(if (listp value)
(let ((max (apply #'max (mapcar #'length (org-remove-if-not
#'sequencep value))))
(min (apply #'min (mapcar #'length (org-remove-if-not
#'sequencep value))))
(transition-file (org-babel-temp-file "julia-import-")))
;; ensure VALUE has an orgtbl structure (depth of at least 2)
(unless (listp (car value)) (setq value (list value)))
(with-temp-file transition-file
(insert
(orgtbl-to-csv value '(:fmt org-babel-julia-quote-csv-field))
"\n"))
(let ((file (org-babel-process-file-name transition-file 'noquote))
(header (if (or (eq (nth 1 value) 'hline) colnames-p)
"TRUE" "FALSE"))
(row-names (if rownames-p "1" "NULL")))
(if (= max min)
(format "%s = readcsv(\"%s\")" name file)
(format "%s = readcsv(\"%s\")"
name file))))
(format "%s = %s" name (org-babel-julia-quote-csv-field value))))
(defvar ess-ask-for-ess-directory) ; dynamically scoped
(defun org-babel-julia-initiate-session (session params)
"If there is not a current julia process then create one."
(unless (string= session "none")
(let ((session (or session "*julia*"))
(ess-ask-for-ess-directory
(and (and (boundp 'ess-ask-for-ess-directory) ess-ask-for-ess-directory)
(not (cdr (assoc :dir params))))))
(if (org-babel-comint-buffer-livep session)
session
(save-window-excursion
(require 'ess) (julia)
(rename-buffer
(if (bufferp session)
(buffer-name session)
(if (stringp session)
session
(buffer-name))))
(current-buffer))))))
(defun org-babel-julia-associate-session (session)
"Associate julia code buffer with a julia session.
Make SESSION be the inferior ESS process associated with the
current code buffer."
(setq ess-local-process-name
(process-name (get-buffer-process session)))
(ess-make-buffer-current))
(defun org-babel-julia-graphical-output-file (params)
"Name of file to which julia should send graphical output."
(and (member "graphics" (cdr (assq :result-params params)))
(cdr (assq :file params))))
(defvar org-babel-julia-eoe-indicator "print(\"org_babel_julia_eoe\")")
(defvar org-babel-julia-eoe-output "org_babel_julia_eoe")
(defvar org-babel-julia-write-object-command "writecsv(\"%s\",%s)")
;; The following was a very complicated write object command
;; The replacement needs to add error catching
;(defvar org-babel-julia-write-object-command "{function(object,transfer.file){object;invisible(if(inherits(try({tfile<-tempfile();write.table(object,file=tfile,sep=\"\\t\",na=\"nil\",row.names=%s,col.names=%s,quote=FALSE);file.rename(tfile,transfer.file)},silent=TRUE),\"try-error\")){if(!file.exists(transfer.file))file.create(transfer.file)})}}(object=%s,transfer.file=\"%s\")")
(defun org-babel-julia-evaluate
(session body result-type result-params column-names-p row-names-p)
"Evaluate julia code in BODY."
(if session
(org-babel-julia-evaluate-session
session body result-type result-params column-names-p row-names-p)
(org-babel-julia-evaluate-external-process
body result-type result-params column-names-p row-names-p)))
(defun org-babel-julia-evaluate-external-process
(body result-type result-params column-names-p row-names-p)
"Evaluate BODY in external julia process.
If RESULT-TYPE equals 'output then return standard output as a
string. If RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp."
(case result-type
(value
(let ((tmp-file (org-babel-temp-file "julia-")))
(org-babel-eval org-babel-julia-command
(format org-babel-julia-write-object-command
(org-babel-process-file-name tmp-file 'noquote)
(format "begin\n%s\nend" body)))
(org-babel-julia-process-value-result
(org-babel-result-cond result-params
(with-temp-buffer
(insert-file-contents tmp-file)
(buffer-string))
(org-babel-import-elisp-from-file tmp-file '(4)))
column-names-p)))
(output (org-babel-eval org-babel-julia-command body))))
(defun org-babel-julia-evaluate-session
(session body result-type result-params column-names-p row-names-p)
"Evaluate BODY in SESSION.
If RESULT-TYPE equals 'output then return standard output as a
string. If RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp."
(case result-type
(value
(with-temp-buffer
(insert (org-babel-chomp body))
(let ((ess-local-process-name
(process-name (get-buffer-process session)))
(ess-eval-visibly-p nil))
(ess-eval-buffer nil)))
(let ((tmp-file (org-babel-temp-file "julia-")))
(org-babel-comint-eval-invisibly-and-wait-for-file
session tmp-file
(format org-babel-julia-write-object-command
(org-babel-process-file-name tmp-file 'noquote) "ans"))
(org-babel-julia-process-value-result
(org-babel-result-cond result-params
(with-temp-buffer
(insert-file-contents tmp-file)
(buffer-string))
(org-babel-import-elisp-from-file tmp-file '(4)))
column-names-p)))
(output
(mapconcat
#'org-babel-chomp
(butlast
(delq nil
(mapcar
(lambda (line) (when (> (length line) 0) line))
(mapcar
(lambda (line) ;; cleanup extra prompts left in output
(if (string-match
"^\\([ ]*[>+\\.][ ]?\\)+\\([[0-9]+\\|[ ]\\)" line)
(substring line (match-end 1))
line))
(org-babel-comint-with-output (session org-babel-julia-eoe-output)
(insert (mapconcat #'org-babel-chomp
(list body org-babel-julia-eoe-indicator)
"\n"))
(inferior-ess-send-input)))))) "\n"))))
(defun org-babel-julia-process-value-result (result column-names-p)
"julia-specific processing of return value.
Insert hline if column names in output have been requested."
(if column-names-p
(cons (car result) (cons 'hline (cdr result)))
result))
(provide 'ob-julia)
;;; ob-julia.el ends here

145
contrib/lisp/ob-mathomatic.el Normal file
View File

@ -0,0 +1,145 @@
;;; ob-mathomatic.el --- Org-babel functions for mathomatic evaluation
;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
;; Author: Eric S Fraga
;; Eric Schulte
;; Luis Anaya (Mathomatic)
;; Keywords: literate programming, reproducible research, mathomatic
;; Homepage: http://orgmode.org
;; 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 of the License, 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:
;; Org-Babel support for evaluating mathomatic entries.
;;
;; This differs from most standard languages in that
;;
;; 1) there is no such thing as a "session" in mathomatic
;;
;; 2) we are adding the "cmdline" header argument
;;; Code:
(require 'ob)
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("mathomatic" . "math"))
(defvar org-babel-default-header-args:mathomatic '())
(defcustom org-babel-mathomatic-command
(if (boundp 'mathomatic-command) mathomatic-command "mathomatic")
"Command used to call mathomatic on the shell."
:group 'org-babel)
(defun org-babel-mathomatic-expand (body params)
"Expand a block of Mathomatic code according to its header arguments."
(let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
(mapconcat 'identity
(list
;; graphic output
(let ((graphic-file (org-babel-mathomatic-graphical-output-file params)))
(if graphic-file
(cond
((string-match ".\.eps$" graphic-file)
(format ;; Need to add command to send to file.
"set plot set terminal postscript eps\\;set output %S "
graphic-file))
((string-match ".\.ps$" graphic-file)
(format ;; Need to add command to send to file.
"set plot set terminal postscript\\;set output %S "
graphic-file))
((string-match ".\.pic$" graphic-file)
(format ;; Need to add command to send to file.
"set plot set terminal gpic\\;set output %S "
graphic-file))
(t
(format ;; Need to add command to send to file.
"set plot set terminal png\\;set output %S "
graphic-file)))
""))
;; variables
(mapconcat 'org-babel-mathomatic-var-to-mathomatic vars "\n")
;; body
body
"")
"\n")))
(defun org-babel-execute:mathomatic (body params)
"Execute a block of Mathomatic entries with org-babel. This function is
called by `org-babel-execute-src-block'."
(message "executing Mathomatic source code block")
(let ((result-params (split-string (or (cdr (assoc :results params)) "")))
(result
(let* ((cmdline (or (cdr (assoc :cmdline params)) ""))
(in-file (org-babel-temp-file "mathomatic-" ".math"))
(cmd (format "%s -t -c -q %s %s"
org-babel-mathomatic-command in-file cmdline)))
(with-temp-file in-file (insert (org-babel-mathomatic-expand body params)))
(message cmd)
((lambda (raw) ;; " | grep -v batch | grep -v 'replaced' | sed '/^$/d' "
(mapconcat
#'identity
(delq nil
(mapcar (lambda (line)
(unless (or (string-match "batch" line)
(string-match "^rat: replaced .*$" line)
(= 0 (length line)))
line))
(split-string raw "[\r\n]"))) "\n"))
(org-babel-eval cmd "")))))
(if (org-babel-mathomatic-graphical-output-file params)
nil
(if (or (member "scalar" result-params)
(member "verbatim" result-params)
(member "output" result-params))
result
(let ((tmp-file (org-babel-temp-file "mathomatic-res-")))
(with-temp-file tmp-file (insert result))
(org-babel-import-elisp-from-file tmp-file))))))
(defun org-babel-prep-session:mathomatic (session params)
(error "Mathomatic does not support sessions"))
(defun org-babel-mathomatic-var-to-mathomatic (pair)
"Convert an elisp val into a string of mathomatic code specifying a var
of the same value."
(let ((var (car pair))
(val (cdr pair)))
(when (symbolp val)
(setq val (symbol-name val))
(when (= (length val) 1)
(setq val (string-to-char val))))
(format "%s=%s" var
(org-babel-mathomatic-elisp-to-mathomatic val))))
(defun org-babel-mathomatic-graphical-output-file (params)
"Name of file to which mathomatic should send graphical output."
(and (member "graphics" (cdr (assq :result-params params)))
(cdr (assq :file params))))
(defun org-babel-mathomatic-elisp-to-mathomatic (val)
"Return a string of mathomatic code which evaluates to VAL."
(if (listp val)
(mapconcat #'org-babel-mathomatic-elisp-to-mathomatic val " ")
(format "%s" val)))
(provide 'ob-mathomatic)
;;; ob-mathomatic.el ends here

40
contrib/babel/langs/ob-oz.el → contrib/lisp/ob-oz.el
View File

@ -1,13 +1,13 @@
;;; ob-oz.el --- org-babel functions for Oz evaluation ;;; ob-oz.el --- Org-babel functions for Oz evaluation
;; Copyright (C) 2009-2013 Torsten Anders and Eric Schulte ;; Copyright (C) 2009-2013 Torsten Anders and Eric Schulte
;; Author: Torsten Anders and Eric Schulte ;; Author: Torsten Anders and Eric Schulte
;; Keywords: literate programming, reproducible research ;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org ;; Homepage: http://orgmode.org
;; Version: 0.02 ;; Version: 0.02
;;; License: ;; This file is not part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify ;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by ;; it under the terms of the GNU General Public License as published by
@ -26,7 +26,7 @@
;;; Commentary: ;;; Commentary:
;; Org-Babel support for evaluating Oz source code. ;; Org-Babel support for evaluating Oz source code.
;; ;;
;; Oz code is always send to the Oz Programming Environment (OPI), the ;; Oz code is always send to the Oz Programming Environment (OPI), the
;; Emacs mode and compiler interface for Oz programs. Therefore, only ;; Emacs mode and compiler interface for Oz programs. Therefore, only
@ -71,7 +71,7 @@
;; arrive then in any order) I could use IDs ;; arrive then in any order) I could use IDs
;; (e.g. integers). However, how do I do concurrency in Emacs Lisp, ;; (e.g. integers). However, how do I do concurrency in Emacs Lisp,
;; and how can I define org-babel-execute:oz concurrently. ;; and how can I define org-babel-execute:oz concurrently.
;; ;;
;; - Expressions are rarely used in Oz at the top-level, and using ;; - Expressions are rarely used in Oz at the top-level, and using
;; them in documentation and Literate Programs will cause ;; them in documentation and Literate Programs will cause
;; confusion. Idea: hide expression from reader and instead show ;; confusion. Idea: hide expression from reader and instead show
@ -94,10 +94,10 @@
;; ;;
;; Interface to communicate with Oz. ;; Interface to communicate with Oz.
;; (1) For statements without any results: oz-send-string ;; (1) For statements without any results: oz-send-string
;; (2) For expressions with a single result: oz-send-string-expression ;; (2) For expressions with a single result: oz-send-string-expression
;; (defined in org-babel-oz-ResultsValue.el) ;; (defined in org-babel-oz-ResultsValue.el)
;; ;;
;; oz-send-string-expression implements an additional very direct ;; oz-send-string-expression implements an additional very direct
;; communication between Org-babel and the Oz compiler. Communication ;; communication between Org-babel and the Oz compiler. Communication
@ -128,7 +128,7 @@
"Path to the contrib/scripts directory in which "Path to the contrib/scripts directory in which
StartOzServer.oz is located.") StartOzServer.oz is located.")
(defvar org-babel-oz-port 6001 (defvar org-babel-oz-port 6001
"Port for communicating with Oz compiler.") "Port for communicating with Oz compiler.")
(defvar org-babel-oz-OPI-socket nil (defvar org-babel-oz-OPI-socket nil
"Socket for communicating with OPI.") "Socket for communicating with OPI.")
@ -144,18 +144,18 @@ StartOzServer.oz is located.")
(defun org-babel-oz-create-socket () (defun org-babel-oz-create-socket ()
(message "Create OPI socket for evaluating expressions") (message "Create OPI socket for evaluating expressions")
;; Start Oz directly ;; Start Oz directly
(run-oz) (run-oz)
;; Create socket on Oz side (after Oz was started). ;; Create socket on Oz side (after Oz was started).
(oz-send-string (concat "\\insert '" org-babel-oz-server-dir "StartOzServer.oz'")) (oz-send-string (concat "\\insert '" org-babel-oz-server-dir "StartOzServer.oz'"))
;; Wait until socket is created before connecting to it. ;; Wait until socket is created before connecting to it.
;; Quick hack: wait 3 sec ;; Quick hack: wait 3 sec
;; ;;
;; extending time to 30 secs does not help when starting Emacs for ;; extending time to 30 secs does not help when starting Emacs for
;; the first time (and computer does nothing else) ;; the first time (and computer does nothing else)
(sit-for 3) (sit-for 3)
;; connect to OPI socket ;; connect to OPI socket
(setq org-babel-oz-OPI-socket (setq org-babel-oz-OPI-socket
;; Creates a socket. I/O interface of Emacs sockets as for processes. ;; Creates a socket. I/O interface of Emacs sockets as for processes.
(open-network-stream "*Org-babel-OPI-socket*" nil "localhost" org-babel-oz-port)) (open-network-stream "*Org-babel-OPI-socket*" nil "localhost" org-babel-oz-port))
;; install filter ;; install filter
@ -166,7 +166,7 @@ StartOzServer.oz is located.")
;; oz-send-string-expression turns is into synchronous... ;; oz-send-string-expression turns is into synchronous...
(defun oz-send-string-expression (string &optional wait-time) (defun oz-send-string-expression (string &optional wait-time)
"Similar to oz-send-string, oz-send-string-expression sends a string to the OPI compiler. However, string must be expression and this function returns the result of the expression (as string). oz-send-string-expression is synchronous, wait-time allows to specify a maximum wait time. After wait-time is over with no result, the function returns nil." "Similar to oz-send-string, oz-send-string-expression sends a string to the OPI compiler. However, string must be expression and this function returns the result of the expression (as string). oz-send-string-expression is synchronous, wait-time allows to specify a maximum wait time. After wait-time is over with no result, the function returns nil."
(if (not org-babel-oz-OPI-socket) (if (not org-babel-oz-OPI-socket)
(org-babel-oz-create-socket)) (org-babel-oz-create-socket))
(let ((polling-delay 0.1) (let ((polling-delay 0.1)
result) result)
@ -176,11 +176,11 @@ StartOzServer.oz is located.")
(let ((waited 0)) (let ((waited 0))
(unwind-protect (unwind-protect
(progn (progn
(while (while
;; stop loop if org-babel-oz-collected-result \= nil or waiting time is over ;; stop loop if org-babel-oz-collected-result \= nil or waiting time is over
(not (or (not (equal org-babel-oz-collected-result nil)) (not (or (not (equal org-babel-oz-collected-result nil))
(> waited wait-time))) (> waited wait-time)))
(progn (progn
(sit-for polling-delay) (sit-for polling-delay)
;; (message "org-babel-oz: next polling iteration") ;; (message "org-babel-oz: next polling iteration")
(setq waited (+ waited polling-delay)))) (setq waited (+ waited polling-delay))))
@ -253,7 +253,7 @@ called by `org-babel-execute-src-block' via multiple-value-bind."
;; (when vars ;; (when vars
;; (with-temp-buffer ;; (with-temp-buffer
;; (insert var-lines) (write-file vars-file) ;; (insert var-lines) (write-file vars-file)
;; (oz-mode) ;; (oz-mode)
;; ;; (inferior-oz-load-file) ; ?? ;; ;; (inferior-oz-load-file) ; ??
;; )) ;; ))
;; (current-buffer)))) ;; (current-buffer))))
@ -262,7 +262,7 @@ called by `org-babel-execute-src-block' via multiple-value-bind."
;; TODO: testing... (simplified version of def in org-babel-prep-session:ocaml) ;; TODO: testing... (simplified version of def in org-babel-prep-session:ocaml)
;; ;;
;; BUG: does not work yet. Error: ad-Orig-error: buffer none doesn't exist or has no process ;; BUG: does not work yet. Error: ad-Orig-error: buffer none doesn't exist or has no process
;; UNUSED DEF ;; UNUSED DEF
(defun org-babel-oz-initiate-session (&optional session params) (defun org-babel-oz-initiate-session (&optional session params)
"If there is not a current inferior-process-buffer in SESSION "If there is not a current inferior-process-buffer in SESSION
@ -278,12 +278,12 @@ then create. Return the initialized session."
specifying a var of the same value." specifying a var of the same value."
(if (listp var) (if (listp var)
;; (concat "[" (mapconcat #'org-babel-oz-var-to-oz var ", ") "]") ;; (concat "[" (mapconcat #'org-babel-oz-var-to-oz var ", ") "]")
(eval var) (eval var)
(format "%s" var) ; don't preserve string quotes. (format "%s" var) ; don't preserve string quotes.
;; (format "%s" var) ;; (format "%s" var)
)) ))
;; TODO: ;; TODO:
(defun org-babel-oz-table-or-string (results) (defun org-babel-oz-table-or-string (results)
"If the results look like a table, then convert them into an "If the results look like a table, then convert them into an
Emacs-lisp table, otherwise return the results as a string." Emacs-lisp table, otherwise return the results as a string."

128
contrib/lisp/ob-tcl.el Normal file
View File

@ -0,0 +1,128 @@
;;; ob-tcl.el --- Org-babel functions for tcl evaluation
;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
;; Authors: Dan Davison
;; Eric Schulte
;; Luis Anaya (tcl)
;;
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; 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 of the License, 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:
;; Org-Babel support for evaluating tcl source code.
;;; Code:
(require 'ob)
(require 'ob-eval)
(eval-when-compile (require 'cl))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("tcl" . "tcl"))
(defvar org-babel-default-header-args:tcl nil)
(defcustom org-babel-tcl-command "tclsh"
"Name of command to use for executing Tcl code."
:group 'org-babel
:type 'string)
(defun org-babel-execute:tcl (body params)
"Execute a block of Tcl code with Babel.
This function is called by `org-babel-execute-src-block'."
(let* ((session (cdr (assoc :session params)))
(result-params (cdr (assoc :result-params params)))
(result-type (cdr (assoc :result-type params)))
(full-body (org-babel-expand-body:generic
body params (org-babel-variable-assignments:tcl params)))
(session (org-babel-tcl-initiate-session session)))
(org-babel-reassemble-table
(org-babel-tcl-evaluate session full-body result-type)
(org-babel-pick-name
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
(defun org-babel-prep-session:tcl (session params)
"Prepare SESSION according to the header arguments in PARAMS."
(error "Sessions are not supported for Tcl."))
(defun org-babel-variable-assignments:tcl (params)
"Return list of tcl statements assigning the block's variables."
(mapcar
(lambda (pair)
(format "set %s %s"
(car pair)
(org-babel-tcl-var-to-tcl (cdr pair))))
(mapcar #'cdr (org-babel-get-header params :var))))
;; helper functions
(defun org-babel-tcl-var-to-tcl (var)
"Convert an elisp value to a tcl variable.
The elisp value, VAR, is converted to a string of tcl source code
specifying a var of the same value."
(if (listp var)
(concat "{" (mapconcat #'org-babel-tcl-var-to-tcl var " ") "}")
(format "%s" var)))
(defvar org-babel-tcl-buffers '(:default . nil))
(defun org-babel-tcl-initiate-session (&optional session params)
"Return nil because sessions are not supported by tcl."
nil)
(defvar org-babel-tcl-wrapper-method
"
proc main {} {
%s
}
set r [eval main]
set o [open \"%s\" \"w\"];
puts $o $r
flush $o
close $o
")
(defvar org-babel-tcl-pp-wrapper-method
nil)
(defun org-babel-tcl-evaluate (session body &optional result-type)
"Pass BODY to the Tcl process in SESSION.
If RESULT-TYPE equals 'output then return a list of the outputs
of the statements in BODY, if RESULT-TYPE equals 'value then
return the value of the last statement in BODY, as elisp."
(when session (error "Sessions are not supported for Tcl."))
(case result-type
(output (org-babel-eval org-babel-tcl-command body))
(value (let ((tmp-file (org-babel-temp-file "tcl-")))
(org-babel-eval
org-babel-tcl-command
(format org-babel-tcl-wrapper-method body
(org-babel-process-file-name tmp-file 'noquote)))
(org-babel-eval-read-file tmp-file)))))
(provide 'ob-tcl)
;;; ob-tcl.el ends here

8
contrib/lisp/org-bibtex-extras.el
View File

@ -9,12 +9,12 @@
;; This file is not yet part of GNU Emacs. ;; This file is not yet part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify ;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by ;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option) ;; the Free Software Foundation; either version 3, or (at your option)
;; any later version. ;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful, ;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details. ;; GNU General Public License for more details.
@ -78,7 +78,7 @@ For example, to point to your `obe-bibtex-file' use the following.
(find-file obe-bibtex-file) (find-file obe-bibtex-file)
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward " :CUSTOM_ID: \\(.+\\)$" nil t) (while (re-search-forward " :CUSTOM_ID: \\(.+\\)$" nil t)
(push (org-babel-clean-text-properties (match-string 1)) (push (org-no-properties (match-string 1))
obe-citations)) obe-citations))
obe-citations))) obe-citations)))
@ -111,7 +111,7 @@ For example, to point to your `obe-bibtex-file' use the following.
(when (obe-goto-citation citation) (when (obe-goto-citation citation)
(let ((pt (point))) (let ((pt (point)))
`((:authors . ,(split-string (org-entry-get pt "AUTHOR") " and " t)) `((:authors . ,(split-string (org-entry-get pt "AUTHOR") " and " t))
(:title . ,(org-babel-clean-text-properties (org-get-heading 1 1))) (:title . ,(org-no-properties (org-get-heading 1 1)))
(:journal . ,(org-entry-get pt "JOURNAL"))))))) (:journal . ,(org-entry-get pt "JOURNAL")))))))
(defun obe-meta-to-json (meta &optional fields) (defun obe-meta-to-json (meta &optional fields)

2
contrib/lisp/org-bookmark.el
View File

@ -12,7 +12,7 @@
;; the Free Software Foundation; either version 3, or (at your option) ;; the Free Software Foundation; either version 3, or (at your option)
;; any later version. ;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful, ;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details. ;; GNU General Public License for more details.

122
contrib/lisp/org-bullets.el Normal file
View File

@ -0,0 +1,122 @@
;;; org-bullets.el --- Show bullets in org-mode as UTF-8 characters
;; Version: 0.2.2
;; Author: sabof
;; URL: https://github.com/sabof/org-bullets
;; 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 this program ; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; The project is hosted at https://github.com/sabof/org-bullets
;; The latest version, and all the relevant information can be found there.
;;; Code:
(eval-when-compile (require 'cl))
(defgroup org-bullets nil
"Display bullets as UTF-8 characters."
:group 'org-appearance)
;; A nice collection of unicode bullets:
;; http://nadeausoftware.com/articles/2007/11/latency_friendly_customized_bullets_using_unicode_characters
(defcustom org-bullets-bullet-list
'(;;; Large
"◉"
"○"
"✸"
"✿"
;; ♥ ● ◇ ✚ ✜ ☯ ◆ ♠ ♣ ♦ ☢ ❀ ◆ ◖ ▶
;;; Small
;; ► • ★ ▸
)
"This variable contains the list of bullets.
It can contain any number of one-character strings.
For levels beyond the size of the list, the stars will be
displayed using the first items again."
:group 'org-bullets
:type '(repeat (string :tag "Bullet character")))
(defcustom org-bullets-face-name nil
"Allows to override `org-mode' bullets face.
If set to a name of a face, that face will be used.
Otherwise the face of the heading level will be used."
:group 'org-bullets
:type 'symbol)
(defvar org-bullets-bullet-map
'(keymap
(mouse-1 . org-cycle)
(mouse-2 . (lambda (e)
(interactive "e")
(mouse-set-point e)
(org-cycle))))
"Mouse events for bullets.
If this is undesirable, one can remove them with
\(setcdr org-bullets-bullet-map nil\)")
(defun org-bullets-level-char (level)
"Return a character corresponding to LEVEL."
(string-to-char
(nth (mod (1- level)
(length org-bullets-bullet-list))
org-bullets-bullet-list)))
;;;###autoload
(define-minor-mode org-bullets-mode
"UTF-8 bullets for `org-mode'."
nil nil nil
(let* ((keyword
`((,org-outline-regexp-bol
(0 (let (( level (- (match-end 0) (match-beginning 0) 1)))
(compose-region (- (match-end 0) 2)
(- (match-end 0) 1)
(org-bullets-level-char level))
(when (facep org-bullets-face-name)
(put-text-property (- (match-end 0) 2)
(- (match-end 0) 1)
'face
org-bullets-face-name))
(put-text-property (match-beginning 0)
(- (match-end 0) 2)
'face (list :foreground
(face-attribute
'default :background)))
(put-text-property (match-beginning 0)
(match-end 0)
'keymap
org-bullets-bullet-map)
nil))))))
(if org-bullets-mode
(progn (font-lock-add-keywords nil keyword)
(font-lock-fontify-buffer))
(save-excursion
(goto-char (point-min))
(font-lock-remove-keywords nil keyword)
(while (re-search-forward org-outline-regexp-bol nil t)
(decompose-region (match-beginning 0) (match-end 0)))
(font-lock-fontify-buffer)))))
(provide 'org-bullets)
;; Local Variables:
;; coding: utf-8-emacs
;; End:
;;; org-bullets.el ends here

5
contrib/lisp/org-checklist.el
View File

@ -6,6 +6,8 @@
;; Version: 1.0 ;; Version: 1.0
;; Keywords: org, checklists ;; Keywords: org, checklists
;; ;;
;; This file is not part of GNU Emacs.
;;
;; This program is free software; you can redistribute it and/or modify ;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by ;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option) ;; the Free Software Foundation; either version 3, or (at your option)
@ -17,8 +19,7 @@
;; GNU General Public License for more details. ;; GNU General Public License for more details.
;; ;;
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Commentary: ;;; Commentary:

712
contrib/lisp/org-choose.el
View File

@ -1,7 +1,5 @@
;;;_ org-choose.el --- decision management for org-mode ;;; org-choose.el --- decision management for org-mode
;;;_. Headers
;;;_ , License
;; Copyright (C) 2009-2013 Tom Breton (Tehom) ;; Copyright (C) 2009-2013 Tom Breton (Tehom)
;; This file is not part of GNU Emacs. ;; This file is not part of GNU Emacs.
@ -24,13 +22,13 @@
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA. ;; Boston, MA 02111-1307, USA.
;;;_ , Commentary: ;;; Commentary:
; This is code to support decision management. It lets you treat a ;; This is code to support decision management. It lets you treat a
; group of sibling items in org-mode as alternatives in a decision. ;; group of sibling items in org-mode as alternatives in a decision.
; There are no user commands in this file. You use it by: ;; There are no user commands in this file. You use it by:
; * Loading it (manually or by M-x customize-apropos org-modules) ;; * Loading it (manually or by M-x customize-apropos org-modules)
;; * Setting up at least one set of TODO keywords with the ;; * Setting up at least one set of TODO keywords with the
;; interpretation "choose" by either: ;; interpretation "choose" by either:
@ -61,31 +59,30 @@
;; * All the other TODO commands are available and behave essentially ;; * All the other TODO commands are available and behave essentially
;; the normal way. ;; the normal way.
;;; Requires
;;;_ , Requires
(require 'org) (require 'org)
;(eval-when-compile ;(eval-when-compile
; (require 'cl)) ; (require 'cl))
(require 'cl) (require 'cl)
;;;_. Body ;;; Body
;;;_ , The variables ;;; The variables
(defstruct (org-choose-mark-data. (:type list)) (defstruct (org-choose-mark-data. (:type list))
"The format of an entry in org-choose-mark-data. "The format of an entry in org-choose-mark-data.
Indexes are 0-based or `nil'. Indexes are 0-based or `nil'.
" "
keyword keyword
bot-lower-range bot-lower-range
top-upper-range top-upper-range
range-length range-length
static-default static-default
all-keywords) all-keywords)
(defvar org-choose-mark-data (defvar org-choose-mark-data
() ()
"Alist of information for choose marks. "Alist of information for choose marks.
Each entry is an `org-choose-mark-data.'" ) Each entry is an `org-choose-mark-data.'" )
(make-variable-buffer-local 'org-choose-mark-data) (make-variable-buffer-local 'org-choose-mark-data)
@ -93,426 +90,394 @@ Each entry is an `org-choose-mark-data.'" )
;;;_ . org-choose-filter-one ;;;_ . org-choose-filter-one
(defun org-choose-filter-one (i) (defun org-choose-filter-one (i)
"Return a list of "Return a list of
* a canonized version of the string * a canonized version of the string
* optionally one symbol" * optionally one symbol"
(if (if
(not (not
(string-match "(.*)" i)) (string-match "(.*)" i))
(list i i) (list i i)
(let* (let*
( (
(end-text (match-beginning 0)) (end-text (match-beginning 0))
(vanilla-text (substring i 0 end-text)) (vanilla-text (substring i 0 end-text))
;;Get the parenthesized part. ;;Get the parenthesized part.
(match (match-string 0 i)) (match (match-string 0 i))
;;Remove the parentheses. ;;Remove the parentheses.
(args (substring match 1 -1)) (args (substring match 1 -1))
;;Split it ;;Split it
(arglist (arglist
(let (let
((arglist-x (org-split-string args ","))) ((arglist-x (org-split-string args ",")))
;;When string starts with "," `split-string' doesn't ;;When string starts with "," `split-string' doesn't
;;make a first arg, so in that case make one ;;make a first arg, so in that case make one
;;manually. ;;manually.
(if (if
(string-match "^," args) (string-match "^," args)
(cons nil arglist-x) (cons nil arglist-x)
arglist-x))) arglist-x)))
(decision-arg (second arglist)) (decision-arg (second arglist))
(type (type
(cond (cond
((string= decision-arg "0") ((string= decision-arg "0")
'default-mark) 'default-mark)
((string= decision-arg "+") ((string= decision-arg "+")
'top-upper-range) 'top-upper-range)
((string= decision-arg "-") ((string= decision-arg "-")
'bot-lower-range) 'bot-lower-range)
(t nil))) (t nil)))
(vanilla-arg (first arglist)) (vanilla-arg (first arglist))
(vanilla-mark (vanilla-mark
(if vanilla-arg (if vanilla-arg
(concat vanilla-text "("vanilla-arg")") (concat vanilla-text "("vanilla-arg")")
vanilla-text))) vanilla-text)))
(if type (if type
(list vanilla-text vanilla-mark type) (list vanilla-text vanilla-mark type)
(list vanilla-text vanilla-mark))))) (list vanilla-text vanilla-mark)))))
;;;_ . org-choose-setup-vars ;;;_ . org-choose-setup-vars
(defun org-choose-setup-vars (bot-lower-range top-upper-range (defun org-choose-setup-vars (bot-lower-range top-upper-range
static-default num-items all-mark-texts) static-default num-items all-mark-texts)
"Add to org-choose-mark-data according to arguments" "Add to org-choose-mark-data according to arguments"
(let*
((tail
;;If there's no bot-lower-range or no default, we don't
;;have ranges.
(cdr
(if (and static-default bot-lower-range)
(let*
;;If there's no top-upper-range, use the last
;;item.
((top-upper-range
(or top-upper-range (1- num-items)))
(lower-range-length
(1+ (- static-default bot-lower-range)))
(upper-range-length
(- top-upper-range static-default))
(range-length
(min upper-range-length lower-range-length)))
(make-org-choose-mark-data.
:keyword nil
:bot-lower-range bot-lower-range
:top-upper-range top-upper-range
:range-length range-length
:static-default static-default
:all-keywords all-mark-texts))
(make-org-choose-mark-data.
:keyword nil
:bot-lower-range nil
:top-upper-range nil
:range-length nil
:static-default (or static-default 0)
:all-keywords all-mark-texts)))))
(dolist (text all-mark-texts)
(pushnew (cons text tail)
org-choose-mark-data
:test
#'(lambda (a b)
(equal (car a) (car b)))))))
(let* ;;; org-choose-filter-tail
(
(tail
;;If there's no bot-lower-range or no default, we don't
;;have ranges.
(cdr
(if (and static-default bot-lower-range)
(let*
(
;;If there's no top-upper-range, use the last
;;item.
(top-upper-range
(or top-upper-range (1- num-items)))
(lower-range-length
(1+ (- static-default bot-lower-range)))
(upper-range-length
(- top-upper-range static-default))
(range-length
(min upper-range-length lower-range-length)))
(make-org-choose-mark-data.
:keyword nil
:bot-lower-range bot-lower-range
:top-upper-range top-upper-range
:range-length range-length
:static-default static-default
:all-keywords all-mark-texts))
(make-org-choose-mark-data.
:keyword nil
:bot-lower-range nil
:top-upper-range nil
:range-length nil
:static-default (or static-default 0)
:all-keywords all-mark-texts)))))
(dolist (text all-mark-texts)
(pushnew (cons text tail)
org-choose-mark-data
:test
#'(lambda (a b)
(equal (car a) (car b)))))))
;;;_ . org-choose-filter-tail
(defun org-choose-filter-tail (raw) (defun org-choose-filter-tail (raw)
"Return a translation of RAW to vanilla and set appropriate "Return a translation of RAW to vanilla and set appropriate
buffer-local variables. buffer-local variables.
RAW is a list of strings representing the input text of a choose RAW is a list of strings representing the input text of a choose
interpretation." interpretation."
(let (let
((vanilla-list nil) ((vanilla-list nil)
(all-mark-texts nil) (all-mark-texts nil)
(index 0) (index 0)
bot-lower-range top-upper-range range-length static-default) bot-lower-range top-upper-range range-length static-default)
(dolist (i raw) (dolist (i raw)
(destructuring-bind (destructuring-bind
(vanilla-text vanilla-mark &optional type) (vanilla-text vanilla-mark &optional type)
(org-choose-filter-one i) (org-choose-filter-one i)
(cond (cond
((eq type 'bot-lower-range) ((eq type 'bot-lower-range)
(setq bot-lower-range index)) (setq bot-lower-range index))
((eq type 'top-upper-range) ((eq type 'top-upper-range)
(setq top-upper-range index)) (setq top-upper-range index))
((eq type 'default-mark) ((eq type 'default-mark)
(setq static-default index))) (setq static-default index)))
(incf index) (incf index)
(push vanilla-text all-mark-texts) (push vanilla-text all-mark-texts)
(push vanilla-mark vanilla-list))) (push vanilla-mark vanilla-list)))
(org-choose-setup-vars bot-lower-range top-upper-range (org-choose-setup-vars bot-lower-range top-upper-range
static-default index (reverse all-mark-texts)) static-default index (reverse all-mark-texts))
(nreverse vanilla-list))) (nreverse vanilla-list)))
;;;_ . org-choose-setup-filter ;;; org-choose-setup-filter
(defun org-choose-setup-filter (raw) (defun org-choose-setup-filter (raw)
"A setup filter for choose interpretations." "A setup filter for choose interpretations."
(when (eq (car raw) 'choose) (when (eq (car raw) 'choose)
(cons (cons
'choose 'choose
(org-choose-filter-tail (cdr raw))))) (org-choose-filter-tail (cdr raw)))))
;;;_ . org-choose-conform-after-promotion ;;; org-choose-conform-after-promotion
(defun org-choose-conform-after-promotion (entry-pos keywords highest-ok-ix) (defun org-choose-conform-after-promotion (entry-pos keywords highest-ok-ix)
"Conform the current item after another item was promoted" "Conform the current item after another item was promoted"
(unless
(unless
;;Skip the entry that triggered this by skipping any entry with ;;Skip the entry that triggered this by skipping any entry with
;;the same starting position. plist uses the start of the ;;the same starting position. plist uses the start of the
;;header line as the position, but map no longer does, so we ;;header line as the position, but map no longer does, so we
;;have to go back to the heading. ;;have to go back to the heading.
(= (=
(save-excursion (save-excursion
(org-back-to-heading) (org-back-to-heading)
(point)) (point))
entry-pos) entry-pos)
(let (let
((ix ((ix
(org-choose-get-entry-index keywords))) (org-choose-get-entry-index keywords)))
;;If the index of the entry exceeds the highest allowable ;;If the index of the entry exceeds the highest allowable
;;index, change it to that. ;;index, change it to that.
(when (and ix (when (and ix
(> ix highest-ok-ix)) (> ix highest-ok-ix))
(org-todo (org-todo
(nth highest-ok-ix keywords)))))) (nth highest-ok-ix keywords))))))
;;;_ . org-choose-conform-after-demotion ;;;_ . org-choose-conform-after-demotion
(defun org-choose-conform-after-demotion (entry-pos keywords (defun org-choose-conform-after-demotion (entry-pos keywords
raise-to-ix raise-to-ix
old-highest-ok-ix) old-highest-ok-ix)
"Conform the current item after another item was demoted." "Conform the current item after another item was demoted."
(unless
(unless
;;Skip the entry that triggered this. ;;Skip the entry that triggered this.
(= (=
(save-excursion (save-excursion
(org-back-to-heading) (org-back-to-heading)
(point)) (point))
entry-pos) entry-pos)
(let (let
((ix ((ix
(org-choose-get-entry-index keywords))) (org-choose-get-entry-index keywords)))
;;If the index of the entry was at or above the old allowable ;;If the index of the entry was at or above the old allowable
;;position, change it to the new mirror position if there is ;;position, change it to the new mirror position if there is
;;one. ;;one.
(when (and (when (and
ix ix
raise-to-ix raise-to-ix
(>= ix old-highest-ok-ix)) (>= ix old-highest-ok-ix))
(org-todo (org-todo
(nth raise-to-ix keywords)))))) (nth raise-to-ix keywords))))))
;;;_ , org-choose-keep-sensible (the org-trigger-hook function) ;;; org-choose-keep-sensible (the org-trigger-hook function)
(defun org-choose-keep-sensible (change-plist) (defun org-choose-keep-sensible (change-plist)
"Bring the other items back into a sensible state after an item's "Bring the other items back into a sensible state after an item's
setting was changed." setting was changed."
(let* (let*
( (from (plist-get change-plist :from)) ( (from (plist-get change-plist :from))
(to (plist-get change-plist :to)) (to (plist-get change-plist :to))
(entry-pos (entry-pos
(set-marker (set-marker
(make-marker) (make-marker)
(plist-get change-plist :position))) (plist-get change-plist :position)))
(kwd-data (kwd-data
(assoc to org-todo-kwd-alist))) (assoc to org-todo-kwd-alist)))
(when (when
(eq (nth 1 kwd-data) 'choose) (eq (nth 1 kwd-data) 'choose)
(let* (let*
( (
(data (data
(assoc to org-choose-mark-data)) (assoc to org-choose-mark-data))
(keywords (keywords
(org-choose-mark-data.-all-keywords data)) (org-choose-mark-data.-all-keywords data))
(old-index (old-index
(org-choose-get-index-in-keywords (org-choose-get-index-in-keywords
from from
keywords)) keywords))
(new-index (new-index
(org-choose-get-index-in-keywords (org-choose-get-index-in-keywords
to to
keywords)) keywords))
(highest-ok-ix (highest-ok-ix
(org-choose-highest-other-ok (org-choose-highest-other-ok
new-index new-index
data)) data))
(funcdata (funcdata
(cond (cond
;;The entry doesn't participate in conformance, ;;The entry doesn't participate in conformance,
;;so give `nil' which does nothing. ;;so give `nil' which does nothing.
((not highest-ok-ix) nil) ((not highest-ok-ix) nil)
;;The entry was created or promoted ;;The entry was created or promoted
((or ((or
(not old-index) (not old-index)
(> new-index old-index)) (> new-index old-index))
(list (list
#'org-choose-conform-after-promotion #'org-choose-conform-after-promotion
entry-pos keywords entry-pos keywords
highest-ok-ix)) highest-ok-ix))
(t ;;Otherwise the entry was demoted. (t ;;Otherwise the entry was demoted.
(let (let
( (
(raise-to-ix (raise-to-ix
(min (min
highest-ok-ix highest-ok-ix
(org-choose-mark-data.-static-default (org-choose-mark-data.-static-default
data))) data)))
(old-highest-ok-ix (old-highest-ok-ix
(org-choose-highest-other-ok (org-choose-highest-other-ok
old-index old-index
data))) data)))
(list
(list #'org-choose-conform-after-demotion
#'org-choose-conform-after-demotion entry-pos
entry-pos keywords
keywords raise-to-ix
raise-to-ix old-highest-ok-ix))))))
old-highest-ok-ix)))))) (if funcdata
;;The funny-looking names are to make variable capture
(if funcdata ;;unlikely. (Poor-man's lexical bindings).
;;The funny-looking names are to make variable capture (destructuring-bind (func-d473 . args-46k) funcdata
;;unlikely. (Poor-man's lexical bindings). (let
(destructuring-bind (func-d473 . args-46k) funcdata ((map-over-entries
(let (org-choose-get-fn-map-group))
((map-over-entries ;;We may call `org-todo', so let various hooks
(org-choose-get-fn-map-group)) ;;`nil' so we don't cause loops.
;;We may call `org-todo', so let various hooks org-after-todo-state-change-hook
;;`nil' so we don't cause loops. org-trigger-hook
org-after-todo-state-change-hook org-blocker-hook
org-trigger-hook org-todo-get-default-hook
org-blocker-hook ;;Also let this alist `nil' so we don't log
org-todo-get-default-hook ;;secondary transitions.
;;Also let this alist `nil' so we don't log org-todo-log-states)
;;secondary transitions. ;;Map over group
org-todo-log-states) (funcall map-over-entries
;;Map over group #'(lambda ()
(funcall map-over-entries
#'(lambda ()
(apply func-d473 args-46k)))))))) (apply func-d473 args-46k))))))))
;;Remove the marker
(set-marker entry-pos nil)))
;;Remove the marker ;;; Getting the default mark
(set-marker entry-pos nil))) ;;; org-choose-get-index-in-keywords
;;;_ , Getting the default mark
;;;_ . org-choose-get-index-in-keywords
(defun org-choose-get-index-in-keywords (ix all-keywords) (defun org-choose-get-index-in-keywords (ix all-keywords)
"Return the index of the current entry." "Return the index of the current entry."
(if ix
(if ix
(position ix all-keywords (position ix all-keywords
:test #'equal))) :test #'equal)))
;;;_ . org-choose-get-entry-index ;;; org-choose-get-entry-index
(defun org-choose-get-entry-index (all-keywords) (defun org-choose-get-entry-index (all-keywords)
"Return index of current entry." "Return index of current entry."
(let*
(let*
((state (org-entry-get (point) "TODO"))) ((state (org-entry-get (point) "TODO")))
(org-choose-get-index-in-keywords state all-keywords))) (org-choose-get-index-in-keywords state all-keywords)))
;;;_ . org-choose-get-fn-map-group ;;; org-choose-get-fn-map-group
(defun org-choose-get-fn-map-group () (defun org-choose-get-fn-map-group ()
"Return a function to map over the group" "Return a function to map over the group"
#'(lambda (fn)
(require 'org-agenda) ;; `org-map-entries' seems to need it.
(save-excursion
(unless (org-up-heading-safe)
(error "Choosing is only supported between siblings in a tree, not on top level"))
(let
((level (org-reduced-level (org-outline-level))))
(save-restriction
(org-map-entries
fn
(format "LEVEL=%d" level)
'tree))))))
#'(lambda (fn) ;;; org-choose-get-highest-mark-index
(require 'org-agenda) ;; `org-map-entries' seems to need it.
(save-excursion
(unless (org-up-heading-safe)
(error "Choosing is only supported between siblings in a tree, not on top level"))
(let
((level (org-reduced-level (org-outline-level))))
(save-restriction
(org-map-entries
fn
(format "LEVEL=%d" level)
'tree))))))
;;;_ . org-choose-get-highest-mark-index
(defun org-choose-get-highest-mark-index (keywords) (defun org-choose-get-highest-mark-index (keywords)
"Get the index of the highest current mark in the group. "Get the index of the highest current mark in the group.
If there is none, return 0" If there is none, return 0"
(let*
;;Func maps over applicable entries.
((map-over-entries
(org-choose-get-fn-map-group))
(indexes-list
(remove nil
(funcall map-over-entries
#'(lambda ()
(org-choose-get-entry-index keywords))))))
(if
indexes-list
(apply #'max indexes-list)
0)))
(let* ;;; org-choose-highest-ok
(
;;Func maps over applicable entries.
(map-over-entries
(org-choose-get-fn-map-group))
(indexes-list
(remove nil
(funcall map-over-entries
#'(lambda ()
(org-choose-get-entry-index keywords))))))
(if
indexes-list
(apply #'max indexes-list)
0)))
;;;_ . org-choose-highest-ok
(defun org-choose-highest-other-ok (ix data) (defun org-choose-highest-other-ok (ix data)
"Return the highest index that any choose mark can sensibly have, "Return the highest index that any choose mark can sensibly have,
given that another mark has index IX. given that another mark has index IX.
DATA must be a `org-choose-mark-data.'." DATA must be a `org-choose-mark-data.'."
(let
((bot-lower-range
(org-choose-mark-data.-bot-lower-range data))
(top-upper-range
(org-choose-mark-data.-top-upper-range data))
(range-length
(org-choose-mark-data.-range-length data)))
(when (and ix bot-lower-range)
(let*
((delta
(- top-upper-range ix)))
(unless
(< range-length delta)
(+ bot-lower-range delta))))))
(let ;;; org-choose-get-default-mark-index
(
(bot-lower-range
(org-choose-mark-data.-bot-lower-range data))
(top-upper-range
(org-choose-mark-data.-top-upper-range data))
(range-length
(org-choose-mark-data.-range-length data)))
(when (and ix bot-lower-range)
(let*
((delta
(- top-upper-range ix)))
(unless
(< range-length delta)
(+ bot-lower-range delta))))))
;;;_ . org-choose-get-default-mark-index
(defun org-choose-get-default-mark-index (data) (defun org-choose-get-default-mark-index (data)
"Return the index of the default mark in a choose interpretation. "Return the index of the default mark in a choose interpretation.
DATA must be a `org-choose-mark-data.'." DATA must be a `org-choose-mark-data.'."
(or
(let
((highest-mark-index
(org-choose-get-highest-mark-index
(org-choose-mark-data.-all-keywords data))))
(org-choose-highest-other-ok
highest-mark-index data))
(org-choose-mark-data.-static-default data)))
;;; org-choose-get-mark-N
(or
(let
((highest-mark-index
(org-choose-get-highest-mark-index
(org-choose-mark-data.-all-keywords data))))
(org-choose-highest-other-ok
highest-mark-index data))
(org-choose-mark-data.-static-default data)))
;;;_ . org-choose-get-mark-N
(defun org-choose-get-mark-N (n data) (defun org-choose-get-mark-N (n data)
"Get the text of the nth mark in a choose interpretation." "Get the text of the nth mark in a choose interpretation."
(let* (let*
((l (org-choose-mark-data.-all-keywords data))) ((l (org-choose-mark-data.-all-keywords data)))
(nth n l))) (nth n l)))
;;;_ . org-choose-get-default-mark ;;; org-choose-get-default-mark
(defun org-choose-get-default-mark (new-mark old-mark) (defun org-choose-get-default-mark (new-mark old-mark)
"Get the default mark IFF in a choose interpretation. "Get the default mark IFF in a choose interpretation.
NEW-MARK and OLD-MARK are the text of the new and old marks." NEW-MARK and OLD-MARK are the text of the new and old marks."
(let*
((old-kwd-data
(assoc old-mark org-todo-kwd-alist))
(new-kwd-data
(assoc new-mark org-todo-kwd-alist))
(becomes-choose
(and
(or
(not old-kwd-data)
(not
(eq (nth 1 old-kwd-data) 'choose)))
(eq (nth 1 new-kwd-data) 'choose))))
(when
becomes-choose
(let
((new-mark-data
(assoc new-mark org-choose-mark-data)))
(if
new-mark
(org-choose-get-mark-N
(org-choose-get-default-mark-index
new-mark-data)
new-mark-data)
(error "Somehow got an unrecognizable mark"))))))
(let* ;;; Setting it all up
(
(old-kwd-data
(assoc old-mark org-todo-kwd-alist))
(new-kwd-data
(assoc new-mark org-todo-kwd-alist))
(becomes-choose
(and
(or
(not old-kwd-data)
(not
(eq (nth 1 old-kwd-data) 'choose)))
(eq (nth 1 new-kwd-data) 'choose))))
(when
becomes-choose
(let
((new-mark-data
(assoc new-mark org-choose-mark-data)))
(if
new-mark
(org-choose-get-mark-N
(org-choose-get-default-mark-index
new-mark-data)
new-mark-data)
(error "Somehow got an unrecognizable mark"))))))
;;;_ , Setting it all up
(eval-after-load "org" (eval-after-load "org"
'(progn '(progn
@ -524,19 +489,8 @@ NEW-MARK and OLD-MARK are the text of the new and old marks."
#'org-choose-keep-sensible) #'org-choose-keep-sensible)
(add-to-list 'org-todo-interpretation-widgets (add-to-list 'org-todo-interpretation-widgets
'(:tag "Choose (to record decisions)" choose) '(:tag "Choose (to record decisions)" choose)
'append) 'append)))
))
;;;_. Footers
;;;_ , Provides
(provide 'org-choose) (provide 'org-choose)
;;;_ * Local emacs vars.
;;;_ + Local variables:
;;;_ + End:
;;;_ , End
;;; org-choose.el ends here ;;; org-choose.el ends here

4
contrib/lisp/org-collector.el
View File

@ -10,12 +10,12 @@
;; This file is not yet part of GNU Emacs. ;; This file is not yet part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify ;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by ;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option) ;; the Free Software Foundation; either version 3, or (at your option)
;; any later version. ;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful, ;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details. ;; GNU General Public License for more details.

15
lisp/org-colview-xemacs.el → contrib/lisp/org-colview-xemacs.el
View File

@ -9,18 +9,19 @@
;; ;;
;; This file is part of Org mode, it is not part of GNU Emacs. ;; This file is part of Org mode, it is not part of GNU Emacs.
;; ;;
;; You can redistribute it and/or modify it under the terms of the ;; This program is free software; you can redistribute it and/or modify
;; GNU General Public License as published by the Free Software ;; it under the terms of the GNU General Public License as published by
;; Foundation; either version 3, or (at your option) any later ;; the Free Software Foundation, either version 3 of the License, or
;; version. ;; (at your option) any later version.
;; This file is distributed in the hope that it will be useful, ;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details. ;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with this file; see the file COPYING. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;;; Commentary: ;;; Commentary:
@ -1553,7 +1554,7 @@ and tailing newline characters."
;; OK, the property is not defined. Use appointment duration? ;; OK, the property is not defined. Use appointment duration?
(when (and org-agenda-columns-add-appointments-to-effort-sum (when (and org-agenda-columns-add-appointments-to-effort-sum
(setq d (get-text-property (point) 'duration))) (setq d (get-text-property (point) 'duration)))
(setq d (org-minutes-to-hh:mm-string d)) (setq d (org-minutes-to-clocksum-string d))
(put-text-property 0 (length d) 'face 'org-warning d) (put-text-property 0 (length d) 'face 'org-warning d)
(push (cons org-effort-property d) p))) (push (cons org-effort-property d) p)))
(push (cons (org-current-line) p) cache)) (push (cons (org-current-line) p) cache))

561
contrib/lisp/org-contacts.el
View File

@ -7,12 +7,12 @@
;; ;;
;; This file is NOT part of GNU Emacs. ;; This file is NOT part of GNU Emacs.
;; ;;
;; GNU Emacs is free software: you can redistribute it and/or modify ;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by ;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or ;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version. ;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful, ;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details. ;; GNU General Public License for more details.
@ -39,18 +39,20 @@
(eval-when-compile (eval-when-compile
(require 'cl)) (require 'cl))
(eval-and-compile (require 'org)
(require 'org))
(require 'gnus-util) (require 'gnus-util)
(require 'gnus-art)
(require 'mail-utils)
(require 'org-agenda) (require 'org-agenda)
(require 'org-capture)
(defgroup org-contacts nil (defgroup org-contacts nil
"Options concerning contacts management." "Options about contacts management."
:group 'org) :group 'org)
(defcustom org-contacts-files nil (defcustom org-contacts-files nil
"List of Org files to use as contacts source. "List of Org files to use as contacts source.
If set to nil, all your Org files will be used." When set to nil, all your Org files will be used."
:type '(repeat file) :type '(repeat file)
:group 'org-contacts) :group 'org-contacts)
@ -59,6 +61,11 @@ If set to nil, all your Org files will be used."
:type 'string :type 'string
:group 'org-contacts) :group 'org-contacts)
(defcustom org-contacts-tel-property "PHONE"
"Name of the property for contact phone number."
:type 'string
:group 'org-contacts)
(defcustom org-contacts-address-property "ADDRESS" (defcustom org-contacts-address-property "ADDRESS"
"Name of the property for contact address." "Name of the property for contact address."
:type 'string :type 'string
@ -69,8 +76,20 @@ If set to nil, all your Org files will be used."
:type 'string :type 'string
:group 'org-contacts) :group 'org-contacts)
(defcustom org-contacts-note-property "NOTE"
"Name of the property for contact note."
:type 'string
:group 'org-contacts)
(defcustom org-contacts-alias-property "ALIAS"
"Name of the property for contact name alias."
:type 'string
:group 'org-contacts)
(defcustom org-contacts-birthday-format "Birthday: %l (%Y)" (defcustom org-contacts-birthday-format "Birthday: %l (%Y)"
"Format of the anniversary agenda entry. The following replacements are available: "Format of the anniversary agenda entry.
The following replacements are available:
%h - Heading name %h - Heading name
%l - Link to the heading %l - Link to the heading
@ -114,7 +133,13 @@ If set to nil, all your Org files will be used."
:type 'string :type 'string
:group 'org-contacts) :group 'org-contacts)
(defcustom org-contacts-matcher (concat org-contacts-email-property "<>\"\"") (defcustom org-contacts-matcher
(mapconcat 'identity (list org-contacts-email-property
org-contacts-alias-property
org-contacts-tel-property
org-contacts-address-property
org-contacts-birthday-property)
"<>\"\"|")
"Matching rule for finding heading that are contacts. "Matching rule for finding heading that are contacts.
This can be a tag name, or a property check." This can be a tag name, or a property check."
:type 'string :type 'string
@ -131,6 +156,24 @@ This overrides `org-email-link-description-format' if set."
:group 'org-contacts :group 'org-contacts
:type 'file) :type 'file)
(defcustom org-contacts-enable-completion t
"Enable or not the completion in `message-mode' with `org-contacts'."
:group 'org-contacts
:type 'boolean)
;; Decalre external functions and variables
(declare-function org-reverse-string "org")
(declare-function diary-ordinal-suffix "ext:diary-lib")
(declare-function wl-summary-message-number "ext:wl-summary")
(declare-function wl-address-header-extract-address "ext:wl-address")
(declare-function wl-address-header-extract-realname "ext:wl-address")
(declare-function erc-buffer-list "ext:erc")
(declare-function erc-get-channel-user-list "ext:erc")
(declare-function google-maps-static-show "ext:google-maps-static")
(declare-function elmo-message-field "ext:elmo-pipe")
(declare-function std11-narrow-to-header "ext:std11")
(declare-function std11-fetch-field "ext:std11")
(defvar org-contacts-keymap (defvar org-contacts-keymap
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
(define-key map "M" 'org-contacts-view-send-email) (define-key map "M" 'org-contacts-view-send-email)
@ -138,38 +181,66 @@ This overrides `org-email-link-description-format' if set."
map) map)
"The keymap used in `org-contacts' result list.") "The keymap used in `org-contacts' result list.")
(defvar org-contacts-db nil
"Org Contacts database.")
(defvar org-contacts-last-update nil
"Last time the Org Contacts database has been updated.")
(defun org-contacts-files () (defun org-contacts-files ()
"Return list of Org files to use for contact management." "Return list of Org files to use for contact management."
(or org-contacts-files (org-agenda-files t 'ifmode))) (or org-contacts-files (org-agenda-files t 'ifmode)))
(defun org-contacts-db-need-update-p ()
"Determine whether `org-contacts-db' needs to be refreshed."
(or (null org-contacts-last-update)
(org-find-if (lambda (file)
(or (time-less-p org-contacts-last-update
(elt (file-attributes file) 5))))
(org-contacts-files))))
(defun org-contacts-db ()
"Return the latest Org Contacts Database."
(let* (todo-only
(contacts-matcher
(cdr (org-make-tags-matcher org-contacts-matcher)))
markers result)
(when (org-contacts-db-need-update-p)
(message "Update Org Contacts Database")
(dolist (file (org-contacts-files))
(org-check-agenda-file file)
(with-current-buffer (org-get-agenda-file-buffer file)
(unless (eq major-mode 'org-mode)
(error "File %s is no in `org-mode'" file))
(org-scan-tags
'(add-to-list 'markers (set-marker (make-marker) (point)))
contacts-matcher
todo-only)))
(dolist (marker markers result)
(org-with-point-at marker
(add-to-list 'result
(list (org-get-heading t) marker (org-entry-properties marker 'all)))))
(setf org-contacts-db result
org-contacts-last-update (current-time)))
org-contacts-db))
(defun org-contacts-filter (&optional name-match tags-match) (defun org-contacts-filter (&optional name-match tags-match)
"Search for a contact maching NAME-MATCH and TAGS-MATCH. "Search for a contact maching NAME-MATCH and TAGS-MATCH.
If both match values are nil, return all contacts." If both match values are nil, return all contacts."
(let* (todo-only (if (and (null name-match)
(tags-matcher (null tags-match))
(if tags-match (org-contacts-db)
(cdr (org-make-tags-matcher tags-match)) (loop for contact in (org-contacts-db)
t)) if (or
(name-matcher (and name-match
(if name-match (org-string-match-p name-match
'(org-string-match-p name-match (org-get-heading t)) (first contact)))
t)) (and tags-match
(contacts-matcher (org-find-if (lambda (tag)
(cdr (org-make-tags-matcher org-contacts-matcher))) (org-string-match-p tags-match tag))
markers result) (org-split-string
(dolist (file (org-contacts-files)) (or (cdr (assoc-string "ALLTAGS" (caddr contact))) "") ":"))))
(org-check-agenda-file file) collect contact)))
(with-current-buffer (org-get-agenda-file-buffer file)
(unless (eq major-mode 'org-mode)
(error "File %s is no in `org-mode'" file))
(org-scan-tags
'(add-to-list 'markers (set-marker (make-marker) (point)))
`(and ,contacts-matcher ,tags-matcher ,name-matcher)
todo-only)))
(dolist (marker markers result)
(org-with-point-at marker
(add-to-list 'result
(list (org-get-heading t) marker (org-entry-properties marker 'all)))))))
(when (not (fboundp 'completion-table-case-fold)) (when (not (fboundp 'completion-table-case-fold))
;; That function is new in Emacs 24... ;; That function is new in Emacs 24...
@ -178,67 +249,256 @@ If both match values are nil, return all contacts."
(let ((completion-ignore-case (not dont-fold))) (let ((completion-ignore-case (not dont-fold)))
(complete-with-action action table string pred))))) (complete-with-action action table string pred)))))
(defun org-contacts-complete-name (&optional start) (defun org-contacts-try-completion-prefix (to-match collection &optional predicate)
"Complete text at START with a user name and email." "Custom implementation of `try-completion'.
(let* ((end (point)) This version works only with list and alist and it looks at all
(start (or start prefixes rather than just the beginning of the string."
(save-excursion (loop with regexp = (concat "\\b" (regexp-quote to-match))
(re-search-backward "\\(\\`\\|[\n:,]\\)[ \t]*") with ret = nil
(goto-char (match-end 0)) with ret-start = nil
(point)))) with ret-end = nil
(orig (buffer-substring start end))
(completion-ignore-case org-contacts-completion-ignore-case)
(group-completion-p (org-string-match-p (concat "^" org-contacts-group-prefix) orig))
(completion-list
(if group-completion-p
(mapcar (lambda (group) (propertize (concat org-contacts-group-prefix group) 'org-contacts-group group))
(org-uniquify
(loop for contact in (org-contacts-filter)
with group-list
nconc (org-split-string
(or (cdr (assoc-string "ALLTAGS" (caddr contact))) "") ":"))))
(loop for contact in (org-contacts-filter)
;; The contact name is always the car of the assoc-list
;; returned by `org-contacts-filter'.
for contact-name = (car contact)
;; Build the list of the user email addresses.
for email-list = (split-string (or
(cdr (assoc-string org-contacts-email-property (caddr contact)))
""))
;; If the user has email addresses…
if email-list
;; … append a list of USER <EMAIL>.
nconc (loop for email in email-list
collect (org-contacts-format-email contact-name email)))))
(completion-list (all-completions orig completion-list)))
;; If we are completing a group, and that's the only group, just return
;; the real result.
(when (and group-completion-p
(= (length completion-list) 1))
(setq completion-list
(list (concat (car completion-list) ";: "
(mapconcat 'identity
(loop for contact in (org-contacts-filter
nil
(get-text-property 0 'org-contacts-group (car completion-list)))
;; The contact name is always the car of the assoc-list
;; returned by `org-contacts-filter'.
for contact-name = (car contact)
;; Grab the first email of the contact
for email = (car (split-string (or
(cdr (assoc-string org-contacts-email-property (caddr contact)))
"")))
;; If the user has an email address, append USER <EMAIL>.
if email collect (org-contacts-format-email contact-name email))
", ")))))
(list start end (completion-table-case-fold completion-list (not org-contacts-completion-ignore-case)))))
(defun org-contacts-message-complete-function () for el in collection
for string = (if (listp el) (car el) el)
for start = (when (or (null predicate) (funcall predicate string))
(string-match regexp string))
if start
do (let ((end (match-end 0))
(len (length string)))
(if (= end len)
(return t)
(destructuring-bind (string start end)
(if (null ret)
(values string start end)
(org-contacts-common-substring
ret ret-start ret-end
string start end))
(setf ret string
ret-start start
ret-end end))))
finally (return
(replace-regexp-in-string "\\`[ \t\n]*" "" ret))))
(defun org-contacts-compare-strings (s1 start1 end1 s2 start2 end2 &optional ignore-case)
"Compare the contents of two strings, using `compare-strings'.
This function works like `compare-strings' excepted that it
returns a cons.
- The CAR is the number of characters that match at the beginning.
- The CDR is T is the two strings are the same and NIL otherwise."
(let ((ret (compare-strings s1 start1 end1 s2 start2 end2 ignore-case)))
(if (eq ret t)
(cons (or end1 (length s1)) t)
(cons (1- (abs ret)) nil))))
(defun org-contacts-common-substring (s1 start1 end1 s2 start2 end2)
"Extract the common substring between S1 and S2.
This function extracts the common substring between S1 and S2 and
adjust the part that remains common.
START1 and END1 delimit the part in S1 that we know is common
between the two strings. This applies to START2 and END2 for S2.
This function returns a list whose contains:
- The common substring found.
- The new value of the start of the known inner substring.
- The new value of the end of the known inner substring."
;; Given two strings:
;; s1: "foo bar baz"
;; s2: "fooo bar baz"
;; and the inner substring is "bar"
;; then: start1 = 4, end1 = 6, start2 = 5, end2 = 7
;;
;; To find the common substring we will compare two substrings:
;; " oof" and " ooof" to find the beginning of the common substring.
;; " baz" and " baz" to find the end of the common substring.
(let* ((len1 (length s1))
(start1 (or start1 0))
(end1 (or end1 len1))
(len2 (length s2))
(start2 (or start2 0))
(end2 (or end2 len2))
(new-start (car (org-contacts-compare-strings
(substring (org-reverse-string s1) (- len1 start1)) nil nil
(substring (org-reverse-string s2) (- len2 start2)) nil nil)))
(new-end (+ end1 (car (org-contacts-compare-strings
(substring s1 end1) nil nil
(substring s2 end2) nil nil)))))
(list (substring s1 (- start1 new-start) new-end)
new-start
(+ new-start (- end1 start1)))))
(defun org-contacts-all-completions-prefix (to-match collection &optional predicate)
"Custom version of `all-completions'.
This version works only with list and alist and it looks at all
prefixes rather than just the beginning of the string."
(loop with regexp = (concat "\\b" (regexp-quote to-match))
for el in collection
for string = (if (listp el) (car el) el)
for match? = (when (and (or (null predicate) (funcall predicate string)))
(string-match regexp string))
if match?
collect (progn
(let ((end (match-end 0)))
(org-no-properties string)
(when (< end (length string))
;; Here we add a text property that will be used
;; later to highlight the character right after
;; the common part between each addresses.
;; See `org-contacts-display-sort-function'.
(put-text-property end (1+ end) 'org-contacts-prefix 't string)))
string)))
(defun org-contacts-make-collection-prefix (collection)
"Make a collection function from COLLECTION which will match on prefixes."
(lexical-let ((collection collection))
(lambda (string predicate flag)
(cond ((eq flag nil)
(org-contacts-try-completion-prefix string collection predicate))
((eq flag t)
;; `org-contacts-all-completions-prefix' has already been
;; used to compute `all-completions'.
collection)
((eq flag 'lambda)
(org-contacts-test-completion-prefix string collection predicate))
((and (listp flag) (eq (car flag) 'boundaries))
(destructuring-bind (to-ignore &rest suffix)
flag
(org-contacts-boundaries-prefix string collection predicate suffix)))
((eq flag 'metadata)
(org-contacts-metadata-prefix string collection predicate))
(t nil ; operation unsupported
)))))
(defun org-contacts-display-sort-function (completions)
"Sort function for contacts display."
(mapcar (lambda (string)
(loop with len = (1- (length string))
for i upfrom 0 to len
if (memq 'org-contacts-prefix
(text-properties-at i string))
do (set-text-properties
i (1+ i)
(list 'font-lock-face
(if (char-equal (aref string i)
(string-to-char " "))
;; Spaces can't be bold.
'underline
'bold)) string)
else
do (set-text-properties i (1+ i) nil string)
finally (return string)))
completions))
(defun org-contacts-test-completion-prefix (string collection predicate)
;; Prevents `org-find-if' from redefining `predicate' and going into
;; an infinite loop.
(lexical-let ((predicate predicate))
(org-find-if (lambda (el)
(and (or (null predicate) (funcall predicate el))
(string= string el)))
collection)))
(defun org-contacts-boundaries-prefix (string collection predicate suffix)
(list* 'boundaries (completion-boundaries string collection predicate suffix)))
(defun org-contacts-metadata-prefix (string collection predicate)
'(metadata .
((display-sort-function . org-contacts-display-sort-function))))
(defun org-contacts-complete-group (start end string)
"Complete text at START from a group.
A group FOO is composed of contacts with the tag FOO."
(let* ((completion-ignore-case org-contacts-completion-ignore-case)
(group-completion-p (org-string-match-p
(concat "^" org-contacts-group-prefix) string)))
(when group-completion-p
(let ((completion-list
(all-completions
string
(mapcar (lambda (group)
(propertize (concat org-contacts-group-prefix group)
'org-contacts-group group))
(org-uniquify
(loop for contact in (org-contacts-filter)
nconc (org-split-string
(or (cdr (assoc-string "ALLTAGS" (caddr contact))) "") ":")))))))
(list start end
(if (= (length completion-list) 1)
;; We've foudn the correct group, returns the address
(lexical-let ((tag (get-text-property 0 'org-contacts-group
(car completion-list))))
(lambda (string pred &optional to-ignore)
(mapconcat 'identity
(loop for contact in (org-contacts-filter
nil
tag)
;; The contact name is always the car of the assoc-list
;; returned by `org-contacts-filter'.
for contact-name = (car contact)
;; Grab the first email of the contact
for email = (car (split-string
(or
(cdr (assoc-string org-contacts-email-property
(caddr contact)))
"")))
;; If the user has an email address, append USER <EMAIL>.
if email collect (org-contacts-format-email contact-name email))
", ")))
;; We haven't found the correct group
(completion-table-case-fold completion-list
(not org-contacts-completion-ignore-case))))))))
(defun org-contacts-complete-name (start end string)
"Complete text at START with a user name and email."
(let* ((completion-ignore-case org-contacts-completion-ignore-case)
(completion-list
(loop for contact in (org-contacts-filter)
;; The contact name is always the car of the assoc-list
;; returned by `org-contacts-filter'.
for contact-name = (car contact)
;; Build the list of the user email addresses.
for email-list = (split-string (or
(cdr (assoc-string org-contacts-email-property
(caddr contact))) ""))
;; If the user has email addresses…
if email-list
;; … append a list of USER <EMAIL>.
nconc (loop for email in email-list
collect (org-contacts-format-email contact-name email))))
(completion-list (org-contacts-all-completions-prefix
string
(org-uniquify completion-list))))
(when completion-list
(list start end
(org-contacts-make-collection-prefix completion-list)))))
(defun org-contacts-message-complete-function (&optional start)
"Function used in `completion-at-point-functions' in `message-mode'." "Function used in `completion-at-point-functions' in `message-mode'."
;; Avoid to complete in `post-command-hook'.
(when completion-in-region-mode
(remove-hook 'post-command-hook #'completion-in-region--postch))
(let ((mail-abbrev-mode-regexp (let ((mail-abbrev-mode-regexp
"^\\(Resent-To\\|To\\|B?Cc\\|Reply-To\\|From\\|Mail-Followup-To\\|Mail-Copies-To\\|Disposition-Notification-To\\|Return-Receipt-To\\):")) "^\\(Resent-To\\|To\\|B?Cc\\|Reply-To\\|From\\|Mail-Followup-To\\|Mail-Copies-To\\|Disposition-Notification-To\\|Return-Receipt-To\\):"))
(when (mail-abbrev-in-expansion-header-p) (when (mail-abbrev-in-expansion-header-p)
(org-contacts-complete-name)))) (lexical-let*
((end (point))
(start (or start
(save-excursion
(re-search-backward "\\(\\`\\|[\n:,]\\)[ \t]*")
(goto-char (match-end 0))
(point))))
(string (buffer-substring start end)))
(or (org-contacts-complete-group start end string)
(org-contacts-complete-name start end string))))))
(defun org-contacts-gnus-get-name-email () (defun org-contacts-gnus-get-name-email ()
"Get name and email address from Gnus message." "Get name and email address from Gnus message."
@ -273,6 +533,7 @@ If both match values are nil, return all contacts."
;; show the next heading ;; show the next heading
(org-flag-heading nil))))))) (org-flag-heading nil)))))))
(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el
(defun org-contacts-anniversaries (&optional field format) (defun org-contacts-anniversaries (&optional field format)
"Compute FIELD anniversary for each contact, returning FORMAT. "Compute FIELD anniversary for each contact, returning FORMAT.
Default FIELD value is \"BIRTHDAY\". Default FIELD value is \"BIRTHDAY\".
@ -343,6 +604,7 @@ This function should be called from `gnus-article-prepare-hook'."
(org-set-property org-contacts-last-read-mail-property link))))))) (org-set-property org-contacts-last-read-mail-property link)))))))
(defun org-contacts-icon-as-string () (defun org-contacts-icon-as-string ()
"Return the contact icon as a string."
(let ((image (org-contacts-get-icon))) (let ((image (org-contacts-get-icon)))
(concat (concat
(propertize "-" 'display (propertize "-" 'display
@ -360,9 +622,9 @@ This function should be called from `gnus-article-prepare-hook'."
(let ((org-agenda-files (org-contacts-files)) (let ((org-agenda-files (org-contacts-files))
(org-agenda-skip-function (org-agenda-skip-function
(lambda () (org-agenda-skip-if nil `(notregexp ,name)))) (lambda () (org-agenda-skip-if nil `(notregexp ,name))))
(org-agenda-format (propertize (org-agenda-prefix-format (propertize
"%(org-contacts-icon-as-string)% p% s%(org-contacts-irc-number-of-unread-messages)%+T" "%(org-contacts-icon-as-string)% s%(org-contacts-irc-number-of-unread-messages) "
'keymap org-contacts-keymap)) 'keymap org-contacts-keymap))
(org-agenda-overriding-header (org-agenda-overriding-header
(or org-agenda-overriding-header (or org-agenda-overriding-header
(concat "List of contacts matching `" name "':")))) (concat "List of contacts matching `" name "':"))))
@ -379,12 +641,17 @@ This function should be called from `gnus-article-prepare-hook'."
(org-completing-read (org-completing-read
prompt (org-contacts-filter) predicate t initial-input hist def inherit-input-method)) prompt (org-contacts-filter) predicate t initial-input hist def inherit-input-method))
(defun org-contacts-format-name (name)
"Trim any local formatting to get a bare NAME."
;; Remove radio targets characters
(replace-regexp-in-string org-radio-target-regexp "\\1" name))
(defun org-contacts-format-email (name email) (defun org-contacts-format-email (name email)
"Format a mail address." "Format an EMAIL address corresponding to NAME."
(unless email (unless email
(error "`email' cannot be nul")) (error "`email' cannot be nul"))
(if name (if name
(concat name " <" email ">") (concat (org-contacts-format-name name) " <" email ">")
email)) email))
(defun org-contacts-check-mail-address (mail) (defun org-contacts-check-mail-address (mail)
@ -407,7 +674,7 @@ This function should be called from `gnus-article-prepare-hook'."
"Add some hooks for Gnus user. "Add some hooks for Gnus user.
This adds `org-contacts-gnus-check-mail-address' and This adds `org-contacts-gnus-check-mail-address' and
`org-contacts-gnus-store-last-mail' to `org-contacts-gnus-store-last-mail' to
`gnus-article-prepare-hook'. It also adds a binding on `;' in `gnus-article-prepare-hook'. It also adds a binding on `;' in
`gnus-summary-mode-map' to `org-contacts-gnus-article-from-goto'" `gnus-summary-mode-map' to `org-contacts-gnus-article-from-goto'"
(require 'gnus) (require 'gnus)
(require 'gnus-art) (require 'gnus-art)
@ -415,7 +682,8 @@ This adds `org-contacts-gnus-check-mail-address' and
(add-hook 'gnus-article-prepare-hook 'org-contacts-gnus-check-mail-address) (add-hook 'gnus-article-prepare-hook 'org-contacts-gnus-check-mail-address)
(add-hook 'gnus-article-prepare-hook 'org-contacts-gnus-store-last-mail)) (add-hook 'gnus-article-prepare-hook 'org-contacts-gnus-store-last-mail))
(when (boundp 'completion-at-point-functions) (when (and org-contacts-enable-completion
(boundp 'completion-at-point-functions))
(add-hook 'message-mode-hook (add-hook 'message-mode-hook
(lambda () (lambda ()
(add-to-list 'completion-at-point-functions (add-to-list 'completion-at-point-functions
@ -427,18 +695,19 @@ Works from wl-summary-mode and mime-view-mode - that is while viewing email.
Depends on Wanderlust been loaded." Depends on Wanderlust been loaded."
(with-current-buffer (org-capture-get :original-buffer) (with-current-buffer (org-capture-get :original-buffer)
(cond (cond
((eq major-mode 'wl-summary-mode) (when wl-summary-buffer-elmo-folder ((eq major-mode 'wl-summary-mode) (when (and (boundp 'wl-summary-buffer-elmo-folder)
wl-summary-buffer-elmo-folder)
(elmo-message-field (elmo-message-field
wl-summary-buffer-elmo-folder wl-summary-buffer-elmo-folder
(wl-summary-message-number) (wl-summary-message-number)
'from))) 'from)))
((eq major-mode 'mime-view-mode) (std11-narrow-to-header) ((eq major-mode 'mime-view-mode) (std11-narrow-to-header)
(prog1 (prog1
(std11-fetch-field "From") (std11-fetch-field "From")
(widen)))))) (widen))))))
(defun org-contacts-wl-get-name-email () (defun org-contacts-wl-get-name-email ()
"Get name and email address from wanderlust email. "Get name and email address from Wanderlust email.
See `org-contacts-wl-get-from-header-content' for limitations." See `org-contacts-wl-get-from-header-content' for limitations."
(let ((from (org-contacts-wl-get-from-header-content))) (let ((from (org-contacts-wl-get-from-header-content)))
(when from (when from
@ -447,13 +716,14 @@ See `org-contacts-wl-get-from-header-content' for limitations."
(defun org-contacts-template-wl-name (&optional return-value) (defun org-contacts-template-wl-name (&optional return-value)
"Try to return the contact name for a template from wl. "Try to return the contact name for a template from wl.
If not found return RETURN-VALUE or something that would ask the user." If not found, return RETURN-VALUE or something that would ask the
user."
(or (car (org-contacts-wl-get-name-email)) (or (car (org-contacts-wl-get-name-email))
return-value return-value
"%^{Name}")) "%^{Name}"))
(defun org-contacts-template-wl-email (&optional return-value) (defun org-contacts-template-wl-email (&optional return-value)
"Try to return the contact email for a template from wl. "Try to return the contact email for a template from Wanderlust.
If not found return RETURN-VALUE or something that would ask the user." If not found return RETURN-VALUE or something that would ask the user."
(or (cadr (org-contacts-wl-get-name-email)) (or (cadr (org-contacts-wl-get-name-email))
return-value return-value
@ -461,7 +731,8 @@ If not found return RETURN-VALUE or something that would ask the user."
(defun org-contacts-view-send-email (&optional ask) (defun org-contacts-view-send-email (&optional ask)
"Send email to the contact at point. "Send email to the contact at point.
If ASK is set, ask for the email address even if there's only one address." If ASK is set, ask for the email address even if there's only one
address."
(interactive "P") (interactive "P")
(let ((marker (org-get-at-bol 'org-hd-marker))) (let ((marker (org-get-at-bol 'org-hd-marker)))
(org-with-point-at marker (org-with-point-at marker
@ -537,24 +808,31 @@ If ASK is set, ask for the email address even if there's only one address."
(defun erc-nicknames-list () (defun erc-nicknames-list ()
"Return all nicknames of all ERC buffers." "Return all nicknames of all ERC buffers."
(if (fboundp 'erc-buffer-list) (loop for buffer in (erc-buffer-list)
(loop for buffer in (erc-buffer-list) nconc (with-current-buffer buffer
nconc (with-current-buffer buffer (loop for user-entry in (mapcar 'car (erc-get-channel-user-list))
(loop for user-entry in (mapcar 'car (erc-get-channel-user-list)) collect (elt user-entry 1)))))
collect (elt user-entry 1))))))
(add-to-list 'org-property-set-functions-alist (add-to-list 'org-property-set-functions-alist
`(,org-contacts-nickname-property . org-contacts-completing-read-nickname)) `(,org-contacts-nickname-property . org-contacts-completing-read-nickname))
(defun org-contacts-vcard-escape (str) (defun org-contacts-vcard-escape (str)
"Escape ; , and \n in STR for use in the VCard format. "Escape ; , and \n in STR for the VCard format."
Thanks to http://www.emacswiki.org/cgi-bin/wiki/bbdb-vcard-export.el for the regexp." ;; Thanks to this library for the regexp:
;; http://www.emacswiki.org/cgi-bin/wiki/bbdb-vcard-export.el
(when str (when str
(replace-regexp-in-string "\n" "\\\\n" (replace-regexp-in-string "\\(;\\|,\\|\\\\\\)" "\\\\\\1" str)))) (replace-regexp-in-string
"\n" "\\\\n"
(replace-regexp-in-string "\\(;\\|,\\|\\\\\\)" "\\\\\\1" str))))
(defun org-contacts-vcard-encode-name (name) (defun org-contacts-vcard-encode-name (name)
"Try to encode NAME as VCard's N property. The N property expects FamilyName;GivenName;AdditionalNames;Prefix;Postfix. "Try to encode NAME as VCard's N property.
Org-contacts does not specify how to encode the name. So we try to do our best." The N property expects
FamilyName;GivenName;AdditionalNames;Prefix;Postfix.
Org-contacts does not specify how to encode the name. So we try
to do our best."
(concat (replace-regexp-in-string "\\(\\w+\\) \\(.*\\)" "\\2;\\1" name) ";;;")) (concat (replace-regexp-in-string "\\(\\w+\\) \\(.*\\)" "\\2;\\1" name) ";;;"))
(defun org-contacts-vcard-format (contact) (defun org-contacts-vcard-format (contact)
@ -562,16 +840,30 @@ Org-contacts does not specify how to encode the name. So we try to do our best."
(let* ((properties (caddr contact)) (let* ((properties (caddr contact))
(name (org-contacts-vcard-escape (car contact))) (name (org-contacts-vcard-escape (car contact)))
(n (org-contacts-vcard-encode-name name)) (n (org-contacts-vcard-encode-name name))
(email (org-contacts-vcard-escape (cdr (assoc-string org-contacts-email-property properties)))) (email (cdr (assoc-string org-contacts-email-property properties)))
(tel (cdr (assoc-string org-contacts-tel-property properties)))
(note (cdr (assoc-string org-contacts-note-property properties)))
(bday (org-contacts-vcard-escape (cdr (assoc-string org-contacts-birthday-property properties)))) (bday (org-contacts-vcard-escape (cdr (assoc-string org-contacts-birthday-property properties))))
(addr (cdr (assoc-string org-contacts-address-property properties))) (addr (cdr (assoc-string org-contacts-address-property properties)))
(nick (org-contacts-vcard-escape (cdr (assoc-string org-contacts-nickname-property properties)))) (nick (org-contacts-vcard-escape (cdr (assoc-string org-contacts-nickname-property properties))))
(head (format "BEGIN:VCARD\nVERSION:3.0\nN:%s\nFN:%s\n" n name))) (head (format "BEGIN:VCARD\nVERSION:3.0\nN:%s\nFN:%s\n" n name)))
(concat head (concat head
(when email (format "EMAIL:%s\n" email)) (when email (progn
(setq emails-list (split-string email "[,;: ]+"))
(setq result "")
(while emails-list
(setq result (concat result "EMAIL:" (car emails-list) "\n"))
(setq emails-list (cdr emails-list)))
result))
(when addr (when addr
(format "ADR:;;%s\n" (replace-regexp-in-string "\\, ?" ";" addr))) (format "ADR:;;%s\n" (replace-regexp-in-string "\\, ?" ";" addr)))
(when tel (progn
(setq phones-list (split-string tel "[,;: ]+"))
(setq result "")
(while phones-list
(setq result (concat result "TEL:" (car phones-list) "\n"))
(setq phones-list (cdr phones-list)))
result))
(when bday (when bday
(let ((cal-bday (calendar-gregorian-from-absolute (org-time-string-to-absolute bday)))) (let ((cal-bday (calendar-gregorian-from-absolute (org-time-string-to-absolute bday))))
(format "BDAY:%04d-%02d-%02d\n" (format "BDAY:%04d-%02d-%02d\n"
@ -579,44 +871,47 @@ Org-contacts does not specify how to encode the name. So we try to do our best."
(calendar-extract-month cal-bday) (calendar-extract-month cal-bday)
(calendar-extract-day cal-bday)))) (calendar-extract-day cal-bday))))
(when nick (format "NICKNAME:%s\n" nick)) (when nick (format "NICKNAME:%s\n" nick))
(when note (format "NOTE:%s\n" note))
"END:VCARD\n\n"))) "END:VCARD\n\n")))
(defun org-contacts-export-as-vcard (&optional name file to-buffer) (defun org-contacts-export-as-vcard (&optional name file to-buffer)
"Export all contacts matching NAME as VCard 3.0. It TO-BUFFER is nil, the content is written to FILE or `org-contacts-vcard-file'. If TO-BUFFER is non-nil, the buffer is created and the VCard is written into that buffer." "Export all contacts matching NAME as VCard 3.0.
If TO-BUFFER is nil, the content is written to FILE or
`org-contacts-vcard-file'. If TO-BUFFER is non-nil, the buffer
is created and the VCard is written into that buffer."
(interactive) ; TODO ask for name? (interactive) ; TODO ask for name?
(let* ((filename (or file org-contacts-vcard-file)) (let* ((filename (or file org-contacts-vcard-file))
(buffer (if to-buffer (buffer (if to-buffer
(get-buffer-create to-buffer) (get-buffer-create to-buffer)
(find-file-noselect filename)))) (find-file-noselect filename))))
(message "Exporting...") (message "Exporting...")
(set-buffer buffer) (set-buffer buffer)
(let ((inhibit-read-only t)) (erase-buffer)) (let ((inhibit-read-only t)) (erase-buffer))
(fundamental-mode) (fundamental-mode)
(org-install-letbind)
(when (fboundp 'set-buffer-file-coding-system) (when (fboundp 'set-buffer-file-coding-system)
(set-buffer-file-coding-system coding-system-for-write)) (set-buffer-file-coding-system coding-system-for-write))
(loop for contact in (org-contacts-filter name) (loop for contact in (org-contacts-filter name)
do (insert (org-contacts-vcard-format contact))) do (insert (org-contacts-vcard-format contact)))
(if to-buffer (if to-buffer
(current-buffer) (current-buffer)
(progn (save-buffer) (kill-buffer))))) (progn (save-buffer) (kill-buffer)))))
(defun org-contacts-show-map (&optional name) (defun org-contacts-show-map (&optional name)
"Show contacts on a map. Requires google-maps-el." "Show contacts on a map.
Requires google-maps-el."
(interactive) (interactive)
(unless (fboundp 'google-maps-static-show) (unless (fboundp 'google-maps-static-show)
(error "`org-contacts-show-map' requires `google-maps-el'")) (error "`org-contacts-show-map' requires `google-maps-el'"))
(google-maps-static-show (google-maps-static-show
:markers :markers
(loop (loop
for contact in (org-contacts-filter name) for contact in (org-contacts-filter name)
for addr = (cdr (assoc-string org-contacts-address-property (caddr contact))) for addr = (cdr (assoc-string org-contacts-address-property (caddr contact)))
if addr if addr
collect (cons (list addr) (list :label (string-to-char (car contact))))))) collect (cons (list addr) (list :label (string-to-char (car contact)))))))
(provide 'org-contacts) (provide 'org-contacts)
(provide 'org-contacts)
;;; org-contacts.el ends here

4
contrib/lisp/org-contribdir.el
View File

@ -8,12 +8,12 @@
;; ;;
;; This file is not yet part of GNU Emacs. ;; This file is not yet part of GNU Emacs.
;; ;;
;; GNU Emacs is free software; you can redistribute it and/or modify ;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by ;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option) ;; the Free Software Foundation; either version 3, or (at your option)
;; any later version. ;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful, ;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details. ;; GNU General Public License for more details.

6
contrib/lisp/org-depend.el
View File

@ -13,15 +13,13 @@
;; the Free Software Foundation; either version 3, or (at your option) ;; the Free Software Foundation; either version 3, or (at your option)
;; any later version. ;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful, ;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details. ;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;;; Commentary: ;;; Commentary:

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

File diff suppressed because it is too large Load Diff

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

File diff suppressed because it is too large Load Diff

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

File diff suppressed because it is too large Load Diff

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

File diff suppressed because it is too large Load Diff

5
contrib/lisp/org-elisp-symbol.el
View File

@ -2,7 +2,7 @@
;; ;;
;; Copyright 2007-2013 Free Software Foundation, Inc. ;; Copyright 2007-2013 Free Software Foundation, Inc.
;; ;;
;; Author: bzg AT gnu DOT org ;; Author: Bastien Guerry
;; Version: 0.2 ;; Version: 0.2
;; Keywords: org, remember, lisp ;; Keywords: org, remember, lisp
;; URL: http://www.cognition.ens.fr/~guerry/u/org-elisp-symbol.el ;; URL: http://www.cognition.ens.fr/~guerry/u/org-elisp-symbol.el
@ -20,8 +20,7 @@
;; GNU General Public License for more details. ;; GNU General Public License for more details.
;; ;;
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;; ;;
;;; Commentary: ;;; Commentary:
;; ;;

8
contrib/lisp/org-eval-light.el
View File

@ -11,20 +11,18 @@
;; This file is not yet part of GNU Emacs. ;; This file is not yet part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify ;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by ;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option) ;; the Free Software Foundation; either version 3, or (at your option)
;; any later version. ;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful, ;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details. ;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary: ;;; Commentary:

11
contrib/lisp/org-eval.el
View File

@ -8,20 +8,18 @@
;; ;;
;; This file is not yet part of GNU Emacs. ;; This file is not yet part of GNU Emacs.
;; ;;
;; GNU Emacs is free software; you can redistribute it and/or modify ;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by ;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option) ;; the Free Software Foundation; either version 3, or (at your option)
;; any later version. ;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful, ;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details. ;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;;; Commentary: ;;; Commentary:
@ -88,8 +86,7 @@
(:foreground "yellow")))) (:foreground "yellow"))))
"Face for command output that is included into an Org-mode buffer." "Face for command output that is included into an Org-mode buffer."
:group 'org-eval :group 'org-eval
:group 'org-faces :group 'org-faces)
:version "22.1")
(defvar org-eval-regexp nil) (defvar org-eval-regexp nil)

148
contrib/lisp/org-exp-bibtex.el
View File

@ -1,148 +0,0 @@
;;; org-exp-bibtex.el --- Export bibtex fragments
;; Copyright (C) 2009-2013 Taru Karttunen
;; Author: Taru Karttunen <taruti@taruti.net>
;; This file is not currently 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 2, 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 this program ; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;
;; This is an utility to handle BibTeX export to both LaTeX and html
;; exports. It uses the bibtex2html software from
;; http://www.lri.fr/~filliatr/bibtex2html/
;;
;; The usage is as follows:
;; #+BIBLIOGRAPHY: bibfilebasename stylename optional-options
;; e.g. given foo.bib and using style plain:
;; #+BIBLIOGRAPHY: foo plain option:-d
;;
;; Optional options are of the form:
;;
;; option:-foobar pass '-foobar' to bibtex2html
;; e.g.
;; option:-d sort by date.
;; option:-a sort as BibTeX (usually by author) *default*
;; option:-u unsorted i.e. same order as in .bib file
;; option:-r reverse the sort.
;; see the bibtex2html man page for more. Multiple options can be combined like:
;; option:-d option:-r
;;
;; Limiting to only the entries cited in the document:
;; limit:t
;; For LaTeX export this simply inserts the lines
;; \bibliographystyle{plain}
;; \bibliography{foo}
;; into the tex-file when exporting.
;; For Html export it:
;; 1) converts all \cite{foo} to links to the bibliography
;; 2) creates a foo.html and foo_bib.html
;; 3) includes the contents of foo.html in the exported html file
(require 'org)
(require 'org-exp)
(defvar org-export-current-backend) ; dynamically bound in org-exp.el
(defun org-export-bibtex-preprocess ()
"Export all BibTeX."
(interactive)
(save-window-excursion
(setq oebp-cite-plist '())
;; Convert #+BIBLIOGRAPHY: name style
(goto-char (point-min))
(while (re-search-forward "^#\\+BIBLIOGRAPHY:[ \t]+\\(\\S-+\\)[ \t]+\\(\\S-+\\)\\([^\r\n]*\\)" nil t)
(let ((file (match-string 1))
(style (match-string 2))
(opt (org-exp-bibtex-options-to-plist (match-string 3))))
(replace-match
(cond
((eq org-export-current-backend 'html) ;; We are exporting to HTML
(let (extra-args cite-list end-hook tmp-files)
(dolist (elt opt)
(when (equal "option" (car elt))
(setq extra-args (cons (cdr elt) extra-args))))
(when (assoc "limit" opt) ;; Limit is true - collect references
(org-exp-bibtex-docites (lambda ()
(dolist (c (org-split-string (match-string 1) ","))
(add-to-list 'cite-list c))))
;; (message "cites: %s" cite-list)
(let ((tmp (make-temp-file "org-exp-bibtex")))
(with-temp-file tmp (dolist (i cite-list) (insert (concat i "\n"))))
(setq tmp-files (cons tmp tmp-files))
(setq extra-args (append extra-args `("-citefile" ,tmp)))))
(when (not (eq 0 (apply 'call-process (append '("bibtex2html" nil nil nil)
`("-a" "--nodoc" "--style" ,style "--no-header")
extra-args
(list (concat file ".bib"))))))
(error "Executing bibtex2html failed"))
(dolist (f tmp-files) (delete-file f)))
(with-temp-buffer
(save-match-data
(insert-file-contents (concat file ".html"))
(goto-char (point-min))
(while (re-search-forward (org-re "a name=\"\\([-_[:word:]]+\\)\">\\([[:word:]]+\\)") nil t)
(setq oebp-cite-plist (cons (cons (match-string 1) (match-string 2)) oebp-cite-plist)))
(goto-char (point-min))
(while (re-search-forward "<hr>" nil t)
(replace-match "<hr/>" t t))
(concat "\n#+BEGIN_HTML\n<div id=\"bibliography\">\n<h2>References</h2>\n" (buffer-string) "\n</div>\n#+END_HTML\n"))))
((eq org-export-current-backend 'latex) ;; Latex export
(concat "\n#+LATEX: \\bibliographystyle{" style "}"
"\n#+LATEX: \\bibliography{" file "}\n"))) t t)))
;; Convert cites to links in html
(when (eq org-export-current-backend 'html)
;; Split citation commands with multiple keys
(org-exp-bibtex-docites
(lambda ()
(let ((keys (save-match-data (org-split-string (match-string 1) ","))))
(when (> (length keys) 1)
(replace-match (mapconcat (lambda (k) (format "\\cite{%s}" k)) keys "")
t t)))))
;; Replace the citation commands with links
(org-exp-bibtex-docites
(lambda () (let* ((cn (match-string 1))
(cv (assoc cn oebp-cite-plist)))
;; (message "L: %s" (concat "\[_{}[[" cn "][" (if cv (cdr cv) cn) "]]\]"))
(replace-match (concat "\[_{}[[#" cn "][" (if cv (cdr cv) cn) "]]\]")) t t))))))
(defun org-exp-bibtex-docites (fun)
(save-excursion
(save-match-data
(goto-char (point-min))
(when (eq org-export-current-backend 'html)
(while (re-search-forward "\\\\cite{\\([^}\n]+\\)}" nil t)
(apply fun nil))))))
(defun org-exp-bibtex-options-to-plist (options)
(save-match-data
(flet ((f (o) (let ((s (split-string o ":"))) (cons (nth 0 s) (nth 1 s)))))
(mapcar 'f (split-string options nil t)))))
(add-hook 'org-export-preprocess-hook 'org-export-bibtex-preprocess)
(provide 'org-exp-bibtex)
;;; org-exp-bibtex.el ends here

7
contrib/lisp/org-expiry.el
View File

@ -2,7 +2,7 @@
;; ;;
;; Copyright 2007-2013 Free Software Foundation, Inc. ;; Copyright 2007-2013 Free Software Foundation, Inc.
;; ;;
;; Author: bzg AT gnu DOT org ;; Author: Bastien Guerry
;; Version: 0.2 ;; Version: 0.2
;; Keywords: org expiry ;; Keywords: org expiry
@ -19,8 +19,7 @@
;; GNU General Public License for more details. ;; GNU General Public License for more details.
;; ;;
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;; ;;
;;; Commentary: ;;; Commentary:
;; ;;
@ -83,7 +82,7 @@
:group 'org) :group 'org)
(defcustom org-expiry-inactive-timestamps nil (defcustom org-expiry-inactive-timestamps nil
"Insert inactive timestamps for the created and expired time properties" "Insert inactive timestamps for created/expired properties."
:type 'boolean :type 'boolean
:group 'org-expiry) :group 'org-expiry)

1480
contrib/lisp/org-export-generic.el
View File

File diff suppressed because it is too large Load Diff

1701
contrib/lisp/org-favtable.el Executable file
View File

File diff suppressed because it is too large Load Diff

14
contrib/lisp/org-git-link.el
View File

@ -5,6 +5,8 @@
;; Author: Reimar Finken <reimar.finken@gmx.de> ;; Author: Reimar Finken <reimar.finken@gmx.de>
;; Keywords: files, calendar, hypermedia ;; Keywords: files, calendar, hypermedia
;; This file is not part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify ;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by ;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or ;; the Free Software Foundation, either version 3 of the License, or
@ -130,10 +132,11 @@
(list (expand-file-name ".git" dir) relpath)))) (list (expand-file-name ".git" dir) relpath))))
(if (featurep 'xemacs) (eval-and-compile
(defalias 'org-git-gitrepos-p 'org-git-find-gitdir) (if (featurep 'xemacs)
(defalias 'org-git-gitrepos-p 'org-git-find-gitdir (defalias 'org-git-gitrepos-p 'org-git-find-gitdir)
"Return non-nil if path is in git repository")) (defalias 'org-git-gitrepos-p 'org-git-find-gitdir
"Return non-nil if path is in git repository")))
;; splitting the link string ;; splitting the link string
@ -194,8 +197,7 @@
(unless (unless
(zerop (call-process org-git-program nil buffer nil (zerop (call-process org-git-program nil buffer nil
"--no-pager" (concat "--git-dir=" gitdir) "show" object)) "--no-pager" (concat "--git-dir=" gitdir) "show" object))
(error "git error: %s " (save-excursion (set-buffer buffer) (error "git error: %s " (with-current-buffer buffer (buffer-string)))))
(buffer-string)))))
(defun org-git-blob-sha (gitdir object) (defun org-git-blob-sha (gitdir object)
"Return sha of the referenced object" "Return sha of the referenced object"

3
contrib/lisp/org-interactive-query.el
View File

@ -19,8 +19,7 @@
;; GNU General Public License for more details. ;; GNU General Public License for more details.
;; ;;
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;; ;;
;;; Commentary: ;;; Commentary:
;; ;;

8
contrib/lisp/org-invoice.el
View File

@ -23,7 +23,7 @@
;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
;; ;;
;; Commentary: ;;; Commentary:
;; ;;
;; Building on top of the terrific OrgMode, org-invoice tries to ;; Building on top of the terrific OrgMode, org-invoice tries to
;; provide functionality for managing invoices. Currently, it does ;; provide functionality for managing invoices. Currently, it does
@ -226,8 +226,8 @@ looks like tree2, where the level is 2."
(setq (setq
org-invoice-total-time (+ org-invoice-total-time work) org-invoice-total-time (+ org-invoice-total-time work)
org-invoice-total-price (+ org-invoice-total-price price))) org-invoice-total-price (+ org-invoice-total-price price)))
(setq total (and total (org-minutes-to-hh:mm-string total))) (setq total (and total (org-minutes-to-clocksum-string total)))
(setq work (and work (org-minutes-to-hh:mm-string work))) (setq work (and work (org-minutes-to-clocksum-string work)))
(insert-before-markers (insert-before-markers
(concat "|" title (concat "|" title
(cond (cond
@ -251,7 +251,7 @@ looks like tree2, where the level is 2."
(when with-summary (when with-summary
(insert-before-markers (insert-before-markers
(concat "|-\n|Total:|" (concat "|-\n|Total:|"
(org-minutes-to-hh:mm-string org-invoice-total-time) (org-minutes-to-clocksum-string org-invoice-total-time)
(and with-price (concat "|" (format "%.2f" org-invoice-total-price))) (and with-price (concat "|" (format "%.2f" org-invoice-total-price)))
"|\n"))))) "|\n")))))

5
contrib/lisp/org-jira.el
View File

@ -14,9 +14,8 @@
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details. ;; General Public License for more details.
;; For a copy of the GNU General Public License, search the Internet, ;; You should have received a copy of the GNU General Public License
;; or write to the Free Software Foundation, Inc., 59 Temple Place, ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; Suite 330, Boston, MA 02111-1307 USA
;;; Commentary: ;;; Commentary:
;; This adds a jira protocol to org mode. ;; This adds a jira protocol to org mode.

4
contrib/lisp/org-learn.el
View File

@ -9,12 +9,12 @@
;; ;;
;; This file is not part of GNU Emacs. ;; This file is not part of GNU Emacs.
;; ;;
;; GNU Emacs is free software: you can redistribute it and/or modify ;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by ;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or ;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version. ;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful, ;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details. ;; GNU General Public License for more details.

21
contrib/lisp/org-mac-iCal.el
View File

@ -3,24 +3,23 @@
;; Copyright (C) 2009-2013 Christopher Suckling ;; Copyright (C) 2009-2013 Christopher Suckling
;; Author: Christopher Suckling <suckling at gmail dot com> ;; Author: Christopher Suckling <suckling at gmail dot com>
;; Version: 0.1057.104
;; Keywords: outlines, calendar
;; This file is Free Software; you can redistribute it and/or modify ;; 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 ;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option) ;; the Free Software Foundation; either version 3, or (at your option)
;; any later version. ;; any later version.
;; It is distributed in the hope that it will be useful, but WITHOUT ;; This program is distributed in the hope that it will be useful, but
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY ;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public ;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
;; License for more details. ;; for more details.
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;; Version: 0.1057.104
;; Keywords: outlines, calendar
;;; Commentary: ;;; Commentary:
;; ;;

5
contrib/lisp/org-mac-link-grabber.el
View File

@ -1,5 +1,5 @@
;;; org-mac-link-grabber.el --- Grab links and url from various mac ;;; org-mac-link-grabber.el --- Grab links and url from various mac
;;; application and insert them as links into org-mode documents ;; Application and insert them as links into org-mode documents
;; ;;
;; Copyright (c) 2010-2013 Free Software Foundation, Inc. ;; Copyright (c) 2010-2013 Free Software Foundation, Inc.
;; ;;
@ -20,8 +20,7 @@
;; GNU General Public License for more details. ;; GNU General Public License for more details.
;; ;;
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;; ;;
;;; Commentary: ;;; Commentary:
;; ;;

9
lisp/org-mac-message.el → contrib/lisp/org-mac-message.el
View File

@ -7,7 +7,7 @@
;; Keywords: outlines, hypermedia, calendar, wp ;; Keywords: outlines, hypermedia, calendar, wp
;; This file is part of GNU Emacs. ;; This file is not part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify ;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by ;; it under the terms of the GNU General Public License as published by
@ -23,9 +23,10 @@
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary: ;;; Commentary:
;; This file implements links to Apple Mail.app messages from within Org-mode. ;; This file implements links to Apple Mail.app messages from within
;; Org-mode does not load this module by default - if you would actually like ;; Org-mode. Org-mode does not load this module by default - if you
;; this to happen then configure the variable `org-modules'. ;; would actually like this to happen then configure the variable
;; `org-modules' and add Org's contrib/ directory to your `load-path'.
;; If you would like to create links to all flagged messages in an ;; If you would like to create links to all flagged messages in an
;; Apple Mail.app account, please customize the variable ;; Apple Mail.app account, please customize the variable

6
contrib/lisp/org-mairix.el
View File

@ -3,6 +3,8 @@
;; Copyright (C) 2007-2013 Georg C. F. Greve ;; Copyright (C) 2007-2013 Georg C. F. Greve
;; mutt support by Adam Spiers <orgmode at adamspiers dot org> ;; mutt support by Adam Spiers <orgmode at adamspiers dot org>
;; ;;
;; This file is not part of GNU Emacs.
;;
;; Author: Georg C. F. Greve <greve at fsfeurope dot org> ;; Author: Georg C. F. Greve <greve at fsfeurope dot org>
;; Keywords: outlines, hypermedia, calendar, wp, email, mairix ;; Keywords: outlines, hypermedia, calendar, wp, email, mairix
;; Purpose: Integrate mairix email searching into Org mode ;; Purpose: Integrate mairix email searching into Org mode
@ -20,9 +22,7 @@
;; License for more details. ;; License for more details.
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; USAGE NOTE ;; USAGE NOTE
;; ;;

21
contrib/lisp/org-man.el
View File

@ -7,27 +7,25 @@
;; ;;
;; This file is not yet part of GNU Emacs. ;; This file is not yet part of GNU Emacs.
;; ;;
;; GNU Emacs is free software; you can redistribute it and/or modify ;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by ;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option) ;; the Free Software Foundation; either version 3, or (at your option)
;; any later version. ;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful, ;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details. ;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;;; Commentary: ;;; Commentary:
(require 'org) (require 'org)
(org-add-link-type "man" 'org-man-open) (org-add-link-type "man" 'org-man-open 'org-man-export)
(add-hook 'org-store-link-functions 'org-man-store-link) (add-hook 'org-store-link-functions 'org-man-store-link)
(defcustom org-man-command 'man (defcustom org-man-command 'man
@ -59,6 +57,17 @@ PATH should be a topic that can be thrown at the man command."
(match-string 1 (buffer-name)) (match-string 1 (buffer-name))
(error "Cannot create link to this man page"))) (error "Cannot create link to this man page")))
(defun org-man-export (link description format)
"Export a man page link from Org files."
(let ((path (format "http://man.he.net/?topic=%s&section=all" link))
(desc (or description link)))
(cond
((eq format 'html) (format "<a target=\"_blank\" href=\"%s\">%s</a>" path desc))
((eq format 'latex) (format "\\href{%s}{%s}" path desc))
((eq format 'texinfo) (format "@uref{%s,%s}" path desc))
((eq format 'ascii) (format "%s (%s)" desc path))
(t path))))
(provide 'org-man) (provide 'org-man)
;;; org-man.el ends here ;;; org-man.el ends here

364
contrib/lisp/org-mew.el Normal file
View File

@ -0,0 +1,364 @@
;;; org-mew.el --- Support for links to Mew messages from within Org-mode
;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; 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 of the License, 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:
;; This file implements links to Mew messages from within Org-mode.
;; Org-mode loads this module by default - if this is not what you want,
;; configure the variable `org-modules'.
;;
;; Here is an example of workflow:
;; In your ~/.mew.el configuration file:
;;
;; (define-key mew-summary-mode-map "'" 'org-mew-search)
;; (eval-after-load "mew-summary"
;; '(define-key mew-summary-mode-map "\C-o" 'org-mew-capture))
;; 1. In the Mew's inbox folder, take a glance at new messages to find
;; a message that requires any action.
;; 2. If the message is a reply from somebody and associated with the
;; existing orgmode entry, type M-x `org-mew-search' RET (or press
;; the ' key simply) to find the entry. If you can find the entry
;; successfully and think you should start the task right now,
;; start the task by M-x `org-agenda-clock-in' RET.
;; 3. If the message is a new message, type M-x `org-mew-capture' RET,
;; enter the refile folder, and the buffer to capture the message
;; is shown up (without selecting the template by hand). Then you
;; can fill the template and type C-c C-c to complete the capture.
;; Note that you can configure `org-capture-templates' so that the
;; captured entry has a link to the message.
;;; Code:
(require 'org)
(defgroup org-mew nil
"Options concerning the Mew link."
:tag "Org Startup"
:group 'org-link)
(defcustom org-mew-link-to-refile-destination t
"Create a link to the refile destination if the message is marked as refile."
:group 'org-mew
:type 'boolean)
(defcustom org-mew-inbox-folder nil
"The folder where new messages are incorporated.
If `org-mew-inbox-folder' is non-nil, `org-mew-open' locates the message
in this inbox folder as well as the folder specified by the link."
:group 'org-mew
:type 'string)
(defcustom org-mew-use-id-db t
"Use ID database to locate the message if id.db is created."
:group 'org-mew
:type 'boolean)
(defcustom org-mew-subject-alist
(list (cons (concat "^\\(?:\\(?:re\\|fwd?\\): *\\)*"
"\\(?:[[(][a-z0-9._-]+[:,]? [0-9]+[])]\\)? *"
"\\(?:\\(?:re\\|fwd?\\): *\\)*"
"\\(.*\\)[ \t]*")
1))
"Alist of subject regular expression and matched group number for search."
:group 'org-mew
:type '(repeat (cons (regexp) (integer))))
(defcustom org-mew-capture-inbox-folders nil
"List of inbox folders whose messages need refile marked before capture.
`org-mew-capture' will ask you to put the refile mark on the
message if the message's folder is any of these folders and the
message is not marked. Nil means `org-mew-capture' never ask you
destination folders before capture."
:group 'org-mew
:type '(repeat string))
(defcustom org-mew-capture-guess-alist nil
"Alist of the regular expression of the folder name and the capture
template selection keys.
For example,
'((\"^%emacs-orgmode$\" . \"o\")
(\"\" . \"t\"))
the messages in \"%emacs-orgmode\" folder will be captured with
the capture template associated with \"o\" key, and any other
messages will be captured with the capture template associated
with \"t\" key."
:group 'org-mew
:type '(repeat (cons regexp string)))
;; Declare external functions and variables
(declare-function mew-cache-hit "ext:mew-cache" (fld msg &optional must-hit))
(declare-function mew-case-folder "ext:mew-func" (case folder))
(declare-function mew-folder-path-to-folder
"ext:mew-func" (path &optional has-proto))
(declare-function mew-idstr-to-id-list "ext:mew-header" (idstr &optional rev))
(declare-function mew-folder-remotep "ext:mew-func" (folder))
(declare-function mew-folder-virtualp "ext:mew-func" (folder))
(declare-function mew-header-get-value "ext:mew-header"
(field &optional as-list))
(declare-function mew-init "ext:mew" ())
(declare-function mew-refile-get "ext:mew-refile" (msg))
(declare-function mew-sinfo-get-case "ext:mew-summary" ())
(declare-function mew-summary-diag-global "ext:mew-thread" (id opt who))
(declare-function mew-summary-display "ext:mew-summary2" (&optional redisplay))
(declare-function mew-summary-folder-name "ext:mew-syntax" (&optional ext))
(declare-function mew-summary-get-mark "ext:mew-mark" ())
(declare-function mew-summary-message-number2 "ext:mew-syntax" ())
(declare-function mew-summary-pick-with-mewl "ext:mew-pick"
(pattern folder src-msgs))
(declare-function mew-summary-refile "ext:mew-refile" (&optional report))
(declare-function mew-summary-search-msg "ext:mew-const" (msg))
(declare-function mew-summary-set-message-buffer "ext:mew-summary3" (fld msg))
(declare-function mew-summary-visit-folder "ext:mew-summary4"
(folder &optional goend no-ls))
(declare-function mew-window-push "ext:mew" ())
(declare-function mew-expand-folder "ext:mew-func" (folder))
(declare-function mew-case:folder-folder "ext:mew-func" (case:folder))
(declare-function mew "ext:mew" (&optional arg))
(declare-function mew-message-goto-summary "ext:mew-message" ())
(declare-function mew-summary-mode "ext:mew-summary" ())
(defvar mew-init-p)
(defvar mew-mark-afterstep-spec)
(defvar mew-summary-goto-line-then-display)
;; Install the link type
(org-add-link-type "mew" 'org-mew-open)
(add-hook 'org-store-link-functions 'org-mew-store-link)
;; Implementation
(defun org-mew-store-link ()
"Store a link to a Mew folder or message."
(save-window-excursion
(if (eq major-mode 'mew-message-mode)
(mew-message-goto-summary))
(when (memq major-mode '(mew-summary-mode mew-virtual-mode))
(let ((msgnum (mew-summary-message-number2))
(folder-name (org-mew-folder-name)))
(if (fboundp 'mew-summary-set-message-buffer)
(mew-summary-set-message-buffer folder-name msgnum)
(set-buffer (mew-cache-hit folder-name msgnum t)))
(let* ((message-id (mew-header-get-value "Message-Id:"))
(from (mew-header-get-value "From:"))
(to (mew-header-get-value "To:"))
(date (mew-header-get-value "Date:"))
(date-ts (and date (format-time-string
(org-time-stamp-format t)
(date-to-time date))))
(date-ts-ia (and date (format-time-string
(org-time-stamp-format t t)
(date-to-time date))))
(subject (mew-header-get-value "Subject:"))
desc link)
(org-store-link-props :type "mew" :from from :to to
:subject subject :message-id message-id)
(when date
(org-add-link-props :date date :date-timestamp date-ts
:date-timestamp-inactive date-ts-ia))
(setq message-id (org-remove-angle-brackets message-id))
(setq desc (org-email-link-description))
(setq link (concat "mew:" folder-name "#" message-id))
(org-add-link-props :link link :description desc)
link)))))
(defun org-mew-folder-name ()
"Return the folder name of the current message."
(save-window-excursion
(if (eq major-mode 'mew-message-mode)
(mew-message-goto-summary))
(let* ((msgnum (mew-summary-message-number2))
(mark-info (mew-summary-get-mark)))
(if (and org-mew-link-to-refile-destination
(eq mark-info ?o)) ; marked as refile
(mew-case-folder (mew-sinfo-get-case)
(nth 1 (mew-refile-get msgnum)))
(let ((folder-or-path (mew-summary-folder-name)))
(mew-folder-path-to-folder folder-or-path t))))))
(defun org-mew-open (path)
"Follow the Mew message link specified by PATH."
(let (folder message-id)
(cond ((string-match "\\`\\(+.*\\)+\\+\\([0-9]+\\)\\'" path) ; for Bastien's
(setq folder (match-string 1 path))
(setq message-id (match-string 2 path)))
((string-match "\\`\\(\\(%#\\)?[^#]+\\)\\(#\\(.*\\)\\)?" path)
(setq folder (match-string 1 path))
(setq message-id (match-string 4 path)))
((and org-mew-use-id-db (string-match "\\`#\\(.+\\)" path))
(setq folder nil)
(setq message-id (match-string 1 path)))
(t (error "Error in Mew link")))
(require 'mew)
(mew-window-push)
(unless mew-init-p (mew-init))
(if (null folder)
(progn
(mew t)
(org-mew-open-by-message-id message-id))
(or (org-mew-follow-link folder message-id)
(and org-mew-inbox-folder (not (string= org-mew-inbox-folder folder))
(org-mew-follow-link org-mew-inbox-folder message-id))
(and org-mew-use-id-db
(org-mew-open-by-message-id message-id))
(error "Message not found")))))
(defun org-mew-follow-link (folder message-id)
(unless (org-mew-folder-exists-p folder)
(error "No such folder or wrong folder %s" folder))
(mew-summary-visit-folder folder)
(when message-id
(let ((msgnum (org-mew-get-msgnum folder message-id)))
(when (mew-summary-search-msg msgnum)
(if mew-summary-goto-line-then-display
(mew-summary-display))
t))))
(defun org-mew-folder-exists-p (folder)
(let ((dir (mew-expand-folder folder)))
(cond
((mew-folder-virtualp folder) (get-buffer folder))
((null dir) nil)
((mew-folder-remotep (mew-case:folder-folder folder)) t)
(t (file-directory-p dir)))))
(defun org-mew-get-msgnum (folder message-id)
(if (string-match "\\`[0-9]+\\'" message-id)
message-id
(let* ((pattern (concat "message-id=" message-id))
(msgs (mew-summary-pick-with-mewl pattern folder nil)))
(car msgs))))
(defun org-mew-open-by-message-id (message-id)
"Open message using ID database."
(let ((result (mew-summary-diag-global (format "<%s>" message-id)
"-p" "Message")))
(unless (eq result t)
(error "Message not found"))))
;; In ~/.mew.el, add the following line:
;; (define-key mew-summary-mode-map "'" 'org-mew-search)
(defun org-mew-search (&optional arg)
"Show all entries related to the message using `org-search-view'.
It shows entries which contains the message ID, the reference
IDs, or the subject of the message.
With C-u prefix, search for the entries that contains the message
ID or any of the reference IDs. With C-u C-u prefix, search for
the message ID or the last reference ID.
The search phase for the subject is extracted with
`org-mew-subject-alist', which defines the regular expression of
the subject and the group number to extract. You can get rid of
\"Re:\" and some other prefix from the subject text."
(interactive "P")
(when (memq major-mode '(mew-summary-mode mew-virtual-mode))
(let ((last-reference-only (equal arg '(16)))
(by-subject (null arg))
(msgnum (mew-summary-message-number2))
(folder-name (mew-summary-folder-name))
subject message-id references id-list)
(save-window-excursion
(if (fboundp 'mew-summary-set-message-buffer)
(mew-summary-set-message-buffer folder-name msgnum)
(set-buffer (mew-cache-hit folder-name msgnum t)))
(setq subject (mew-header-get-value "Subject:"))
(setq message-id (mew-header-get-value "Message-Id:"))
(setq references (mew-header-get-value "References:")))
(setq id-list (mapcar (lambda (id) (org-remove-angle-brackets id))
(mew-idstr-to-id-list references)))
(if last-reference-only
(setq id-list (last id-list))
(if message-id
(setq id-list (cons (org-remove-angle-brackets message-id)
id-list))))
(when (and by-subject (stringp subject))
(catch 'matched
(mapc (lambda (elem)
(let ((regexp (car elem))
(num (cdr elem)))
(when (string-match regexp subject)
(setq subject (match-string num subject))
(throw 'matched t))))
org-mew-subject-alist))
(setq id-list (cons subject id-list)))
(cond ((null id-list)
(error "No message ID to search."))
((equal (length id-list) 1)
(org-search-view nil (car id-list)))
(t
(org-search-view nil (format "{\\(%s\\)}"
(mapconcat 'regexp-quote
id-list "\\|"))))))
(delete-other-windows)))
(defun org-mew-capture (arg)
"Guess the capture template from the folder name and invoke `org-capture'.
This selects a capture template in `org-capture-templates' by
searching for capture template selection keys defined in
`org-mew-capture-guess-alist' which are associated with the
regular expression that matches the message's folder name, and
then invokes `org-capture'.
If the message's folder is a inbox folder, you are prompted to
put the refile mark on the message and the capture template is
guessed from the refile destination folder. You can customize
the inbox folders by `org-mew-capture-inbox-folders'.
If ARG is non-nil, this does not guess the capture template but
asks you to select the capture template."
(interactive "P")
(or (not (member (org-mew-folder-name)
org-mew-capture-inbox-folders))
(eq (mew-summary-get-mark) ?o)
(save-window-excursion
(if (eq major-mode 'mew-message-mode)
(mew-message-goto-summary))
(let ((mew-mark-afterstep-spec '((?o 0 0 0 0 0 0 0))))
(mew-summary-refile)))
(error "No refile folder selected."))
(let* ((org-mew-link-to-refile-destination t)
(folder-name (org-mew-folder-name))
(keys (if arg
nil
(org-mew-capture-guess-selection-keys folder-name))))
(org-capture nil keys)))
(defun org-mew-capture-guess-selection-keys (folder-name)
(catch 'found
(let ((alist org-mew-capture-guess-alist))
(while alist
(let ((elem (car alist)))
(if (string-match (car elem) folder-name)
(throw 'found (cdr elem))))
(setq alist (cdr alist))))))
(provide 'org-mew)
;;; org-mew.el ends here

40
contrib/lisp/org-mime.el
View File

@ -22,9 +22,7 @@
;; GNU General Public License for more details. ;; GNU General Public License for more details.
;; ;;
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary: ;;; Commentary:
@ -57,6 +55,9 @@
;;; Code: ;;; Code:
(require 'cl) (require 'cl)
(declare-function org-export-string-as "ox"
(string backend &optional body-only ext-plist))
(defcustom org-mime-use-property-inheritance nil (defcustom org-mime-use-property-inheritance nil
"Non-nil means al MAIL_ properties apply also for sublevels." "Non-nil means al MAIL_ properties apply also for sublevels."
:group 'org-mime :group 'org-mime
@ -195,6 +196,8 @@ and images in a multipart/related part."
html using `org-mode'. If called with an active region only html using `org-mode'. If called with an active region only
export that region, otherwise export the entire body." export that region, otherwise export the entire body."
(interactive "P") (interactive "P")
(require 'ox-org)
(require 'ox-html)
(let* ((region-p (org-region-active-p)) (let* ((region-p (org-region-active-p))
(html-start (or (and region-p (region-beginning)) (html-start (or (and region-p (region-beginning))
(save-excursion (save-excursion
@ -204,10 +207,11 @@ export that region, otherwise export the entire body."
(html-end (or (and region-p (region-end)) (html-end (or (and region-p (region-end))
;; TODO: should catch signature... ;; TODO: should catch signature...
(point-max))) (point-max)))
(raw-body (buffer-substring html-start html-end)) (raw-body (concat org-mime-default-header
(buffer-substring html-start html-end)))
(tmp-file (make-temp-name (expand-file-name (tmp-file (make-temp-name (expand-file-name
"mail" temporary-file-directory))) "mail" temporary-file-directory)))
(body (org-export-string raw-body 'org (file-name-directory tmp-file))) (body (org-export-string-as raw-body 'org t))
;; because we probably don't want to skip part of our mail ;; because we probably don't want to skip part of our mail
(org-export-skip-text-before-1st-heading nil) (org-export-skip-text-before-1st-heading nil)
;; because we probably don't want to export a huge style file ;; because we probably don't want to export a huge style file
@ -219,8 +223,7 @@ export that region, otherwise export the entire body."
;; to hold attachments for inline html images ;; to hold attachments for inline html images
(html-and-images (html-and-images
(org-mime-replace-images (org-mime-replace-images
(org-export-string raw-body 'html (file-name-directory tmp-file)) (org-export-string-as raw-body 'html t) tmp-file))
tmp-file))
(html-images (unless arg (cdr html-and-images))) (html-images (unless arg (cdr html-and-images)))
(html (org-mime-apply-html-hook (html (org-mime-apply-html-hook
(if arg (if arg
@ -295,26 +298,29 @@ export that region, otherwise export the entire body."
(let ((fmt (if (symbolp fmt) fmt (intern fmt)))) (let ((fmt (if (symbolp fmt) fmt (intern fmt))))
(cond (cond
((eq fmt 'org) ((eq fmt 'org)
(insert (org-export-string (org-babel-trim (bhook body 'org)) 'org))) (require 'ox-org)
(insert (org-export-string-as
(org-babel-trim (bhook body 'org)) 'org t)))
((eq fmt 'ascii) ((eq fmt 'ascii)
(insert (org-export-string (require 'ox-ascii)
(concat "#+Title:\n" (bhook body 'ascii)) 'ascii))) (insert (org-export-string-as
(concat "#+Title:\n" (bhook body 'ascii)) 'ascii t)))
((or (eq fmt 'html) (eq fmt 'html-ascii)) ((or (eq fmt 'html) (eq fmt 'html-ascii))
(require 'ox-ascii)
(require 'ox-org)
(let* ((org-link-file-path-type 'absolute) (let* ((org-link-file-path-type 'absolute)
;; we probably don't want to export a huge style file ;; we probably don't want to export a huge style file
(org-export-htmlize-output-type 'inline-css) (org-export-htmlize-output-type 'inline-css)
(html-and-images (org-mime-replace-images (html-and-images
(org-export-string (org-mime-replace-images
(bhook body 'html) (org-export-string-as (bhook body 'html) 'html t) file))
'html (file-name-nondirectory file))
file))
(images (cdr html-and-images)) (images (cdr html-and-images))
(html (org-mime-apply-html-hook (car html-and-images)))) (html (org-mime-apply-html-hook (car html-and-images))))
(insert (org-mime-multipart (insert (org-mime-multipart
(org-export-string (org-export-string-as
(org-babel-trim (org-babel-trim
(bhook body (if (eq fmt 'html) 'org 'ascii))) (bhook body (if (eq fmt 'html) 'org 'ascii)))
(if (eq fmt 'html) 'org 'ascii)) (if (eq fmt 'html) 'org 'ascii) t)
html) html)
(mapconcat 'identity images "\n")))))))) (mapconcat 'identity images "\n"))))))))

8
contrib/lisp/org-mtags.el
View File

@ -9,20 +9,18 @@
;; ;;
;; This file is not yet part of GNU Emacs. ;; This file is not yet part of GNU Emacs.
;; ;;
;; GNU Emacs is free software; you can redistribute it and/or modify ;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by ;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option) ;; the Free Software Foundation; either version 3, or (at your option)
;; any later version. ;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful, ;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details. ;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;;; Commentary: ;;; Commentary:

61
contrib/lisp/org-notify.el
View File

@ -5,6 +5,8 @@
;; Author: Peter Münster <pmrb@free.fr> ;; Author: Peter Münster <pmrb@free.fr>
;; Keywords: notification, todo-list, alarm, reminder, pop-up ;; Keywords: notification, todo-list, alarm, reminder, pop-up
;; This file is not part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify ;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by ;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or ;; the Free Software Foundation, either version 3 of the License, or
@ -35,6 +37,7 @@
;; (org-notify-start) ;; (org-notify-start)
;; Example setup: ;; Example setup:
;;
;; (org-notify-add 'appt ;; (org-notify-add 'appt
;; '(:time "-1s" :period "20s" :duration 10 ;; '(:time "-1s" :period "20s" :duration 10
;; :actions (-message -ding)) ;; :actions (-message -ding))
@ -42,11 +45,12 @@
;; :actions -notify) ;; :actions -notify)
;; '(:time "2h" :period "5m" :actions -message) ;; '(:time "2h" :period "5m" :actions -message)
;; '(:time "3d" :actions -email)) ;; '(:time "3d" :actions -email))
;;
;; This means for todo-items with `notify' property set to `appt': 3 days ;; This means for todo-items with `notify' property set to `appt': 3 days
;; before deadline, send a reminder-email, 2 hours before deadline, start to ;; before deadline, send a reminder-email, 2 hours before deadline, start to
;; send messages every 5 minutes, then 15 minutes before deadline, start to ;; send messages every 5 minutes, then 15 minutes before deadline, start to
;; pop up notification windows every 2 minutes. The timeout of the window is ;; pop up notification windows every 2 minutes. The timeout of the window is
;; set to 100 seconds. Finally, when deadline is overdue, send messages and ;; set to 100 seconds. Finally, when deadline is overdue, send messages and
;; make noise." ;; make noise."
;; Take also a look at the function `org-notify-add'. ;; Take also a look at the function `org-notify-add'.
@ -104,12 +108,21 @@
(cdr (assoc (match-string 3 str) conv)) (cdr (assoc (match-string 3 str) conv))
(if (= (length (match-string 1 str)) 1) -1 1))))) (if (= (length (match-string 1 str)) 1) -1 1)))))
(defun org-notify-convert-deadline (orig)
"Convert original deadline from `org-element-parse-buffer' to
simple timestamp string."
(if orig
(replace-regexp-in-string "^<\\|>$" ""
(plist-get (plist-get orig 'timestamp)
:raw-value))))
(defun org-notify-make-todo (heading &rest ignored) (defun org-notify-make-todo (heading &rest ignored)
"Create one todo item." "Create one todo item."
(macrolet ((get (k) `(plist-get list ,k)) (macrolet ((get (k) `(plist-get list ,k))
(pr (k v) `(setq result (plist-put result ,k ,v)))) (pr (k v) `(setq result (plist-put result ,k ,v))))
(let* ((list (nth 1 heading)) (notify (or (get :notify) "default")) (let* ((list (nth 1 heading)) (notify (or (get :notify) "default"))
(deadline (get :deadline)) (heading (get :raw-value)) (deadline (org-notify-convert-deadline (get :deadline)))
(heading (get :raw-value))
result) result)
(when (and (eq (get :todo-type) 'todo) heading deadline) (when (and (eq (get :todo-type) 'todo) heading deadline)
(pr :heading heading) (pr :notify (intern notify)) (pr :heading heading) (pr :notify (intern notify))
@ -173,26 +186,29 @@ forgotten tasks."
(return))))))) (return)))))))
(defun org-notify-add (name &rest params) (defun org-notify-add (name &rest params)
"Add a new notification type. The NAME can be used in Org-mode property "Add a new notification type.
`notify'. If NAME is `default', the notification type applies for todo items The NAME can be used in Org-mode property `notify'. If NAME is
without the `notify' property. This file predefines such a default `default', the notification type applies for todo items without
the `notify' property. This file predefines such a default
notification type. notification type.
Each element of PARAMS is a list with parameters for a given time Each element of PARAMS is a list with parameters for a given time
distance to the deadline. This distance must increase from one element to distance to the deadline. This distance must increase from one
the next. element to the next.
List of possible parameters: List of possible parameters:
:time Time distance to deadline, when this type of notification shall :time Time distance to deadline, when this type of notification shall
start. It's a string: an integral value (positive or negative) start. It's a string: an integral value (positive or negative)
followed by a unit (s, m, h, d, w, M). followed by a unit (s, m, h, d, w, M).
:actions A function or a list of functions to be called to notify the :actions A function or a list of functions to be called to notify the
user. Instead of a function name, you can also supply a suffix user. Instead of a function name, you can also supply a suffix
of one of the various predefined `org-notify-action-xxx' of one of the various predefined `org-notify-action-xxx'
functions. functions.
:period Optional: can be used to repeat the actions periodically. Same :period Optional: can be used to repeat the actions periodically.
format as :time. Same format as :time.
:duration Some actions use this parameter to specify the duration of the :duration Some actions use this parameter to specify the duration of the
notification. It's an integral number in seconds. notification. It's an integral number in seconds.
:audible Overwrite the value of `org-notify-audible' for this action. :audible Overwrite the value of `org-notify-audible' for this action.
For the actions, you can use your own functions or some of the predefined For the actions, you can use your own functions or some of the predefined
@ -200,11 +216,12 @@ ones, whose names are prefixed with `org-notify-action-'."
(setq org-notify-map (plist-put org-notify-map name params))) (setq org-notify-map (plist-put org-notify-map name params)))
(defun org-notify-start (&optional secs) (defun org-notify-start (&optional secs)
"Start the notification daemon. If SECS is positive, it's the "Start the notification daemon.
period in seconds for processing the notifications of one If SECS is positive, it's the period in seconds for processing
org-agenda file, and if negative, notifications will be checked the notifications of one org-agenda file, and if negative,
only when emacs is idle for -SECS seconds. The default value for notifications will be checked only when emacs is idle for -SECS
SECS is 20." seconds. The default value for SECS is 20."
(interactive)
(if org-notify-timer (if org-notify-timer
(org-notify-stop)) (org-notify-stop))
(setq secs (or secs 20) (setq secs (or secs 20)
@ -216,8 +233,8 @@ SECS is 20."
(defun org-notify-stop () (defun org-notify-stop ()
"Stop the notification daemon." "Stop the notification daemon."
(when org-notify-timer (when org-notify-timer
(cancel-timer org-notify-timer) (cancel-timer org-notify-timer)
(setq org-notify-timer nil))) (setq org-notify-timer nil)))
(defun org-notify-on-action (plist key) (defun org-notify-on-action (plist key)
"User wants to see action." "User wants to see action."
@ -299,7 +316,7 @@ SECS is 20."
(defun org-notify-select-highest-window () (defun org-notify-select-highest-window ()
"Select the highest window on the frame, that is not is not an "Select the highest window on the frame, that is not is not an
org-notify window. Mostly copied from `appt-select-lowest-window'." org-notify window. Mostly copied from `appt-select-lowest-window'."
(let ((highest-window (selected-window)) (let ((highest-window (selected-window))
(bottom-edge (nth 3 (window-edges))) (bottom-edge (nth 3 (window-edges)))
next-bottom-edge) next-bottom-edge)
@ -370,7 +387,7 @@ terminal an emacs window."
;;; Provide a minimal default setup. ;;; Provide a minimal default setup.
(org-notify-add 'default '(:time "1h" :actions -notify/window (org-notify-add 'default '(:time "1h" :actions -notify/window
:period "2m" :duration 60)) :period "2m" :duration 60))
(provide 'org-notify) (provide 'org-notify)

4
contrib/lisp/org-notmuch.el
View File

@ -19,9 +19,7 @@
;; GNU General Public License for more details. ;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary: ;;; Commentary:

21
contrib/lisp/org-panel.el
View File

@ -50,9 +50,7 @@
;; General Public License for more details. ;; General Public License for more details.
;; ;;
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING. If not, write to ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
@ -133,8 +131,6 @@ active.)"
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Hook functions etc ;;; Hook functions etc
;;(defvar orgpan-this-panel-window nil)
(defun orgpan-delete-panel () (defun orgpan-delete-panel ()
"Remove the panel." "Remove the panel."
(interactive) (interactive)
@ -203,8 +199,7 @@ active.)"
(unless (and orgpan-point (unless (and orgpan-point
(= (point) orgpan-point)) (= (point) orgpan-point))
;; Go backward so it is possible to click on a "button": ;; Go backward so it is possible to click on a "button":
(orgpan-backward-field))))) (orgpan-backward-field))))))
(setq orgpan-this-panel-window nil))
(error (lwarn 't :warning "orgpan-post: %S" err)))) (error (lwarn 't :warning "orgpan-post: %S" err))))
;; (defun orgpan-window-config-change () ;; (defun orgpan-window-config-change ()
@ -294,7 +289,7 @@ active.)"
(defun orgpan-check-panel-mode () (defun orgpan-check-panel-mode ()
(unless (derived-mode-p 'orgpan-mode) (unless (derived-mode-p 'orgpan-mode)
(error "Not orgpan-mode in buffer: " major-mode))) (error "Not orgpan-mode in buffer: %s" major-mode)))
(defun orgpan-display-bindings-help () (defun orgpan-display-bindings-help ()
(orgpan-check-panel-mode) (orgpan-check-panel-mode)
@ -401,6 +396,9 @@ There can be only one such buffer at any time.")
(defvar orgpan-point nil) (defvar orgpan-point nil)
;;(make-variable-buffer-local 'orgpan-point) ;;(make-variable-buffer-local 'orgpan-point)
(defvar viper-emacs-state-mode-list)
(defvar viper-new-major-mode-buffer-list)
(defun orgpan-avoid-viper-in-buffer () (defun orgpan-avoid-viper-in-buffer ()
;; Fix-me: This is ugly. However see `this-major-mode-requires-vi-state': ;; Fix-me: This is ugly. However see `this-major-mode-requires-vi-state':
(set (make-local-variable 'viper-emacs-state-mode-list) '(orgpan-mode)) (set (make-local-variable 'viper-emacs-state-mode-list) '(orgpan-mode))
@ -598,12 +596,11 @@ button changes the binding of the arrow keys."
org-mode-map)) org-mode-map))
;;(org-back-to-heading) ;;(org-back-to-heading)
;;(remove-hook 'window-configuration-change-hook 'orgpan-window-config-change) ;;(remove-hook 'window-configuration-change-hook 'orgpan-window-config-change)
(split-window) (setq orgpan-org-window (selected-window))
(setq orgpan-panel-window (split-window nil -4 'below))
(select-window orgpan-panel-window)
(set-window-buffer (selected-window) (orgpan-make-panel-buffer)) (set-window-buffer (selected-window) (orgpan-make-panel-buffer))
(setq orgpan-panel-window (selected-window))
;;(set-window-dedicated-p (selected-window) t) ;;(set-window-dedicated-p (selected-window) t)
(fit-window-to-buffer nil nil 3)
(setq orgpan-org-window (next-window))
;; The minor mode version starts here: ;; The minor mode version starts here:
(when orgpan-minor-mode-version (when orgpan-minor-mode-version
(select-window orgpan-org-window) (select-window orgpan-org-window)

5
contrib/lisp/org-registry.el
View File

@ -11,6 +11,8 @@
;; Description: Shows Org files where the current buffer is linked ;; Description: Shows Org files where the current buffer is linked
;; URL: http://www.cognition.ens.fr/~guerry/u/org-registry.el ;; URL: http://www.cognition.ens.fr/~guerry/u/org-registry.el
;; ;;
;; This file is not part of GNU Emacs.
;;
;; This program is free software; you can redistribute it and/or modify ;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by ;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option) ;; the Free Software Foundation; either version 3, or (at your option)
@ -22,8 +24,7 @@
;; GNU General Public License for more details. ;; GNU General Public License for more details.
;; ;;
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Commentary: ;;; Commentary:
;; ;;

8
contrib/lisp/org-screen.el
View File

@ -7,20 +7,18 @@
;; ;;
;; This file is not yet part of GNU Emacs. ;; This file is not yet part of GNU Emacs.
;; ;;
;; GNU Emacs is free software; you can redistribute it and/or modify ;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by ;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option) ;; the Free Software Foundation; either version 3, or (at your option)
;; any later version. ;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful, ;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details. ;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;;; Commentary: ;;; Commentary:

4
contrib/lisp/org-secretary.el
View File

@ -19,9 +19,7 @@
;; GNU General Public License for more details. ;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;;; Commentary: ;;; Commentary:

18
contrib/lisp/org-static-mathjax.el
View File

@ -2,6 +2,22 @@
;; ;;
;; Author: Jan Böker <jan dot boecker at jboecker dot de> ;; Author: Jan Böker <jan dot boecker at jboecker dot de>
;; 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 elisp code integrates Static MathJax into the ;; This elisp code integrates Static MathJax into the
;; HTML export process of Org-mode. ;; HTML export process of Org-mode.
;; ;;
@ -39,7 +55,7 @@
;; of your math, add the following line at the top of your Org file: ;; of your math, add the following line at the top of your Org file:
;; -*- coding: utf-8; -*- ;; -*- coding: utf-8; -*-
;; ;;
;; License: GPL v2 or later ;;; Code:
(defcustom org-static-mathjax-app-ini-path (defcustom org-static-mathjax-app-ini-path
(or (expand-file-name (or (expand-file-name

8
contrib/lisp/org-sudoku.el
View File

@ -9,20 +9,18 @@
;; ;;
;; This file is not yet part of GNU Emacs. ;; This file is not yet part of GNU Emacs.
;; ;;
;; GNU Emacs is free software; you can redistribute it and/or modify ;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by ;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option) ;; the Free Software Foundation; either version 3, or (at your option)
;; any later version. ;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful, ;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details. ;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;;; Commentary: ;;; Commentary:

3
contrib/lisp/org-toc.el
View File

@ -20,8 +20,7 @@
;; GNU General Public License for more details. ;; GNU General Public License for more details.
;; ;;
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Commentary: ;;; Commentary:

7
contrib/lisp/org-track.el
View File

@ -16,12 +16,12 @@
;; ;;
;; This file is not part of GNU Emacs. ;; This file is not part of GNU Emacs.
;; ;;
;; GNU Emacs is free software: you can redistribute it and/or modify ;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by ;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or ;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version. ;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful, ;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details. ;; GNU General Public License for more details.
@ -69,10 +69,9 @@ unpack it into that directory (i.e. a subdirectory
sources. sources.
All you'll have to do is call `M-x org-track-update' from All you'll have to do is call `M-x org-track-update' from
time to time." time to time."
:version "22.1"
:group 'org) :group 'org)
(defcustom org-track-directory "~/.emacs.d/org/lisp" (defcustom org-track-directory (concat user-emacs-directory "org/lisp")
"Directory where your org-mode/ directory lives. "Directory where your org-mode/ directory lives.
If that directory does not exist, it will be created." If that directory does not exist, it will be created."
:type 'directory) :type 'directory)

5
contrib/lisp/org-velocity.el
View File

@ -17,9 +17,8 @@
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details. ;; General Public License for more details.
;; For a copy of the GNU General Public License, search the Internet, ;; You should have received a copy of the GNU General Public License
;; or write to the Free Software Foundation, Inc., 59 Temple Place, ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; Suite 330, Boston, MA 02111-1307 USA
;;; Commentary: ;;; Commentary:
;; Org-Velocity.el is an interface for Org inspired by the minimalist ;; Org-Velocity.el is an interface for Org inspired by the minimalist

6
lisp/org-vm.el → contrib/lisp/org-vm.el
View File

@ -10,14 +10,14 @@
;; by Konrad Hinsen <konrad dot hinsen at fastmail dot net> ;; by Konrad Hinsen <konrad dot hinsen at fastmail dot net>
;; Requires VM 8.2.0a or later. ;; Requires VM 8.2.0a or later.
;; ;;
;; This file is part of GNU Emacs. ;; This file is not part of GNU Emacs.
;; ;;
;; GNU Emacs is free software: you can redistribute it and/or modify ;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by ;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or ;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version. ;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful, ;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details. ;; GNU General Public License for more details.

51
contrib/lisp/org-wikinodes.el
View File

@ -9,12 +9,12 @@
;; ;;
;; This file is not part of GNU Emacs. ;; This file is not part of GNU Emacs.
;; ;;
;; GNU Emacs is free software: you can redistribute it and/or modify ;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by ;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or ;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version. ;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful, ;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details. ;; GNU General Public License for more details.
@ -281,30 +281,29 @@ with working links."
link file) link file)
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward re nil t) (while (re-search-forward re nil t)
(org-if-unprotected-at (match-beginning 0) (unless (save-match-data
(unless (save-match-data (or (org-at-heading-p)
(or (org-at-heading-p) (org-in-regexp org-bracket-link-regexp)
(org-in-regexp org-bracket-link-regexp) (org-in-regexp org-plain-link-re)
(org-in-regexp org-plain-link-re) (org-in-regexp "<<[^<>]+>>")))
(org-in-regexp "<<[^<>]+>>"))) (setq link (match-string 0))
(setq link (match-string 0)) (delete-region (match-beginning 0) (match-end 0))
(delete-region (match-beginning 0) (match-end 0)) (save-match-data
(save-match-data (cond
(cond ((org-find-exact-headline-in-buffer link (current-buffer))
((org-find-exact-headline-in-buffer link (current-buffer)) ;; Found in current buffer
;; Found in current buffer (insert (format "[[#%s][%s]]" link link)))
(insert (format "[[#%s][%s]]" link link))) ((eq org-wikinodes-scope 'file)
((eq org-wikinodes-scope 'file) ;; No match in file, and other files are not allowed
;; No match in file, and other files are not allowed (insert (format "%s" link)))
(insert (format "%s" link))) ((setq file
((setq file (and (org-string-nw-p org-current-export-file)
(and (org-string-nw-p org-current-export-file) (org-wikinodes-which-file
(org-wikinodes-which-file link (file-name-directory org-current-export-file))))
link (file-name-directory org-current-export-file)))) ;; Match in another file in the current directory
;; Match in another file in the current directory (insert (format "[[file:%s::%s][%s]]" file link link)))
(insert (format "[[file:%s::%s][%s]]" file link link))) (t ;; No match for this link
(t ;; No match for this link (insert (format "%s" link)))))))))
(insert (format "%s" link))))))))))
;;; Hook the WikiNode mechanism into Org ;;; Hook the WikiNode mechanism into Org

11
lisp/org-wl.el → contrib/lisp/org-wl.el
View File

@ -7,14 +7,14 @@
;; Keywords: outlines, hypermedia, calendar, wp ;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org ;; Homepage: http://orgmode.org
;; ;;
;; This file is part of GNU Emacs. ;; This file is not part of GNU Emacs.
;; ;;
;; GNU Emacs is free software: you can redistribute it and/or modify ;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by ;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or ;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version. ;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful, ;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details. ;; GNU General Public License for more details.
@ -46,13 +46,11 @@
(defcustom org-wl-link-remove-filter nil (defcustom org-wl-link-remove-filter nil
"Remove filter condition if message is filter folder." "Remove filter condition if message is filter folder."
:group 'org-wl :group 'org-wl
:version "24.1"
:type 'boolean) :type 'boolean)
(defcustom org-wl-shimbun-prefer-web-links nil (defcustom org-wl-shimbun-prefer-web-links nil
"If non-nil create web links for shimbun messages." "If non-nil create web links for shimbun messages."
:group 'org-wl :group 'org-wl
:version "24.1"
:type 'boolean) :type 'boolean)
(defcustom org-wl-nntp-prefer-web-links nil (defcustom org-wl-nntp-prefer-web-links nil
@ -60,19 +58,16 @@
When folder name contains string \"gmane\" link to gmane, When folder name contains string \"gmane\" link to gmane,
googlegroups otherwise." googlegroups otherwise."
:type 'boolean :type 'boolean
:version "24.1"
:group 'org-wl) :group 'org-wl)
(defcustom org-wl-disable-folder-check t (defcustom org-wl-disable-folder-check t
"Disable check for new messages when open a link." "Disable check for new messages when open a link."
:type 'boolean :type 'boolean
:version "24.1"
:group 'org-wl) :group 'org-wl)
(defcustom org-wl-namazu-default-index nil (defcustom org-wl-namazu-default-index nil
"Default namazu search index." "Default namazu search index."
:type 'directory :type 'directory
:version "24.1"
:group 'org-wl) :group 'org-wl)
;; Declare external functions and variables ;; Declare external functions and variables

651
contrib/lisp/org2rem.el
View File

@ -1,651 +0,0 @@
;;; org2rem.el --- Convert org appointments into reminders
;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
;; Author: Bastien Guerry and Shatad Pratap
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 6.09a
;;
;; 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:
;; (require 'org2rem)
;; To export, do
;;
;; M-x org2rem-combine-agenda-files
;;
;; Then you can use reming like this:
;;
;; $ remind ~/org.rem
;;
;; If you want to use this regualrly, try in .emacs
;;
;; (add-hook 'org-mode-hook
;; (lambda() (add-hook 'after-save-hook
;; 'org-export-remind-all-agenda-files t t)))
(require 'org)
(require 'org-agenda)
(require 'org-exp)
(eval-and-compile
(require 'cl))
(defgroup org2rem nil
"Options specific for Remind export of Org-mode files."
:tag "Org Export Remind"
:group 'org-export)
(defcustom org-combined-agenda-remind-file "~/org.rem"
"The file name for the Remind file covering all agenda files.
This file is created with the command \\[org2rem-all-agenda-files].
The file name should be absolute, the file will be overwritten without warning."
:group 'org2rem
:type 'file)
(defcustom org-remind-combined-name "OrgMode"
"Calendar name for the combined Remind representing all agenda files."
:group 'org2rem
:type 'string)
(defcustom org-remind-use-deadline '(event-if-not-todo todo-due)
"Contexts where Remind export should use a deadline time stamp.
This is a list with several symbols in it. Valid symbol are:
event-if-todo Deadlines in TODO entries become calendar events.
event-if-not-todo Deadlines in non-TODO entries become calendar events.
todo-due Use deadlines in TODO entries as due-dates"
:group 'org2rem
:type '(set :greedy t
(const :tag "Deadlines in non-TODO entries become events"
event-if-not-todo)
(const :tag "Deadline in TODO entries become events"
event-if-todo)
(const :tag "Deadlines in TODO entries become due-dates"
todo-due)))
(defcustom org-remind-use-scheduled '(todo-start)
"Contexts where Remind export should use a scheduling time stamp.
This is a list with several symbols in it. Valid symbol are:
event-if-todo Scheduling time stamps in TODO entries become an event.
event-if-not-todo Scheduling time stamps in non-TODO entries become an event.
todo-start Scheduling time stamps in TODO entries become start date.
Some calendar applications show TODO entries only after
that date."
:group 'org2rem
:type '(set :greedy t
(const :tag
"SCHEDULED timestamps in non-TODO entries become events"
event-if-not-todo)
(const :tag "SCHEDULED timestamps in TODO entries become events"
event-if-todo)
(const :tag "SCHEDULED in TODO entries become start date"
todo-start)))
(defcustom org-remind-categories '(local-tags category)
"Items that should be entered into the categories field.
This is a list of symbols, the following are valid:
category The Org-mode category of the current file or tree
todo-state The todo state, if any
local-tags The tags, defined in the current line
all-tags All tags, including inherited ones."
:group 'org2rem
:type '(repeat
(choice
(const :tag "The file or tree category" category)
(const :tag "The TODO state" todo-state)
(const :tag "Tags defined in current line" local-tags)
(const :tag "All tags, including inherited ones" all-tags))))
(defcustom org-remind-include-todo nil
"Non-nil means export to remind files should also cover TODO items."
:group 'org2rem
:type '(choice
(const :tag "None" nil)
(const :tag "Unfinished" t)
(const :tag "All" all)))
(defcustom org-remind-include-sexps t
"Non-nil means export to Remind files should also cover sexp entries.
These are entries like in the diary, but directly in an Org-mode file."
:group 'org2rem
:type 'boolean)
(defcustom org-remind-deadline-over-scheduled t
"Non-nil means use deadline as target when both deadline and
scheduled present, vice-versa. Default is Non-nil."
:group 'org2rem
:type 'boolean)
(defcustom org-remind-escape-percentage t
"Non-nil means % will be escaped, vice-versa. Default is Non-nil."
:group 'org2rem
:type 'boolean)
(defcustom org-remind-extra-warn-days 3
"Extra days Remind keep reminding."
:group 'org2rem
:type 'number)
(defcustom org-remind-advanced-warn-days 3
"Advanced days Remind start reminding."
:group 'org2rem
:type 'number)
(defcustom org-remind-suppress-last-newline nil
"Non-nil means suppress last newline REM body. Default is nil."
:group 'org2rem
:type 'boolean)
(defcustom org-remind-include-body 100
"Amount of text below headline to be included in Remind export.
This is a number of characters that should maximally be included.
Properties, scheduling and clocking lines will always be removed.
The text will be inserted into the DESCRIPTION field."
:group 'org2rem
:type '(choice
(const :tag "Nothing" nil)
(const :tag "Everything" t)
(integer :tag "Max characters")))
(defcustom org-remind-store-UID nil
"Non-nil means store any created UIDs in properties.
The Remind standard requires that all entries have a unique identifyer.
Org will create these identifiers as needed. When this variable is non-nil,
the created UIDs will be stored in the ID property of the entry. Then the
next time this entry is exported, it will be exported with the same UID,
superceeding the previous form of it. This is essential for
synchronization services.
This variable is not turned on by default because we want to avoid creating
a property drawer in every entry if people are only playing with this feature,
or if they are only using it locally."
:group 'org2rem
:type 'boolean)
;;;; Exporting
;;; Remind export
;;;###autoload
(defun org2rem-this-file ()
"Export current file as an Remind file.
The Remind file will be located in the same directory as the Org-mode
file, but with extension `.rem'."
(interactive)
(org2rem nil buffer-file-name))
;;;###autoload
(defun org2rem-all-agenda-files ()
"Export all files in `org-agenda-files' to Remind .rem files.
Each Remind file will be located in the same directory as the Org-mode
file, but with extension `.rem'."
(interactive)
(apply 'org2rem nil (org-agenda-files t)))
;;;###autoload
(defun org2rem-combine-agenda-files ()
"Export all files in `org-agenda-files' to a single combined Remind file.
The file is stored under the name `org-combined-agenda-remind-file'."
(interactive)
(apply 'org2rem t (org-agenda-files t)))
(defun org2rem (combine &rest files)
"Create Remind files for all elements of FILES.
If COMBINE is non-nil, combine all calendar entries into a single large
file and store it under the name `org-combined-agenda-remind-file'."
(save-excursion
(org-agenda-prepare-buffers files)
(let* ((dir (org-export-directory
:ical (list :publishing-directory
org-export-publishing-directory)))
file rem-file rem-buffer category started org-agenda-new-buffers)
(and (get-buffer "*rem-tmp*") (kill-buffer "*rem-tmp*"))
(when combine
(setq rem-file
(if (file-name-absolute-p org-combined-agenda-remind-file)
org-combined-agenda-remind-file
(expand-file-name org-combined-agenda-remind-file dir))
rem-buffer (org-get-agenda-file-buffer rem-file))
(set-buffer rem-buffer) (erase-buffer))
(while (setq file (pop files))
(catch 'nextfile
(org-check-agenda-file file)
(set-buffer (org-get-agenda-file-buffer file))
(unless combine
(setq rem-file (concat (file-name-as-directory dir)
(file-name-sans-extension
(file-name-nondirectory buffer-file-name))
".rem"))
(setq rem-buffer (org-get-agenda-file-buffer rem-file))
(with-current-buffer rem-buffer (erase-buffer)))
(setq category (or org-category
(file-name-sans-extension
(file-name-nondirectory buffer-file-name))))
(if (symbolp category) (setq category (symbol-name category)))
(let ((standard-output rem-buffer))
(if combine
(and (not started) (setq started t)
(org-start-remind-file org-remind-combined-name))
(org-start-remind-file category))
(org-print-remind-entries combine)
(when (or (and combine (not files)) (not combine))
(org-finish-remind-file)
(set-buffer rem-buffer)
(run-hooks 'org-before-save-Remind-file-hook)
(save-buffer)
(run-hooks 'org-after-save-Remind-file-hook)
(and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait))
))))
(org-release-buffers org-agenda-new-buffers))))
(defvar org-before-save-Remind-file-hook nil
"Hook run before an Remind file has been saved.
This can be used to modify the result of the export.")
(defvar org-after-save-Remind-file-hook nil
"Hook run after an Remind file has been saved.
The Remind buffer is still current when this hook is run.
A good way to use this is to tell a desktop calenndar application to re-read
the Remind file.")
(defvar org-agenda-default-appointment-duration) ; defined in org-agenda.el
(defun org-print-remind-entries (&optional combine)
"Print Remind entries for the current Org-mode file to `standard-output'.
When COMBINE is non nil, add the category to each line."
(require 'org-agenda)
(let ((re1 (concat org-ts-regexp "\\|<%%([^>\n]+>"))
(re2 (concat "--?-?\\(" org-ts-regexp "\\)"))
(dts (org-rem-ts-to-string
(format-time-string (cdr org-time-stamp-formats) (current-time))
"start time:"))
hd ts ts2 state status (inc t) pos b sexp rrule
scheduledp deadlinep todo prefix due start
tmp pri categories entry location summary desc uid
remind-aw remind-ew (org-rem-ew org-remind-extra-warn-days)
(org-rem-aw org-remind-advanced-warn-days)
trigger diff-days (dos org-remind-deadline-over-scheduled)
(suppress-last-newline org-remind-suppress-last-newline)
(sexp-buffer (get-buffer-create "*rem-tmp*")))
(org-refresh-category-properties)
(save-excursion
(goto-char (point-min))
(while (re-search-forward re1 nil t)
(catch :skip
(org-agenda-skip)
(when (boundp 'org-remind-verify-function)
(unless (funcall org-remind-verify-function)
(outline-next-heading)
(backward-char 1)
(throw :skip nil)))
(setq pos (match-beginning 0)
ts (match-string 0)
inc t
hd (condition-case nil
(org-remind-cleanup-string
(org-get-heading))
(error (throw :skip nil)))
summary (org-remind-cleanup-string
(org-entry-get nil "SUMMARY"))
desc (org-remind-cleanup-string
(or (org-entry-get nil "DESCRIPTION")
(and org-remind-include-body (org-get-entry)))
t org-remind-include-body)
location (org-remind-cleanup-string
(org-entry-get nil "LOCATION"))
uid (if org-remind-store-UID
(org-id-get-create)
(or (org-id-get) (org-id-new)))
categories (org-export-get-remind-categories)
deadlinep nil scheduledp nil)
(if (looking-at re2)
(progn
(goto-char (match-end 0))
(setq ts2 (match-string 1)
inc (not (string-match "[0-9]\\{1,2\\}:[0-9][0-9]" ts2))))
(setq tmp (buffer-substring (max (point-min)
(- pos org-ds-keyword-length))
pos)
ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts)
(progn
(setq inc nil)
(replace-match "\\1" t nil ts))
ts)
deadlinep (string-match org-deadline-regexp tmp)
scheduledp (string-match org-scheduled-regexp tmp)
todo (org-get-todo-state)
;; donep (org-entry-is-done-p)
))
(when (and
deadlinep
(if todo
(not (memq 'event-if-todo org-remind-use-deadline))
(not (memq 'event-if-not-todo org-remind-use-deadline))))
(throw :skip t))
(when (and
scheduledp
(if todo
(not (memq 'event-if-todo org-remind-use-scheduled))
(not (memq 'event-if-not-todo org-remind-use-scheduled))))
(throw :skip t))
(setq prefix (if deadlinep "DEADLINE-" (if scheduledp "SCHEDULED-" "TS-")))
(if (or (string-match org-tr-regexp hd)
(string-match org-ts-regexp hd))
(setq hd (replace-match "" t t hd)))
(if (string-match "\\+\\([0-9]+\\)\\([dwmy]\\)>" ts)
(setq rrule ;is recurrence value. later give it good name.
(* (string-to-number
(cdr (assoc
(match-string 2 ts)
'(("d" . "1")("w" . "7")
("m" . "0")("y" . "0")))))
(string-to-number (match-string 1 ts))))
(setq rrule nil))
(setq summary (or summary hd))
(if (string-match org-bracket-link-regexp summary)
(setq summary
(replace-match (if (match-end 3)
(match-string 3 summary)
(match-string 1 summary))
t t summary)))
(if deadlinep (setq summary (concat "DEADLINE: " summary)))
(if scheduledp (setq summary (concat "SCHEDULED: " summary)))
(if (string-match "\\`<%%" ts)
(with-current-buffer sexp-buffer
(insert (substring ts 1 -1) " " summary "\n"))
(princ (format "\n## BEGIN:EVENT
## UID: %s
REM %s %s MSG EVENT:%s%s %s%s%%
## CATEGORIES:%s
## END:EVENT\n"
(concat prefix uid)
(org-rem-ts-to-string ts nil nil rrule)
(org-rem-ts-to-string ts2 "UNTIL " inc)
summary
(if (and desc (string-match "\\S-" desc))
(concat "%_\\\n" desc) "")
(if (and location (string-match "\\S-" location))
(concat "\nLOCATION: " location) "")
(if suppress-last-newline "" "%_")
categories)))))
(when (and org-remind-include-sexps
(condition-case nil (require 'remind) (error nil))
(fboundp 'remind-export-region))
;; Get all the literal sexps
(goto-char (point-min))
(while (re-search-forward "^&?%%(" nil t)
(catch :skip
(org-agenda-skip)
(setq b (match-beginning 0))
(goto-char (1- (match-end 0)))
(forward-sexp 1)
(end-of-line 1)
(setq sexp (buffer-substring b (point)))
(with-current-buffer sexp-buffer
(insert sexp "\n"))))
;; (princ (org-diary-to-rem-string sexp-buffer))
(kill-buffer sexp-buffer))
(when org-remind-include-todo
(setq prefix "TODO-")
(goto-char (point-min))
(while (re-search-forward org-todo-line-regexp nil t)
(catch :skip
(org-agenda-skip)
(when (boundp 'org-remind-verify-function)
(unless (funcall org-remind-verify-function)
(outline-next-heading)
(backward-char 1)
(throw :skip nil)))
(setq state (match-string 2))
(setq status (if (member state org-done-keywords)
"COMPLETED" "NEEDS-ACTION"))
(when (and state
(or (not (member state org-done-keywords))
(eq org-remind-include-todo 'all))
(not (member org-archive-tag (org-get-tags-at)))
)
(setq hd (match-string 3)
summary (org-remind-cleanup-string
(org-entry-get nil "SUMMARY"))
desc (org-remind-cleanup-string
(or (org-entry-get nil "DESCRIPTION")
(and org-remind-include-body (org-get-entry)))
t org-remind-include-body)
location (org-remind-cleanup-string
(org-entry-get nil "LOCATION"))
due (and (member 'todo-due org-remind-use-deadline)
(org-entry-get nil "DEADLINE"))
start (and (member 'todo-start org-remind-use-scheduled)
(org-entry-get nil "SCHEDULED"))
categories (org-export-get-remind-categories)
uid (if org-remind-store-UID
(org-id-get-create)
(or (org-id-get) (org-id-new))))
(if (and due start)
(setq diff-days (org-rem-time-diff-days due start)))
(setq remind-aw
(if due
(if diff-days
(if (> diff-days 0)
(if dos diff-days 0)
(if dos 0 diff-days))
1000)))
(if (and (numberp org-rem-aw) (> org-rem-aw 0))
(setq remind-aw (+ (or remind-aw 0) org-rem-aw)))
(setq remind-ew
(if due
(if diff-days
(if (> diff-days 0) due nil)
due)))
(setq trigger (if dos (if due due start) (if start start due)))
;; (and trigger (setq trigger (org-rem-ts-to-string trigger nil nil 1 remind-aw)))
(if trigger
(setq trigger (concat
(format "[trigger('%s')] *%d "
(org-rem-ts-to-remind-date-type trigger) 1)
(if remind-aw (format "++%d" remind-aw)))))
(and due (setq due (org-rem-ts-to-remind-date-type due)))
(and start (setq start (org-rem-ts-to-remind-date-type start)))
(and remind-ew (setq remind-ew (org-rem-ts-to-remind-date-type remind-ew)))
(if (string-match org-bracket-link-regexp hd)
(setq hd (replace-match (if (match-end 3) (match-string 3 hd)
(match-string 1 hd))
t t hd)))
(if (string-match org-priority-regexp hd)
(setq pri (string-to-char (match-string 2 hd))
hd (concat (substring hd 0 (match-beginning 1))
(substring hd (match-end 1))))
(setq pri org-default-priority))
(setq pri (floor (1+ (* 8. (/ (float (- org-lowest-priority pri))
(- org-lowest-priority org-highest-priority))))))
(princ (format "\n## BEGIN:TODO
## UID: %s
REM %s %s %s MSG TODO: %s%s%s%s%s%s%%
## CATEGORIES:%s
## SEQUENCE:1
## STATUS:%s
## END:TODO\n"
(concat prefix uid)
(or trigger "") ;; dts)
(if remind-ew (format "UNTIL [trigger('%s' + %d)]" remind-ew (or org-rem-ew 0)) "")
(if pri (format "PRIORITY %d" pri) "")
(or summary hd)
(if (and desc (string-match "\\S-" desc))
(concat "%_\\\nDESCRIPTION: " desc) "")
(if (and location (string-match "\\S-" location))
(concat "LOCATION: " location) "")
(if start
(concat
"%_\\\n['" start "' - today()] "
"days over, for scheduled date - "
"[trigger('" start "')]") "")
(if due
(concat
"%_\\\n[today() - '" due "'] "
"days left, to deadline date - "
"[trigger('" due "')]") "")
(if suppress-last-newline "" "%_")
categories
status)))))))))
(defun org-export-get-remind-categories ()
"Get categories according to `org-remind-categories'."
(let ((cs org-remind-categories) c rtn tmp)
(while (setq c (pop cs))
(cond
((eq c 'category) (push (org-get-category) rtn))
((eq c 'todo-state)
(setq tmp (org-get-todo-state))
(and tmp (push tmp rtn)))
((eq c 'local-tags)
(setq rtn (append (nreverse (org-get-local-tags-at (point))) rtn)))
((eq c 'all-tags)
(setq rtn (append (nreverse (org-get-tags-at (point))) rtn)))))
(mapconcat 'identity (nreverse rtn) ",")))
(defun org-remind-cleanup-string (s &optional is-body maxlength)
"Take out stuff and quote what needs to be quoted.
When IS-BODY is non-nil, assume that this is the body of an item, clean up
whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH
characters."
(if (or (not s) (string-match "^[ \t\n]*$" s))
nil
(when is-body
(let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?"))
(re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?")))
(while (string-match re s) (setq s (replace-match "" t t s)))
(while (string-match re2 s) (setq s (replace-match "" t t s)))))
(if org-remind-escape-percentage
(let ((start 0))
(while (string-match "\\([%]\\)" s start)
(setq start (+ (match-beginning 0) 2)
s (replace-match "\\1\\1" nil nil s)))))
(let ((start 0))
(while (string-match "\\([\n]\\)" s start)
(setq start (+ (match-beginning 0) 4) ;; less than 4 is not correct.
s (replace-match "%_\\\\\\1" nil nil s))))
(let ((start 0))
(while (string-match "\\([[]\\)" s start)
(setq start (+ (match-beginning 0) 5)
s (replace-match (concat "\[" "\"" "\\1" "\"" "\]") nil nil s))))
;;; (when is-body
;;; (while (string-match "[ \t]*\n[ \t]*" s)
;;; (setq s (replace-match "%_" t t s))))
(setq s (org-trim s))
(if is-body
(if maxlength
(if (and (numberp maxlength)
(> (length s) maxlength))
(setq s (substring s 0 maxlength)))))
s))
(defun org-get-entry ()
"Clean-up description string."
(save-excursion
(org-back-to-heading t)
(buffer-substring (point-at-bol 2) (org-end-of-subtree t))))
(defun org-start-remind-file (name)
"Start an Remind file by inserting the header."
(let ((user user-full-name)
(name (or name "unknown"))
(timezone (cadr (current-time-zone))))
(princ
(format "# -*- Mode: shell-script; auto-fill-mode: nil -*-
## BEGIN: Reminders
## VERSION:2.0
## Emacs with Org-mode
## Calendar:%s
## Created by: %s
## Timezone:%s
## Calscale:Gregorian\n" name user timezone))))
(defun org-finish-remind-file ()
"Finish an Remind file by inserting the END statement."
(princ "\n## END:Reminders\n"))
(defun org-rem-ts-to-remind-date-type (s)
(format-time-string
"%Y-%m-%d"
(apply 'encode-time (butlast (org-parse-time-string s) 3))))
;; (defun org-rem-date-type-to-string (s keyword &optional inc day-repeat day-advance-warn)
;; (if trigger
;; (setq trigger
;; (concat
;; (format "[trigger('%s')] *%d "
;; (org-rem-ts-to-remind-date-type trigger) day-repeat)
;; (if day-advance-warn (format "++%d" day-advance-warn))))))
;; (format-time-string "%Y"
;; (apply 'encode-time (butlast (org-parse-time-string "<2008-11-20 Thu 10:30>") 3)))
(defun org-rem-ts-to-string (s keyword &optional inc day-repeat day-advance-warn)
"Take a time string S and convert it to Remind format.
KEYWORD is added in front, to make a complete line like DTSTART....
When INC is non-nil, increase the hour by two (if time string contains
a time), or the day by one (if it does not contain a time)."
(let ((t1 (org-parse-time-string s 'nodefault))
t2 fmt have-time time)
(if (and (car t1) (nth 1 t1) (nth 2 t1))
(setq t2 t1 have-time t)
(setq t2 (org-parse-time-string s)))
(let ((s (car t2)) (mi (nth 1 t2)) (h (nth 2 t2))
(d (nth 3 t2)) (m (nth 4 t2)) (y (nth 5 t2)))
(when inc
(if have-time
(if org-agenda-default-appointment-duration
(setq mi (+ org-agenda-default-appointment-duration mi))
(setq h (+ 2 h)))
(setq d (1+ d))))
(setq time (encode-time s mi h d m y)))
(setq fmt (concat
"%d %b %Y"
(if day-advance-warn (format " ++%d" day-advance-warn))
(if day-repeat (format " *%d" day-repeat))
(if have-time " AT %H:%M")))
(concat keyword (format-time-string fmt time))))
(defun org-rem-time-diff-days (end start)
(floor (/ (apply '- (mapcar
(lambda (s)
(let*
((t1 (org-parse-time-string s))
(s (car t1)) (mi (nth 1 t1))
(h (nth 2 t1)) (d (nth 3 t1))
(m (nth 4 t1)) (y (nth 5 t1)))
(float-time (encode-time s mi h d m y))))
(list end start))) (* 24 60 60))))
(provide 'org2rem)
;;; org-exp.el ends here

2
contrib/lisp/orgtbl-sqlinsert.el
View File

@ -5,6 +5,8 @@
;; Author: Jason Riedy <jason@acm.org> ;; Author: Jason Riedy <jason@acm.org>
;; Keywords: org, tables, sql ;; Keywords: org, tables, sql
;; This file is not part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify ;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by ;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or ;; the Free Software Foundation, either version 3 of the License, or

191
contrib/lisp/ox-confluence.el Normal file
View File

@ -0,0 +1,191 @@
;;; ox-confluence --- Confluence Wiki Back-End for Org Export Engine
;; Copyright (C) 2012 Sébastien Delafond
;; Author: Sébastien Delafond <sdelafond at gmx dot net>
;; Keywords: outlines, confluence, wiki
;; 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 of the License, 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:
;;
;; ox-confluence.el lets you convert Org files to confluence files
;; using the ox.el export engine.
;;
;; Put this file into your load-path and the following into your ~/.emacs:
;; (require 'ox-confluence)
;;
;; Export Org files to confluence:
;; M-x org-confluence-export-as-confluence RET
;;
;;; Code:
(require 'ox)
(require 'ox-ascii)
;; Define the backend itself
(org-export-define-derived-backend 'confluence 'ascii
:translate-alist '((bold . org-confluence-bold)
(example-block . org-confluence-example-block)
(fixed-width . org-confluence-fixed-width)
(footnote-definition . org-confluence-empty)
(footnote-reference . org-confluence-empty)
(headline . org-confluence-headline)
(italic . org-confluence-italic)
(link . org-confluence-link)
(section . org-confluence-section)
(src-block . org-confluence-src-block)
(strike-through . org-confluence-strike-through)
(table . org-confluence-table)
(table-cell . org-confluence-table-cell)
(table-row . org-confluence-table-row)
(template . org-confluence-template)
(underline . org-confluence-underline)))
;; All the functions we use
(defun org-confluence-bold (bold contents info)
(format "*%s*" contents))
(defun org-confluence-empty (empty contents info)
"")
(defun org-confluence-example-block (example-block contents info)
;; FIXME: provide a user-controlled variable for theme
(let ((content (org-export-format-code-default example-block info)))
(org-confluence--block "none" "Confluence" content)))
(defun org-confluence-italic (italic contents info)
(format "_%s_" contents))
(defun org-confluence-fixed-width (fixed-width contents info)
(format "\{\{%s\}\}" contents))
(defun org-confluence-headline (headline contents info)
(let ((low-level-rank (org-export-low-level-p headline info))
(text (org-export-data (org-element-property :title headline)
info))
(level (org-export-get-relative-level headline info)))
;; Else: Standard headline.
(format "h%s. %s\n%s" level text
(if (org-string-nw-p contents) contents
""))))
(defun org-confluence-link (link desc info)
(let ((raw-link (org-element-property :raw-link link)))
(concat "["
(when (org-string-nw-p desc) (format "%s|" desc))
(cond
((string-match "^confluence:" raw-link)
(replace-regexp-in-string "^confluence:" "" raw-link))
(t
raw-link))
"]")))
(defun org-confluence-section (section contents info)
contents)
(defun org-confluence-src-block (src-block contents info)
;; FIXME: provide a user-controlled variable for theme
(let* ((lang (org-element-property :language src-block))
(language (if (string= lang "sh") "bash" ;; FIXME: provide a mapping of some sort
lang))
(content (org-export-format-code-default src-block info)))
(org-confluence--block language "Emacs" content)))
(defun org-confluence-strike-through (strike-through contents info)
(format "-%s-" contents))
(defun org-confluence-table (table contents info)
contents)
(defun org-confluence-table-row (table-row contents info)
(concat
(if (org-string-nw-p contents) (format "|%s" contents)
"")
(when (org-export-table-row-ends-header-p table-row info)
"|")))
(defun org-confluence-table-cell (table-cell contents info)
(let ((table-row (org-export-get-parent table-cell)))
(concat
(when (org-export-table-row-starts-header-p table-row info)
"|")
contents "|")))
(defun org-confluence-template (contents info)
(let ((depth (plist-get info :with-toc)))
(concat (when depth "\{toc\}\n\n") contents)))
(defun org-confluence-underline (underline contents info)
(format "+%s+" contents))
(defun org-confluence--block (language theme contents)
(concat "\{code:theme=" theme
(when language (format "|language=%s" language))
"}\n"
contents
"\{code\}\n"))
;; main interactive entrypoint
(defun org-confluence-export-as-confluence
(&optional async subtreep visible-only body-only ext-plist)
"Export current buffer to a text 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.
When optional argument BODY-ONLY is non-nil, strip title, table
of contents and footnote definitions from output.
EXT-PLIST, when provided, is a property list with external
parameters overriding Org default settings, but still inferior to
file-local settings.
Export is done in a buffer named \"*Org E-Confluence Export*\", which
will be displayed when `org-export-show-temporary-export-buffer'
is non-nil."
(interactive)
(if async
(org-export-async-start
(lambda (output)
(with-current-buffer (get-buffer-create "*Org E-Confluence Export*")
(erase-buffer)
(insert output)
(goto-char (point-min))
(text-mode)
(org-export-add-to-stack (current-buffer) 'confluence)))
`(org-export-as 'confluence ,subtreep ,visible-only ,body-only
',ext-plist))
(let ((outbuf (org-export-to-buffer
'confluence "*Org E-Confluence Export*"
subtreep visible-only body-only ext-plist)))
(with-current-buffer outbuf (text-mode))
(when org-export-show-temporary-export-buffer
(switch-to-buffer-other-window outbuf)))))
(provide 'ox-confluence)

590
contrib/lisp/ox-deck.el Normal file
View File

@ -0,0 +1,590 @@
;;; ox-deck.el --- deck.js Presentation Back-End for Org Export Engine
;; Copyright (C) 2013 Rick Frankel
;; Author: Rick Frankel <emacs at rickster dot com>
;; Keywords: outlines, hypermedia, slideshow
;; 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 of the License, 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 this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements a deck.js presentation back-end for the Org
;; generic exporter.
;; Installation
;; -------------
;; Get a copy of deck.js from http://imakewebthings.com/deck.js/ or
;; the gitub repository at https://github.com/imakewebthings/deck.js.
;;
;; Add the path to the extracted code to the variable
;; `org-deck-directories' There are a number of customization in the
;; org-export-deck group, most of which can be overrriden with buffer
;; local customization (starting with DECK_.)
;; See ox.el and ox-html.el for more details on how this exporter
;; works (it is derived from ox-html.)
(require 'ox-html)
(eval-when-compile (require 'cl))
(org-export-define-derived-backend 'deck 'html
:menu-entry
'(?d "Export to deck.js HTML Presentation"
((?H "To temporary buffer" org-deck-export-as-html)
(?h "To file" org-deck-export-to-html)
(?o "To file and open"
(lambda (a s v b)
(if a (org-deck-export-to-html t s v b)
(org-open-file (org-deck-export-to-html nil s v b)))))))
:options-alist
'((:html-link-home "HTML_LINK_HOME" nil nil)
(: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-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)
(:deck-transition "DECK_TRANSITION" nil org-deck-transition)
(:deck-include-extensions "DECK_INCLUDE_EXTENSIONS" nil
org-deck-include-extensions split)
(:deck-exclude-extensions "DECK_EXCLUDE_EXTENSIONS" nil
org-deck-exclude-extensions split))
:translate-alist
'((headline . org-deck-headline)
(inner-template . org-deck-inner-template)
(item . org-deck-item)
(template . org-deck-template)))
(defgroup org-export-deck nil
"Options for exporting Org mode files to deck.js HTML Presentations."
:tag "Org Export DECK"
:group 'org-export-html)
(defcustom org-deck-directories '("./deck.js")
"Directories to search for deck.js components (jquery,
modernizr; core, extensions and themes directories.)"
:group 'org-export-deck
:type '(repeat (string :tag "Directory")))
(defun org-deck--cleanup-components (components)
(remove-duplicates
(car (remove 'nil components))
:test (lambda (x y)
(string= (file-name-nondirectory x)
(file-name-nondirectory y)))))
(defun org-deck--find-extensions ()
"Returns a unique list of all extensions found in
in the extensions directories under `org-deck-directories'"
(org-deck--cleanup-components
(mapcar ; extensions under existing dirs
(lambda (dir)
(when (file-directory-p dir) (directory-files dir t "^[^.]")))
(mapcar ; possible extension directories
(lambda (x) (expand-file-name "extensions" x))
org-deck-directories))))
(defun org-deck--find-css (type)
"Return a unique list of all the css stylesheets in the themes/TYPE
directories under `org-deck-directories'."
(org-deck--cleanup-components
(mapcar
(lambda (dir)
(let ((css-dir (expand-file-name
(concat (file-name-as-directory "themes") type) dir)))
(when (file-directory-p css-dir)
(directory-files css-dir t "\\.css$"))))
org-deck-directories)))
(defun org-deck-list-components ()
"List all available deck extensions, styles and
transitions (with full paths) to a temporary buffer."
(interactive)
(let ((outbuf (get-buffer-create "*deck.js Extensions*")))
(with-current-buffer outbuf
(erase-buffer)
(insert "Extensions\n----------\n")
(insert (mapconcat 'identity (org-deck--find-extensions) "\n"))
(insert "\n\nStyles\n------\n")
(insert (mapconcat 'identity (org-deck--find-css "style") "\n"))
(insert "\n\nTransitions\n----------\n")
(insert (mapconcat 'identity (org-deck--find-css "transition") "\n")))
(switch-to-buffer-other-window outbuf)))
(defcustom org-deck-include-extensions nil
"If non-nil, list of extensions to include instead of all available.
Can be overriden or set with the DECK_INCLUDE_EXTENSIONS property.
During output generation, the extensions found by
`org-deck--find-extensions' are searched for the appropriate
files (scripts and/or stylesheets) to include in the generated
html. The href/src attributes are created relative to `org-deck-base-url'."
:group 'org-export-deck
:type '(repeat (string :tag "Extension")))
(defcustom org-deck-exclude-extensions nil
"If non-nil, list of extensions to exclude.
Can be overriden or set with the DECK_EXCLUDE_EXTENSIONS property."
:group 'org-export-deck
:type '(repeat (string :tag "Extension")))
(defcustom org-deck-theme "swiss.css"
"deck.js theme. Can be overriden with the DECK_THEME property.
If this value contains a path component (\"/\"), it is used as a
literal path (url). Otherwise it is prepended with
`org-deck-base-url'/themes/style/."
:group 'org-export-deck
:type 'string)
(defcustom org-deck-transition "fade.css"
"deck.js transition theme. Can be overriden with the
DECK_TRANSITION property.
If this value contains a path component (\"/\"), it is used as a
literal path (url). Otherwise it is prepended with
`org-deck-base-url'/themes/transition/."
:group 'org-export-deck
:type 'string)
(defcustom org-deck-base-url "deck.js"
"Url prefix to deck.js base directory containing the core, extensions
and themes directories.
Can be overriden with the DECK_BASE_URL property."
:group 'org-export-deck
:type 'string)
(defvar org-deck-pre/postamble-styles
`((both "left: 5px; width: 100%;")
(preamble "position: absolute; top: 10px;")
(postamble ""))
"Alist of css styles for the preamble, postamble and both respectively.
Can be overriden in `org-deck-styles'. See also `org-html-divs'.")
(defcustom org-deck-postamble "<h1>%a - %t</h1>"
"Non-nil means insert a postamble in HTML export.
When set to a string, use this string
as the postamble. When t, insert a string as defined by the
formatting string in `org-html-postamble-format'.
When set to a function, apply this function and insert the
returned string. The function takes the property list of export
options as its only argument.
This is included in the document at the bottom of the content
section, and uses the postamble element and id from
`org-html-divs'. The default places the author and presentation
title at the bottom of each slide.
The css styling is controlled by `org-deck-pre/postamble-styles'.
Setting :deck-postamble in publishing projects will take
precedence over this variable."
:group 'org-export-deck
:type '(choice (const :tag "No postamble" nil)
(const :tag "Default formatting string" t)
(string :tag "Custom formatting string")
(function :tag "Function (must return a string)")))
(defcustom org-deck-preamble nil
"Non-nil means insert a preamble in HTML export.
When set to a string, use this string
as the preamble. When t, insert a string as defined by the
formatting string in `org-html-preamble-format'.
When set to a function, apply this function and insert the
returned string. The function takes the property list of export
options as its only argument.
This is included in the document at the top of content section, and
uses the preamble element and id from `org-html-divs'. The css
styling is controlled by `org-deck-pre/postamble-styles'.
Setting :deck-preamble in publishing projects will take
precedence over this variable."
:group 'org-export-deck
:type '(choice (const :tag "No preamble" nil)
(const :tag "Default formatting string" t)
(string :tag "Custom formatting string")
(function :tag "Function (must return a string)")))
(defvar org-deck-toc-styles
(mapconcat
'identity
(list
"#table-of-contents a {color: inherit;}"
"#table-of-contents ul {margin-bottom: 0;}"
"#table-of-contents li {padding: 0;}") "\n")
"Default css styles used for formatting a table of contents slide.
Can be overriden in `org-deck-styles'.
Note that when the headline numbering option is true, a \"list-style: none\"
is automatically added to avoid both numbers and bullets on the toc entries.")
(defcustom org-deck-styles
"
#title-slide h1 {
position: static; padding: 0;
margin-top: 10%;
-webkit-transform: none;
-moz-transform: none;
-ms-transform: none;
-o-transform: none;
transform: none;
}
#title-slide h2 {
text-align: center;
border:none;
padding: 0;
margin: 0;
}"
"Deck specific CSS styles to include in exported html.
Defaults to styles for the title page."
:group 'org-export-deck
:type 'string)
(defcustom org-deck-title-slide-template
"<h1>%t</h1>
<h2>%a</h2>
<h2>%e</h2>
<h2>%d</h2>"
"Format template to specify title page section.
See `org-html-postamble-format' for the valid elements which
can be included.
It will be wrapped in the element defined in the :html-container
property, and defaults to the value of `org-html-container-element',
and have the id \"title-slide\"."
:group 'org-export-deck
:type 'string)
(defun org-deck-toc (depth info)
(concat
(format "<%s id='table-of-contents' class='slide'>\n"
(plist-get info :html-container))
(format "<h2>%s</h2>\n" (org-html--translate "Table of Contents" info))
(org-html--toc-text
(mapcar
(lambda (headline)
(let* ((class (org-element-property :HTML_CONTAINER_CLASS headline))
(section-number
(when
(and (not (org-export-low-level-p headline info))
(org-export-numbered-headline-p headline info))
(concat
(mapconcat
'number-to-string
(org-export-get-headline-number headline info) ".") ". ")))
(title
(concat
section-number
(replace-regexp-in-string ; remove any links in headline...
"</?a[^>]*>" ""
(org-export-data
(org-element-property :title headline) info)))))
(cons
(if (and class (string-match-p "\\<slide\\>" class))
(format
"<a href='#outline-container-%s'>%s</a>"
(or (org-element-property :CUSTOM_ID headline)
(mapconcat
'number-to-string
(org-export-get-headline-number headline info) "-"))
title)
title)
(org-export-get-relative-level headline info))))
(org-export-collect-headlines info depth)))
(format "</%s>\n" (plist-get info :html-container))))
(defun org-deck--get-packages (info)
(let ((prefix (concat (plist-get info :deck-base-url) "/"))
(theme (plist-get info :deck-theme))
(transition (plist-get info :deck-transition))
(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 "core/deck.core.js"))
(add-to-list 'scripts (concat prefix "modernizr.custom.js"))
(add-to-list 'sheets (concat prefix "core/deck.core.css"))
(mapc
(lambda (extdir)
(let* ((name (file-name-nondirectory extdir))
(dir (file-name-as-directory extdir))
(path (concat prefix "extensions/" name "/"))
(base (format "deck.%s." name)))
(when (and (or (eq nil include) (member name include))
(not (member name exclude)))
(when (file-exists-p (concat dir base "js"))
(add-to-list 'scripts (concat path base "js")))
(when (file-exists-p (concat dir base "css"))
(add-to-list 'sheets (concat path base "css")))
(when (file-exists-p (concat dir base "html"))
(add-to-list 'snippets (concat dir base "html"))))))
(org-deck--find-extensions))
(if (not (string-match-p "^[[:space:]]*$" theme))
(add-to-list 'sheets
(if (file-name-directory theme) theme
(format "%sthemes/style/%s" prefix theme))))
(if (not (string-match-p "^[[:space:]]*$" transition))
(add-to-list
'sheets
(if (file-name-directory transition) transition
(format "%sthemes/transition/%s" prefix transition))))
(list :scripts (nreverse scripts) :sheets (nreverse sheets)
:snippets snippets)))
(defun org-deck-inner-template (contents info)
"Return body of document string after HTML conversion.
CONTENTS is the transcoded contents string. INFO is a plist
holding export options."
(concat contents "\n"))
(defun org-deck-headline (headline contents info)
(let ((org-html-toplevel-hlevel 2)
(class (or (org-element-property :HTML_CONTAINER_CLASS headline) ""))
(level (org-export-get-relative-level headline info)))
(when (and (= 1 level) (not (string-match-p "\\<slide\\>" class)))
(org-element-put-property headline :HTML_CONTAINER_CLASS (concat class " slide")))
(org-html-headline headline contents info)))
(defun org-deck-item (item contents info)
"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
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)))
(if (org-export-get-node-property :STEP item t)
(replace-regexp-in-string "^<li>" "<li class='slide'>" text)
text)))
(defun org-deck-template (contents info)
"Return complete document string after HTML conversion.
CONTENTS is the transcoded contents string. INFO is a plist
holding export options."
(let ((pkg-info (org-deck--get-packages info))
(org-html--pre/postamble-class "deck-status")
(info (plist-put
(plist-put info :html-preamble (plist-get info :deck-preamble))
:html-postamble (plist-get info :deck-postamble))))
(mapconcat
'identity
(list
(plist-get info :html-doctype)
(let ((lang (plist-get info :language)))
(mapconcat
(lambda (x)
(apply
'format
"<!--%s <html %s lang='%s' xmlns='http://www.w3.org/1999/xhtml'> %s<![endif]-->"
x))
(list `("[if lt IE 7]>" "class='no-js ie6'" ,lang "")
`("[if IE 7]>" "class='no-js ie7'" ,lang "")
`("[if IE 8]>" "class='no-js ie8'" ,lang "")
`("[if gt IE 8]><!-->" "" ,lang "<!--")) "\n"))
"<head>"
(org-deck--build-meta-info info)
(mapconcat
(lambda (sheet)
(format
"<link rel='stylesheet' href='%s' type='text/css' />" sheet))
(plist-get pkg-info :sheets) "\n")
(mapconcat
(lambda (script)
(format
"<script src='%s' type='text/javascript'></script>" script))
(plist-get pkg-info :scripts) "\n")
(org-html--build-mathjax-config info)
"<script type='text/javascript'>"
" $(document).ready(function () { $.deck('.slide'); });"
"</script>"
(org-html--build-head info)
"<style type='text/css'>"
org-deck-toc-styles
(when (plist-get info :section-numbers)
"#table-of-contents ul li {list-style-type: none;}")
(format "#%s, #%s {%s}"
(nth 2 (assq 'preamble org-html-divs))
(nth 2 (assq 'postamble org-html-divs))
(nth 1 (assq 'both org-deck-pre/postamble-styles)))
(format "#%s {%s}"
(nth 2 (assq 'preamble org-html-divs))
(nth 1 (assq 'preamble org-deck-pre/postamble-styles)))
(format "#%s {%s}"
(nth 2 (assq 'postamble org-html-divs))
(nth 1 (assq 'postamble org-deck-pre/postamble-styles)))
org-deck-styles
"</style>"
"</head>"
"<body>"
(format "<%s id='%s' class='deck-container'>"
(nth 1 (assq 'content org-html-divs))
(nth 2 (assq 'content org-html-divs)))
(org-html--build-pre/postamble 'preamble info)
;; title page
(format "<%s id='title-slide' class='slide'>"
(plist-get info :html-container))
(format-spec org-deck-title-slide-template (org-html-format-spec info))
(format "</%s>" (plist-get info :html-container))
;; toc page
(let ((depth (plist-get info :with-toc)))
(when depth (org-deck-toc depth info)))
contents
(mapconcat
(lambda (snippet)
(with-temp-buffer (insert-file-contents snippet)
(buffer-string)))
(plist-get pkg-info :snippets) "\n")
(org-html--build-pre/postamble 'postamble info)
(format "</%s>" (nth 1 (assq 'content org-html-divs)))
"</body>"
"</html>\n") "\n")))
(defun org-deck--build-meta-info (info)
"Return meta tags for exported document.
INFO is a plist used as a communication channel."
(let* ((title (org-export-data (plist-get info :title) info))
(author (and (plist-get info :with-author)
(let ((auth (plist-get info :author)))
(and auth (org-export-data auth info)))))
(date (and (plist-get info :with-date)
(let ((date (org-export-get-date info)))
(and date (org-export-data date info)))))
(description (plist-get info :description))
(keywords (plist-get info :keywords)))
(mapconcat
'identity
(list
(format "<title>%s</title>" title)
(format "<meta http-equiv='Content-Type' content='text/html; charset=%s'/>"
(or (and org-html-coding-system
(fboundp 'coding-system-get)
(coding-system-get
org-html-coding-system 'mime-charset))
"iso-8859-1"))
(mapconcat
(lambda (attr)
(when (< 0 (length (car attr)))
(format "<meta name='%s' content='%s'/>\n"
(nth 1 attr) (car attr))))
(list '("Org-mode" "generator")
`(,author "author")
`(,description "description")
`(,keywords "keywords")) "")) "\n")))
(defun org-deck-export-as-html
(&optional async subtreep visible-only body-only ext-plist)
"Export current buffer to an HTML 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.
When optional argument BODY-ONLY is non-nil, only write code
between \"<body>\" and \"</body>\" tags.
EXT-PLIST, when provided, is a property list with external
parameters overriding Org default settings, but still inferior to
file-local settings.
Export is done in a buffer named \"*Org deck.js Export*\", which
will be displayed when `org-export-show-temporary-export-buffer'
is non-nil."
(interactive)
(if async
(org-export-async-start
(lambda (output)
(with-current-buffer (get-buffer-create "*Org deck.js Export*")
(erase-buffer)
(insert output)
(goto-char (point-min))
(nxml-mode)
(org-export-add-to-stack (current-buffer) 'deck)))
`(org-export-as 'deck ,subtreep ,visible-only ,body-only ',ext-plist))
(let ((outbuf (org-export-to-buffer
'deck "*Org deck.js Export*"
subtreep visible-only body-only ext-plist)))
;; Set major mode.
(with-current-buffer outbuf (nxml-mode))
(when org-export-show-temporary-export-buffer
(switch-to-buffer-other-window outbuf)))))
(defun org-deck-export-to-html
(&optional async subtreep visible-only body-only ext-plist)
"Export current buffer to a deck.js HTML 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.
When optional argument BODY-ONLY is non-nil, only write code
between \"<body>\" and \"</body>\" tags.
EXT-PLIST, when provided, is a property list with external
parameters overriding Org default settings, but still inferior to
file-local settings.
Return output file's name."
(interactive)
(let* ((extension (concat "." org-html-extension))
(file (org-export-output-file-name extension subtreep))
(org-export-coding-system org-html-coding-system))
(if async
(org-export-async-start
(lambda (f) (org-export-add-to-stack f 'deck))
(let ((org-export-coding-system org-html-coding-system))
`(expand-file-name
(org-export-to-file
'deck ,file ,subtreep ,visible-only ,body-only ',ext-plist))))
(let ((org-export-coding-system org-html-coding-system))
(org-export-to-file
'deck file subtreep visible-only body-only ext-plist)))))
(defun org-deck-publish-to-html (plist filename pub-dir)
"Publish an org file to deck.js HTML Presentation.
FILENAME is the filename of the Org file to be published. PLIST
is the property list for the given project. PUB-DIR is the
publishing directory. Returns output file name."
(org-publish-org-to 'deck filename ".html" plist pub-dir))
(provide 'ox-deck)
;;; ox-deck.el ends here

536
contrib/lisp/ox-freemind.el Normal file
View File

@ -0,0 +1,536 @@
;;; ox-freemind.el --- Freemind Mindmap Back-End for Org Export Engine
;; Copyright (C) 2013 Free Software Foundation, Inc.
;; Author: Jambunathan K <kjambunathan at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp
;; 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 of the License, 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:
;; This library implements a Freemind Mindmap back-end for Org generic
;; exporter.
;; To test it, run:
;;
;; M-x org-freemind-export-to-freemind
;;
;; in an Org mode buffer. See ox.el for more details on how this
;; exporter works.
;;; Code:
;;; Dependencies
(require 'ox-html)
;;; Define Back-End
(org-export-define-derived-backend 'freemind 'html
:export-block "FREEMIND"
:menu-entry
'(?f "Export to Freemind Mindmap"
((?f "As Freemind Mindmap file" org-freemind-export-to-freemind)
(?o "As Freemind Mindmap file and open"
(lambda (a s v b)
(if a (org-freemind-export-to-freemind t s v b)
(org-open-file (org-freemind-export-to-freemind nil s v b)))))))
:translate-alist '((headline . org-freemind-headline)
(template . org-freemind-template)
(inner-template . org-freemind-inner-template)
(section . org-freemind-section)
(entity . org-freemind-entity))
:filters-alist '((:filter-options . org-freemind-options-function)
(:filter-final-output . org-freemind-final-function)))
;;; User Configuration Variables
(defgroup org-export-freemind nil
"Options for exporting Org mode files to Freemind Mindmap."
:tag "Org Export Freemind Mindmap"
:group 'org-export)
(defcustom org-freemind-styles
'((default . "<node>\n</node>")
(0 . "<node COLOR=\"#000000\">\n<font NAME=\"SansSerif\" SIZE=\"20\"/>\n</node>")
(1 . "<node COLOR=\"#0033ff\">\n<edge STYLE=\"sharp_bezier\" WIDTH=\"8\"/>\n<font NAME=\"SansSerif\" SIZE=\"18\"/>\n</node>")
(2 . "<node COLOR=\"#00b439\">\n<edge STYLE=\"bezier\" WIDTH=\"thin\"/>\n<font NAME=\"SansSerif\" SIZE=\"16\"/>\n</node>")
(3 . "<node COLOR=\"#990000\" FOLDED=\"true\">\n<font NAME=\"SansSerif\" SIZE=\"14\"/>\n</node>")
(4 . "<node COLOR=\"#111111\">\n</node>"))
"List of Freemind node styles.
Each entry is of the form (STYLE-NAME . STYLE-SPEC). STYLE-NAME
can be one of an integer (signifying an outline level), a string
or the symbol `default'. STYLE-SPEC, a string, is a Freemind
node style."
:type '(alist :options (default 0 1 2 3)
:key-type (choice :tag "Style tag"
(integer :tag "Outline level")
(const :tag "Default value" default)
(string :tag "Node style"))
:value-type (string :tag "Style spec"))
:group 'org-export-freemind)
(defcustom org-freemind-style-map-function 'org-freemind-style-map--automatic
"Function to map an Org element to it's node style.
The mapping function takes two arguments an Org ELEMENT and INFO.
ELEMENT can be one of the following types - `org-data',
`headline' or `section'. INFO is a plist holding contextual
information during export. The function must return a STYLE-SPEC
to be applied to ELEMENT.
See `org-freemind-style-map--automatic' for a sample style
function. See `org-freemind-styles' for a list of named styles."
:type '(radio
(function-item org-freemind-style-map--automatic)
(function-item org-freemind-style-map--default)
function)
:group 'org-export-freemind)
(defcustom org-freemind-section-format 'note
"Specify how outline sections are to be formatted.
If `inline', append it to the contents of it's heading node. If
`note', attach it as a note to it's heading node. If `node',
attach it as a separate node to it's heading node.
Use `note', if the input Org file contains large sections. Use
`node', if the Org file contains mid-sized sections that need to
stand apart. Otherwise, use `inline'."
:type '(choice
(const :tag "Append to outline title" inline)
(const :tag "Attach as a note" note)
(const :tag "Create a separate node" node))
:group 'org-export-freemind)
;;;; Debugging
(defcustom org-freemind-pretty-output nil
"Enable this to generate pretty Freemind Mindmap."
:type 'boolean
:group 'org-export-freemind)
;;; Internal Functions
;;;; XML Manipulation
(defun org-freemind--serialize (parsed-xml &optional contents)
"Convert PARSED-XML in to XML string.
PARSED-XML is a parse tree as returned by
`libxml-parse-xml-region'. CONTENTS is an optional string.
Ignore CONTENTS, if PARSED-XML is not a sole XML element.
Otherwise, append CONTENTS to the contents of top-level element
in PARSED-XML.
This is an inverse function of `libxml-parse-xml-region'.
For purposes of Freemind export, PARSED-XML is a node style
specification - \"<node ...>...</node>\" - as a parse tree."
(when contents
(assert (symbolp (car parsed-xml))))
(cond
((null parsed-xml) "")
((stringp parsed-xml) parsed-xml)
((symbolp (car parsed-xml))
(let ((attributes (mapconcat
(lambda (av)
(format "%s=\"%s\"" (car av) (cdr av)))
(cadr parsed-xml) " ")))
(if (or (cddr parsed-xml) contents)
(format "\n<%s%s>%s\n</%s>"
(car parsed-xml)
(if (string= attributes "") "" (concat " " attributes))
(concat (org-freemind--serialize (cddr parsed-xml))
contents )
(car parsed-xml))
(format "\n<%s%s/>"
(car parsed-xml)
(if (string= attributes "") "" (concat " " attributes))))))
(t (mapconcat #'org-freemind--serialize parsed-xml ""))))
(defun org-freemind--parse-xml (xml-string)
"Return parse tree for XML-STRING using `libxml-parse-xml-region'.
For purposes of Freemind export, XML-STRING is a node style
specification - \"<node ...>...</node>\" - as a string."
(with-temp-buffer
(insert (or xml-string ""))
(libxml-parse-xml-region (point-min) (point-max))))
;;;; Style mappers :: Default and Automatic layout
(defun org-freemind-style-map--automatic (element info)
"Return a node style corresponding to relative outline level of ELEMENT.
ELEMENT can be any of the following types - `org-data',
`headline' or `section'. See `org-freemind-styles' for style
mappings of different outline levels."
(let ((style-name
(case (org-element-type element)
(headline
(org-export-get-relative-level element info))
(section
(let ((parent (org-export-get-parent-headline element)))
(if (not parent) 1
(1+ (org-export-get-relative-level parent info)))))
(t 0))))
(or (assoc-default style-name org-freemind-styles)
(assoc-default 'default org-freemind-styles)
"<node></node>")))
(defun org-freemind-style-map--default (element info)
"Return the default style for all ELEMENTs.
ELEMENT can be any of the following types - `org-data',
`headline' or `section'. See `org-freemind-styles' for current
value of default style."
(or (assoc-default 'default org-freemind-styles)
"<node></node>"))
;;;; Helpers :: Retrieve, apply Freemind styles
(defun org-freemind--get-node-style (element info)
"Return Freemind node style applicable for HEADLINE.
ELEMENT is an Org element of type `org-data', `headline' or
`section'. INFO is a plist holding contextual information."
(unless (fboundp org-freemind-style-map-function)
(setq org-freemind-style-map-function 'org-freemind-style-map--default))
(let ((style (funcall org-freemind-style-map-function element info)))
;; Sanitize node style.
;; Loop through the attributes of node element and purge those
;; attributes that look suspicious. This is an extra bit of work
;; that allows one to copy verbatim node styles from an existing
;; Freemind Mindmap file without messing with the exported data.
(let* ((data (org-freemind--parse-xml style))
(attributes (cadr data))
(ignored-attrs '(POSITION FOLDED TEXT CREATED ID
MODIFIED)))
(let (attr)
(while (setq attr (pop ignored-attrs))
(setq attributes (assq-delete-all attr attributes))))
(when data (setcar (cdr data) attributes))
(org-freemind--serialize data))))
(defun org-freemind--build-stylized-node (style-1 style-2 &optional contents)
"Build a Freemind node with style STYLE-1 + STYLE-2 and add CONTENTS to it.
STYLE-1 and STYLE-2 are Freemind node styles as a string.
STYLE-1 is the base node style and STYLE-2 is the overriding
style that takes precedence over STYLE-1. CONTENTS is a string.
Return value is a Freemind node with following properties:
1. The attributes of \"<node ...> </node>\" element is the union
of corresponding attributes of STYLE-1 and STYLE-2. When
STYLE-1 and STYLE-2 specify values for the same attribute
name, choose the attribute value from STYLE-2.
2. The children of \"<node ...> </node>\" element is the union of
top-level children of STYLE-1 and STYLE-2 with CONTENTS
appended to it. When STYLE-1 and STYLE-2 share a child
element of same type, the value chosen is that from STYLE-2.
For example, merging with following parameters
STYLE-1 =>
<node COLOR=\"#00b439\" STYLE=\"Bubble\">
<edge STYLE=\"bezier\" WIDTH=\"thin\"/>
<font NAME=\"SansSerif\" SIZE=\"16\"/>
</node>
STYLE-2 =>
<node COLOR=\"#990000\" FOLDED=\"true\">
<font NAME=\"SansSerif\" SIZE=\"14\"/>
</node>
CONTENTS =>
<attribute NAME=\"ORGTAG\" VALUE=\"@home\"/>
will result in following node:
RETURN =>
<node STYLE=\"Bubble\" COLOR=\"#990000\" FOLDED=\"true\">
<edge STYLE=\"bezier\" WIDTH=\"thin\"/>
<font NAME=\"SansSerif\" SIZE=\"14\"/>
<attribute NAME=\"ORGTAG\" VALUE=\"@home\"/>
</node>."
(let* ((data1 (org-freemind--parse-xml (or style-1 "")))
(data2 (org-freemind--parse-xml (or style-2 "")))
(attr1 (cadr data1))
(attr2 (cadr data2))
(merged-attr attr2)
(children1 (cddr data1))
(children2 (cddr data2))
(merged-children children2))
(let (attr)
(while (setq attr (pop attr1))
(unless (assq (car attr) merged-attr)
(push attr merged-attr))))
(let (child)
(while (setq child (pop children1))
(when (or (stringp child) (not (assq (car child) merged-children)))
(push child merged-children))))
(let ((merged-data (nconc (list 'node merged-attr) merged-children)))
(org-freemind--serialize merged-data contents))))
;;;; Helpers :: Node contents
(defun org-freemind--richcontent (type contents &optional css-style)
(let* ((type (case type
(note "NOTE")
(node "NODE")
(t "NODE")))
(contents (org-trim contents)))
(if (string= (org-trim contents) "") ""
(format "\n<richcontent TYPE=\"%s\">%s\n</richcontent>"
type
(format "\n<html>\n<head>%s\n</head>\n%s\n</html>"
(or css-style "")
(format "<body>\n%s\n</body>" contents))))))
(defun org-freemind--build-node-contents (element contents info)
(let* ((title (case (org-element-type element)
(headline
(org-element-property :title element))
(org-data
(plist-get info :title))
(t (error "Shouldn't come here."))))
(element-contents (org-element-contents element))
(section (assoc 'section element-contents))
(section-contents
(let* ((translations
(nconc (list (cons 'section
(lambda (section contents info)
contents)))
(plist-get info :translate-alist))))
(org-export-data-with-translations section translations info)))
(itemized-contents-p (let ((first-child-headline
(org-element-map element-contents
'headline 'identity info t)))
(when first-child-headline
(org-export-low-level-p first-child-headline
info))))
(node-contents (concat section-contents
(when itemized-contents-p
contents))))
(concat (let ((title (org-export-data title info)))
(case org-freemind-section-format
(inline
(org-freemind--richcontent
'node (concat (format "\n<h2>%s</h2>" title)
node-contents) ))
(note
(concat (org-freemind--richcontent
'node (format "\n<p>%s\n</p>" title))
(org-freemind--richcontent
'note node-contents)))
(node
(concat
(org-freemind--richcontent
'node (format "\n<p>%s\n</p>" title))
(when section
(org-freemind--build-stylized-node
(org-freemind--get-node-style section info) nil
(org-freemind--richcontent 'node node-contents)))))))
(unless itemized-contents-p
contents))))
;;; Template
(defun org-freemind-template (contents info)
"Return complete document string after Freemind Mindmap conversion.
CONTENTS is the transcoded contents string. RAW-DATA is the
original parsed data. INFO is a plist holding export options."
(format
"<map version=\"0.9.0\">\n%s\n</map>"
(org-freemind--build-stylized-node
(org-freemind--get-node-style nil info) nil
(let ((org-data (plist-get info :parse-tree)))
(org-freemind--build-node-contents org-data contents info)))))
(defun org-freemind-inner-template (contents info)
"Return body of document string after Freemind Mindmap conversion.
CONTENTS is the transcoded contents string. INFO is a plist
holding export options."
contents)
;;;; Tags
(defun org-freemind--tags (tags)
(mapconcat (lambda (tag)
(format "\n<attribute NAME=\"%s\" VALUE=\"%s\"/>" tag ""))
tags "\n"))
;;; Transcode Functions
;;;; Entity
(defun org-freemind-entity (entity contents info)
"Transcode an ENTITY object from Org to Freemind Mindmap.
CONTENTS are the definition itself. INFO is a plist holding
contextual information."
(org-element-property :utf-8 entity))
;;;; Headline
(defun org-freemind-headline (headline contents info)
"Transcode a HEADLINE element from Org to Freemind Mindmap.
CONTENTS holds the contents of the headline. INFO is a plist
holding contextual information."
;; Empty contents?
(setq contents (or contents ""))
(let* ((numberedp (org-export-numbered-headline-p headline info))
(level (org-export-get-relative-level headline info))
(text (org-export-data (org-element-property :title headline) info))
(todo (and (plist-get info :with-todo-keywords)
(let ((todo (org-element-property :todo-keyword headline)))
(and todo (org-export-data todo info)))))
(todo-type (and todo (org-element-property :todo-type headline)))
(tags (and (plist-get info :with-tags)
(org-export-get-tags headline info)))
(priority (and (plist-get info :with-priority)
(org-element-property :priority headline)))
(section-number (and (not (org-export-low-level-p headline info))
(org-export-numbered-headline-p headline info)
(mapconcat 'number-to-string
(org-export-get-headline-number
headline info) ".")))
;; Create the headline text.
(full-text (org-export-data (org-element-property :title headline)
info))
;; Headline order (i.e, first digit of the section number)
(headline-order (car (org-export-get-headline-number headline info))))
(cond
;; Case 1: This is a footnote section: ignore it.
((org-element-property :footnote-section-p headline) nil)
;; Case 2. This is a deep sub-tree, export it as a list item.
;; Delegate the actual export to `html' backend.
((org-export-low-level-p headline info)
(org-html-headline headline contents info))
;; Case 3. Standard headline. Export it as a section.
(t
(let* ((section-number (mapconcat 'number-to-string
(org-export-get-headline-number
headline info) "-"))
(ids (remove 'nil
(list (org-element-property :CUSTOM_ID headline)
(concat "sec-" section-number)
(org-element-property :ID headline))))
(preferred-id (car ids))
(extra-ids (cdr ids))
(left-p (zerop (% headline-order 2))))
(org-freemind--build-stylized-node
(org-freemind--get-node-style headline info)
(format "<node ID=\"%s\" POSITION=\"%s\" FOLDED=\"%s\">\n</node>"
preferred-id
(if left-p "left" "right")
(if (= level 1) "true" "false"))
(concat (org-freemind--build-node-contents headline contents info)
(org-freemind--tags tags))))))))
;;;; Section
(defun org-freemind-section (section contents info)
"Transcode a SECTION element from Org to Freemind Mindmap.
CONTENTS holds the contents of the section. INFO is a plist
holding contextual information."
(let ((parent (org-export-get-parent-headline section)))
(when (and parent (org-export-low-level-p parent info))
contents)))
;;; Filter Functions
(defun org-freemind-final-function (contents backend info)
"Return CONTENTS as pretty XML using `indent-region'."
(if (not org-freemind-pretty-output) contents
(with-temp-buffer
(nxml-mode)
(insert contents)
(indent-region (point-min) (point-max))
(buffer-substring-no-properties (point-min) (point-max)))))
(defun org-freemind-options-function (info backend)
"Install script in export options when appropriate.
EXP-PLIST is a plist containing export options. BACKEND is the
export back-end currently used."
;; Freemind/Freeplane doesn't seem to like named html entities in
;; richcontent. For now, turn off smart quote processing so that
;; entities like "&rsquo;" & friends are avoided in the exported
;; output.
(plist-put info :with-smart-quotes nil))
;;; End-user functions
;;;###autoload
(defun org-freemind-export-to-freemind
(&optional async subtreep visible-only body-only ext-plist)
"Export current buffer to a Freemind Mindmap 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.
When optional argument BODY-ONLY is non-nil, only write code
between \"<body>\" and \"</body>\" tags.
EXT-PLIST, when provided, is a property list with external
parameters overriding Org default settings, but still inferior to
file-local settings.
Return output file's name."
(interactive)
(let* ((extension (concat ".mm" ))
(file (org-export-output-file-name extension subtreep)))
(if async
(org-export-async-start
(lambda (f) (org-export-add-to-stack f 'freemind))
(let ((org-export-coding-system 'utf-8))
`(expand-file-name
(org-export-to-file
'freemind ,file ,subtreep ,visible-only ,body-only ',ext-plist))))
(let ((org-export-coding-system 'utf-8))
(org-export-to-file
'freemind file subtreep visible-only body-only ext-plist)))))
(provide 'ox-freemind)
;;; ox-freemind.el ends here

1203
contrib/lisp/org-e-groff.el → contrib/lisp/ox-groff.el
View File

File diff suppressed because it is too large Load Diff

370
contrib/lisp/ox-koma-letter.el Normal file
View File

@ -0,0 +1,370 @@
;;; ox-koma-letter.el --- KOMA Scrlttr2 Back-End for Org Export Engine
;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou AT gmail DOT com>
;; Alan Schmitt <alan.schmitt AT polytechnique DOT org>
;; Keywords: org, wp, tex
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; 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:
;;
;; This library implements a KOMA Scrlttr2 back-end, derived from the
;; LaTeX one.
;;
;; Depending on the desired output format, three commands are provided
;; for export: `org-koma-letter-export-as-latex' (temporary buffer),
;; `org-koma-letter-export-to-latex' ("tex" file) and
;; `org-koma-letter-export-to-pdf' ("pdf" file).
;;
;; 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') and "TO_ADDRESS".
;;
;; You will need to add an appropriate association in
;; `org-latex-classes' in order to use the KOMA Scrlttr2 class. For
;; example, you can use the following code:
;;
;; (add-to-list 'org-latex-classes
;; '("my-letter"
;; "\\documentclass\[%
;; DIV=14,
;; fontsize=12pt,
;; parskip=half,
;; subject=titled,
;; backaddress=false,
;; fromalign=left,
;; fromemail=true,
;; fromphone=true\]\{scrlttr2\}
;; \[DEFAULT-PACKAGES]
;; \[PACKAGES]
;; \[EXTRA]"))
;;
;; Then, in your Org document, be sure to require the proper class
;; with :
;;
;; #+LATEX_CLASS: my-letter
;;; Code:
(require 'ox-latex)
;;; User-Configurable Variables
(defgroup org-export-koma-letter nil
"Options for exporting to KOMA scrlttr2 class in LaTeX export."
:tag "Org Koma-Letter"
:group 'org-export)
(defcustom org-koma-letter-class-option-file "NF"
"Letter Class Option File."
:group 'org-export-koma-letter
:type 'string)
(defcustom org-koma-letter-closing "See you soon,"
"Koma-Letter's closing, as a string."
:group 'org-export-koma-letter
:type 'string)
(defcustom org-koma-letter-from-address "Somewhere \\ Over the rainbow."
"Sender's address, as a string."
:group 'org-export-koma-letter
:type 'string)
(defcustom org-koma-letter-opening "Dear Sir,"
"Letter's opening, as a string."
:group 'org-export-koma-letter
:type 'string)
(defcustom org-koma-letter-phone-number "00-00-00-00"
"Sender's phone number, as a string."
:group 'org-export-koma-letter
:type 'string)
(defcustom org-koma-letter-signature "\\usekomavar{fromname}"
"String used as the signature."
:group 'org-export-koma-letter
:type 'string)
;;; Define Back-End
(org-export-define-derived-backend 'koma-letter 'latex
:options-alist
'((:closing "CLOSING" nil org-koma-letter-closing)
(:from-address "FROM_ADDRESS" nil org-koma-letter-from-address newline)
(:lco "LCO" nil org-koma-letter-class-option-file)
(:opening "OPENING" nil org-koma-letter-opening)
(:phone-number "PHONE_NUMBER" nil org-koma-letter-phone-number)
(:signature "SIGNATURE" nil nil newline)
(:to-address "TO_ADDRESS" nil nil newline))
:translate-alist '((export-block . org-koma-letter-export-block)
(export-snippet . org-koma-letter-export-snippet)
(keyword . org-koma-letter-keyword)
(template . org-koma-letter-template))
:menu-entry
'(?k "Export with KOMA Scrlttr2"
((?K "As LaTeX buffer" org-koma-letter-export-as-latex)
(?k "As LaTeX file" org-koma-letter-export-to-latex)
(?p "As PDF file" org-koma-letter-export-to-pdf)
(?O "As PDF file and open"
(lambda (a s v b)
(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))))))))
;;; Transcode Functions
;;;; Export Block
(defun org-koma-letter-export-block (export-block contents info)
"Transcode an EXPORT-BLOCK element into KOMA Scrlttr2 code.
CONTENTS is nil. INFO is a plist used as a communication
channel."
(when (member (org-element-property :type export-block) '("KOMA-LETTER" "LATEX"))
(org-remove-indentation (org-element-property :value export-block))))
;;;; Export Snippet
(defun org-koma-letter-export-snippet (export-snippet contents info)
"Transcode an EXPORT-SNIPPET object into KOMA Scrlttr2 code.
CONTENTS is nil. INFO is a plist used as a communication
channel."
(when (memq (org-export-snippet-backend export-snippet) '(latex koma-letter))
(org-element-property :value export-snippet)))
;;;; Keyword
(defun org-koma-letter-keyword (keyword contents info)
"Transcode a KEYWORD element into KOMA Scrlttr2 code.
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.
(if (equal key "KOMA-LETTER") value
(org-export-with-backend 'latex keyword contents info))))
;;;; Template
(defun org-koma-letter-template (contents info)
"Return complete document string after KOMA Scrlttr2 conversion.
CONTENTS is the transcoded contents string. INFO is a plist
holding export options."
(concat
;; Time-stamp.
(and (plist-get info :time-stamp-file)
(format-time-string "%% Created %Y-%m-%d %a %H:%M\n"))
;; Document class and packages.
(let ((class (plist-get info :latex-class))
(class-options (plist-get info :latex-class-options)))
(org-element-normalize-string
(let* ((header (nth 1 (assoc class org-latex-classes)))
(document-class-string
(and (stringp header)
(if (not class-options) header
(replace-regexp-in-string
"^[ \t]*\\\\documentclass\\(\\(\\[[^]]*\\]\\)?\\)"
class-options header t nil 1)))))
(if (not document-class-string)
(user-error "Unknown LaTeX class `%s'")
(org-latex-guess-babel-language
(org-latex-guess-inputenc
(org-splice-latex-header
document-class-string
org-latex-default-packages-alist ; defined in org.el
org-latex-packages-alist nil ; defined in org.el
(concat (plist-get info :latex-header)
(plist-get info :latex-header-extra))))
info)))))
;; Define "From" data.
(format "\\setkomavar{fromname}{%s}\n"
(org-export-data (plist-get info :author) info))
(format "\\setkomavar{fromaddress}{%s}\n" (plist-get info :from-address))
(format "\\setkomavar{signature}{%s}\n" (plist-get info :signature))
(format "\\setkomavar{fromemail}{%s}\n"
(org-export-data (plist-get info :email) info))
(format "\\setkomavar{fromphone}{%s}\n" (plist-get info :phone-number))
;; Date.
(format "\\date{%s}\n" (org-export-data (org-export-get-date info) info))
;; Letter Class Option File
(format "\\LoadLetterOption{%s}\n" (plist-get info :lco))
;; Letter start.
"\\begin{document}\n\n"
(format "\\setkomavar{subject}{%s}\n\n"
(org-export-data (plist-get info :title) info))
(format "\\begin{letter}{%%\n%s}\n\n"
(or (plist-get info :to-address) "no address given"))
;; Opening.
(format "\\opening{%s}\n\n" (plist-get info :opening))
;; Letter body.
contents
;; Closing.
(format "\n\\closing{%s}\n\n" (plist-get info :closing))
;; Letter end.
"\\end{letter}\n\\end{document}"))
;;; Commands
;;;###autoload
(defun org-koma-letter-export-as-latex
(&optional async subtreep visible-only body-only ext-plist)
"Export current buffer as a KOMA Scrlttr2 letter.
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.
When optional argument BODY-ONLY is non-nil, only write code
between \"\\begin{letter}\" and \"\\end{letter}\".
EXT-PLIST, when provided, is a property list with external
parameters overriding Org default settings, but still inferior to
file-local settings.
Export is done in a buffer named \"*Org KOMA-LETTER Export*\". It
will be displayed if `org-export-show-temporary-export-buffer' is
non-nil."
(interactive)
(if async
(org-export-async-start
(lambda (output)
(with-current-buffer (get-buffer-create "*Org KOMA-LETTER Export*")
(erase-buffer)
(insert output)
(goto-char (point-min))
(LaTeX-mode)
(org-export-add-to-stack (current-buffer) 'koma-letter)))
`(org-export-as 'koma-letter ,subtreep ,visible-only ,body-only
',ext-plist))
(let ((outbuf (org-export-to-buffer
'koma-letter "*Org KOMA-LETTER Export*"
subtreep visible-only body-only ext-plist)))
(with-current-buffer outbuf (LaTeX-mode))
(when org-export-show-temporary-export-buffer
(switch-to-buffer-other-window outbuf)))))
;;;###autoload
(defun org-koma-letter-export-to-latex
(&optional async subtreep visible-only body-only ext-plist)
"Export current buffer as a KOMA Scrlttr2 letter (tex).
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.
When optional argument BODY-ONLY is non-nil, only write code
between \"\\begin{letter}\" and \"\\end{letter}\".
EXT-PLIST, when provided, is a property list with external
parameters overriding Org default settings, but still inferior to
file-local settings.
When optional argument PUB-DIR is set, use it as the publishing
directory.
Return output file's name."
(interactive)
(let ((outfile (org-export-output-file-name ".tex" subtreep)))
(if async
(org-export-async-start
(lambda (f) (org-export-add-to-stack f 'koma-letter))
`(expand-file-name
(org-export-to-file
'koma-letter ,outfile ,subtreep ,visible-only ,body-only
',ext-plist)))
(org-export-to-file
'koma-letter outfile subtreep visible-only body-only ext-plist))))
;;;###autoload
(defun org-koma-letter-export-to-pdf
(&optional async subtreep visible-only body-only ext-plist)
"Export current buffer as a KOMA Scrlttr2 letter (pdf).
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.
When optional argument BODY-ONLY is non-nil, only write code
between \"\\begin{letter}\" and \"\\end{letter}\".
EXT-PLIST, when provided, is a property list with external
parameters overriding Org default settings, but still inferior to
file-local settings.
Return PDF file's name."
(interactive)
(if async
(let ((outfile (org-export-output-file-name ".tex" subtreep)))
(org-export-async-start
(lambda (f) (org-export-add-to-stack f 'koma-letter))
`(expand-file-name
(org-latex-compile
(org-export-to-file
'koma-letter ,outfile ,subtreep ,visible-only ,body-only
',ext-plist)))))
(org-latex-compile
(org-koma-letter-export-to-latex
nil subtreep visible-only body-only ext-plist))))
(provide 'ox-koma-letter)
;;; ox-koma-letter.el ends here

402
contrib/lisp/ox-rss.el Normal file
View File

@ -0,0 +1,402 @@
;;; ox-rss.el --- RSS 2.0 Back-End for Org Export Engine
;; Copyright (C) 2013 Bastien Guerry
;; Author: Bastien Guerry <bzg at gnu dot org>
;; Keywords: org, wp, blog, feed, rss
;; 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 of the License, 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:
;; This library implements a RSS 2.0 back-end for Org exporter, based on
;; the `html' back-end.
;;
;; It provides two commands for export, depending on the desired output:
;; `org-rss-export-as-rss' (temporary buffer) and `org-rss-export-to-rss'
;; (as a ".xml" file).
;;
;; This backend understands two new option keywords:
;;
;; #+RSS_EXTENSION: xml
;; #+RSS_IMAGE_URL: http://myblog.org/mypicture.jpg
;;
;; It uses #+HTML_LINK_HOME: to set the base url of the feed.
;;
;; Exporting an Org file to RSS modifies each top-level entry by adding a
;; PUBDATE property. If `org-rss-use-entry-url-as-guid', it will also add
;; an ID property, later used as the guid for the feed's item.
;;
;; You typically want to use it within a publishing project like this:
;;
;; (add-to-list
;; 'org-publish-project-alist
;; '("homepage_rss"
;; :base-directory "~/myhomepage/"
;; :base-extension "org"
;; :rss-image-url "http://lumiere.ens.fr/~guerry/images/faces/15.png"
;; :home-link-home "http://lumiere.ens.fr/~guerry/"
;; :rss-extension "xml"
;; :publishing-directory "/home/guerry/public_html/"
;; :publishing-function (org-rss-publish-to-rss)
;; :section-numbers nil
;; :exclude ".*" ;; To exclude all files...
;; :include ("index.org") ;; ... except index.org.
;; :table-of-contents nil))
;;
;; ... then rsync /home/guerry/public_html/ with your server.
;;; Code:
(require 'ox-html)
(declare-function url-encode-url "url-util" (url))
;;; Variables and options
(defgroup org-export-rss nil
"Options specific to RSS export back-end."
:tag "Org RSS"
:group 'org-export
:version "24.4"
:package-version '(Org . "8.0"))
(defcustom org-rss-image-url "http://orgmode.org/img/org-mode-unicorn-logo.png"
"The URL of the an image for the RSS feed."
:group 'org-export-rss
:type 'string)
(defcustom org-rss-extension "xml"
"File extension for the RSS 2.0 feed."
:group 'org-export-rss
:type 'string)
(defcustom org-rss-categories 'from-tags
"Where to extract items category information from.
The default is to extract categories from the tags of the
headlines. When set to another value, extract the category
from the :CATEGORY: property of the entry."
:group 'org-export-rss
:type '(choice
(const :tag "From tags" from-tags)
(const :tag "From the category property" from-category)))
(defcustom org-rss-use-entry-url-as-guid t
"Use the URL for the <guid> metatag?
When nil, Org will create ids using `org-icalendar-create-uid'."
:group 'org-export-rss
:type 'boolean)
;;; Define backend
(org-export-define-derived-backend 'rss 'html
:menu-entry
'(?r "Export to RSS"
((?R "As RSS buffer"
(lambda (a s v b) (org-rss-export-as-rss a s v)))
(?r "As RSS file" (lambda (a s v b) (org-rss-export-to-rss a s v)))
(?o "As RSS file and open"
(lambda (a s v b)
(if a (org-rss-export-to-rss t s v)
(org-open-file (org-rss-export-to-rss nil s v)))))))
:options-alist
'((:with-toc nil nil nil) ;; Never include HTML's toc
(:rss-extension "RSS_EXTENSION" nil org-rss-extension)
(:rss-image-url "RSS_IMAGE_URL" nil org-rss-image-url)
(:rss-categories nil nil org-rss-categories))
:filters-alist '((:filter-final-output . org-rss-final-function))
:translate-alist '((headline . org-rss-headline)
(comment . (lambda (&rest args) ""))
(comment-block . (lambda (&rest args) ""))
(timestamp . (lambda (&rest args) ""))
(plain-text . org-rss-plain-text)
(section . org-rss-section)
(template . org-rss-template)))
;;; Export functions
;;;###autoload
(defun org-rss-export-as-rss (&optional async subtreep visible-only)
"Export current buffer to a RSS 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 RSS Export*\", which will
be displayed when `org-export-show-temporary-export-buffer' is
non-nil."
(interactive)
(let ((file (buffer-file-name (buffer-base-buffer))))
(org-icalendar-create-uid file 'warn-user)
(org-rss-add-pubdate-property))
(if async
(org-export-async-start
(lambda (output)
(with-current-buffer (get-buffer-create "*Org RSS Export*")
(erase-buffer)
(insert output)
(goto-char (point-min))
(text-mode)
(org-export-add-to-stack (current-buffer) 'rss)))
`(org-export-as 'rss ,subtreep ,visible-only))
(let ((outbuf (org-export-to-buffer
'rss "*Org RSS Export*" subtreep visible-only)))
(with-current-buffer outbuf (text-mode))
(when org-export-show-temporary-export-buffer
(switch-to-buffer-other-window outbuf)))))
;;;###autoload
(defun org-rss-export-to-rss (&optional async subtreep visible-only)
"Export current buffer to a RSS 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 ((file (buffer-file-name (buffer-base-buffer))))
(org-icalendar-create-uid file 'warn-user)
(org-rss-add-pubdate-property))
(let ((outfile (org-export-output-file-name
(concat "." org-rss-extension) subtreep)))
(if async
(org-export-async-start
(lambda (f) (org-export-add-to-stack f 'rss))
`(expand-file-name
(org-export-to-file 'rss ,outfile ,subtreep ,visible-only)))
(org-export-to-file 'rss outfile subtreep visible-only))))
;;;###autoload
(defun org-rss-publish-to-rss (plist filename pub-dir)
"Publish an org file to RSS.
FILENAME is the filename of the Org file to be published. PLIST
is the property list for the given project. PUB-DIR is the
publishing directory.
Return output file name."
(org-publish-org-to
'rss filename (concat "." org-rss-extension) plist pub-dir))
;;; Main transcoding functions
(defun org-rss-headline (headline contents info)
"Transcode HEADLINE element into RSS format.
CONTENTS is the headline contents. INFO is a plist used as a
communication channel."
(unless (or (org-element-property :footnote-section-p headline)
;; Only consider first-level headlines
(> (org-export-get-relative-level headline info) 1))
(let* ((htmlext (plist-get info :html-extension))
(hl-number (org-export-get-headline-number headline info))
(anchor
(org-export-solidify-link-text
(or (org-element-property :CUSTOM_ID headline)
(concat "sec-" (mapconcat 'number-to-string hl-number "-")))))
(category (org-rss-plain-text
(or (org-element-property :CATEGORY headline) "") info))
(pubdate
(let ((system-time-locale "C"))
(format-time-string
"%a, %d %h %Y %H:%M:%S %Z"
(org-time-string-to-time
(or (org-element-property :PUBDATE headline)
(error "Missing PUBDATE property"))))))
(title (org-rss-plain-text
(org-element-property :raw-value headline) info))
(publink
(concat
(file-name-as-directory
(or (plist-get info :html-link-home)
(plist-get info :publishing-directory)))
(file-name-nondirectory
(file-name-sans-extension
(buffer-file-name))) "." htmlext "#" anchor))
(guid (if org-rss-use-entry-url-as-guid
publink
(org-rss-plain-text
(or (org-element-property :ID headline)
(org-element-property :CUSTOM_ID headline)
publink)
info))))
(format
(concat
"<item>\n"
"<title>%s</title>\n"
"<link>%s</link>\n"
"<guid isPermaLink=\"false\">%s</guid>\n"
"<pubDate>%s</pubDate>\n"
(org-rss-build-categories headline info) "\n"
"<description><![CDATA[%s]]></description>\n"
"</item>\n")
title publink guid pubdate contents))))
(defun org-rss-build-categories (headline info)
"Build categories for the RSS item."
(if (eq (plist-get info :rss-categories) 'from-tags)
(mapconcat
(lambda (c) (format "<category><![CDATA[%s]]></category>" c))
(org-element-property :tags headline)
"\n")
(let ((c (org-element-property :CATEGORY headline)))
(format "<category><![CDATA[%s]]></category>" c))))
(defun org-rss-template (contents info)
"Return complete document string after RSS conversion.
CONTENTS is the transcoded contents string. INFO is a plist used
as a communication channel."
(concat
(format "<?xml version=\"1.0\" encoding=\"%s\"?>"
(symbol-name org-html-coding-system))
"\n<rss version=\"2.0\"
xmlns:content=\"http://purl.org/rss/1.0/modules/content/\"
xmlns:wfw=\"http://wellformedweb.org/CommentAPI/\"
xmlns:dc=\"http://purl.org/dc/elements/1.1/\"
xmlns:atom=\"http://www.w3.org/2005/Atom\"
xmlns:sy=\"http://purl.org/rss/1.0/modules/syndication/\"
xmlns:slash=\"http://purl.org/rss/1.0/modules/slash/\"
xmlns:georss=\"http://www.georss.org/georss\"
xmlns:geo=\"http://www.w3.org/2003/01/geo/wgs84_pos#\"
xmlns:media=\"http://search.yahoo.com/mrss/\">"
"<channel>"
(org-rss-build-channel-info info) "\n"
contents
"</channel>\n"
"</rss>"))
(defun org-rss-build-channel-info (info)
"Build the RSS channel information."
(let* ((system-time-locale "C")
(title (org-export-data (plist-get info :title) info))
(email (org-export-data (plist-get info :email) info))
(author (and (plist-get info :with-author)
(let ((auth (plist-get info :author)))
(and auth (org-export-data auth info)))))
(date (format-time-string "%a, %d %h %Y %H:%M:%S %Z")) ;; RFC 882
(description (org-export-data (plist-get info :description) info))
(lang (plist-get info :language))
(keywords (plist-get info :keywords))
(rssext (plist-get info :rss-extension))
(blogurl (or (plist-get info :html-link-home)
(plist-get info :publishing-directory)))
(image (url-encode-url (plist-get info :rss-image-url)))
(publink
(concat (file-name-as-directory blogurl)
(file-name-nondirectory
(file-name-sans-extension (buffer-file-name)))
"." rssext)))
(format
"\n<title>%s</title>
<atom:link href=\"%s\" rel=\"self\" type=\"application/rss+xml\" />
<link>%s</link>
<description><![CDATA[%s]]></description>
<language>%s</language>
<pubDate>%s</pubDate>
<lastBuildDate>%s</lastBuildDate>
<generator>%s</generator>
<webMaster>%s</webMaster>
<image>
<url>%s</url>
<title>%s</title>
<link>%s</link>
</image>
"
title publink blogurl description lang date date
(concat (format "Emacs %d.%d"
emacs-major-version
emacs-minor-version)
" Org-mode " (org-version))
email image title blogurl)))
(defun org-rss-section (section contents info)
"Transcode SECTION element into RSS format.
CONTENTS is the section contents. INFO is a plist used as
a communication channel."
contents)
(defun org-rss-timestamp (timestamp contents info)
"Transcode a TIMESTAMP object from Org to RSS.
CONTENTS is nil. INFO is a plist holding contextual
information."
(org-html-encode-plain-text
(org-timestamp-translate timestamp)))
(defun org-rss-plain-text (contents info)
"Convert plain text into RSS encoded text."
(let (output)
(setq output (org-html-encode-plain-text contents)
output (org-export-activate-smart-quotes
output :html info))))
;;; Filters
(defun org-rss-final-function (contents backend info)
"Prettify the RSS output."
(with-temp-buffer
(xml-mode)
(insert contents)
(indent-region (point-min) (point-max))
(buffer-substring-no-properties (point-min) (point-max))))
;;; Miscellaneous
(defun org-rss-add-pubdate-property ()
"Set the PUBDATE property for top-level headlines."
(let (msg)
(org-map-entries
(lambda ()
(let* ((entry (org-element-at-point))
(level (org-element-property :level entry)))
(when (= level 1)
(unless (org-entry-get (point) "PUBDATE")
(setq msg t)
(org-set-property
"PUBDATE" (format-time-string
(cdr org-time-stamp-formats)))))))
nil nil 'comment 'archive)
(when msg
(message "Property PUBDATE added to top-level entries in %s"
(buffer-file-name))
(sit-for 2))))
(provide 'ox-rss)
;;; ox-rss.el ends here

445
contrib/lisp/ox-s5.el Normal file
View File

@ -0,0 +1,445 @@
;;; ox-s5.el --- S5 Presentation Back-End for Org Export Engine
;; Copyright (C) 2011-2013 Rick Frankel
;; Author: Rick Frankel <emacs at rickster dot com>
;; Keywords: outlines, hypermedia, S5, wp
;; 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 of the License, 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 this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements an S5 Presentation back-end for the Org
;; generic exporter.
;; Installation
;; ------------
;; Get the s5 scripts from
;; http://meyerweb.com/eric/tools/s5/
;; (Note that the default s5 version is set for using the alpha, 1.2a2.
;; Copy the ui dir to somewhere reachable from your published presentation
;; The default (`org-s5-ui-url') is set to "ui" (e.g., in the
;; same directory as the html file).
;; Usage
;; -----
;; Follow the general instructions at the above website. To generate
;; incremental builds, you can set the HTML_CONTAINER_CLASS on an
;; object to "incremental" to make it build. If you want an outline to
;; build, set the :INCREMENTAL property on the parent headline.
;; To test it, run:
;;
;; M-x org-s5-export-as-html
;;
;; in an Org mode buffer. See ox.el and ox-html.el for more details
;; on how this exporter works.
(require 'ox-html)
(org-export-define-derived-backend 's5 'html
:menu-entry
'(?s "Export to S5 HTML Presentation"
((?H "To temporary buffer" org-s5-export-as-html)
(?h "To file" org-s5-export-to-html)
(?o "To file and open"
(lambda (a s v b)
(if a (org-s5-export-to-html t s v b)
(org-open-file (org-s5-export-to-html nil s v b)))))))
:options-alist
'((:html-link-home "HTML_LINK_HOME" nil nil)
(:html-link-up "HTML_LINK_UP" nil nil)
(:s5-postamble "S5_POSTAMBLE" nil org-s5-postamble newline)
(:s5-preamble "S5_PREAMBLE" nil org-s5-preamble newline)
(:html-head-include-default-style "HTML_INCLUDE_DEFAULT_STYLE" nil nil)
(:html-head-include-scripts "HTML_INCLUDE_SCRIPTS" nil nil)
(:s5-version "S5_VERSION" nil org-s5-version)
(:s5-theme-file "S5_THEME_FILE" nil org-s5-theme-file)
(:s5-ui-url "S5_UI_URL" nil org-s5-ui-url)
(:s5-default-view "S5_DEFAULT_VIEW" nil org-s5-default-view)
(:s5-control-visibility "S5_CONTROL_VISIBILITY" nil
org-s5-control-visibility))
:translate-alist
'((headline . org-s5-headline)
(plain-list . org-s5-plain-list)
(inner-template . org-s5-inner-template)
(template . org-s5-template)))
(defgroup org-export-s5 nil
"Options for exporting Org mode files to S5 HTML Presentations."
:tag "Org Export S5"
:group 'org-export-html)
(defcustom org-s5-version "1.2a2"
"Version of s5 being used (for version metadata.) Defaults to
s5 v2 alpha 2.
Can be overridden with S5_VERSION."
:group 'org-export-s5
:type 'string)
(defcustom org-s5-theme-file nil
"Url to S5 theme (slides.css) file. Can be overriden with the
S5_THEME_FILE property. If nil, defaults to
`org-s5-ui-url'/default/slides.css. If it starts with anything but
\"http\" or \"/\", it is used as-is. Otherwise the link in generated
relative to `org-s5-ui-url'.
The links for all other required stylesheets and scripts will be
generated relative to `org-s5-ui-url'/default."
:group 'org-export-s5
:type 'string)
(defcustom org-s5-ui-url "ui"
"Base url to directory containing S5 \"default\" subdirectory
and the \"s5-notes.html\" file.
Can be overriden with the S5_UI_URL property."
:group 'org-export-s5
:type 'string)
(defcustom org-s5-default-view 'slideshow
"Setting for \"defaultView\" meta info."
:group 'org-export-s5
:type '(choice (const slideshow) (const outline)))
(defcustom org-s5-control-visibility 'hidden
"Setting for \"controlVis\" meta info."
:group 'org-export-s5
:type '(choice (const hidden) (const visibile)))
(defvar org-s5--divs
'((preamble "div" "header")
(content "div" "content")
(postamble "div" "footer"))
"Alist of the three section elements for HTML export.
The car of each entry is one of 'preamble, 'content or 'postamble.
The cdrs of each entry are the ELEMENT_TYPE and ID for each
section of the exported document.
If you set `org-html-container-element' to \"li\", \"ol\" will be
uses as the content ELEMENT_TYPE, generating an XOXO format
slideshow.
Note that changing the preamble or postamble will break the
core S5 stylesheets.")
(defcustom org-s5-postamble "<h1>%a - %t</h1>"
"Preamble inserted into the S5 layout section.
When set to a string, use this string as the postamble.
When set to a function, apply this function and insert the
returned string. The function takes the property list of export
options as its only argument.
Setting the S5_POSTAMBLE option -- or the :s5-postamble in publishing
projects -- will take precedence over this variable.
Note that the default css styling will break if this is set to nil
or an empty string."
:group 'org-export-s5
:type '(choice (const :tag "No postamble" "&#x20;")
(string :tag "Custom formatting string")
(function :tag "Function (must return a string)")))
(defcustom org-s5-preamble "&#x20;"
"Peamble inserted into the S5 layout section.
When set to a string, use this string as the preamble.
When set to a function, apply this function and insert the
returned string. The function takes the property list of export
options as its only argument.
Setting S5_PREAMBLE option -- or the :s5-preamble in publishing
projects -- will take precedence over this variable.
Note that the default css styling will break if this is set to nil
or an empty string."
:group 'org-export-s5
:type '(choice (const :tag "No preamble" "&#x20;")
(string :tag "Custom formatting string")
(function :tag "Function (must return a string)")))
(defcustom org-s5-title-slide-template
"<h1>%t</h1>
<h2>%a</h2>
<h2>%e</h2>
<h2>%d</h2>"
"Format template to specify title page section.
See `org-html-postamble-format' for the valid elements which
can be included.
It will be wrapped in the element defined in the :html-container
property, and defaults to the value of `org-html-container-element',
and have the id \"title-slide\"."
:group 'org-export-s5
:type 'string)
(defun org-s5--format-toc-headline (headline info)
"Return an appropriate table of contents entry for HEADLINE.
Note that (currently) the S5 exporter does not support deep links,
so the table of contents is not \"active\".
INFO is a plist used as a communication channel."
(let* ((headline-number (org-export-get-headline-number headline info))
(section-number
(and (not (org-export-low-level-p headline info))
(org-export-numbered-headline-p headline info)
(concat (mapconcat 'number-to-string headline-number ".") ". ")))
(tags (and (eq (plist-get info :with-tags) t)
(org-export-get-tags headline info))))
(concat section-number
(org-export-data
(org-export-get-alt-title headline info) info)
(and tags "&nbsp;&nbsp;&nbsp;") (org-html--tags tags))))
(defun org-s5-toc (depth info)
(let* ((headlines (org-export-collect-headlines info depth))
(toc-entries
(mapcar (lambda (headline)
(cons (org-s5--format-toc-headline headline info)
(org-export-get-relative-level headline info)))
(org-export-collect-headlines info depth))))
(when toc-entries
(concat
(format "<%s id='table-of-contents' class='slide'>\n"
(plist-get info :html-container))
(format "<h1>%s</h1>\n"
(org-html--translate "Table of Contents" info))
"<div id=\"text-table-of-contents\">"
(org-html--toc-text toc-entries)
"</div>\n"
(format "</%s>\n" (plist-get info :html-container))))))
(defun org-s5--build-head (info)
(let* ((dir (plist-get info :s5-ui-url))
(theme (or (plist-get info :s5-theme-file) "default/slides.css")))
(mapconcat
'identity
(list
"<!-- style sheet links -->"
(mapconcat
(lambda (list)
(format
(concat
"<link rel='stylesheet' href='%s/default/%s' type='text/css'"
" media='%s' id='%s' />")
dir (nth 0 list) (nth 1 list) (nth 2 list)))
(list
'("outline.css" "screen" "outlineStyle")
'("print.css" "print" "slidePrint")
'("opera.css" "projection" "operaFix")) "\n")
(format (concat
"<link rel='stylesheet' href='%s' type='text/css'"
" media='screen' id='slideProj' />")
(if (string-match-p "^\\(http\\|/\\)" theme) theme
(concat dir "/" theme)))
"<!-- S5 JS -->"
(concat
"<script src='" dir
"/default/slides.js' type='text/javascript'></script>")) "\n")))
(defun org-s5--build-meta-info (info)
(concat
(org-html--build-meta-info info)
(format "<meta name=\"version\" content=\"S5 %s\" />\n"
(plist-get info :s5-version))
(format "<meta name='defaultView' content='%s' />\n"
(plist-get info :s5-default-view))
(format "<meta name='controlVis' content='%s' />"
(plist-get info :s5-control-visibility))))
(defun org-s5-headline (headline contents info)
(let ((org-html-toplevel-hlevel 1)
(class (or (org-element-property :HTML_CONTAINER_CLASS headline) ""))
(level (org-export-get-relative-level headline info)))
(when (and (= 1 level) (not (string-match-p "\\<slide\\>" class)))
(org-element-put-property headline :HTML_CONTAINER_CLASS (concat class " slide")))
(org-html-headline headline contents info)))
(defun org-s5-plain-list (plain-list contents info)
"Transcode a PLAIN-LIST element from Org to HTML.
CONTENTS is the contents of the list. INFO is a plist holding
contextual information.
If a containing headline has the property :INCREMENTAL,
then the \"incremental\" class will be added to the to the list,
which will make the list into a \"build\"."
(let* ((type (org-element-property :type plain-list))
(tag (case type
(ordered "ol")
(unordered "ul")
(descriptive "dl"))))
(format "%s\n%s%s"
(format
"<%s class='org-%s%s'>" tag tag
(if (org-export-get-node-property :INCREMENTAL plain-list t)
" incremental" ""))
contents (org-html-end-plain-list type))))
(defun org-s5-inner-template (contents info)
"Return body of document string after HTML conversion.
CONTENTS is the transcoded contents string. INFO is a plist
holding export options."
(concat contents "\n"))
(defun org-s5-template (contents info)
"Return complete document string after HTML conversion.
CONTENTS is the transcoded contents string. INFO is a plist
holding export options."
(let ((org-html-divs
(if (equal (plist-get info :html-container) "li")
(append '((content "ol" "content")) org-s5--divs)
org-s5--divs))
(info (plist-put
(plist-put info :html-preamble (plist-get info :s5-preamble))
:html-postamble (plist-get info :s5-postamble))))
(mapconcat
'identity
(list
(plist-get info :html-doctype)
(format "<html xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"%s\" xml:lang=\"%s\">"
(plist-get info :language) (plist-get info :language))
"<head>"
(org-s5--build-meta-info info)
(org-s5--build-head info)
(org-html--build-head info)
(org-html--build-mathjax-config info)
"</head>"
"<body>"
"<div class=\"layout\">"
"<div id=\"controls\"><!-- no edit --></div>"
"<div id=\"currentSlide\"><!-- no edit --></div>"
(org-html--build-pre/postamble 'preamble info)
(org-html--build-pre/postamble 'postamble info)
"</div>"
(format "<%s id=\"%s\" class=\"presentation\">"
(nth 1 (assq 'content org-html-divs))
(nth 2 (assq 'content org-html-divs)))
;; title page
(format "<%s id='title-slide' class='slide'>"
(plist-get info :html-container))
(format-spec org-s5-title-slide-template (org-html-format-spec info))
(format "</%s>" (plist-get info :html-container))
;; table of contents.
(let ((depth (plist-get info :with-toc)))
(when depth (org-s5-toc depth info)))
contents
(format "</%s>" (nth 1 (assq 'content org-html-divs)))
"</body>"
"</html>\n") "\n")))
(defun org-s5-export-as-html
(&optional async subtreep visible-only body-only ext-plist)
"Export current buffer to an HTML 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.
When optional argument BODY-ONLY is non-nil, only write code
between \"<body>\" and \"</body>\" tags.
EXT-PLIST, when provided, is a property list with external
parameters overriding Org default settings, but still inferior to
file-local settings.
Export is done in a buffer named \"*Org S5 Export*\", which
will be displayed when `org-export-show-temporary-export-buffer'
is non-nil."
(interactive)
(if async
(org-export-async-start
(lambda (output)
(with-current-buffer (get-buffer-create "*Org S5 Export*")
(erase-buffer)
(insert output)
(goto-char (point-min))
(nxml-mode)
(org-export-add-to-stack (current-buffer) 's5)))
`(org-export-as 's5 ,subtreep ,visible-only ,body-only ',ext-plist))
(let ((outbuf (org-export-to-buffer
's5 "*Org S5 Export*"
subtreep visible-only body-only ext-plist)))
;; Set major mode.
(with-current-buffer outbuf (nxml-mode))
(when org-export-show-temporary-export-buffer
(switch-to-buffer-other-window outbuf)))))
(defun org-s5-export-to-html
(&optional async subtreep visible-only body-only ext-plist)
"Export current buffer to a S5 HTML 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.
When optional argument BODY-ONLY is non-nil, only write code
between \"<body>\" and \"</body>\" tags.
EXT-PLIST, when provided, is a property list with external
parameters overriding Org default settings, but still inferior to
file-local settings.
Return output file's name."
(interactive)
(let* ((extension (concat "." org-html-extension))
(file (org-export-output-file-name extension subtreep))
(org-export-coding-system org-html-coding-system))
(if async
(org-export-async-start
(lambda (f) (org-export-add-to-stack f 's5))
(let ((org-export-coding-system org-html-coding-system))
`(expand-file-name
(org-export-to-file
's5 ,file ,subtreep ,visible-only ,body-only ',ext-plist))))
(let ((org-export-coding-system org-html-coding-system))
(org-export-to-file
's5 file subtreep visible-only body-only ext-plist)))))
(defun org-s5-publish-to-html (plist filename pub-dir)
"Publish an org file to S5 HTML Presentation.
FILENAME is the filename of the Org file to be published. PLIST
is the property list for the given project. PUB-DIR is the
publishing directory.
Return output file name."
(org-publish-org-to 's5 filename ".html" plist pub-dir))
(provide 'ox-s5)
;;; ox-s5.el ends here

904
contrib/lisp/ox-taskjuggler.el Normal file
View File

@ -0,0 +1,904 @@
;;; ox-taskjuggler.el --- TaskJuggler Back-End for Org Export Engine
;;
;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
;;
;; Emacs Lisp Archive Entry
;; Filename: ox-taskjuggler.el
;; Author: Christian Egli
;; Nicolas Goaziou <n dot goaziou at gmail dot com>
;; Maintainer: Christian Egli
;; Keywords: org, taskjuggler, project planning
;; Description: Converts an Org mode buffer into a TaskJuggler project plan
;; 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 of the License, 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 this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; This library implements a TaskJuggler exporter for Org mode.
;; TaskJuggler is a project planing tool that uses a text format to
;; define projects, tasks and resources, so it is a natural fit for
;; Org mode. It can produce all sorts of reports for tasks or
;; resources in either HTML, CSV or PDF. TaskJuggler is implemented
;; in Ruby and should therefore run on any platform.
;;
;; The exporter does not export all the nodes of a document or
;; strictly follow the order of the nodes in the document.
;;
;; Instead the TaskJuggler exporter looks for a tree that defines the
;; tasks and a optionally tree that defines the resources for this
;; project. It then creates a TaskJuggler file based on these trees
;; and the attributes defined in all the nodes.
;;
;; * Installation
;;
;; Put this file into your load-path and the following line into your
;; ~/.emacs:
;;
;; (add-to-list 'org-export-backends 'taskjuggler)
;;
;; or customize `org-export-backends' variable.
;;
;; The interactive functions are the following:
;;
;; M-x `org-taskjuggler-export'
;; M-x `org-taskjuggler-export-and-open'
;;
;; * Tasks
;;
;; Let's illustrate the usage with a small example. Create your tasks
;; as you usually do with org-mode. Assign efforts to each task using
;; properties (it's easiest to do this in the column view). You
;; should end up with something similar to the example by Peter Jones
;; in:
;;
;; http://www.contextualdevelopment.com/static/artifacts/articles/2008/project-planning/project-planning.org.
;;
;; Now mark the top node of your tasks with a tag named
;; "taskjuggler_project" (or whatever you customized
;; `org-taskjuggler-project-tag' to). You are now ready to export the
;; project plan with `org-taskjuggler-export-and-open' which will
;; export the project plan and open a Gantt chart in TaskJugglerUI.
;;
;; * Resources
;;
;; Next you can define resources and assign those to work on specific
;; tasks. You can group your resources hierarchically. Tag the top
;; node of the resources with "taskjuggler_resource" (or whatever you
;; customized `org-taskjuggler-resource-tag' to). You can optionally
;; assign an identifier (named "resource_id") to the resources (using
;; the standard org properties commands) or you can let the exporter
;; generate identifiers automatically (the exporter picks the first
;; word of the headline as the identifier as long as it is unique, see
;; the documentation of `org-taskjuggler--build-unique-id'). Using that
;; identifier you can then allocate resources to tasks. This is again
;; done with the "allocate" property on the tasks. Do this in column
;; view or when on the task type
;;
;; C-c C-x p allocate RET <resource_id> RET
;;
;; Once the allocations are done you can again export to TaskJuggler
;; and check in the Resource Allocation Graph which person is working
;; on what task at what time.
;;
;; * Export of properties
;;
;; The exporter also takes TODO state information into consideration,
;; i.e. if a task is marked as done it will have the corresponding
;; attribute in TaskJuggler ("complete 100"). Also it will export any
;; property on a task resource or resource node which is known to
;; TaskJuggler, such as limits, vacation, shift, booking, efficiency,
;; journalentry, rate for resources or account, start, note, duration,
;; end, journalentry, milestone, reference, responsible, scheduling,
;; etc for tasks.
;;
;; * Dependencies
;;
;; The exporter will handle dependencies that are defined in the tasks
;; either with the ORDERED attribute (see TODO dependencies in the Org
;; mode manual) or with the BLOCKER attribute (see org-depend.el) or
;; alternatively with a depends attribute. Both the BLOCKER and the
;; depends attribute can be either "previous-sibling" or a reference
;; to an identifier (named "task_id") which is defined for another
;; task in the project. BLOCKER and the depends attribute can define
;; multiple dependencies separated by either space or comma. You can
;; also specify optional attributes on the dependency by simply
;; appending it. The following examples should illustrate this:
;;
;; * Training material
;; :PROPERTIES:
;; :task_id: training_material
;; :ORDERED: t
;; :END:
;; ** Markup Guidelines
;; :PROPERTIES:
;; :Effort: 2d
;; :END:
;; ** Workflow Guidelines
;; :PROPERTIES:
;; :Effort: 2d
;; :END:
;; * Presentation
;; :PROPERTIES:
;; :Effort: 2d
;; :BLOCKER: training_material { gapduration 1d } some_other_task
;; :END:
;;
;;;; * TODO
;; - Look at org-file-properties, org-global-properties and
;; org-global-properties-fixed
;; - What about property inheritance and org-property-inherit-p?
;; - Use TYPE_TODO as an way to assign resources
;;
;;; Code:
(eval-when-compile (require 'cl))
(require 'ox)
;;; User Variables
(defgroup org-export-taskjuggler nil
"Options specific for TaskJuggler export back-end."
:tag "Org Export TaskJuggler"
:group 'org-export)
(defcustom org-taskjuggler-extension ".tjp"
"Extension of TaskJuggler files."
:group 'org-export-taskjuggler
:type 'string)
(defcustom org-taskjuggler-project-tag "taskjuggler_project"
"Tag marking project's tasks.
This tag is used to find the tree containing all the tasks for
the project."
:group 'org-export-taskjuggler
:type 'string)
(defcustom org-taskjuggler-resource-tag "taskjuggler_resource"
"Tag marking project's resources.
This tag is used to find the tree containing all the resources
for the project."
:group 'org-export-taskjuggler
:type 'string)
(defcustom org-taskjuggler-report-tag "taskjuggler_report"
"Tag marking project's reports.
This tag is used to find the tree containing all the reports for
the project."
:group 'org-export-taskjuggler
:type 'string)
(defcustom org-taskjuggler-target-version 3.0
"Which version of TaskJuggler the exporter is targeting.
By default a project plan is exported which conforms to version
3.x of TaskJuggler. For a project plan that is compatible with
versions of TaskJuggler older than 3.0 set this to 2.4.
If you change this variable be sure to also change
`org-taskjuggler-default-reports' as the format of reports has
changed considerably between version 2.x and 3.x of TaskJuggler"
:group 'org-export-taskjuggler
:type 'number)
(defcustom org-taskjuggler-default-project-version "1.0"
"Default version string for the project.
This value can also be set with the \":VERSION:\" property
associated to the headline defining the project."
:group 'org-export-taskjuggler
:type 'string)
(defcustom org-taskjuggler-default-project-duration 280
"Default project duration.
The value will be used if no start and end date have been defined
in the root node of the task tree, i.e. the tree that has been
marked with `org-taskjuggler-project-tag'"
:group 'org-export-taskjuggler
:type 'integer)
(defcustom org-taskjuggler-default-reports
'("textreport report \"Plan\" {
formats html
header '== <-query attribute=\"name\"-> =='
center -8<-
[#Plan Plan] | [#Resource_Allocation Resource Allocation]
----
=== Plan ===
<[report id=\"plan\"]>
----
=== Resource Allocation ===
<[report id=\"resourceGraph\"]>
->8-
}
# A traditional Gantt chart with a project overview.
taskreport plan \"\" {
headline \"Project Plan\"
columns bsi, name, start, end, effort, chart
loadunit shortauto
hideresource 1
}
# A graph showing resource allocation. It identifies whether each
# resource is under- or over-allocated for.
resourcereport resourceGraph \"\" {
headline \"Resource Allocation Graph\"
columns no, name, effort, weekly
loadunit shortauto
hidetask ~(isleaf() & isleaf_())
sorttasks plan.start.up
}")
"Default reports for the project.
These are sensible default reports to give a good out-of-the-box
result when exporting without defining any reports. If you want
to define your own reports you can change them here or simply
define the default reports so that they include an external
report definition as follows:
include reports.tji
These default are made to work with tj3. If you are targeting
TaskJuggler 2.4 (see `org-taskjuggler-target-version') please
change these defaults to something like the following:
taskreport \"Gantt Chart\" {
headline \"Project Gantt Chart\"
columns hierarchindex, name, start, end, effort, duration, completed, chart
timeformat \"%Y-%m-%d\"
hideresource 1
loadunit shortauto
}
resourcereport \"Resource Graph\" {
headline \"Resource Allocation Graph\"
columns no, name, utilization, freeload, chart
loadunit shortauto
sorttasks startup
hidetask ~isleaf()
}"
:group 'org-export-taskjuggler
:type '(repeat (string :tag "Report")))
(defcustom org-taskjuggler-default-global-header ""
"Default global header for the project.
This goes before project declaration, and might be useful for
early macros."
:group 'org-export-taskjuggler
:type '(string :tag "Preamble"))
(defcustom org-taskjuggler-default-global-properties
"shift s40 \"Part time shift\" {
workinghours wed, thu, fri off
}
"
"Default global properties for the project.
Here you typically define global properties such as shifts,
accounts, rates, vacation, macros and flags. Any property that
is allowed within the TaskJuggler file can be inserted. You
could for example include another TaskJuggler file.
The global properties are inserted after the project declaration
but before any resource and task declarations."
:group 'org-export-taskjuggler
:type '(string :tag "Preamble"))
(defcustom org-taskjuggler-valid-task-attributes
'(account start note duration endbuffer endcredit end
flags journalentry length limits maxend maxstart minend
minstart period reference responsible scheduling
startbuffer startcredit statusnote chargeset charge)
"Valid attributes for Taskjuggler tasks.
If one of these appears as a property for a headline, it will be
exported with the corresponding task."
:group 'org-export-taskjuggler)
(defcustom org-taskjuggler-valid-resource-attributes
'(limits vacation shift booking efficiency journalentry rate
workinghours flags)
"Valid attributes for Taskjuggler resources.
If one of these appears as a property for a headline, it will be
exported with the corresponding resource."
:group 'org-export-taskjuggler)
(defcustom org-taskjuggler-valid-report-attributes
'(headline columns definitions timeformat hideresource hidetask
loadunit sorttasks formats period)
"Valid attributes for Taskjuggler reports.
If one of these appears as a property for a headline, it will be
exported with the corresponding report."
:group 'org-export-taskjuggler)
(defcustom org-taskjuggler-keep-project-as-task t
"Non-nil keeps the project headline as an umbrella task for all tasks.
Setting this to nil will allow maintaining completely separated
task buckets, while still sharing the same resources pool."
:group 'org-export-taskjuggler
:type 'boolean)
;;; Hooks
(defvar org-taskjuggler-final-hook nil
"Hook run after a TaskJuggler files has been saved.
This hook is run with the name of the file as argument.")
;;; Back-End Definition
(org-export-define-backend 'taskjuggler
'((template . org-taskjuggler-project-plan))
:menu-entry
'(?J "Export to TaskJuggler"
((?j "As TJP file" (lambda (a s v b) (org-taskjuggler-export a s v)))
(?o "As TJP file and open"
(lambda (a s v b)
(if a (org-taskjuggler-export a s v)
(org-taskjuggler-export-and-open s v))))))
;; This property will be used to store unique ids in communication
;; channel. Ids will be retrieved with `org-taskjuggler-get-id'.
:options-alist '((:taskjuggler-unique-ids nil nil nil)))
;;; Unique IDs
(defun org-taskjuggler-assign-task-ids (tasks info)
"Assign a unique ID to each task in TASKS.
TASKS is a list of headlines. INFO is a plist used as a
communication channel. Return value is an alist between
headlines and their associated ID. IDs are hierarchical, which
means they only need to be unique among the task siblings."
(let* (alist
(build-id
(lambda (tasks local-ids)
(org-element-map tasks 'headline
(lambda (task)
(let ((id (org-taskjuggler--build-unique-id task local-ids)))
(push id local-ids)
(push (cons task id) alist)
(funcall build-id (org-element-contents task) nil)))
info nil 'headline))))
(funcall build-id tasks nil)
alist))
(defun org-taskjuggler-assign-resource-ids (resources info)
"Assign a unique ID to each resource within RESOURCES.
RESOURCES is a list of headlines. INFO is a plist used as a
communication channel. Return value is an alist between
headlines and their associated ID."
(let (ids)
(org-element-map resources 'headline
(lambda (resource)
(let ((id (org-taskjuggler--build-unique-id resource ids)))
(push id ids)
(cons resource id)))
info)))
;;; Accessors
(defun org-taskjuggler-get-project (info)
"Return project in parse tree.
INFO is a plist used as a communication channel. First headline
in buffer with `org-taskjuggler-project-tag' defines the project.
If no such task is defined, pick the first headline in buffer.
If there is no headline at all, return nil."
(or (org-element-map (plist-get info :parse-tree) 'headline
(lambda (hl)
(and (member org-taskjuggler-project-tag
(org-export-get-tags hl info))
hl))
info t)
(org-element-map tree 'headline 'identity info t)))
(defun org-taskjuggler-get-id (item info)
"Return id for task or resource ITEM.
ITEM is a headline. INFO is a plist used as a communication
channel. Return value is a string."
(cdr (assq item (plist-get info :taskjuggler-unique-ids))))
(defun org-taskjuggler-get-name (item)
"Return name for task or resource ITEM.
ITEM is a headline. Return value is a string."
;; Quote double quotes in name.
(replace-regexp-in-string
"\"" "\\\"" (org-element-property :raw-value item) t t))
(defun org-taskjuggler-get-start (item)
"Return start date for task or resource ITEM.
ITEM is a headline. Return value is a string or nil if ITEM
doesn't have any start date defined.."
(let ((scheduled (org-element-property :scheduled item)))
(and scheduled (org-timestamp-format scheduled "%Y-%02m-%02d"))))
(defun org-taskjuggler-get-end (item)
"Return end date for task or resource ITEM.
ITEM is a headline. Return value is a string or nil if ITEM
doesn't have any end date defined.."
(let ((deadline (org-element-property :deadline item)))
(and deadline (org-timestamp-format deadline "%Y-%02m-%02d"))))
;;; Internal Functions
(defun org-taskjuggler--indent-string (s)
"Indent string S by 2 spaces.
Return new string. If S is the empty string, return it."
(if (equal "" s) s (replace-regexp-in-string "^ *\\S-" " \\&" s)))
(defun org-taskjuggler--build-attributes (item attributes)
"Return attributes string for task, resource or report ITEM.
ITEM is a headline. ATTRIBUTES is a list of symbols
representing valid attributes for ITEM."
(mapconcat
(lambda (attribute)
(let ((value (org-element-property
(intern (upcase (format ":%s" attribute)))
item)))
(and value (format "%s %s\n" attribute value))))
(remq nil attributes) ""))
(defun org-taskjuggler--build-unique-id (item unique-ids)
"Return a unique id for a given task or a resource.
ITEM is an `headline' type element representing the task or
resource. Its id is derived from its name and made unique
against UNIQUE-IDS. If the (downcased) first token of the
headline is not unique try to add more (downcased) tokens of the
headline or finally add more underscore characters (\"_\")."
(let ((id (org-string-nw-p (org-element-property :TASK_ID item))))
;; If an id is specified, use it, as long as it's unique.
(if (and id (not (member id unique-ids))) id
(let* ((parts (org-split-string (org-element-property :raw-value item)))
(id (org-taskjuggler--clean-id (downcase (pop parts)))))
;; Try to add more parts of the headline to make it unique.
(while (and (car parts) (member id unique-ids))
(setq id (concat id "_"
(org-taskjuggler--clean-id (downcase (pop parts))))))
;; If it's still not unique, add "_".
(while (member id unique-ids)
(setq id (concat id "_")))
id))))
(defun org-taskjuggler--clean-id (id)
"Clean and return ID to make it acceptable for TaskJuggler.
ID is a string."
;; Replace non-ascii by "_".
(replace-regexp-in-string
"[^a-zA-Z0-9_]" "_"
;; Make sure id doesn't start with a number.
(replace-regexp-in-string "^\\([0-9]\\)" "_\\1" id)))
;;; Dependencies
(defun org-taskjuggler-resolve-dependencies (task info)
"Return a list of all tasks TASK depends on.
TASK is a headline. INFO is a plist used as a communication
channel."
(let ((deps-ids
;; Get all dependencies specified in BLOCKER and DEPENDS task
;; properties. Clean options from them.
(let ((deps (concat (org-element-property :BLOCKER task)
(org-element-property :DEPENDS task))))
(and deps
(org-split-string (replace-regexp-in-string "{.*?}" "" deps)
"[ ,]* +"))))
depends)
(when deps-ids
;; Find tasks with :task_id: property matching id in DEPS-IDS.
;; Add them to DEPENDS.
(let* ((project (org-taskjuggler-get-project info))
(tasks (if org-taskjuggler-keep-project-as-task project
(org-element-contents project))))
(setq depends
(org-element-map tasks 'headline
(lambda (task)
(let ((task-id (org-element-property :TASK_ID task)))
(and task-id (member task-id deps-ids) task)))
info)))
;; Check BLOCKER and DEPENDS properties. If "previous-sibling"
;; belongs to DEPS-ID, add it to DEPENDS.
(when (and (member-ignore-case "previous-sibling" deps-ids)
(not (org-export-first-sibling-p task info)))
(let ((prev (org-export-get-previous-element task info)))
(and (not (memq prev depends)) (push prev depends)))))
;; Check ORDERED status of parent.
(let ((parent (org-export-get-parent task)))
(when (and parent
(org-element-property :ORDERED parent)
(not (org-export-first-sibling-p task info)))
(push (org-export-get-previous-element task info) depends)))
;; Return dependencies.
depends))
(defun org-taskjuggler-format-dependencies (dependencies task info)
"Format DEPENDENCIES to match TaskJuggler syntax.
DEPENDENCIES is list of dependencies for TASK, as returned by
`org-taskjuggler-resolve-depedencies'. TASK is a headline.
INFO is a plist used as a communication channel. Return value
doesn't include leading \"depends\"."
(let ((dep-str (concat (org-element-property :BLOCKER task)
" "
(org-element-property :DEPENDS task)))
(get-path
(lambda (dep)
;; Return path to DEP relatively to TASK.
(let ((parent (org-export-get-parent dep))
(exclamations 1)
(option
(let ((id (org-element-property :TASK_ID dep)))
(and id
(string-match (concat id " +\\({.*?}\\)") dep-str)
(org-match-string-no-properties 1))))
path)
;; Compute number of exclamation marks by looking for the
;; common ancestor between TASK and DEP.
(while (not (org-element-map parent 'headline
(lambda (hl) (eq hl task))))
(incf exclamations)
(setq parent (org-export-get-parent parent)))
;; Build path from DEP to PARENT.
(while (not (eq parent dep))
(push (org-taskjuggler-get-id dep info) path)
(setq dep (org-export-get-parent dep)))
;; Return full path. Add dependency options, if any.
(concat (make-string exclamations ?!)
(mapconcat 'identity path ".")
(and option (concat " " option)))))))
;; Return dependencies string, without the leading "depends".
(mapconcat (lambda (dep) (funcall get-path dep)) dependencies ", ")))
;;; Translator Functions
(defun org-taskjuggler-project-plan (contents info)
"Build TaskJuggler project plan.
CONTENTS is ignored. INFO is a plist holding export options.
Return complete project plan as a string in TaskJuggler syntax."
(let* ((tree (plist-get info :parse-tree))
(project (or (org-taskjuggler-get-project info)
(error "No project specified"))))
(concat
;; 1. Insert header.
(org-element-normalize-string org-taskjuggler-default-global-header)
;; 2. Insert project.
(org-taskjuggler--build-project project info)
;; 3. Insert global properties.
(org-element-normalize-string org-taskjuggler-default-global-properties)
;; 4. Insert resources. Provide a default one if none is
;; specified.
(let ((main-resources
;; Collect contents from various trees marked with
;; `org-taskjuggler-resource-tag'. Only gather top level
;; resources.
(apply 'append
(org-element-map tree 'headline
(lambda (hl)
(and (member org-taskjuggler-resource-tag
(org-export-get-tags hl info))
(org-element-map (org-element-contents hl) 'headline
'identity info nil 'headline)))
info nil 'headline))))
;; Assign a unique ID to each resource. Store it under
;; `:taskjuggler-unique-ids' property in INFO.
(setq info
(plist-put info :taskjuggler-unique-ids
(org-taskjuggler-assign-resource-ids
main-resources info)))
(concat
(if main-resources
(mapconcat
(lambda (resource) (org-taskjuggler--build-resource resource info))
main-resources "")
(format "resource %s \"%s\" {\n}\n" (user-login-name) user-full-name))
;; 5. Insert tasks.
(let ((main-tasks
;; If `org-taskjuggler-keep-project-as-task' is
;; non-nil, there is only one task. Otherwise, every
;; direct children of PROJECT is a top level task.
(if org-taskjuggler-keep-project-as-task (list project)
(or (org-element-map (org-element-contents project) 'headline
'identity info nil 'headline)
(error "No task specified")))))
;; Assign a unique ID to each task. Add it to
;; `:taskjuggler-unique-ids' property in INFO.
(setq info
(plist-put info :taskjuggler-unique-ids
(append
(org-taskjuggler-assign-task-ids main-tasks info)
(plist-get info :taskjuggler-unique-ids))))
;; If no resource is allocated among tasks, allocate one to
;; the first task.
(unless (org-element-map main-tasks 'headline
(lambda (task) (org-element-property :ALLOCATE task))
info t)
(org-element-put-property
(car main-tasks) :ALLOCATE
(or (org-taskjuggler-get-id (car main-resources) info)
(user-login-name))))
(mapconcat
(lambda (task) (org-taskjuggler--build-task task info))
main-tasks ""))
;; 6. Insert reports. If no report is defined, insert default
;; reports.
(let ((main-reports
;; Collect contents from various trees marked with
;; `org-taskjuggler-report-tag'. Only gather top level
;; reports.
(apply 'append
(org-element-map tree 'headline
(lambda (hl)
(and (member org-taskjuggler-report-tag
(org-export-get-tags hl info))
(org-element-map (org-element-contents hl)
'headline 'identity info nil 'headline)))
info nil 'headline))))
(if main-reports
(mapconcat
(lambda (report) (org-taskjuggler--build-report report info))
main-reports "")
(mapconcat 'org-element-normalize-string
org-taskjuggler-default-reports ""))))))))
(defun org-taskjuggler--build-project (project info)
"Return a project declaration.
PROJECT is a headline. INFO is a plist used as a communication
channel. If no start date is specified, start today. If no end
date is specified, end `org-taskjuggler-default-project-duration'
days from now."
(format "project %s \"%s\" \"%s\" %s %s {\n}\n"
(org-taskjuggler-get-id project info)
(org-taskjuggler-get-name project)
;; Version is obtained through :TASKJUGGLER_VERSION:
;; property or `org-taskjuggler-default-project-version'.
(or (org-element-property :VERSION project)
org-taskjuggler-default-project-version)
(or (org-taskjuggler-get-start project)
(format-time-string "%Y-%m-%d"))
(let ((end (org-taskjuggler-get-end project)))
(or (and end (format "- %s" end))
(format "+%sd" org-taskjuggler-default-project-duration)))))
(defun org-taskjuggler--build-resource (resource info)
"Return a resource declaration.
RESOURCE is a headline. INFO is a plist used as a communication
channel.
All valid attributes from RESOURCE are inserted. If RESOURCE
defines a property \"resource_id\" it will be used as the id for
this resource. Otherwise it will use the ID property. If
neither is defined a unique id will be associated to it."
(concat
;; Opening resource.
(format "resource %s \"%s\" {\n"
(org-taskjuggler--clean-id
(or (org-element-property :RESOURCE_ID resource)
(org-element-property :ID resource)
(org-taskjuggler-get-id resource info)))
(org-taskjuggler-get-name resource))
;; Add attributes.
(org-taskjuggler--indent-string
(org-taskjuggler--build-attributes
resource org-taskjuggler-valid-resource-attributes))
;; Add inner resources.
(org-taskjuggler--indent-string
(mapconcat
'identity
(org-element-map (org-element-contents resource) 'headline
(lambda (hl) (org-taskjuggler--build-resource hl info))
info nil 'headline)
""))
;; Closing resource.
"}\n"))
(defun org-taskjuggler--build-report (report info)
"Return a report declaration.
REPORT is a headline. INFO is a plist used as a communication
channel."
(concat
;; Opening report.
(format "%s \"%s\" {\n"
(or (org-element-property :REPORT_KIND report) "taskreport")
(org-taskjuggler-get-name report))
;; Add attributes.
(org-taskjuggler--indent-string
(org-taskjuggler--build-attributes
report org-taskjuggler-valid-report-attributes))
;; Add inner reports.
(org-taskjuggler--indent-string
(mapconcat
'identity
(org-element-map (org-element-contents report) 'headline
(lambda (hl) (org-taskjuggler--build-report hl info))
info nil 'headline)
""))
;; Closing report.
"}\n"))
(defun org-taskjuggler--build-task (task info)
"Return a task declaration.
TASK is a headline. INFO is a plist used as a communication
channel.
All valid attributes from TASK are inserted. If TASK defines
a property \"task_id\" it will be used as the id for this task.
Otherwise it will use the ID property. If neither is defined
a unique id will be associated to it."
(let* ((allocate (org-element-property :ALLOCATE task))
(complete
(if (eq (org-element-property :todo-type task) 'done) "100"
(org-element-property :COMPLETE task)))
(depends (org-taskjuggler-resolve-dependencies task info))
(effort (org-element-property :EFFORT task))
(milestone
(or (org-element-property :MILESTONE task)
(not (or (org-element-map (org-element-contents task) 'headline
'identity info t) ; Has task any child?
effort
(org-element-property :LENGTH task)
(org-element-property :DURATION task)
(and (org-taskjuggler-get-start task)
(org-taskjuggler-get-end task))
(org-element-property :PERIOD task)))))
(priority
(let ((pri (org-element-property :priority task)))
(and pri
(max 1 (/ (* 1000 (- org-lowest-priority pri))
(- org-lowest-priority org-highest-priority)))))))
(concat
;; Opening task.
(format "task %s \"%s\" {\n"
(org-taskjuggler-get-id task info)
(org-taskjuggler-get-name task))
;; Add default attributes.
(and depends
(format " depends %s\n"
(org-taskjuggler-format-dependencies depends task info)))
(and allocate
(format " purge %s\n allocate %s\n"
;; Compatibility for previous TaskJuggler versions.
(if (>= org-taskjuggler-target-version 3.0) "allocate"
"allocations")
allocate))
(and complete (format " complete %s\n" complete))
(and effort
(format " effort %s\n"
(let* ((minutes (org-duration-string-to-minutes effort))
(hours (/ minutes 60.0)))
(format "%.1fh" hours))))
(and priority (format " priority %s\n" complete))
(and milestone " milestone\n")
;; Add other valid attributes.
(org-taskjuggler--indent-string
(org-taskjuggler--build-attributes
task org-taskjuggler-valid-task-attributes))
;; Add inner tasks.
(org-taskjuggler--indent-string
(mapconcat 'identity
(org-element-map (org-element-contents task) 'headline
(lambda (hl) (org-taskjuggler--build-task hl info))
info nil 'headline)
""))
;; Closing task.
"}\n")))
;;; Interactive Functions
;;;###autoload
(defun org-taskjuggler-export (&optional async subtreep visible-only)
"Export current buffer to a TaskJuggler file.
The exporter looks for a tree with tag that matches
`org-taskjuggler-project-tag' and takes this as the tasks for
this project. The first node of this tree defines the project
properties such as project name and project period.
If there is a tree with tag that matches
`org-taskjuggler-resource-tag' this tree is taken as resources
for the project. If no resources are specified, a default
resource is created and allocated to the project.
Also the TaskJuggler project will be created with default reports
as defined in `org-taskjuggler-default-reports'.
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 org-taskjuggler-extension subtreep)))
(if async
(org-export-async-start
(lambda (f)
(org-export-add-to-stack f 'taskjuggler)
(run-hook-with-args 'org-taskjuggler-final-hook f))
`(expand-file-name
(org-export-to-file 'taskjuggler ,outfile ,subtreep ,visible-only)))
(org-export-to-file 'taskjuggler outfile subtreep visible-only)
(run-hook-with-args 'org-taskjuggler-final-hook outfile)
outfile)))
;;;###autoload
(defun org-taskjuggler-export-and-open (&optional subtreep visible-only)
"Export current buffer to a TaskJuggler file and open it.
The exporter looks for a tree with tag that matches
`org-taskjuggler-project-tag' and takes this as the tasks for
this project. The first node of this tree defines the project
properties such as project name and project period.
If there is a tree with tag that matches
`org-taskjuggler-resource-tag' this tree is taken as resources
for the project. If no resources are specified, a default
resource is created and allocated to the project.
Also the TaskJuggler project will be created with default reports
as defined in `org-taskjuggler-default-reports'.
If narrowing is active in the current buffer, only export its
narrowed part.
If a region is active, export that region.
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.
Open file with the TaskJuggler GUI."
(interactive)
(let* ((file (org-taskjuggler-export nil subtreep visible-only))
(process-name "TaskJugglerUI")
(command (concat process-name " " file)))
(start-process-shell-command process-name nil command)))
(provide 'ox-taskjuggler)
;; Local variables:
;; sentence-end-double-space: t
;; End:
;;; ox-taskjuggler.el ends here

28
contrib/scripts/x11idle.c Normal file
View File

@ -0,0 +1,28 @@
#include <X11/extensions/scrnsaver.h>
#include <stdio.h>
/* Based on code from
* http://coderrr.wordpress.com/2008/04/20/getting-idle-time-in-unix/
*
* compile with 'gcc -l Xss x11idle.c -o x11idle' and copy x11idle into your
* path
*/
main() {
XScreenSaverInfo *info = XScreenSaverAllocInfo();
//open the display specified by the DISPLAY environment variable
Display *display = XOpenDisplay(0);
//display could be null if there is no X server running
if (info == NULL || display == NULL) {
return -1;
}
//X11 is running, try to retrieve info
if (XScreenSaverQueryInfo(display, DefaultRootWindow(display), info) == 0) {
return -1;
}
//info was retrieved successfully, print idle time
printf("%lu\n", info->idle);
return 0;
}

0
contrib/babel/library-of-babel.org → doc/library-of-babel.org
View File

5684
doc/org.texi
View File

File diff suppressed because it is too large Load Diff

125
doc/orgguide.texi
View File

@ -13,9 +13,9 @@
@c Version and Contact Info @c Version and Contact Info
@set MAINTAINERSITE @uref{http://orgmode.org,maintainers webpage} @set MAINTAINERSITE @uref{http://orgmode.org,maintainers webpage}
@set AUTHOR Carsten Dominik @set AUTHOR Carsten Dominik
@set MAINTAINER Carsten Dominik @set MAINTAINER Bastien Guerry
@set MAINTAINEREMAIL @email{carsten at orgmode dot org} @set MAINTAINEREMAIL @email{bzg at gnu dot org}
@set MAINTAINERCONTACT @uref{mailto:carsten at orgmode dot org,contact the maintainer} @set MAINTAINERCONTACT @uref{mailto:bzg at gnu dot org,contact the maintainer}
@c %**end of header @c %**end of header
@finalout @finalout
@ -98,7 +98,7 @@ modify this GNU manual.''
* Working With Source Code:: Source code snippets embedded in Org * Working With Source Code:: Source code snippets embedded in Org
* Miscellaneous:: All the rest which did not fit elsewhere * Miscellaneous:: All the rest which did not fit elsewhere
* GNU Free Documentation License:: This manual license. * GNU Free Documentation License:: This manual license.
@detailmenu @detailmenu
--- The Detailed Node Listing --- --- The Detailed Node Listing ---
@ -148,6 +148,7 @@ Tags
* Tag inheritance:: Tags use the tree structure of the outline * Tag inheritance:: Tags use the tree structure of the outline
* Setting tags:: How to assign tags to a headline * Setting tags:: How to assign tags to a headline
* Tag searches:: Searching for combinations of tags * Tag searches:: Searching for combinations of tags
* Tag searches:: Searching for combinations of tags
Dates and Times Dates and Times
@ -158,8 +159,8 @@ Dates and Times
Capture - Refile - Archive Capture - Refile - Archive
* Capture:: * Capture:: Capturing new stuff
* Refiling notes:: Moving a tree from one place to another * Refile and copy:: Moving a tree from one place to another
* Archiving:: What to do with finished projects * Archiving:: What to do with finished projects
Capture Capture
@ -427,7 +428,7 @@ Promote/demote the current subtree by one level.
Move subtree up/down (swap with previous/next subtree of same Move subtree up/down (swap with previous/next subtree of same
level). level).
@item C-c C-w @item C-c C-w
Refile entry or region to a different location. @xref{Refiling notes}. Refile entry or region to a different location. @xref{Refile and copy}.
@item C-x n s/w @item C-x n s/w
Narrow buffer to current subtree / widen it again Narrow buffer to current subtree / widen it again
@end table @end table
@ -729,6 +730,9 @@ Links such as @samp{[[My Target]]} or @samp{[[My Target][Find my target]]}
lead to a text search in the current file for the corresponding target which lead to a text search in the current file for the corresponding target which
looks like @samp{<<My Target>>}. looks like @samp{<<My Target>>}.
Internal links will be used to reference their destination, through links or
numbers, when possible.
@node External links, Handling links, Internal links, Hyperlinks @node External links, Handling links, Internal links, Hyperlinks
@section External links @section External links
@ -1110,6 +1114,7 @@ Tags will by default be in bold face with the same color as the headline.
* Tag inheritance:: Tags use the tree structure of the outline * Tag inheritance:: Tags use the tree structure of the outline
* Setting tags:: How to assign tags to a headline * Setting tags:: How to assign tags to a headline
* Tag searches:: Searching for combinations of tags * Tag searches:: Searching for combinations of tags
* Tag searches:: Searching for combinations of tags
@end menu @end menu
@node Tag inheritance, Setting tags, Tags, Tags @node Tag inheritance, Setting tags, Tags, Tags
@ -1189,7 +1194,46 @@ can instead set the TAGS option line as:
#+TAGS: @@work(w) @@home(h) @@tennisclub(t) laptop(l) pc(p) #+TAGS: @@work(w) @@home(h) @@tennisclub(t) laptop(l) pc(p)
@end smallexample @end smallexample
@node Tag searches, , Setting tags, Tags @node Tag searches, Tag searches, Setting tags, Tags
@section Tag groups
@cindex group tags
@cindex tags, groups
In a set of mutually exclusive tags, the first tag can be defined as a
@emph{group tag}. When you search for a group tag, it will return matches
for all members in the group. In an agenda view, filtering by a group tag
will display headlines tagged with at least one of the members of the
group. This makes tag searches and filters even more flexible.
You can set group tags by inserting a colon between the group tag and other
tags, like this:
@example
#+TAGS: @{ @@read : @@read_book @@read_ebook @}
@end example
In this example, @samp{@@read} is a @emph{group tag} for a set of three
tags: @samp{@@read}, @samp{@@read_book} and @samp{@@read_ebook}.
You can also use the @code{:grouptags} keyword directly when setting
@var{org-tag-alist}:
@lisp
(setq org-tag-alist '((:startgroup . nil)
("@@read" . nil)
(:grouptags . nil)
("@@read_book" . nil)
("@@read_ebook" . nil)
(:endgroup . nil)))
@end lisp
@kindex C-c C-x q
@vindex org-group-tags
If you want to ignore group tags temporarily, toggle group tags support
with @command{org-toggle-tags-groups}, bound to @kbd{C-c C-x q}. If you
want to disable tag groups completely, set @var{org-group-tags} to nil.
@node Tag searches, , Tag searches, Tags
@section Tag searches @section Tag searches
Once a system of tags has been set up, it can be used to collect related Once a system of tags has been set up, it can be used to collect related
@ -1518,17 +1562,17 @@ projects need to be moved around. Moving completed project trees to an
archive file keeps the system compact and fast. archive file keeps the system compact and fast.
@menu @menu
* Capture:: * Capture:: Capturing new stuff
* Refiling notes:: Moving a tree from one place to another * Refile and copy:: Moving a tree from one place to another
* Archiving:: What to do with finished projects * Archiving:: What to do with finished projects
@end menu @end menu
@node Capture, Refiling notes, Capture - Refile - Archive, Capture - Refile - Archive @node Capture, Refile and copy, Capture - Refile - Archive, Capture - Refile - Archive
@section Capture @section Capture
Org's method for capturing new items is heavily inspired by John Wiegley Org's method for capturing new items is heavily inspired by John Wiegley
excellent remember package. It lets you store quick notes with little excellent @file{remember.el} package. It lets you store quick notes with
interruption of your work flow. Org lets you define templates for new little interruption of your work flow. Org lets you define templates for new
entries and associate them with different targets for storing notes. entries and associate them with different targets for storing notes.
@menu @menu
@ -1563,7 +1607,7 @@ Once you are done entering information into the capture buffer,
@kbd{C-c C-c} will return you to the window configuration before the capture @kbd{C-c C-c} will return you to the window configuration before the capture
process, so that you can resume your work without further distraction. process, so that you can resume your work without further distraction.
@item C-c C-w @item C-c C-w
Finalize by moving the entry to a refile location (@pxref{Refiling notes}). Finalize by moving the entry to a refile location (@pxref{Refile and copy}).
@item C-c C-k @item C-c C-k
Abort the capture process and return to the previous state. Abort the capture process and return to the previous state.
@end table @end table
@ -1605,21 +1649,24 @@ allow dynamic insertion of content. Here is a small selection of the
possibilities, consult the manual for more. possibilities, consult the manual for more.
@smallexample @smallexample
%a @r{annotation, normally the link created with @code{org-store-link}} %a @r{annotation, normally the link created with @code{org-store-link}}
%i @r{initial content, the region when remember is called with C-u.} %i @r{initial content, the region when capture is called with C-u.}
%t @r{timestamp, date only} %t @r{timestamp, date only}
%T @r{timestamp with date and time} %T @r{timestamp with date and time}
%u, %U @r{like the above, but inactive timestamps} %u, %U @r{like the above, but inactive timestamps}
@end smallexample @end smallexample
@node Refiling notes, Archiving, Capture, Capture - Refile - Archive @node Refile and copy, Archiving, Capture, Capture - Refile - Archive
@section Refiling notes @section Refile and copy
When reviewing the captured data, you may want to refile some of the entries When reviewing the captured data, you may want to refile or copy some of the
into a different list, for example into a project. Cutting, finding the entries into a different list, for example into a project. Cutting, finding
right location, and then pasting the note is cumbersome. To simplify this the right location, and then pasting the note is cumbersome. To simplify
process, you can use the following special command: this process, you can use the following special command:
@table @kbd @table @kbd
@item C-c M-x
Copy the entry or region at point. This command behaves like
@code{org-refile}, except that the original note will not be deleted.
@item C-c C-w @item C-c C-w
Refile the entry or region at point. This command offers possible locations Refile the entry or region at point. This command offers possible locations
for refiling the entry and lets you select one with completion. The item (or for refiling the entry and lets you select one with completion. The item (or
@ -1633,7 +1680,7 @@ Use the refile interface to jump to a heading.
Jump to the location where @code{org-refile} last moved a tree to. Jump to the location where @code{org-refile} last moved a tree to.
@end table @end table
@node Archiving, , Refiling notes, Capture - Refile - Archive @node Archiving, , Refile and copy, Capture - Refile - Archive
@section Archiving @section Archiving
When a project represented by a (sub)tree is finished, you may want When a project represented by a (sub)tree is finished, you may want
@ -1666,8 +1713,6 @@ setting this variable, for example
@seealso{ @seealso{
@uref{http://orgmode.org/manual/Capture-_002d-Refile-_002d-Archive.html#Capture-_002d-Refile-_002d-Archive, @uref{http://orgmode.org/manual/Capture-_002d-Refile-_002d-Archive.html#Capture-_002d-Refile-_002d-Archive,
Chapter 9 of the manual}@* Chapter 9 of the manual}@*
@uref{http://members.optusnet.com.au/~charles57/GTD/remember.html, Charles
Cave's remember tutorial}@*
@uref{http://orgmode.org/worg/org-tutorials/org-protocol-custom-handler.php, @uref{http://orgmode.org/worg/org-tutorials/org-protocol-custom-handler.php,
Sebastian Rose's tutorial for capturing from a web browser}}@uref{}@* Sebastian Rose's tutorial for capturing from a web browser}}@uref{}@*
@ -2045,7 +2090,7 @@ summarizes the markup rules used in an Org-mode buffer.
@menu @menu
* Structural markup elements:: The basic structure as seen by the exporter * Structural markup elements:: The basic structure as seen by the exporter
* Images and tables:: Tables and Images will be included * Images and tables:: Images, tables and caption mechanism
* Literal examples:: Source code examples with special formatting * Literal examples:: Source code examples with special formatting
* Include files:: Include additional files into a document * Include files:: Include additional files into a document
* Embedded @LaTeX{}:: @LaTeX{} can be freely used inside Org documents * Embedded @LaTeX{}:: @LaTeX{} can be freely used inside Org documents
@ -2166,32 +2211,30 @@ Toggle the COMMENT keyword at the beginning of an entry.
For Org mode tables, the lines before the first horizontal separator line For Org mode tables, the lines before the first horizontal separator line
will become table header lines. You can use the following lines somewhere will become table header lines. You can use the following lines somewhere
before the table to assign a caption and a label for cross references, and in before the table to assign a caption and a label for cross references, and in
the text you can refer to the object with @code{\ref@{tab:basic-data@}}: the text you can refer to the object with @code{[[tab:basic-data]]}:
@smallexample @smallexample
#+CAPTION: This is the caption for the next table (or link) #+CAPTION: This is the caption for the next table (or link)
#+LABEL: tbl:basic-data #+NAME: tbl:basic-data
| ... | ...| | ... | ...|
|-----|----| |-----|----|
@end smallexample @end smallexample
Some backends (HTML, @LaTeX{}, and DocBook) allow you to directly include Some backends allow you to directly include images into the exported
images into the exported document. Org does this, if a link to an image document. Org does this, if a link to an image files does not have
files does not have a description part, for example @code{[[./img/a.jpg]]}. a description part, for example @code{[[./img/a.jpg]]}. If you wish to
If you wish to define a caption for the image and maybe a label for internal define a caption for the image and maybe a label for internal cross
cross references, you sure that the link is on a line by itself precede it references, you sure that the link is on a line by itself precede it with:
with:
@smallexample @smallexample
#+CAPTION: This is the caption for the next figure link (or table) #+CAPTION: This is the caption for the next figure link (or table)
#+LABEL: fig:SED-HR4049 #+NAME: fig:SED-HR4049
[[./img/a.jpg]] [[./img/a.jpg]]
@end smallexample @end smallexample
You may also define additional attributes for the figure. As this is The same caption mechanism applies to other structures than images and tables
backend-specific, see the sections about the individual backends for more (e.g., @LaTeX{} equations, source code blocks), provided the chosen export
information. back-end supports them.
@node Literal examples, Include files, Images and tables, Markup @node Literal examples, Include files, Images and tables, Markup
@section Literal examples @section Literal examples
@ -2251,7 +2294,7 @@ processed normally. @kbd{C-c '} will visit the included file.
For scientific notes which need to be able to contain mathematical symbols For scientific notes which need to be able to contain mathematical symbols
and the occasional formula, Org-mode supports embedding @LaTeX{} code into and the occasional formula, Org-mode supports embedding @LaTeX{} code into
its files. You can directly use TeX-like macros for special symbols, enter its files. You can directly use TeX-like syntax for special symbols, enter
formulas and entire @LaTeX{} environments. formulas and entire @LaTeX{} environments.
@smallexample @smallexample
@ -2311,8 +2354,6 @@ Insert template with export options, see example below.
#+DESCRIPTION: the page description, e.g.@: for the XHTML meta tag #+DESCRIPTION: the page description, e.g.@: for the XHTML meta tag
#+KEYWORDS: the page keywords, e.g.@: for the XHTML meta tag #+KEYWORDS: the page keywords, e.g.@: for the XHTML meta tag
#+LANGUAGE: language for HTML, e.g.@: @samp{en} (@code{org-export-default-language}) #+LANGUAGE: language for HTML, e.g.@: @samp{en} (@code{org-export-default-language})
#+TEXT: Some descriptive text to be inserted at the beginning.
#+TEXT: Several lines may be given.
#+OPTIONS: H:2 num:t toc:t \n:nil @@:t ::t |:t ^:t f:t TeX:t ... #+OPTIONS: H:2 num:t toc:t \n:nil @@:t ::t |:t ^:t f:t TeX:t ...
#+LINK_UP: the ``up'' link of an exported page #+LINK_UP: the ``up'' link of an exported page
#+LINK_HOME: the ``home'' link of an exported page #+LINK_HOME: the ``home'' link of an exported page
@ -2386,7 +2427,7 @@ Export as @LaTeX{} and then process to PDF, then open the resulting PDF file.
By default, the @LaTeX{} output uses the class @code{article}. You can By default, the @LaTeX{} output uses the class @code{article}. You can
change this by adding an option like @code{#+LaTeX_CLASS: myclass} in your change this by adding an option like @code{#+LaTeX_CLASS: myclass} in your
file. The class must be listed in @code{org-export-latex-classes}. file. The class must be listed in @code{org-latex-classes}.
Embedded @LaTeX{} as described in @ref{Embedded @LaTeX{}}, will be correctly Embedded @LaTeX{} as described in @ref{Embedded @LaTeX{}}, will be correctly
inserted into the @LaTeX{} file. Similarly to the HTML exporter, you can use inserted into the @LaTeX{} file. Similarly to the HTML exporter, you can use

4
etc/schema/od-manifest-schema-v1.2-cs01.rnc → etc/schema/od-manifest-schema-v1.2-os.rnc
View File

@ -1,7 +1,7 @@
# Open Document Format for Office Applications (OpenDocument) Version 1.2 # Open Document Format for Office Applications (OpenDocument) Version 1.2
# Committee Specification (CS) 01, 17 March 2011 # OASIS Standard, 29 September 2011
# Manifest Relax-NG Schema # Manifest Relax-NG Schema
# # Source: http://docs.oasis-open.org/office/v1.2/os/
# Copyright (c) OASIS Open 2002-2011, 2013. All Rights Reserved. # Copyright (c) OASIS Open 2002-2011, 2013. All Rights Reserved.
# #
# All capitalized terms in the following text have the meanings assigned to them # All capitalized terms in the following text have the meanings assigned to them

4
etc/schema/od-schema-v1.2-cs01.rnc → etc/schema/od-schema-v1.2-os.rnc
View File

@ -1,7 +1,7 @@
# Open Document Format for Office Applications (OpenDocument) Version 1.2 # Open Document Format for Office Applications (OpenDocument) Version 1.2
# Committee Specification (CS) 01, 17 March 2011 # OASIS Standard, 29 September 2011
# Relax-NG Schema # Relax-NG Schema
# # Source: http://docs.oasis-open.org/office/v1.2/os/
# Copyright (c) OASIS Open 2002-2011, 2013. All Rights Reserved. # Copyright (c) OASIS Open 2002-2011, 2013. All Rights Reserved.
# #
# All capitalized terms in the following text have the meanings assigned to them # All capitalized terms in the following text have the meanings assigned to them

4
etc/schema/schemas.xml
View File

@ -2,6 +2,6 @@
<locatingRules xmlns="http://thaiopensource.com/ns/locating-rules/1.0"> <locatingRules xmlns="http://thaiopensource.com/ns/locating-rules/1.0">
<documentElement prefix="office" typeId="OpenDocument"/> <documentElement prefix="office" typeId="OpenDocument"/>
<documentElement prefix="manifest" localName="manifest" typeId="OpenDocument Manifest"/> <documentElement prefix="manifest" localName="manifest" typeId="OpenDocument Manifest"/>
<typeId id="OpenDocument" uri="od-schema-v1.2-cs01.rnc"/> <typeId id="OpenDocument" uri="od-schema-v1.2-os.rnc"/>
<typeId id="OpenDocument Manifest" uri="od-manifest-schema-v1.2-cs01.rnc"/> <typeId id="OpenDocument Manifest" uri="od-manifest-schema-v1.2-os.rnc"/>
</locatingRules> </locatingRules>

12
etc/styles/OrgOdtContentTemplate.xml
View File

@ -46,7 +46,19 @@
<!-- automatic styles --> <!-- automatic styles -->
<office:automatic-styles> <office:automatic-styles>
<!-- Section styles --> <!-- Section styles -->
<!-- Section styles for Table Of Contents and Other Indices -->
<style:style style:name="OrgIndexSection" style:family="section">
<style:section-properties fo:background-color="#c0c0c0" style:editable="false">
<style:columns fo:column-count="1" fo:column-gap="0cm"/>
<style:background-image/>
</style:section-properties>
</style:style>
<!-- Indented sections, used as container for tables that occur
within list items -->
<style:style style:name="OrgIndentedSection-Level-1" style:family="section"> <style:style style:name="OrgIndentedSection-Level-1" style:family="section">
<style:section-properties text:dont-balance-text-columns="false" fo:margin-left="1.281cm" fo:margin-right="0cm" style:editable="false"> <style:section-properties text:dont-balance-text-columns="false" fo:margin-left="1.281cm" fo:margin-right="0cm" style:editable="false">
<style:columns fo:column-count="1" fo:column-gap="0cm"/> <style:columns fo:column-count="1" fo:column-gap="0cm"/>

76
etc/styles/OrgOdtStyles.xml
View File

@ -86,7 +86,11 @@
<style:style style:name="Standard" style:family="paragraph" style:class="text"/> <style:style style:name="Standard" style:family="paragraph" style:class="text"/>
<style:style style:name="Heading" style:family="paragraph" style:parent-style-name="Standard" style:next-style-name="Text_20_body" style:class="text"> <style:style style:name="Heading" style:family="paragraph" style:parent-style-name="Standard" style:next-style-name="Text_20_body" style:class="text">
<style:paragraph-properties fo:margin-top="0.423cm" fo:margin-bottom="0.212cm" fo:keep-with-next="always"/> <style:paragraph-properties fo:margin-top="0.423cm" fo:margin-bottom="0.212cm" fo:keep-with-next="always">
<style:tab-stops>
<style:tab-stop style:position="17cm" style:type="right"/>
</style:tab-stops>
</style:paragraph-properties>
<style:text-properties style:font-name="Arial" fo:font-size="14pt" style:font-name-asian="SimSun" style:font-size-asian="14pt" style:font-name-complex="Tahoma" style:font-size-complex="14pt"/> <style:text-properties style:font-name="Arial" fo:font-size="14pt" style:font-name-asian="SimSun" style:font-size-asian="14pt" style:font-name-complex="Tahoma" style:font-size-complex="14pt"/>
</style:style> </style:style>
<style:style style:name="Text_20_body" style:display-name="Text body" style:family="paragraph" style:parent-style-name="Standard" style:class="text"> <style:style style:name="Text_20_body" style:display-name="Text body" style:family="paragraph" style:parent-style-name="Standard" style:class="text">
@ -252,26 +256,44 @@
<style:style style:name="Quotations" style:family="paragraph" style:parent-style-name="Standard" style:class="html"> <style:style style:name="Quotations" style:family="paragraph" style:parent-style-name="Standard" style:class="html">
<style:paragraph-properties fo:margin-left="1cm" fo:margin-right="1cm" fo:margin-top="0cm" fo:margin-bottom="0.499cm" fo:text-indent="0cm" style:auto-text-indent="false"/> <style:paragraph-properties fo:margin-left="1cm" fo:margin-right="1cm" fo:margin-top="0cm" fo:margin-bottom="0.499cm" fo:text-indent="0cm" style:auto-text-indent="false"/>
</style:style> </style:style>
<style:style style:name="OrgFootnoteQuotations" style:family="paragraph" style:parent-style-name="Footnote" style:class="html">
<style:paragraph-properties fo:margin-left="1cm" fo:margin-right="1cm" fo:margin-top="0cm" fo:margin-bottom="0.499cm" fo:text-indent="0cm" style:auto-text-indent="false"/>
</style:style>
<style:style style:name="Preformatted_20_Text" style:display-name="Preformatted Text" style:family="paragraph" style:parent-style-name="Standard" style:class="html"> <style:style style:name="Preformatted_20_Text" style:display-name="Preformatted Text" style:family="paragraph" style:parent-style-name="Standard" style:class="html">
<style:paragraph-properties fo:margin-top="0cm" fo:margin-bottom="0cm"/> <style:paragraph-properties fo:margin-top="0cm" fo:margin-bottom="0cm"/>
<style:text-properties style:font-name="Courier New" fo:font-size="10pt" style:font-name-asian="NSimSun" style:font-size-asian="10pt" style:font-name-complex="Courier New" style:font-size-complex="10pt"/> <style:text-properties style:font-name="Courier New" fo:font-size="10pt" style:font-name-asian="NSimSun" style:font-size-asian="10pt" style:font-name-complex="Courier New" style:font-size-complex="10pt"/>
</style:style> </style:style>
<style:style style:name="OrgVerse" style:family="paragraph" style:parent-style-name="Preformatted_20_Text"> <style:style style:name="OrgVerse" style:family="paragraph" style:parent-style-name="Preformatted_20_Text">
<style:paragraph-properties fo:background-color="#c0c0c0" fo:padding="0.049cm" fo:border="0.018cm solid #000000" style:shadow="none"> <style:paragraph-properties fo:background-color="transparent" fo:padding="0cm" fo:border="none" style:shadow="none">
<style:background-image/> <style:background-image/>
</style:paragraph-properties> </style:paragraph-properties>
</style:style> </style:style>
<style:style style:name="OrgClock" style:family="paragraph" style:parent-style-name="Text_20_body">
<style:paragraph-properties fo:margin-top="0cm" fo:margin-bottom="0cm"/>
</style:style>
<style:style style:name="OrgClockLastLine" style:family="paragraph" style:parent-style-name="OrgClock"/>
<style:style style:name="OrgPlanning" style:family="paragraph" style:parent-style-name="Text_20_body"/>
<!-- Fixed width block -->
<style:style style:name="OrgFixedWidthBlock" style:family="paragraph" style:parent-style-name="Preformatted_20_Text"> <style:style style:name="OrgFixedWidthBlock" style:family="paragraph" style:parent-style-name="Preformatted_20_Text">
<style:paragraph-properties fo:background-color="#c0c0c0" fo:padding="0.049cm" fo:border="0.018cm solid #000000" style:shadow="none"> <style:paragraph-properties fo:background-color="#c0c0c0" fo:padding="0.049cm" fo:border="0.06pt solid #000000" style:shadow="none">
<style:background-image/> <style:background-image/>
</style:paragraph-properties> </style:paragraph-properties>
</style:style> </style:style>
<style:style style:name="OrgFixedWidthBlockLastLine" style:family="paragraph" style:parent-style-name="OrgFixedWidthBlock"> <style:style style:name="OrgFixedWidthBlockLastLine" style:family="paragraph" style:parent-style-name="OrgFixedWidthBlock">
<style:paragraph-properties fo:margin-top="0cm" fo:margin-bottom="0.21cm"/> <style:paragraph-properties fo:margin-top="0cm" fo:margin-bottom="0.21cm"/>
</style:style> </style:style>
<style:style style:name="OrgFormula" style:family="paragraph" style:parent-style-name="Text_20_body">
<style:paragraph-properties>
<style:tab-stops>
<style:tab-stop style:position="17cm" style:type="right"/>
</style:tab-stops>
</style:paragraph-properties>
</style:style>
<style:style style:name="OrgSrcBlockLastLine" style:family="paragraph" style:parent-style-name="OrgSrcBlock"> <style:style style:name="OrgSrcBlockLastLine" style:family="paragraph" style:parent-style-name="OrgSrcBlock">
<style:paragraph-properties fo:margin-top="0cm" fo:margin-bottom="0.21cm"/> <style:paragraph-properties fo:margin-top="0cm" fo:margin-bottom="0.21cm"/>
</style:style> </style:style>
@ -279,6 +301,9 @@
<style:style style:name="OrgCenter" style:family="paragraph" style:parent-style-name="Text_20_body"> <style:style style:name="OrgCenter" style:family="paragraph" style:parent-style-name="Text_20_body">
<style:paragraph-properties fo:text-align="center" style:justify-single-word="false"/> <style:paragraph-properties fo:text-align="center" style:justify-single-word="false"/>
</style:style> </style:style>
<style:style style:name="OrgFootnoteCenter" style:family="paragraph" style:parent-style-name="Footnote">
<style:paragraph-properties fo:text-align="center" style:justify-single-word="false"/>
</style:style>
<style:style style:name="OrgTableContents" style:family="paragraph" style:parent-style-name="Text_20_body"/> <style:style style:name="OrgTableContents" style:family="paragraph" style:parent-style-name="Text_20_body"/>
<style:style style:name="OrgTableHeading" style:family="paragraph" style:parent-style-name="OrgTableContents" style:class="extra"> <style:style style:name="OrgTableHeading" style:family="paragraph" style:parent-style-name="OrgTableContents" style:class="extra">
<style:paragraph-properties fo:text-align="center" style:justify-single-word="false" text:number-lines="false" text:line-number="0"/> <style:paragraph-properties fo:text-align="center" style:justify-single-word="false" text:number-lines="false" text:line-number="0"/>
@ -325,9 +350,10 @@
</style:paragraph-properties> </style:paragraph-properties>
</style:style> </style:style>
<style:style style:name="Horizontal_20_Line" style:display-name="Horizontal Line" style:family="paragraph" style:parent-style-name="Standard" style:next-style-name="Text_20_body" style:class="html"> <style:style style:name="Horizontal_20_Line" style:display-name="Horizontal Line" style:family="paragraph" style:parent-style-name="Standard" style:next-style-name="Text_20_body" style:class="html">
<style:paragraph-properties fo:margin-top="0cm" fo:margin-bottom="0.499cm" style:border-line-width-bottom="0.002cm 0.035cm 0.002cm" fo:padding="0cm" fo:border-left="none" fo:border-right="none" fo:border-top="none" fo:border-bottom="0.039cm double #808080" text:number-lines="false" text:line-number="0" style:join-border="false"/> <style:paragraph-properties fo:margin-top="0cm" fo:margin-bottom="0.21cm" style:page-number="auto" fo:padding="0cm" fo:border-left="none" fo:border-right="none" fo:border-top="none" fo:border-bottom="0.06pt solid #000000" style:shadow="none" text:number-lines="false" text:line-number="0" style:join-border="false"/>
<style:text-properties fo:font-size="6pt" style:font-size-asian="6pt" style:font-size-complex="6pt"/> <style:text-properties fo:font-size="6pt" style:font-size-asian="6pt" style:font-size-complex="6pt"/>
</style:style> </style:style>
<style:style style:name="Emphasis" style:family="text"> <style:style style:name="Emphasis" style:family="text">
<style:text-properties fo:font-style="italic" style:font-style-asian="italic" style:font-style-complex="italic"/> <style:text-properties fo:font-style="italic" style:font-style-asian="italic" style:font-style-complex="italic"/>
</style:style> </style:style>
@ -349,23 +375,41 @@
<style:style style:name="OrgCode" style:family="text" style:parent-style-name="Source_20_Text"/> <style:style style:name="OrgCode" style:family="text" style:parent-style-name="Source_20_Text"/>
<!-- BEGIN: Org Agenda Styles --> <!-- BEGIN: Org Agenda Styles -->
<style:style style:name="OrgTodo" style:family="text"> <style:style style:name="OrgTodo" style:family="text"/>
<style:text-properties fo:color="#ff0000"/> <style:style style:name="OrgDone" style:family="text"/>
</style:style>
<style:style style:name="OrgDone" style:family="text">
<style:text-properties fo:color="#008000"/>
</style:style>
<style:style style:name="OrgTag" style:family="text"> <style:style style:name="OrgTag" style:family="text">
<style:text-properties fo:background-color="#add8e6"/> <style:text-properties fo:font-variant="small-caps" fo:background-color="transparent"/>
</style:style> </style:style>
<style:style style:name="OrgTimestamp" style:family="text"> <style:style style:name="OrgTags" style:family="text"/>
<style:text-properties fo:color="#bebebe"/>
<style:style style:name="OrgPriority" style:family="text"/>
<style:style style:name="OrgPriority-A" style:family="text" style:parent-style-name="OrgPriority"/>
<style:style style:name="OrgPriority-B" style:family="text" style:parent-style-name="OrgPriority"/>
<style:style style:name="OrgPriority-C" style:family="text" style:parent-style-name="OrgPriority"/>
<style:style style:name="OrgTimestamp" style:display-name="OrgTimestamp" style:family="text">
<style:text-properties style:font-name="Courier New" fo:background-color="transparent" style:font-name-asian="NSimSun" style:font-name-complex="Courier New"/>
</style:style> </style:style>
<style:style style:name="OrgActiveTimestamp" style:family="text" style:parent-style-name="OrgTimestamp"/>
<style:style style:name="OrgInactiveTimestamp" style:family="text" style:parent-style-name="OrgTimestamp"/>
<style:style style:name="OrgTimestampKeyword" style:family="text"> <style:style style:name="OrgTimestampKeyword" style:family="text">
<style:text-properties fo:color="#5f9ea0"/> <style:text-properties style:use-window-font-color="true" fo:font-weight="bold"/>
</style:style> </style:style>
<style:style style:name="OrgScheduledKeyword" style:family="text" style:parent-style-name="OrgTimestampKeyword"/>
<style:style style:name="OrgDeadlineKeyword" style:family="text" style:parent-style-name="OrgTimestampKeyword"/>
<style:style style:name="OrgClockKeyword" style:family="text" style:parent-style-name="OrgTimestampKeyword"/>
<style:style style:name="OrgClosedKeyword" style:family="text" style:parent-style-name="OrgTimestampKeyword"/>
<style:style style:name="OrgTimestampWrapper" style:family="text"/> <style:style style:name="OrgTimestampWrapper" style:family="text"/>
<style:style style:name="OrgTarget" style:family="text"/> <style:style style:name="OrgTarget" style:family="text"/>
<number:date-style style:name="OrgDate" number:automatic-order="true">
<number:day number:style="long"/>
<number:text>/</number:text>
<number:month number:style="long"/>
<number:text>/</number:text>
<number:year number:style="long"/>
</number:date-style>
<!-- END: Org Agenda Styles --> <!-- END: Org Agenda Styles -->
<style:style style:name="Bold" style:family="text"> <style:style style:name="Bold" style:family="text">
@ -441,7 +485,7 @@
</style:style> </style:style>
<style:style style:name="OrgFormulaCaptionFrame" style:family="graphic" style:parent-style-name="Frame"> <style:style style:name="OrgFormulaCaptionFrame" style:family="graphic" style:parent-style-name="Frame">
<style:graphic-properties fo:margin-top="0cm" fo:margin-bottom="0cm" style:vertical-pos="middle" style:vertical-rel="text" style:horizontal-pos="from-left" style:horizontal-rel="paragraph-content" fo:padding="0cm" fo:border="none"/> <style:graphic-properties text:anchor-type="paragraph" fo:margin-left="0cm" fo:margin-right="0cm" fo:margin-top="0cm" fo:margin-bottom="0cm" style:wrap="right" style:number-wrapped-paragraphs="1" style:wrap-contour="false" style:vertical-pos="top" style:vertical-rel="paragraph" style:horizontal-pos="center" style:horizontal-rel="paragraph" fo:padding="0cm" fo:border="none"/>
</style:style> </style:style>
<style:style style:name="OrgCaptionedFormula" style:family="graphic" style:parent-style-name="OrgFormula"> <style:style style:name="OrgCaptionedFormula" style:family="graphic" style:parent-style-name="OrgFormula">

2
lisp/Makefile
View File

@ -89,5 +89,5 @@ clean cleanall cleanelc::
clean-install: clean-install:
if [ -d $(DESTDIR)$(lispdir) ] ; then \ if [ -d $(DESTDIR)$(lispdir) ] ; then \
$(RM) $(DESTDIR)$(lispdir)/org*.el* $(DESTDIR)$(lispdir)/ob*.el* ; \ $(RM) $(DESTDIR)$(lispdir)/org*.el* $(DESTDIR)$(lispdir)/ob*.el* $(DESTDIR)$(lispdir)/ox*.el* ; \
fi ; fi ;

11
lisp/ob-C.el
View File

@ -31,7 +31,6 @@
;;; Code: ;;; Code:
(require 'ob) (require 'ob)
(require 'ob-eval)
(require 'cc-mode) (require 'cc-mode)
(declare-function org-entry-get "org" (declare-function org-entry-get "org"
@ -106,11 +105,11 @@ or `org-babel-execute:C++'."
(org-babel-process-file-name tmp-src-file)) "")))) (org-babel-process-file-name tmp-src-file)) ""))))
((lambda (results) ((lambda (results)
(org-babel-reassemble-table (org-babel-reassemble-table
(if (member "vector" (cdr (assoc :result-params params))) (org-babel-result-cond (cdr (assoc :result-params params))
(let ((tmp-file (org-babel-temp-file "c-"))) (org-babel-read results)
(with-temp-file tmp-file (insert results)) (let ((tmp-file (org-babel-temp-file "c-")))
(org-babel-import-elisp-from-file tmp-file)) (with-temp-file tmp-file (insert results))
(org-babel-read results)) (org-babel-import-elisp-from-file tmp-file)))
(org-babel-pick-name (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 (org-babel-pick-name

26
lisp/ob-R.el
View File

@ -28,9 +28,6 @@
;;; Code: ;;; Code:
(require 'ob) (require 'ob)
(require 'ob-ref)
(require 'ob-comint)
(require 'ob-eval)
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl))
(declare-function orgtbl-to-tsv "org-table" (table params)) (declare-function orgtbl-to-tsv "org-table" (table params))
@ -212,6 +209,9 @@ This function is called by `org-babel-execute-src-block'."
(if (org-babel-comint-buffer-livep session) (if (org-babel-comint-buffer-livep session)
session session
(save-window-excursion (save-window-excursion
(when (get-buffer session)
;; Session buffer exists, but with dead process
(set-buffer session))
(require 'ess) (R) (require 'ess) (R)
(rename-buffer (rename-buffer
(if (bufferp session) (if (bufferp session)
@ -240,7 +240,7 @@ current code buffer."
'((:bmp . "bmp") '((:bmp . "bmp")
(:jpg . "jpeg") (:jpg . "jpeg")
(:jpeg . "jpeg") (:jpeg . "jpeg")
(:tex . "tikz") (:tikz . "tikz")
(:tiff . "tiff") (:tiff . "tiff")
(:png . "png") (:png . "png")
(:svg . "svg") (:svg . "svg")
@ -302,11 +302,10 @@ last statement in BODY, as elisp."
(format "{function ()\n{\n%s\n}}()" body) (format "{function ()\n{\n%s\n}}()" body)
(org-babel-process-file-name tmp-file 'noquote))) (org-babel-process-file-name tmp-file 'noquote)))
(org-babel-R-process-value-result (org-babel-R-process-value-result
(if (or (member "scalar" result-params) (org-babel-result-cond result-params
(member "verbatim" result-params)) (with-temp-buffer
(with-temp-buffer (insert-file-contents tmp-file)
(insert-file-contents tmp-file) (buffer-string))
(buffer-string))
(org-babel-import-elisp-from-file tmp-file '(16))) (org-babel-import-elisp-from-file tmp-file '(16)))
column-names-p))) column-names-p)))
(output (org-babel-eval org-babel-R-command body)))) (output (org-babel-eval org-babel-R-command body))))
@ -335,11 +334,10 @@ last statement in BODY, as elisp."
"FALSE") "FALSE")
".Last.value" (org-babel-process-file-name tmp-file 'noquote))) ".Last.value" (org-babel-process-file-name tmp-file 'noquote)))
(org-babel-R-process-value-result (org-babel-R-process-value-result
(if (or (member "scalar" result-params) (org-babel-result-cond result-params
(member "verbatim" result-params)) (with-temp-buffer
(with-temp-buffer (insert-file-contents tmp-file)
(insert-file-contents tmp-file) (buffer-string))
(buffer-string))
(org-babel-import-elisp-from-file tmp-file '(16))) (org-babel-import-elisp-from-file tmp-file '(16)))
column-names-p))) column-names-p)))
(output (output

9
lisp/ob-awk.el
View File

@ -32,7 +32,6 @@
;;; Code: ;;; Code:
(require 'ob) (require 'ob)
(require 'ob-eval)
(require 'org-compat) (require 'org-compat)
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl))
@ -45,7 +44,7 @@
(defvar org-babel-awk-command "awk" (defvar org-babel-awk-command "awk"
"Name of the awk executable command.") "Name of the awk executable command.")
(defun org-babel-expand-body:awk (body params &optional processed-params) (defun org-babel-expand-body:awk (body params)
"Expand BODY according to PARAMS, return the expanded body." "Expand BODY according to PARAMS, return the expanded body."
(dolist (pair (mapcar #'cdr (org-babel-get-header params :var))) (dolist (pair (mapcar #'cdr (org-babel-get-header params :var)))
(setf body (replace-regexp-in-string (setf body (replace-regexp-in-string
@ -78,10 +77,8 @@ called by `org-babel-execute-src-block'"
(org-babel-reassemble-table (org-babel-reassemble-table
((lambda (results) ((lambda (results)
(when results (when results
(if (or (member "scalar" result-params) (org-babel-result-cond result-params
(member "verbatim" result-params) results
(member "output" result-params))
results
(let ((tmp (org-babel-temp-file "awk-results-"))) (let ((tmp (org-babel-temp-file "awk-results-")))
(with-temp-file tmp (insert results)) (with-temp-file tmp (insert results))
(org-babel-import-elisp-from-file tmp))))) (org-babel-import-elisp-from-file tmp)))))

1
lisp/ob-calc.el
View File

@ -31,7 +31,6 @@
(unless (featurep 'xemacs) (unless (featurep 'xemacs)
(require 'calc-trail) (require 'calc-trail)
(require 'calc-store)) (require 'calc-store))
(eval-when-compile (require 'ob-comint))
(declare-function calc-store-into "calc-store" (&optional var)) (declare-function calc-store-into "calc-store" (&optional var))
(declare-function calc-recall "calc-store" (&optional var)) (declare-function calc-recall "calc-store" (&optional var))

5
lisp/ob-clojure.el
View File

@ -79,9 +79,8 @@
(insert (org-babel-expand-body:clojure body params)) (insert (org-babel-expand-body:clojure body params))
((lambda (result) ((lambda (result)
(let ((result-params (cdr (assoc :result-params params)))) (let ((result-params (cdr (assoc :result-params params))))
(if (or (member "scalar" result-params) (org-babel-result-cond result-params
(member "verbatim" result-params)) result
result
(condition-case nil (org-babel-script-escape result) (condition-case nil (org-babel-script-escape result)
(error result))))) (error result)))))
(slime-eval (slime-eval

2
lisp/ob-comint.el
View File

@ -30,7 +30,7 @@
;; org-babel at large. ;; org-babel at large.
;;; Code: ;;; Code:
(require 'ob) (require 'ob-core)
(require 'org-compat) (require 'org-compat)
(require 'comint) (require 'comint)
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl))

2707
lisp/ob-core.el Normal file
View File

File diff suppressed because it is too large Load Diff

39
lisp/ob-ditaa.el
View File

@ -34,22 +34,38 @@
;; 3) we are adding the "file" and "cmdline" header arguments ;; 3) we are adding the "file" and "cmdline" header arguments
;; ;;
;; 4) there are no variables (at least for now) ;; 4) there are no variables (at least for now)
;;
;; 5) it depends on a variable defined in org-exp-blocks (namely
;; `org-ditaa-jar-path') so be sure you have org-exp-blocks loaded
;;; Code: ;;; Code:
(require 'ob) (require 'ob)
(require 'org-compat) (require 'org-compat)
(defvar org-ditaa-jar-path) ;; provided by org-exp-blocks
(defvar org-babel-default-header-args:ditaa (defvar org-babel-default-header-args:ditaa
'((:results . "file") '((:results . "file")
(:exports . "results") (:exports . "results")
(:java . "-Dfile.encoding=UTF-8")) (:java . "-Dfile.encoding=UTF-8"))
"Default arguments for evaluating a ditaa source block.") "Default arguments for evaluating a ditaa source block.")
(defcustom org-ditaa-jar-path (expand-file-name
"ditaa.jar"
(file-name-as-directory
(expand-file-name
"scripts"
(file-name-as-directory
(expand-file-name
"../contrib"
(file-name-directory (org-find-library-dir "org")))))))
"Path to the ditaa jar executable."
:group 'org-babel
:type 'string)
(defcustom org-ditaa-eps-jar-path
(expand-file-name "DitaaEps.jar" (file-name-directory org-ditaa-jar-path))
"Path to the DitaaEps.jar executable."
:group 'org-babel
:version "24.4"
:package-version '(Org . "8.0")
:type 'string)
(defcustom org-ditaa-jar-option "-jar" (defcustom org-ditaa-jar-option "-jar"
"Option for the ditaa jar file. "Option for the ditaa jar file.
Do not leave leading or trailing spaces in this string." Do not leave leading or trailing spaces in this string."
@ -69,16 +85,25 @@ This function is called by `org-babel-execute-src-block'."
(cmdline (cdr (assoc :cmdline params))) (cmdline (cdr (assoc :cmdline params)))
(java (cdr (assoc :java params))) (java (cdr (assoc :java params)))
(in-file (org-babel-temp-file "ditaa-")) (in-file (org-babel-temp-file "ditaa-"))
(eps (cdr (assoc :eps params)))
(cmd (concat "java " java " " org-ditaa-jar-option " " (cmd (concat "java " java " " org-ditaa-jar-option " "
(shell-quote-argument (shell-quote-argument
(expand-file-name org-ditaa-jar-path)) (expand-file-name
(if eps org-ditaa-eps-jar-path org-ditaa-jar-path)))
" " cmdline " " cmdline
" " (org-babel-process-file-name in-file) " " (org-babel-process-file-name in-file)
" " (org-babel-process-file-name out-file)))) " " (org-babel-process-file-name out-file)))
(pdf-cmd (when (and (or (string= (file-name-extension out-file) "pdf")
(cdr (assoc :pdf params))))
(concat
"epstopdf"
" " (org-babel-process-file-name (concat in-file ".eps"))
" -o=" (org-babel-process-file-name out-file)))))
(unless (file-exists-p org-ditaa-jar-path) (unless (file-exists-p org-ditaa-jar-path)
(error "Could not find ditaa.jar at %s" org-ditaa-jar-path)) (error "Could not find ditaa.jar at %s" org-ditaa-jar-path))
(with-temp-file in-file (insert body)) (with-temp-file in-file (insert body))
(message cmd) (shell-command cmd) (message cmd) (shell-command cmd)
(when pdf-cmd (message pdf-cmd) (shell-command pdf-cmd))
nil)) ;; signal that output has already been written to file nil)) ;; signal that output has already been written to file
(defun org-babel-prep-session:ditaa (session params) (defun org-babel-prep-session:ditaa (session params)

1
lisp/ob-dot.el
View File

@ -39,7 +39,6 @@
;;; Code: ;;; Code:
(require 'ob) (require 'ob)
(require 'ob-eval)
(defvar org-babel-default-header-args:dot (defvar org-babel-default-header-args:dot
'((:results . "file") (:exports . "results")) '((:results . "file") (:exports . "results"))

13
lisp/ob-emacs-lisp.el
View File

@ -27,7 +27,6 @@
;;; Code: ;;; Code:
(require 'ob) (require 'ob)
(eval-when-compile (require 'ob-comint))
(defvar org-babel-default-header-args:emacs-lisp (defvar org-babel-default-header-args:emacs-lisp
'((:hlines . "yes") (:colnames . "no")) '((:hlines . "yes") (:colnames . "no"))
@ -56,11 +55,13 @@
"Execute a block of emacs-lisp code with Babel." "Execute a block of emacs-lisp code with Babel."
(save-window-excursion (save-window-excursion
((lambda (result) ((lambda (result)
(if (or (member "scalar" (cdr (assoc :result-params params))) (org-babel-result-cond (cdr (assoc :result-params params))
(member "verbatim" (cdr (assoc :result-params params)))) (let ((print-level nil)
(let ((print-level nil) (print-length nil))
(print-length nil)) (if (or (member "scalar" (cdr (assoc :result-params params)))
(format "%S" result)) (member "verbatim" (cdr (assoc :result-params params))))
(format "%S" result)
(format "%s" result)))
(org-babel-reassemble-table (org-babel-reassemble-table
result result
(org-babel-pick-name (cdr (assoc :colname-names params)) (org-babel-pick-name (cdr (assoc :colname-names params))

193
lisp/ob-eval.el
View File

@ -50,8 +50,8 @@ STDERR with `org-babel-eval-error-notify'."
(with-temp-buffer (with-temp-buffer
(insert body) (insert body)
(setq exit-code (setq exit-code
(org-babel-shell-command-on-region (org-babel--shell-command-on-region
(point-min) (point-max) cmd t 'replace err-buff)) (point-min) (point-max) cmd err-buff))
(if (or (not (numberp exit-code)) (> exit-code 0)) (if (or (not (numberp exit-code)) (> exit-code 0))
(progn (progn
(with-current-buffer err-buff (with-current-buffer err-buff
@ -64,79 +64,15 @@ STDERR with `org-babel-eval-error-notify'."
(with-temp-buffer (insert-file-contents file) (with-temp-buffer (insert-file-contents file)
(buffer-string))) (buffer-string)))
(defun org-babel-shell-command-on-region (start end command (defun org-babel--shell-command-on-region (start end command error-buffer)
&optional output-buffer replace
error-buffer display-error-buffer)
"Execute COMMAND in an inferior shell with region as input. "Execute COMMAND in an inferior shell with region as input.
Fixes bugs in the emacs 23.1.1 version of `shell-command-on-region' Stripped down version of shell-command-on-region for internal use
in Babel only. This lets us work around errors in the original
Normally display output (if any) in temp buffer `*Shell Command Output*'; function in various versions of Emacs.
Prefix arg means replace the region with it. Return the exit code of "
COMMAND. (let ((input-file (org-babel-temp-file "ob-input-"))
(error-file (if error-buffer (org-babel-temp-file "ob-error-") nil))
To specify a coding system for converting non-ASCII characters in
the input and output to the shell command, use
\\[universal-coding-system-argument] before this command. By
default, the input (from the current buffer) is encoded in the
same coding system that will be used to save the file,
`buffer-file-coding-system'. If the output is going to replace
the region, then it is decoded from that same coding system.
The noninteractive arguments are START, END, COMMAND,
OUTPUT-BUFFER, REPLACE, ERROR-BUFFER, and DISPLAY-ERROR-BUFFER.
Noninteractive callers can specify coding systems by binding
`coding-system-for-read' and `coding-system-for-write'.
If the command generates output, the output may be displayed
in the echo area or in a buffer.
If the output is short enough to display in the echo area
\(determined by the variable `max-mini-window-height' if
`resize-mini-windows' is non-nil), it is shown there. Otherwise
it is displayed in the buffer `*Shell Command Output*'. The output
is available in that buffer in both cases.
If there is output and an error, a message about the error
appears at the end of the output.
If there is no output, or if output is inserted in the current buffer,
then `*Shell Command Output*' is deleted.
If the optional fourth argument OUTPUT-BUFFER is non-nil,
that says to put the output in some other buffer.
If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
If OUTPUT-BUFFER is not a buffer and not nil,
insert output in the current buffer.
In either case, the output is inserted after point (leaving mark after it).
If REPLACE, the optional fifth argument, is non-nil, that means insert
the output in place of text from START to END, putting point and mark
around it.
If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer
or buffer name to which to direct the command's standard error output.
If it is nil, error output is mingled with regular output.
If DISPLAY-ERROR-BUFFER is non-nil, display the error buffer if there
were any errors. (This is always t, interactively.)
In an interactive call, the variable `shell-command-default-error-buffer'
specifies the value of ERROR-BUFFER."
(interactive (let (string)
(unless (mark)
(error "The mark is not set now, so there is no region"))
;; Do this before calling region-beginning
;; and region-end, in case subprocess output
;; relocates them while we are in the minibuffer.
(setq string (read-shell-command "Shell command on region: "))
;; call-interactively recognizes region-beginning and
;; region-end specially, leaving them in the history.
(list (region-beginning) (region-end)
string
current-prefix-arg
current-prefix-arg
shell-command-default-error-buffer
t)))
(let ((input-file (org-babel-temp-file "input-"))
(error-file (if error-buffer (org-babel-temp-file "scor-") nil))
;; Unfortunately, `executable-find' does not support file name ;; Unfortunately, `executable-find' does not support file name
;; handlers. Therefore, we could use it in the local case ;; handlers. Therefore, we could use it in the local case
;; only. ;; only.
@ -154,96 +90,26 @@ specifies the value of ERROR-BUFFER."
;; workaround for now. ;; workaround for now.
(unless (file-remote-p default-directory) (unless (file-remote-p default-directory)
(delete-file error-file)) (delete-file error-file))
(if (or replace ;; we always call this with 'replace, remove conditional
(and output-buffer ;; Replace specified region with output from command.
(not (or (bufferp output-buffer) (stringp output-buffer))))) (let ((swap (< start end)))
;; Replace specified region with output from command. (goto-char start)
(let ((swap (and replace (< start end)))) (push-mark (point) 'nomsg)
;; Don't muck with mark unless REPLACE says we should. (write-region start end input-file)
(goto-char start) (delete-region start end)
(and replace (push-mark (point) 'nomsg)) (setq exit-status
(write-region start end input-file) (process-file shell-file-name input-file
(delete-region start end) (if error-file
(setq exit-status (list t error-file)
(process-file shell-file-name input-file t)
(if error-file nil shell-command-switch command))
(list output-buffer error-file) (when swap (exchange-point-and-mark)))
t)
nil shell-command-switch command))
;; It is rude to delete a buffer which the command is not using.
;; (let ((shell-buffer (get-buffer "*Shell Command Output*")))
;; (and shell-buffer (not (eq shell-buffer (current-buffer)))
;; (kill-buffer shell-buffer)))
;; Don't muck with mark unless REPLACE says we should.
(and replace swap (exchange-point-and-mark)))
;; No prefix argument: put the output in a temp buffer,
;; replacing its entire contents.
(let ((buffer (get-buffer-create
(or output-buffer "*Shell Command Output*"))))
(unwind-protect
(if (eq buffer (current-buffer))
;; If the input is the same buffer as the output,
;; delete everything but the specified region,
;; then replace that region with the output.
(progn (setq buffer-read-only nil)
(delete-region (max start end) (point-max))
(delete-region (point-min) (min start end))
(write-region (point-min) (point-max) input-file)
(delete-region (point-min) (point-max))
(setq exit-status
(process-file shell-file-name input-file
(if error-file
(list t error-file)
t)
nil shell-command-switch command)))
;; Clear the output buffer, then run the command with
;; output there.
(let ((directory default-directory))
(with-current-buffer buffer
(setq buffer-read-only nil)
(if (not output-buffer)
(setq default-directory directory))
(erase-buffer)))
(setq exit-status
(process-file shell-file-name nil
(if error-file
(list buffer error-file)
buffer)
nil shell-command-switch command)))
;; Report the output.
(with-current-buffer buffer
(setq mode-line-process
(cond ((null exit-status)
" - Error")
((stringp exit-status)
(format " - Signal [%s]" exit-status))
((not (equal 0 exit-status))
(format " - Exit [%d]" exit-status)))))
(if (with-current-buffer buffer (> (point-max) (point-min)))
;; There's some output, display it
(display-message-or-buffer buffer)
;; No output; error?
(let ((output
(if (and error-file
(< 0 (nth 7 (file-attributes error-file))))
"some error output"
"no output")))
(cond ((null exit-status)
(message "(Shell command failed with error)"))
((equal 0 exit-status)
(message "(Shell command succeeded with %s)"
output))
((stringp exit-status)
(message "(Shell command killed by signal %s)"
exit-status))
(t
(message "(Shell command failed with code %d and %s)"
exit-status output))))
;; Don't kill: there might be useful info in the undo-log.
;; (kill-buffer buffer)
))))
(when (and input-file (file-exists-p input-file)) (when (and input-file (file-exists-p input-file)
;; bind org-babel--debug-input around the call to keep
;; the temporary input files available for inspection
(not (when (boundp 'org-babel--debug-input)
org-babel--debug-input)))
(delete-file input-file)) (delete-file input-file))
(when (and error-file (file-exists-p error-file)) (when (and error-file (file-exists-p error-file))
@ -258,8 +124,7 @@ specifies the value of ERROR-BUFFER."
(format-insert-file error-file nil) (format-insert-file error-file nil)
;; Put point after the inserted errors. ;; Put point after the inserted errors.
(goto-char (- (point-max) pos-from-end))) (goto-char (- (point-max) pos-from-end)))
(and display-error-buffer (current-buffer)))
(display-buffer (current-buffer)))))
(delete-file error-file)) (delete-file error-file))
exit-status)) exit-status))

260
lisp/ob-exp.el
View File

@ -23,8 +23,7 @@
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Code: ;;; Code:
(require 'ob) (require 'ob-core)
(require 'org-exp-blocks)
(eval-when-compile (eval-when-compile
(require 'cl)) (require 'cl))
@ -35,23 +34,31 @@
(declare-function org-babel-lob-get-info "ob-lob" ()) (declare-function org-babel-lob-get-info "ob-lob" ())
(declare-function org-babel-eval-wipe-error-buffer "ob-eval" ()) (declare-function org-babel-eval-wipe-error-buffer "ob-eval" ())
(declare-function org-between-regexps-p "org"
(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-heading-components "org" ())
(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-link-search "org" (s &optional type avoid-pos stealth))
(declare-function org-fill-template "org" (template alist)) (declare-function org-fill-template "org" (template alist))
(declare-function org-in-verbatim-emphasis "org" ()) (declare-function org-split-string "org" (string &optional separators))
(declare-function org-in-block-p "org" (names)) (declare-function org-element-at-point "org-element" (&optional keep-trail))
(declare-function org-between-regexps-p "org" (start-re end-re &optional lim-up lim-down)) (declare-function org-element-context "org-element" ())
(declare-function org-element-property "org-element" (property element))
(add-to-list 'org-export-interblocks '(src org-babel-exp-non-block-elements)) (declare-function org-element-type "org-element" (element))
(org-export-blocks-add-block '(src org-babel-exp-src-block nil)) (declare-function org-escape-code-in-string "org-src" (s))
(defcustom org-export-babel-evaluate t (defcustom org-export-babel-evaluate t
"Switch controlling code evaluation during export. "Switch controlling code evaluation during export.
When set to nil no code will be evaluated as part of the export When set to nil no code will be evaluated as part of the export
process." process. When set to 'inline-only, only inline code blocks will
be executed."
:group 'org-babel :group 'org-babel
:version "24.1" :version "24.1"
:type 'boolean) :type '(choice (const :tag "Never" nil)
(const :tag "Only inline code" inline-only)
(const :tag "Always" t)))
(put 'org-export-babel-evaluate 'safe-local-variable (lambda (x) (eq x nil))) (put 'org-export-babel-evaluate 'safe-local-variable (lambda (x) (eq x nil)))
(defun org-babel-exp-get-export-buffer () (defun org-babel-exp-get-export-buffer ()
@ -86,10 +93,10 @@ process."
results))) results)))
(def-edebug-spec org-babel-exp-in-export-file (form body)) (def-edebug-spec org-babel-exp-in-export-file (form body))
(defun org-babel-exp-src-block (body &rest headers) (defun org-babel-exp-src-block (&rest headers)
"Process source block for export. "Process source block for export.
Depending on the 'export' headers argument in replace the source Depending on the 'export' headers argument, replace the source
code block with... code block like this:
both ---- display the code and the results both ---- display the code and the results
@ -99,11 +106,12 @@ code ---- the default, display the code inside the block but do
results - just like none only the block is run on export ensuring results - just like none only the block is run on export ensuring
that it's results are present in the org-mode buffer that it's results are present in the org-mode buffer
none ----- do not display either code or results upon export" none ---- do not display either code or results upon export
Assume point is at the beginning of block's starting line."
(interactive) (interactive)
(unless noninteractive (message "org-babel-exp processing...")) (unless noninteractive (message "org-babel-exp processing..."))
(save-excursion (save-excursion
(goto-char (match-beginning 0))
(let* ((info (org-babel-get-src-block-info 'light)) (let* ((info (org-babel-get-src-block-info 'light))
(lang (nth 0 info)) (lang (nth 0 info))
(raw-params (nth 2 info)) hash) (raw-params (nth 2 info)) hash)
@ -149,66 +157,156 @@ this template."
(let ((m (make-marker))) (let ((m (make-marker)))
(set-marker m end (current-buffer)) (set-marker m end (current-buffer))
(setq end m))) (setq end m)))
(let ((rx (concat "\\(" org-babel-inline-src-block-regexp (let ((rx (concat "\\(?:" org-babel-inline-src-block-regexp
"\\|" org-babel-lob-one-liner-regexp "\\)"))) "\\|" org-babel-lob-one-liner-regexp "\\)")))
(while (and (< (point) (marker-position end)) (while (re-search-forward rx end t)
(re-search-forward rx end t)) (save-excursion
(if (save-excursion (let* ((element (save-excursion
(goto-char (match-beginning 0)) ;; If match is inline, point is at its
(looking-at org-babel-inline-src-block-regexp)) ;; end. Move backward so
(progn ;; `org-element-context' can get the
(forward-char 1) ;; object, not the following one.
(let* ((info (save-match-data (backward-char)
(org-babel-parse-inline-src-block-match))) (save-match-data (org-element-context))))
(params (nth 2 info))) (type (org-element-type element)))
(save-match-data (when (memq type '(babel-call inline-babel-call inline-src-block))
(goto-char (match-beginning 2)) (let ((beg-el (org-element-property :begin element))
(unless (org-babel-in-example-or-verbatim) (end-el (org-element-property :end element)))
;; expand noweb references in the original file (case type
(setf (nth 1 info) (inline-src-block
(if (and (cdr (assoc :noweb params)) (let* ((info (org-babel-parse-inline-src-block-match))
(string= "yes" (cdr (assoc :noweb params)))) (params (nth 2 info)))
(org-babel-expand-noweb-references (setf (nth 1 info)
info (org-babel-exp-get-export-buffer)) (if (and (cdr (assoc :noweb params))
(nth 1 info))) (string= "yes" (cdr (assoc :noweb params))))
(let ((code-replacement (save-match-data (org-babel-expand-noweb-references
(org-babel-exp-do-export info (org-babel-exp-get-export-buffer))
info 'inline)))) (nth 1 info)))
(if code-replacement (goto-char beg-el)
(progn (replace-match code-replacement nil nil nil 1) (let ((replacement (org-babel-exp-do-export info 'inline)))
(delete-char 1)) (if (equal replacement "")
(org-babel-examplize-region (match-beginning 1) ;; Replacement code is empty: completely
(match-end 1)) ;; remove inline src block, including extra
(forward-char 2))))))) ;; white space that might have been created
(unless (org-babel-in-example-or-verbatim) ;; when inserting results.
(let* ((lob-info (org-babel-lob-get-info)) (delete-region beg-el
(inlinep (match-string 11)) (progn (goto-char end-el)
(inline-start (match-end 11)) (skip-chars-forward " \t")
(inline-end (match-end 0)) (point)))
(results (save-match-data ;; Otherwise: remove inline src block but
(org-babel-exp-do-export ;; preserve following white spaces. Then
(list "emacs-lisp" "results" ;; insert value.
(org-babel-merge-params (delete-region beg-el
org-babel-default-header-args (progn (goto-char end-el)
org-babel-default-lob-header-args (skip-chars-backward " \t")
(org-babel-params-from-properties) (point)))
(org-babel-parse-header-arguments (insert replacement)))))
(org-no-properties ((babel-call inline-babel-call)
(concat ":var results=" (let* ((lob-info (org-babel-lob-get-info))
(mapconcat #'identity (results
(butlast lob-info) (org-babel-exp-do-export
" "))))) (list "emacs-lisp" "results"
"" nil (car (last lob-info))) (org-babel-merge-params
'lob))) org-babel-default-header-args
(rep (org-fill-template org-babel-default-lob-header-args
org-babel-exp-call-line-template (org-babel-params-from-properties)
`(("line" . ,(nth 0 lob-info)))))) (org-babel-parse-header-arguments
(if inlinep (org-no-properties
(save-excursion (concat ":var results="
(goto-char inline-start) (mapconcat 'identity
(delete-region inline-start inline-end) (butlast lob-info)
(insert rep)) " ")))))
(replace-match rep t t))))))))) "" nil (car (last 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."
(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]+")))))
(preserve-indent
(or org-src-preserve-indentation
(org-element-property :preserve-indent element))))
;; 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 preserve-indent
;; 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)
(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)))))
(defun org-babel-in-example-or-verbatim () (defun org-babel-in-example-or-verbatim ()
"Return true if point is in example or verbatim code. "Return true if point is in example or verbatim code.
@ -269,9 +367,7 @@ replaced with its value."
(org-fill-template (org-fill-template
org-babel-exp-code-template org-babel-exp-code-template
`(("lang" . ,(nth 0 info)) `(("lang" . ,(nth 0 info))
("body" . ,(if (string= (nth 0 info) "org") ("body" . ,(org-escape-code-in-string (nth 1 info)))
(replace-regexp-in-string "^" "," (nth 1 info))
(nth 1 info)))
,@(mapcar (lambda (pair) ,@(mapcar (lambda (pair)
(cons (substring (symbol-name (car pair)) 1) (cons (substring (symbol-name (car pair)) 1)
(format "%S" (cdr pair)))) (format "%S" (cdr pair))))
@ -285,7 +381,9 @@ Results are prepared in a manner suitable for export by org-mode.
This function is called by `org-babel-exp-do-export'. The code This function is called by `org-babel-exp-do-export'. The code
block will be evaluated. Optional argument SILENT can be used to block will be evaluated. Optional argument SILENT can be used to
inhibit insertion of results into the buffer." inhibit insertion of results into the buffer."
(when (and org-export-babel-evaluate (when (and (or (eq org-export-babel-evaluate t)
(and (eq type 'inline)
(eq org-export-babel-evaluate 'inline-only)))
(not (and hash (equal hash (org-babel-current-result-hash))))) (not (and hash (equal hash (org-babel-current-result-hash)))))
(let ((lang (nth 0 info)) (let ((lang (nth 0 info))
(body (if (org-babel-noweb-p (nth 2 info) :eval) (body (if (org-babel-noweb-p (nth 2 info) :eval)
@ -318,10 +416,10 @@ inhibit insertion of results into the buffer."
((equal type 'lob) ((equal type 'lob)
(save-excursion (save-excursion
(re-search-backward org-babel-lob-one-liner-regexp nil t) (re-search-backward org-babel-lob-one-liner-regexp nil t)
(org-babel-execute-src-block nil info))))))))) (let (org-confirm-babel-evaluate)
(org-babel-execute-src-block nil info))))))))))
(provide 'ob-exp) (provide 'ob-exp)
;;; ob-exp.el ends here ;;; ob-exp.el ends here

11
lisp/ob-fortran.el
View File

@ -28,7 +28,6 @@
;;; Code: ;;; Code:
(require 'ob) (require 'ob)
(require 'ob-eval)
(require 'cc-mode) (require 'cc-mode)
(declare-function org-entry-get "org" (declare-function org-entry-get "org"
@ -62,11 +61,11 @@
(org-babel-process-file-name tmp-src-file)) "")))) (org-babel-process-file-name tmp-src-file)) ""))))
((lambda (results) ((lambda (results)
(org-babel-reassemble-table (org-babel-reassemble-table
(if (member "vector" (cdr (assoc :result-params params))) (org-babel-result-cond (cdr (assoc :result-params params))
(let ((tmp-file (org-babel-temp-file "f-"))) (org-babel-read results)
(with-temp-file tmp-file (insert results)) (let ((tmp-file (org-babel-temp-file "f-")))
(org-babel-import-elisp-from-file tmp-file)) (with-temp-file tmp-file (insert results))
(org-babel-read results)) (org-babel-import-elisp-from-file tmp-file)))
(org-babel-pick-name (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 (org-babel-pick-name

2
lisp/ob-gnuplot.el
View File

@ -39,8 +39,6 @@
;;; Code: ;;; Code:
(require 'ob) (require 'ob)
(require 'ob-ref)
(require 'ob-comint)
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl))
(declare-function org-time-string-to-time "org" (s)) (declare-function org-time-string-to-time "org" (s))

23
lisp/ob-haskell.el
View File

@ -40,7 +40,6 @@
;;; Code: ;;; Code:
(require 'ob) (require 'ob)
(require 'ob-comint)
(require 'comint) (require 'comint)
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl))
@ -79,11 +78,12 @@
(cdr (member org-babel-haskell-eoe (cdr (member org-babel-haskell-eoe
(reverse (mapcar #'org-babel-trim raw))))))) (reverse (mapcar #'org-babel-trim raw)))))))
(org-babel-reassemble-table (org-babel-reassemble-table
(cond ((lambda (result)
((equal result-type 'output) (org-babel-result-cond (cdr (assoc :result-params params))
(mapconcat #'identity (reverse (cdr results)) "\n")) result (org-babel-haskell-table-or-string result)))
((equal result-type 'value) (case result-type
(org-babel-haskell-table-or-string (car results)))) ('output (mapconcat #'identity (reverse (cdr results)) "\n"))
('value (car results))))
(org-babel-pick-name (cdr (assoc :colname-names params)) (org-babel-pick-name (cdr (assoc :colname-names params))
(cdr (assoc :colname-names params))) (cdr (assoc :colname-names params)))
(org-babel-pick-name (cdr (assoc :rowname-names params)) (org-babel-pick-name (cdr (assoc :rowname-names params))
@ -147,8 +147,9 @@ specifying a variable of the same value."
(format "%S" var))) (format "%S" var)))
(defvar org-src-preserve-indentation) (defvar org-src-preserve-indentation)
(declare-function org-export-as-latex "org-latex" (declare-function org-export-to-file "ox"
(arg &optional ext-plist to-buffer body-only pub-dir)) (backend file
&optional subtreep visible-only body-only ext-plist))
(defun org-babel-haskell-export-to-lhs (&optional arg) (defun org-babel-haskell-export-to-lhs (&optional arg)
"Export to a .lhs file with all haskell code blocks escaped. "Export to a .lhs file with all haskell code blocks escaped.
When called with a prefix argument the resulting When called with a prefix argument the resulting
@ -192,7 +193,11 @@ constructs (header arguments, no-web syntax etc...) are ignored."
(indent-code-rigidly (match-beginning 0) (match-end 0) indentation))) (indent-code-rigidly (match-beginning 0) (match-end 0) indentation)))
(save-excursion (save-excursion
;; export to latex w/org and save as .lhs ;; export to latex w/org and save as .lhs
(find-file tmp-org-file) (funcall 'org-export-as-latex nil) (require 'ox-latex)
(find-file tmp-org-file)
;; Ensure we do not clutter kill ring with incomplete results.
(let (org-export-copy-to-kill-ring)
(org-export-to-file 'latex tmp-tex-file))
(kill-buffer nil) (kill-buffer nil)
(delete-file tmp-org-file) (delete-file tmp-org-file)
(find-file tmp-tex-file) (find-file tmp-tex-file)

7
lisp/ob-io.el
View File

@ -33,9 +33,6 @@
;;; Code: ;;; Code:
(require 'ob) (require 'ob)
(require 'ob-ref)
(require 'ob-comint)
(require 'ob-eval)
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl))
(defvar org-babel-tangle-lang-exts) ;; Autoloaded (defvar org-babel-tangle-lang-exts) ;; Autoloaded
@ -98,8 +95,8 @@ in BODY as elisp."
(wrapper (format org-babel-io-wrapper-method body))) (wrapper (format org-babel-io-wrapper-method body)))
(with-temp-file src-file (insert wrapper)) (with-temp-file src-file (insert wrapper))
((lambda (raw) ((lambda (raw)
(if (member "code" result-params) (org-babel-result-cond result-params
raw raw
(org-babel-io-table-or-string raw))) (org-babel-io-table-or-string raw)))
(org-babel-eval (org-babel-eval
(concat org-babel-io-command " " src-file) "")))))) (concat org-babel-io-command " " src-file) ""))))))

9
lisp/ob-java.el
View File

@ -28,7 +28,6 @@
;;; Code: ;;; Code:
(require 'ob) (require 'ob)
(require 'ob-eval)
(defvar org-babel-tangle-lang-exts) (defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("java" . "java")) (add-to-list 'org-babel-tangle-lang-exts '("java" . "java"))
@ -58,11 +57,11 @@
(make-directory packagename 'parents)) (make-directory packagename 'parents))
((lambda (results) ((lambda (results)
(org-babel-reassemble-table (org-babel-reassemble-table
(if (member "vector" (cdr (assoc :result-params params))) (org-babel-result-cond (cdr (assoc :result-params params))
(let ((tmp-file (org-babel-temp-file "c-"))) (org-babel-read results)
(let ((tmp-file (org-babel-temp-file "c-")))
(with-temp-file tmp-file (insert results)) (with-temp-file tmp-file (insert results))
(org-babel-import-elisp-from-file tmp-file)) (org-babel-import-elisp-from-file tmp-file)))
(org-babel-read results))
(org-babel-pick-name (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 (org-babel-pick-name

53
lisp/ob-js.el
View File

@ -39,9 +39,6 @@
;;; Code: ;;; Code:
(require 'ob) (require 'ob)
(require 'ob-ref)
(require 'ob-comint)
(require 'ob-eval)
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl))
(declare-function run-mozilla "ext:moz" (arg)) (declare-function run-mozilla "ext:moz" (arg))
@ -68,30 +65,32 @@ This function is called by `org-babel-execute-src-block'"
(let* ((org-babel-js-cmd (or (cdr (assoc :cmd params)) org-babel-js-cmd)) (let* ((org-babel-js-cmd (or (cdr (assoc :cmd params)) org-babel-js-cmd))
(result-type (cdr (assoc :result-type params))) (result-type (cdr (assoc :result-type params)))
(full-body (org-babel-expand-body:generic (full-body (org-babel-expand-body:generic
body params (org-babel-variable-assignments:js params)))) body params (org-babel-variable-assignments:js params)))
(org-babel-js-read (result (if (not (string= (cdr (assoc :session params)) "none"))
(if (not (string= (cdr (assoc :session params)) "none")) ;; session evaluation
;; session evaluation (let ((session (org-babel-prep-session:js
(let ((session (org-babel-prep-session:js (cdr (assoc :session params)) params)))
(cdr (assoc :session params)) params))) (nth 1
(nth 1 (org-babel-comint-with-output
(org-babel-comint-with-output (session (format "%S" org-babel-js-eoe) t body)
(session (format "%S" org-babel-js-eoe) t body) (mapc
(mapc (lambda (line)
(lambda (line) (insert (org-babel-chomp line))
(insert (org-babel-chomp line)) (comint-send-input nil t)) (comint-send-input nil t))
(list body (format "%S" org-babel-js-eoe)))))) (list body (format "%S" org-babel-js-eoe))))))
;; external evaluation ;; external evaluation
(let ((script-file (org-babel-temp-file "js-script-"))) (let ((script-file (org-babel-temp-file "js-script-")))
(with-temp-file script-file (with-temp-file script-file
(insert (insert
;; return the value or the output ;; return the value or the output
(if (string= result-type "value") (if (string= result-type "value")
(format org-babel-js-function-wrapper full-body) (format org-babel-js-function-wrapper full-body)
full-body))) full-body)))
(org-babel-eval (org-babel-eval
(format "%s %s" org-babel-js-cmd (format "%s %s" org-babel-js-cmd
(org-babel-process-file-name script-file)) "")))))) (org-babel-process-file-name script-file)) "")))))
(org-babel-result-cond (cdr (assoc :result-params params))
result (org-babel-js-read result))))
(defun org-babel-js-read (results) (defun org-babel-js-read (results)
"Convert RESULTS into an appropriate elisp value. "Convert RESULTS into an appropriate elisp value.

2
lisp/ob-keys.el
View File

@ -29,7 +29,7 @@
;; functions and their associated keys. ;; functions and their associated keys.
;;; Code: ;;; Code:
(require 'ob) (require 'ob-core)
(defvar org-babel-key-prefix "\C-c\C-v" (defvar org-babel-key-prefix "\C-c\C-v"
"The key prefix for Babel interactive key-bindings. "The key prefix for Babel interactive key-bindings.

103
lisp/ob-latex.el
View File

@ -35,19 +35,16 @@
(declare-function org-create-formula-image "org" (string tofile options buffer)) (declare-function org-create-formula-image "org" (string tofile options buffer))
(declare-function org-splice-latex-header "org" (declare-function org-splice-latex-header "org"
(tpl def-pkg pkg snippets-p &optional extra)) (tpl def-pkg pkg snippets-p &optional extra))
(declare-function org-export-latex-fix-inputenc "org-latex" ()) (declare-function org-latex-guess-inputenc "ox-latex" (header))
(declare-function org-latex-compile "ox-latex" (file))
(defvar org-babel-tangle-lang-exts) (defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("latex" . "tex")) (add-to-list 'org-babel-tangle-lang-exts '("latex" . "tex"))
(defvar org-format-latex-header) (defvar org-format-latex-header) ; From org.el
(defvar org-format-latex-header-extra) (defvar org-format-latex-options) ; From org.el
(defvar org-export-latex-packages-alist) (defvar org-latex-default-packages-alist) ; From org.el
(defvar org-export-latex-default-packages-alist) (defvar org-latex-packages-alist) ; From org.el
(defvar org-export-pdf-logfiles)
(defvar org-latex-to-pdf-process)
(defvar org-export-pdf-remove-logfiles)
(defvar org-format-latex-options)
(defvar org-export-latex-packages-alist)
(defvar org-babel-default-header-args:latex (defvar org-babel-default-header-args:latex
'((:results . "latex") (:exports . "results")) '((:results . "latex") (:exports . "results"))
@ -81,28 +78,28 @@ This function is called by `org-babel-execute-src-block'."
(width (and fit (cdr (assoc :pdfwidth params)))) (width (and fit (cdr (assoc :pdfwidth params))))
(headers (cdr (assoc :headers params))) (headers (cdr (assoc :headers params)))
(in-buffer (not (string= "no" (cdr (assoc :buffer params))))) (in-buffer (not (string= "no" (cdr (assoc :buffer params)))))
(org-export-latex-packages-alist (org-latex-packages-alist
(append (cdr (assoc :packages params)) (append (cdr (assoc :packages params)) org-latex-packages-alist)))
org-export-latex-packages-alist)))
(cond (cond
((and (string-match "\\.png$" out-file) (not imagemagick)) ((and (string-match "\\.png$" out-file) (not imagemagick))
(org-create-formula-image (org-create-formula-image
body out-file org-format-latex-options in-buffer)) body out-file org-format-latex-options in-buffer))
((or (string-match "\\.pdf$" out-file) imagemagick) ((or (string-match "\\.pdf$" out-file) imagemagick)
(require 'org-latex)
(with-temp-file tex-file (with-temp-file tex-file
(require 'ox-latex)
(insert (insert
(org-splice-latex-header (org-latex-guess-inputenc
org-format-latex-header (org-splice-latex-header
(delq org-format-latex-header
nil (delq
(mapcar nil
(lambda (el) (mapcar
(unless (and (listp el) (string= "hyperref" (cadr el))) (lambda (el)
el)) (unless (and (listp el) (string= "hyperref" (cadr el)))
org-export-latex-default-packages-alist)) el))
org-export-latex-packages-alist org-latex-default-packages-alist))
org-format-latex-header-extra) org-latex-packages-alist
nil))
(if fit "\n\\usepackage[active, tightpage]{preview}\n" "") (if fit "\n\\usepackage[active, tightpage]{preview}\n" "")
(if border (format "\\setlength{\\PreviewBorder}{%s}" border) "") (if border (format "\\setlength{\\PreviewBorder}{%s}" border) "")
(if height (concat "\n" (format "\\pdfpageheight %s" height)) "") (if height (concat "\n" (format "\\pdfpageheight %s" height)) "")
@ -113,14 +110,10 @@ This function is called by `org-babel-execute-src-block'."
(mapconcat #'identity headers "\n") (mapconcat #'identity headers "\n")
headers) "\n") headers) "\n")
"") "")
(if org-format-latex-header-extra
(concat "\n" org-format-latex-header-extra)
"")
(if fit (if fit
(concat "\n\\begin{document}\n\\begin{preview}\n" body (concat "\n\\begin{document}\n\\begin{preview}\n" body
"\n\\end{preview}\n\\end{document}\n") "\n\\end{preview}\n\\end{document}\n")
(concat "\n\\begin{document}\n" body "\n\\end{document}\n"))) (concat "\n\\begin{document}\n" body "\n\\end{document}\n"))))
(org-export-latex-fix-inputenc))
(when (file-exists-p out-file) (delete-file out-file)) (when (file-exists-p out-file) (delete-file out-file))
(let ((transient-pdf-file (org-babel-latex-tex-to-pdf tex-file))) (let ((transient-pdf-file (org-babel-latex-tex-to-pdf tex-file)))
(cond (cond
@ -137,7 +130,6 @@ This function is called by `org-babel-execute-src-block'."
nil) ;; signal that output has already been written to file nil) ;; signal that output has already been written to file
body)) body))
(defun convert-pdf (pdffile out-file im-in-options im-out-options) (defun convert-pdf (pdffile out-file im-in-options im-out-options)
"Generate a file from a pdf file using imagemagick." "Generate a file from a pdf file using imagemagick."
(let ((cmd (concat "convert " im-in-options " " pdffile " " (let ((cmd (concat "convert " im-in-options " " pdffile " "
@ -146,55 +138,14 @@ This function is called by `org-babel-execute-src-block'."
(shell-command cmd))) (shell-command cmd)))
(defun org-babel-latex-tex-to-pdf (file) (defun org-babel-latex-tex-to-pdf (file)
"Generate a pdf file according to the contents FILE. "Generate a pdf file according to the contents FILE."
Extracted from `org-export-as-pdf' in org-latex.el." (require 'ox-latex)
(let* ((wconfig (current-window-configuration)) (org-latex-compile file))
(default-directory (file-name-directory file))
(base (file-name-sans-extension file))
(pdffile (concat base ".pdf"))
(cmds org-latex-to-pdf-process)
(outbuf (get-buffer-create "*Org PDF LaTeX Output*"))
output-dir cmd)
(with-current-buffer outbuf (erase-buffer))
(message (concat "Processing LaTeX file " file "..."))
(setq output-dir (file-name-directory file))
(if (and cmds (symbolp cmds))
(funcall cmds (shell-quote-argument file))
(while cmds
(setq cmd (pop cmds))
(while (string-match "%b" cmd)
(setq cmd (replace-match
(save-match-data
(shell-quote-argument base))
t t cmd)))
(while (string-match "%f" cmd)
(setq cmd (replace-match
(save-match-data
(shell-quote-argument file))
t t cmd)))
(while (string-match "%o" cmd)
(setq cmd (replace-match
(save-match-data
(shell-quote-argument output-dir))
t t cmd)))
(shell-command cmd outbuf)))
(message (concat "Processing LaTeX file " file "...done"))
(if (not (file-exists-p pdffile))
(error (concat "PDF file " pdffile " was not produced"))
(set-window-configuration wconfig)
(when org-export-pdf-remove-logfiles
(dolist (ext org-export-pdf-logfiles)
(setq file (concat base "." ext))
(and (file-exists-p file) (delete-file file))))
(message "Exporting to PDF...done")
pdffile)))
(defun org-babel-prep-session:latex (session params) (defun org-babel-prep-session:latex (session params)
"Return an error because LaTeX doesn't support sessions." "Return an error because LaTeX doesn't support sessions."
(error "LaTeX does not support sessions")) (error "LaTeX does not support sessions"))
(provide 'ob-latex) (provide 'ob-latex)
;;; ob-latex.el ends here ;;; ob-latex.el ends here

9
lisp/ob-lilypond.el
View File

@ -30,10 +30,7 @@
;; http://lilypond.org/manuals.html ;; http://lilypond.org/manuals.html
;;; Code: ;;; Code:
(require 'ob) (require 'ob)
(require 'ob-eval)
(require 'ob-tangle)
(require 'outline) (require 'outline)
(defalias 'lilypond-mode 'LilyPond-mode) (defalias 'lilypond-mode 'LilyPond-mode)
@ -155,7 +152,11 @@ specific arguments to =org-babel-tangle="
" -dbackend=eps " " -dbackend=eps "
"-dno-gs-load-fonts " "-dno-gs-load-fonts "
"-dinclude-eps-fonts " "-dinclude-eps-fonts "
"--png " (or (cdr (assoc (file-name-extension out-file)
'(("pdf" . "--pdf ")
("ps" . "--ps ")
("png" . "--png "))))
"--png ")
"--output=" "--output="
(file-name-sans-extension out-file) (file-name-sans-extension out-file)
" " " "

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