Merge changes from Org 7.4 to current Org 7.7.

This commit is contained in:
Bastien Guerry 2011-07-28 17:13:49 +02:00
parent 44a8054f97
commit 3ab2c837b3
104 changed files with 18444 additions and 6673 deletions

View file

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

View file

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

File diff suppressed because it is too large Load diff

View file

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

View file

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

View file

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

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

@ -0,0 +1,119 @@
;;; ob-awk.el --- org-babel functions for awk evaluation
;; Copyright (C) 2011 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.7
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Commentary:
;; Babel's awk can use special header argument:
;;
;; - :in-file takes a path to a file of data to be processed by awk
;;
;; - :stdin takes an Org-mode data or code block reference, the value
;; of which will be passed to the awk process through STDIN
;;; Code:
(require 'ob)
(require 'ob-eval)
(eval-when-compile (require 'cl))
(declare-function org-babel-ref-resolve "ob-ref" (ref))
(declare-function orgtbl-to-generic "org-table" (table params))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("awk" . "awk"))
(defvar org-babel-awk-command "awk"
"Name of the awk executable command.")
(defun org-babel-expand-body:awk (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body."
(dolist (pair (mapcar #'cdr (org-babel-get-header params :var)))
(setf body (replace-regexp-in-string
(regexp-quote (concat "$" (car pair))) (cdr pair) body)))
body)
(defun org-babel-execute:awk (body params)
"Execute a block of Awk code with org-babel. This function is
called by `org-babel-execute-src-block'"
(message "executing Awk source code block")
(let* ((result-params (cdr (assoc :result-params params)))
(cmd-line (cdr (assoc :cmd-line params)))
(in-file (cdr (assoc :in-file params)))
(full-body (org-babel-expand-body:awk body params))
(code-file ((lambda (file) (with-temp-file file (insert full-body)) file)
(org-babel-temp-file "awk-")))
(stdin ((lambda (stdin)
(when stdin
(let ((tmp (org-babel-temp-file "awk-stdin-"))
(res (org-babel-ref-resolve stdin)))
(with-temp-file tmp
(insert (org-babel-awk-var-to-awk res)))
tmp)))
(cdr (assoc :stdin params))))
(cmd (mapconcat #'identity (remove nil (list org-babel-awk-command
"-f" code-file
cmd-line
in-file))
" ")))
(org-babel-reassemble-table
((lambda (results)
(when results
(if (or (member "scalar" result-params)
(member "verbatim" result-params)
(member "output" result-params))
results
(let ((tmp (org-babel-temp-file "awk-results-")))
(with-temp-file tmp (insert results))
(org-babel-import-elisp-from-file tmp)))))
(cond
(stdin (with-temp-buffer
(call-process-shell-command cmd stdin (current-buffer))
(buffer-string)))
(t (org-babel-eval cmd ""))))
(org-babel-pick-name
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
(defun org-babel-awk-var-to-awk (var &optional sep)
"Return a printed value of VAR suitable for parsing with awk."
(flet ((echo-var (v) (if (stringp v) v (format "%S" v))))
(cond
((and (listp var) (listp (car var)))
(orgtbl-to-generic var (list :sep (or sep "\t") :fmt #'echo-var)))
((listp var)
(mapconcat #'echo-var var "\n"))
(t (echo-var var)))))
(defun org-babel-awk-table-or-string (results)
"If the results look like a table, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
(org-babel-script-escape results))
(provide 'ob-awk)
;; arch-tag: 844e2c88-6aad-4018-868d-a2df6bcdf68f
;;; ob-awk.el ends here

View file

@ -1,11 +1,11 @@
;;; ob-calc.el --- org-babel functions for calc code evaluation ;;; ob-calc.el --- org-babel functions for calc code evaluation
;; Copyright (C) 2010-2011 Free Software Foundation, Inc ;; Copyright (C) 2010 Free Software Foundation, Inc
;; Author: Eric Schulte ;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research ;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org ;; Homepage: http://orgmode.org
;; Version: 7.4 ;; Version: 7.7
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
@ -29,7 +29,8 @@
;;; Code: ;;; Code:
(require 'ob) (require 'ob)
(require 'calc) (require 'calc)
(require 'calc-trail) (require 'calc-store)
(unless (featurep 'xemacs) (require 'calc-trail))
(eval-when-compile (require 'ob-comint)) (eval-when-compile (require 'ob-comint))
(defvar org-babel-default-header-args:calc nil (defvar org-babel-default-header-args:calc nil
@ -68,21 +69,16 @@
((math-read-number res) (math-read-number res)) ((math-read-number res) (math-read-number res))
((listp res) (error "calc error \"%s\" on input \"%s\"" ((listp res) (error "calc error \"%s\" on input \"%s\""
(cadr res) line)) (cadr res) line))
(t (calc-eval (t (replace-regexp-in-string
"'\\[" "["
(calc-eval
(math-evaluate-expr (math-evaluate-expr
;; resolve user variables, calc built in ;; resolve user variables, calc built in
;; variables are handled automatically ;; variables are handled automatically
;; upstream by calc ;; upstream by calc
(mapcar (lambda (el) (mapcar #'ob-calc-maybe-resolve-var
(if (and (consp el) (equal 'var (car el))
(member (cadr el) var-syms))
(progn
(calc-recall (cadr el))
(prog1 (calc-top 1)
(calc-pop 1)))
el))
;; parse line into calc objects ;; parse line into calc objects
(car (math-read-exprs line)))))))) (car (math-read-exprs line)))))))))
(calc-eval line)))))))) (calc-eval line))))))))
(mapcar #'org-babel-trim (mapcar #'org-babel-trim
(split-string (org-babel-expand-body:calc body params) "[\n\r]")))) (split-string (org-babel-expand-body:calc body params) "[\n\r]"))))
@ -90,7 +86,19 @@
(with-current-buffer (get-buffer "*Calculator*") (with-current-buffer (get-buffer "*Calculator*")
(calc-eval (calc-top 1))))) (calc-eval (calc-top 1)))))
(defvar var-syms) ; Dynamically scoped from org-babel-execute:calc
(defun ob-calc-maybe-resolve-var (el)
(if (consp el)
(if (and (equal 'var (car el)) (member (cadr el) var-syms))
(progn
(calc-recall (cadr el))
(prog1 (calc-top 1)
(calc-pop 1)))
(mapcar #'ob-calc-maybe-resolve-var el))
el))
(provide 'ob-calc) (provide 'ob-calc)
;; arch-tag: 5c57a3b7-5818-4c6c-acda-7a94831a6449
;;; ob-calc.el ends here ;;; ob-calc.el ends here

View file

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

View file

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

View file

@ -1,11 +1,11 @@
;;; ob-css.el --- org-babel functions for css evaluation ;;; ob-css.el --- org-babel functions for css evaluation
;; Copyright (C) 2009-2011 Free Software Foundation, Inc. ;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; Author: Eric Schulte ;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research ;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org ;; Homepage: http://orgmode.org
;; Version: 7.4 ;; Version: 7.7
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
@ -44,5 +44,6 @@ CSS does not support sessions."
(provide 'ob-css) (provide 'ob-css)
;; arch-tag: f4447e8c-50ab-41f9-b322-b7b9574d9fbe
;;; ob-css.el ends here ;;; ob-css.el ends here

View file

@ -1,11 +1,11 @@
;;; ob-ditaa.el --- org-babel functions for ditaa evaluation ;;; ob-ditaa.el --- org-babel functions for ditaa evaluation
;; Copyright (C) 2009-2011 Free Software Foundation, Inc. ;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; Author: Eric Schulte ;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research ;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org ;; Homepage: http://orgmode.org
;; Version: 7.4 ;; Version: 7.7
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
@ -40,7 +40,7 @@
(require 'ob) (require 'ob)
(defvar org-babel-default-header-args:ditaa (defvar org-babel-default-header-args:ditaa
'((:results . "file") (:exports . "results")) '((:results . "file") (:exports . "results") (:java . "-Dfile.encoding=UTF-8"))
"Default arguments for evaluating a ditaa source block.") "Default arguments for evaluating a ditaa source block.")
(defvar org-ditaa-jar-path) (defvar org-ditaa-jar-path)
@ -48,10 +48,15 @@
"Execute a block of Ditaa code with org-babel. "Execute a block of Ditaa code with org-babel.
This function is called by `org-babel-execute-src-block'." This function is called by `org-babel-execute-src-block'."
(let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) (let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
(out-file (cdr (assoc :file params))) (out-file ((lambda (el)
(or el
(error
"ditaa code block requires :file header argument")))
(cdr (assoc :file params))))
(cmdline (cdr (assoc :cmdline params))) (cmdline (cdr (assoc :cmdline params)))
(java (cdr (assoc :java params)))
(in-file (org-babel-temp-file "ditaa-")) (in-file (org-babel-temp-file "ditaa-"))
(cmd (concat "java -jar " (cmd (concat "java " java " -jar "
(shell-quote-argument (shell-quote-argument
(expand-file-name org-ditaa-jar-path)) (expand-file-name org-ditaa-jar-path))
" " cmdline " " cmdline
@ -61,7 +66,7 @@ This function is called by `org-babel-execute-src-block'."
(error "Could not find ditaa.jar at %s" org-ditaa-jar-path)) (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)
out-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)
"Return an error because ditaa does not support sessions." "Return an error because ditaa does not support sessions."
@ -69,5 +74,6 @@ This function is called by `org-babel-execute-src-block'."
(provide 'ob-ditaa) (provide 'ob-ditaa)
;; arch-tag: 492cd006-07d9-4fac-bef6-5bb60b48842e
;;; ob-ditaa.el ends here ;;; ob-ditaa.el ends here

View file

@ -1,11 +1,11 @@
;;; ob-dot.el --- org-babel functions for dot evaluation ;;; ob-dot.el --- org-babel functions for dot evaluation
;; Copyright (C) 2009-2011 Free Software Foundation, Inc. ;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; Author: Eric Schulte ;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research ;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org ;; Homepage: http://orgmode.org
;; Version: 7.4 ;; Version: 7.7
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
@ -77,7 +77,7 @@ This function is called by `org-babel-execute-src-block'."
" " (org-babel-process-file-name in-file) " " (org-babel-process-file-name in-file)
" " cmdline " " cmdline
" -o " (org-babel-process-file-name out-file)) "") " -o " (org-babel-process-file-name out-file)) "")
out-file)) nil)) ;; signal that output has already been written to file
(defun org-babel-prep-session:dot (session params) (defun org-babel-prep-session:dot (session params)
"Return an error because Dot does not support sessions." "Return an error because Dot does not support sessions."
@ -85,5 +85,6 @@ This function is called by `org-babel-execute-src-block'."
(provide 'ob-dot) (provide 'ob-dot)
;; arch-tag: 817d0516-7b47-4f77-a8b2-2aadd8e4d0e2
;;; ob-dot.el ends here ;;; ob-dot.el ends here

View file

@ -1,11 +1,11 @@
;;; ob-emacs-lisp.el --- org-babel functions for emacs-lisp code evaluation ;;; ob-emacs-lisp.el --- org-babel functions for emacs-lisp code evaluation
;; Copyright (C) 2009-2011 Free Software Foundation, Inc ;; Copyright (C) 2009, 2010 Free Software Foundation, Inc
;; Author: Eric Schulte ;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research ;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org ;; Homepage: http://orgmode.org
;; Version: 7.4 ;; Version: 7.7
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
@ -56,15 +56,26 @@
(defun org-babel-execute:emacs-lisp (body params) (defun org-babel-execute:emacs-lisp (body params)
"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)
(if (or (member "scalar" (cdr (assoc :result-params params)))
(member "verbatim" (cdr (assoc :result-params params))))
(let ((print-level nil)
(print-length nil))
(format "%S" result))
(org-babel-reassemble-table (org-babel-reassemble-table
(eval (read (format "(progn %s)" result
(org-babel-expand-body:emacs-lisp body params))))
(org-babel-pick-name (cdr (assoc :colname-names params)) (org-babel-pick-name (cdr (assoc :colname-names params))
(cdr (assoc :colnames params))) (cdr (assoc :colnames params)))
(org-babel-pick-name (cdr (assoc :rowname-names params)) (org-babel-pick-name (cdr (assoc :rowname-names params))
(cdr (assoc :rownames params)))))) (cdr (assoc :rownames params))))))
(eval (read (format (if (member "output"
(cdr (assoc :result-params params)))
"(with-output-to-string %s)"
"(progn %s)")
(org-babel-expand-body:emacs-lisp body params)))))))
(provide 'ob-emacs-lisp) (provide 'ob-emacs-lisp)
;; arch-tag: e9a3acca-dc84-472a-9f5a-23c35befbcd6
;;; ob-emacs-lisp.el ends here ;;; ob-emacs-lisp.el ends here

View file

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

View file

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

View file

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

View file

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

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

@ -0,0 +1,74 @@
;;; ob-java.el --- org-babel functions for java evaluation
;; Copyright (C) 2011 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.7
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Currently this only supports the external compilation and execution
;; of java code blocks (i.e., no session support).
;;; Code:
(require 'ob)
(require 'ob-eval)
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("java" . "java"))
(defvar org-babel-java-command "java"
"Name of the java command.")
(defvar org-babel-java-compiler "javac"
"Name of the java compiler.")
(defun org-babel-execute:java (body params)
(let* ((classname (or (cdr (assoc :classname params))
(error
"Can't compile a java block without a classname")))
(packagename (file-name-directory classname))
(src-file (concat classname ".java"))
(full-body (org-babel-expand-body:generic body params))
(compile
(progn (with-temp-file src-file (insert full-body))
(org-babel-eval
(concat org-babel-java-compiler " " src-file) ""))))
;; created package-name directories if missing
(unless (or (not packagename) (file-exists-p packagename))
(make-directory packagename 'parents))
((lambda (results)
(org-babel-reassemble-table
(if (member "vector" (cdr (assoc :result-params params)))
(let ((tmp-file (org-babel-temp-file "c-")))
(with-temp-file tmp-file (insert results))
(org-babel-import-elisp-from-file tmp-file))
(org-babel-read results))
(org-babel-pick-name
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))
(org-babel-eval (concat org-babel-java-command " " classname) ""))))
(provide 'ob-java)
;; arch-tag: dd1cfb00-7f76-4ecf-922c-f7031b68b85e
;;; ob-java.el ends here

View file

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

View file

@ -1,11 +1,11 @@
;;; ob-keys.el --- key bindings for org-babel ;;; ob-keys.el --- key bindings for org-babel
;; Copyright (C) 2009-2011 Free Software Foundation, Inc. ;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; Author: Eric Schulte ;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research ;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org ;; Homepage: http://orgmode.org
;; Version: 7.4 ;; Version: 7.7
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
@ -73,10 +73,14 @@ functions which are assigned key bindings, and see
("t" . org-babel-tangle) ("t" . org-babel-tangle)
("\C-f" . org-babel-tangle-file) ("\C-f" . org-babel-tangle-file)
("f" . org-babel-tangle-file) ("f" . org-babel-tangle-file)
("\C-c" . org-babel-check-src-block)
("c" . org-babel-check-src-block)
("\C-l" . org-babel-load-in-session) ("\C-l" . org-babel-load-in-session)
("l" . org-babel-load-in-session) ("l" . org-babel-load-in-session)
("\C-i" . org-babel-lob-ingest) ("\C-i" . org-babel-lob-ingest)
("i" . org-babel-lob-ingest) ("i" . org-babel-lob-ingest)
("\C-I" . org-babel-view-src-block-info)
("I" . org-babel-view-src-block-info)
("\C-z" . org-babel-switch-to-session) ("\C-z" . org-babel-switch-to-session)
("z" . org-babel-switch-to-session-with-code) ("z" . org-babel-switch-to-session-with-code)
("\C-a" . org-babel-sha1-hash) ("\C-a" . org-babel-sha1-hash)
@ -93,5 +97,6 @@ a-list placed behind the generic `org-babel-key-prefix'.")
(provide 'ob-keys) (provide 'ob-keys)
;; arch-tag: 01e348ee-4906-46fa-839a-6b7b6f989048
;;; ob-keys.el ends here ;;; ob-keys.el ends here

View file

@ -1,11 +1,11 @@
;;; ob-latex.el --- org-babel functions for latex "evaluation" ;;; ob-latex.el --- org-babel functions for latex "evaluation"
;; Copyright (C) 2009-2011 Free Software Foundation, Inc. ;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; Author: Eric Schulte ;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research ;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org ;; Homepage: http://orgmode.org
;; Version: 7.4 ;; Version: 7.7
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
@ -37,6 +37,7 @@
(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-export-latex-fix-inputenc "org-latex" ())
(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)
@ -122,7 +123,7 @@ This function is called by `org-babel-execute-src-block'."
((string-match "\\.\\([^\\.]+\\)$" out-file) ((string-match "\\.\\([^\\.]+\\)$" out-file)
(error "can not create %s files, please specify a .png or .pdf file" (error "can not create %s files, please specify a .png or .pdf file"
(match-string 1 out-file)))) (match-string 1 out-file))))
out-file) nil) ;; signal that output has already been written to file
body)) body))
(defun org-babel-latex-tex-to-pdf (file) (defun org-babel-latex-tex-to-pdf (file)
@ -175,5 +176,6 @@ Extracted from `org-export-as-pdf' in org-latex.el."
(provide 'ob-latex) (provide 'ob-latex)
;; arch-tag: 1f13f7e2-26de-4c24-9274-9f331d4c6ff3
;;; ob-latex.el ends here ;;; ob-latex.el ends here

View file

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

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

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

View file

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

View file

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

View file

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

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

@ -0,0 +1,80 @@
;;; ob-maxima.el --- org-babel functions for maxima evaluation
;; Copyright (c) 2009, 2010, 2011 Eric S Fraga, Eric Schulte
;; Author: Eric S Fraga, Eric Schulte
;; Keywords: literate programming, reproducible research, maxima
;; Homepage: http://orgmode.org
;; Version: 7.7
;;; License:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Org-Babel support for evaluating maxima entries.
;;
;; This differs from most standard languages in that
;;
;; 1) there is no such thing as a "session" in maxima
;;
;; 2) we are generally only going to return output from maxima
;;
;; 3) we are adding the "cmdline" header argument
;;
;; 4) there are no variables
;;; Code:
(require 'ob)
(defvar org-babel-default-header-args:maxima '())
(defun org-babel-maxima-expand (body params)
"Expand a block of Maxima code according to its header arguments."
body)
(defun org-babel-execute:maxima (body params)
"Execute a block of Maxima entries with org-babel. This function is
called by `org-babel-execute-src-block'."
(message "executing Maxima source code block")
(let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
(cmdline (cdr (assoc :cmdline params)))
(in-file (org-babel-temp-file "maxima-"))
(cmd (format "maxima --very-quiet -r 'batchload(%S)$' %s"
in-file cmdline)))
(with-temp-file in-file (insert body))
(message cmd)
((lambda (raw) ;; " | grep -v batch | grep -v 'replaced' | sed '/^$/d' "
(mapconcat
#'identity
(delq nil
(mapcar (lambda (line)
(unless (or (string-match "batch" line)
(string-match "^rat: replaced .*$" line)
(= 0 (length line)))
line))
(split-string raw "[\r\n]"))) "\n"))
(org-babel-eval cmd ""))))
(defun org-babel-prep-session:maxima (session params)
(error "Maxima does not support sessions"))
(provide 'ob-maxima)
;; arch-tag: d86c97ac-7eab-4349-8d8b-302dd09779a8
;;; ob-maxima.el ends here

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

File diff suppressed because it is too large Load diff

File diff suppressed because it is too large Load diff

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

File diff suppressed because it is too large Load diff

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

File diff suppressed because it is too large Load diff

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

@ -1,10 +1,10 @@
;;; org-latex.el --- LaTeX exporter for org-mode ;;; org-latex.el --- LaTeX exporter for org-mode
;; ;;
;; Copyright (C) 2007-2011 Free Software Foundation, Inc. ;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; ;;
;; Emacs Lisp Archive Entry ;; Emacs Lisp Archive Entry
;; Filename: org-latex.el ;; Filename: org-latex.el
;; Version: 7.4 ;; Version: 7.7
;; Author: Bastien Guerry <bzg AT altern DOT org> ;; Author: Bastien Guerry <bzg AT altern DOT org>
;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com> ;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com>
;; Keywords: org, wp, tex ;; Keywords: org, wp, tex
@ -65,6 +65,8 @@
(defvar org-export-latex-display-custom-times nil) (defvar org-export-latex-display-custom-times nil)
(defvar org-export-latex-all-targets-re nil) (defvar org-export-latex-all-targets-re nil)
(defvar org-export-latex-add-level 0) (defvar org-export-latex-add-level 0)
(defvar org-export-latex-footmark-seen nil
"List of footnotes markers seen so far by exporter.")
(defvar org-export-latex-sectioning "") (defvar org-export-latex-sectioning "")
(defvar org-export-latex-sectioning-depth 0) (defvar org-export-latex-sectioning-depth 0)
(defvar org-export-latex-special-keyword-regexp (defvar org-export-latex-special-keyword-regexp
@ -73,9 +75,8 @@
org-closed-string"\\)") org-closed-string"\\)")
"Regexp matching special time planning keywords plus the time after it.") "Regexp matching special time planning keywords plus the time after it.")
(defvar latexp) ; dynamically scoped from org.el (defvar org-re-quote) ; dynamically scoped from org.el
(defvar re-quote) ; dynamically scoped from org.el (defvar org-commentsp) ; dynamically scoped from org.el
(defvar commentsp) ; dynamically scoped from org.el
;;; User variables: ;;; User variables:
@ -230,14 +231,15 @@ are written as utf8 files."
("/" "\\emph{%s}" nil) ("/" "\\emph{%s}" nil)
("_" "\\underline{%s}" nil) ("_" "\\underline{%s}" nil)
("+" "\\st{%s}" nil) ("+" "\\st{%s}" nil)
("=" "\\verb" t) ("=" "\\protectedtexttt" t)
("~" "\\verb" t)) ("~" "\\verb" t))
"Alist of LaTeX expressions to convert emphasis fontifiers. "Alist of LaTeX expressions to convert emphasis fontifiers.
Each element of the list is a list of three elements. Each element of the list is a list of three elements.
The first element is the character used as a marker for fontification. The first element is the character used as a marker for fontification.
The second element is a formatting string to wrap fontified text with. The second element is a formatting string to wrap fontified text with.
If it is \"\\verb\", Org will automatically select a delimiter If it is \"\\verb\", Org will automatically select a delimiter
character that is not in the string. character that is not in the string. \"\\protectedtexttt\" will use \\texttt
to typeset and try to protect special characters.
The third element decides whether to protect converted text from other The third element decides whether to protect converted text from other
conversions." conversions."
:group 'org-export-latex :group 'org-export-latex
@ -258,7 +260,7 @@ For example \orgTITLE for #+TITLE."
:type 'boolean) :type 'boolean)
(defcustom org-export-latex-date-format (defcustom org-export-latex-date-format
"%d %B %Y" "\\today"
"Format string for \\date{...}." "Format string for \\date{...}."
:group 'org-export-latex :group 'org-export-latex
:type 'string) :type 'string)
@ -290,6 +292,11 @@ markup defined, the first one in the association list will be used."
:group 'org-export-latex :group 'org-export-latex
:type 'string) :type 'string)
(defcustom org-export-latex-timestamp-inactive-markup "\\textit{%s}"
"A printf format string to be applied to inactive time stamps."
:group 'org-export-latex
:type 'string)
(defcustom org-export-latex-timestamp-keyword-markup "\\texttt{%s}" (defcustom org-export-latex-timestamp-keyword-markup "\\texttt{%s}"
"A printf format string to be applied to time stamps." "A printf format string to be applied to time stamps."
:group 'org-export-latex :group 'org-export-latex
@ -297,18 +304,51 @@ markup defined, the first one in the association list will be used."
(defcustom org-export-latex-href-format "\\href{%s}{%s}" (defcustom org-export-latex-href-format "\\href{%s}{%s}"
"A printf format string to be applied to href links. "A printf format string to be applied to href links.
The format must contain two %s instances. The first will be filled with The format must contain either two %s instances or just one.
the link, the second with the link description." If it contains two %s instances, the first will be filled with
the link, the second with the link description. If it contains
only one, the %s will be filled with the link."
:group 'org-export-latex :group 'org-export-latex
:type 'string) :type 'string)
(defcustom org-export-latex-hyperref-format "\\hyperref[%s]{%s}" (defcustom org-export-latex-hyperref-format "\\hyperref[%s]{%s}"
"A printf format string to be applied to hyperref links. "A printf format string to be applied to hyperref links.
The format must contain two %s instances. The first will be filled with The format must contain one or two %s instances. The first one
the link, the second with the link description." will be filled with the link, the second with its description."
:group 'org-export-latex :group 'org-export-latex
:type 'string) :type 'string)
(defcustom org-export-latex-footnote-separator "\\textsuperscript{,}\\,"
"Text used to separate footnotes."
:group 'org-export-latex
:type 'string)
(defcustom org-export-latex-quotes
'(("fr" ("\\(\\s-\\|[[(]\\)\"" . "«~") ("\\(\\S-\\)\"" . "") ("\\(\\s-\\|(\\)'" . "'"))
("en" ("\\(\\s-\\|[[(]\\)\"" . "``") ("\\(\\S-\\)\"" . "''") ("\\(\\s-\\|(\\)'" . "`")))
"Alist for quotes to use when converting english double-quotes.
The CAR of each item in this alist is the language code.
The CDR of each item in this alist is a list of three CONS:
- the first CONS defines the opening quote;
- the second CONS defines the closing quote;
- the last CONS defines single quotes.
For each item in a CONS, the first string is a regexp
for allowed characters before/after the quote, the second
string defines the replacement string for this quote."
:group 'org-export-latex
:type '(list
(cons :tag "Opening quote"
(string :tag "Regexp for char before")
(string :tag "Replacement quote "))
(cons :tag "Closing quote"
(string :tag "Regexp for char after ")
(string :tag "Replacement quote "))
(cons :tag "Single quote"
(string :tag "Regexp for char before")
(string :tag "Replacement quote "))))
(defcustom org-export-latex-tables-verbatim nil (defcustom org-export-latex-tables-verbatim nil
"When non-nil, tables are exported verbatim." "When non-nil, tables are exported verbatim."
:group 'org-export-latex :group 'org-export-latex
@ -353,7 +393,7 @@ string should be like \"\\end{itemize\"."
(string :tag "Use a section string" :value "\\subparagraph{%s}"))) (string :tag "Use a section string" :value "\\subparagraph{%s}")))
(defcustom org-export-latex-list-parameters (defcustom org-export-latex-list-parameters
'(:cbon "$\\boxtimes$" :cboff "$\\Box$") '(:cbon "$\\boxtimes$" :cboff "$\\Box$" :cbtrans "$\\boxminus$")
"Parameters for the LaTeX list exporter. "Parameters for the LaTeX list exporter.
These parameters will be passed on to `org-list-to-latex', which in turn These parameters will be passed on to `org-list-to-latex', which in turn
will pass them (combined with the LaTeX default list parameters) to will pass them (combined with the LaTeX default list parameters) to
@ -397,8 +437,8 @@ example using customize, or with
(require 'org-latex) (require 'org-latex)
(add-to-list 'org-export-latex-packages-alist '(\"\" \"minted\")) (add-to-list 'org-export-latex-packages-alist '(\"\" \"minted\"))
In addition, it is neccessary to install In addition, it is necessary to install
pygments (http://pygments.org), and to configure pygments (http://pygments.org), and to configure the variable
`org-latex-to-pdf-process' so that the -shell-escape option is `org-latex-to-pdf-process' so that the -shell-escape option is
passed to pdflatex. passed to pdflatex.
" "
@ -460,6 +500,67 @@ pygmentize -L lexers
(symbol :tag "Major mode ") (symbol :tag "Major mode ")
(string :tag "Listings language")))) (string :tag "Listings language"))))
(defcustom org-export-latex-listings-options nil
"Association list of options for the latex listings package.
These options are supplied as a comma-separated list to the
\\lstset command. Each element of the association list should be
a list containing two strings: the name of the option, and the
value. For example,
(setq org-export-latex-listings-options
'((\"basicstyle\" \"\\small\")
(\"keywordstyle\" \"\\color{black}\\bfseries\\underbar\")))
will typeset the code in a small size font with underlined, bold
black keywords.
Note that the same options will be applied to blocks of all
languages."
:group 'org-export-latex
:type '(repeat
(list
(string :tag "Listings option name ")
(string :tag "Listings option value"))))
(defcustom org-export-latex-minted-options nil
"Association list of options for the latex minted package.
These options are supplied within square brackets in
\\begin{minted} environments. Each element of the alist should be
a list containing two strings: the name of the option, and the
value. For example,
(setq org-export-latex-minted-options
'((\"bgcolor\" \"bg\") (\"frame\" \"lines\")))
will result in src blocks being exported with
\\begin{minted}[bgcolor=bg,frame=lines]{<LANG>}
as the start of the minted environment. Note that the same
options will be applied to blocks of all languages."
:group 'org-export-latex
:type '(repeat
(list
(string :tag "Minted option name ")
(string :tag "Minted option value"))))
(defvar org-export-latex-custom-lang-environments nil
"Association list mapping languages to language-specific latex
environments used during export of src blocks by the listings
and minted latex packages. For example,
(setq org-export-latex-custom-lang-environments
'((python \"pythoncode\")))
would have the effect that if org encounters begin_src python
during latex export it will output
\\begin{pythoncode}
<src block body>
\\end{pythoncode}")
(defcustom org-export-latex-remove-from-headlines (defcustom org-export-latex-remove-from-headlines
'(:todo nil :priority nil :tags nil) '(:todo nil :priority nil :tags nil)
"A plist of keywords to remove from headlines. OBSOLETE. "A plist of keywords to remove from headlines. OBSOLETE.
@ -473,11 +574,16 @@ and `org-export-with-tags' instead."
:type 'plist :type 'plist
:group 'org-export-latex) :group 'org-export-latex)
(defcustom org-export-latex-image-default-option "width=10em" (defcustom org-export-latex-image-default-option "width=.9\\linewidth"
"Default option for images." "Default option for images."
:group 'org-export-latex :group 'org-export-latex
:type 'string) :type 'string)
(defcustom org-latex-default-figure-position "htb"
"Default position for latex figures."
:group 'org-export-latex
:type 'string)
(defcustom org-export-latex-tabular-environment "tabular" (defcustom org-export-latex-tabular-environment "tabular"
"Default environment used to build tables." "Default environment used to build tables."
:group 'org-export-latex :group 'org-export-latex
@ -644,7 +750,7 @@ a Lisp program could call this function in the following way:
When called interactively, the output buffer is selected, and shown When called interactively, the output buffer is selected, and shown
in a window. A non-interactive call will only return the buffer." in a window. A non-interactive call will only return the buffer."
(interactive "r\nP") (interactive "r\nP")
(when (interactive-p) (when (org-called-interactively-p 'any)
(setq buffer "*Org LaTeX Export*")) (setq buffer "*Org LaTeX Export*"))
(let ((transient-mark-mode t) (zmacs-regions t) (let ((transient-mark-mode t) (zmacs-regions t)
ext-plist rtn) ext-plist rtn)
@ -656,7 +762,7 @@ in a window. A non-interactive call will only return the buffer."
nil nil ext-plist nil nil ext-plist
buffer body-only)) buffer body-only))
(if (fboundp 'deactivate-mark) (deactivate-mark)) (if (fboundp 'deactivate-mark) (deactivate-mark))
(if (and (interactive-p) (bufferp rtn)) (if (and (org-called-interactively-p 'any) (bufferp rtn))
(switch-to-buffer-other-window rtn) (switch-to-buffer-other-window rtn)
rtn))) rtn)))
@ -700,11 +806,15 @@ when PUB-DIR is set, use this as the publishing directory."
'(:org-license-to-kill nil)))) '(:org-license-to-kill nil))))
(org-update-radio-target-regexp) (org-update-radio-target-regexp)
(org-export-latex-set-initial-vars ext-plist arg) (org-export-latex-set-initial-vars ext-plist arg)
(setq org-export-opt-plist org-export-latex-options-plist) (setq org-export-opt-plist org-export-latex-options-plist
org-export-footnotes-data (org-footnote-all-labels 'with-defs)
org-export-footnotes-seen nil
org-export-latex-footmark-seen nil)
(org-install-letbind) (org-install-letbind)
(run-hooks 'org-export-latex-after-initial-vars-hook) (run-hooks 'org-export-latex-after-initial-vars-hook)
(let* ((wcf (current-window-configuration)) (let* ((wcf (current-window-configuration))
(opt-plist org-export-latex-options-plist) (opt-plist
(org-export-process-option-filters org-export-latex-options-plist))
(region-p (org-region-active-p)) (region-p (org-region-active-p))
(rbeg (and region-p (region-beginning))) (rbeg (and region-p (region-beginning)))
(rend (and region-p (region-end))) (rend (and region-p (region-end)))
@ -794,7 +904,7 @@ when PUB-DIR is set, use this as the publishing directory."
(org-export-preprocess-string (org-export-preprocess-string
text text
:emph-multiline t :emph-multiline t
:for-LaTeX t :for-backend 'latex
:comments nil :comments nil
:tags (plist-get opt-plist :tags) :tags (plist-get opt-plist :tags)
:priority (plist-get opt-plist :priority) :priority (plist-get opt-plist :priority)
@ -802,6 +912,7 @@ when PUB-DIR is set, use this as the publishing directory."
:drawers (plist-get opt-plist :drawers) :drawers (plist-get opt-plist :drawers)
:timestamps (plist-get opt-plist :timestamps) :timestamps (plist-get opt-plist :timestamps)
:todo-keywords (plist-get opt-plist :todo-keywords) :todo-keywords (plist-get opt-plist :todo-keywords)
:tasks (plist-get opt-plist :tasks)
:add-text nil :add-text nil
:skip-before-1st-heading skip :skip-before-1st-heading skip
:select-tags nil :select-tags nil
@ -811,7 +922,7 @@ when PUB-DIR is set, use this as the publishing directory."
(org-export-preprocess-string (org-export-preprocess-string
region region
:emph-multiline t :emph-multiline t
:for-LaTeX t :for-backend 'latex
:comments nil :comments nil
:tags (plist-get opt-plist :tags) :tags (plist-get opt-plist :tags)
:priority (plist-get opt-plist :priority) :priority (plist-get opt-plist :priority)
@ -819,6 +930,7 @@ when PUB-DIR is set, use this as the publishing directory."
:drawers (plist-get opt-plist :drawers) :drawers (plist-get opt-plist :drawers)
:timestamps (plist-get opt-plist :timestamps) :timestamps (plist-get opt-plist :timestamps)
:todo-keywords (plist-get opt-plist :todo-keywords) :todo-keywords (plist-get opt-plist :todo-keywords)
:tasks (plist-get opt-plist :tasks)
:add-text (if (eq to-buffer 'string) nil text) :add-text (if (eq to-buffer 'string) nil text)
:skip-before-1st-heading skip :skip-before-1st-heading skip
:select-tags (plist-get opt-plist :select-tags) :select-tags (plist-get opt-plist :select-tags)
@ -843,7 +955,7 @@ when PUB-DIR is set, use this as the publishing directory."
"\n\n")) "\n\n"))
;; insert lines before the first headline ;; insert lines before the first headline
(unless skip (unless (or skip (string-match "^\\*" first-lines))
(insert first-lines)) (insert first-lines))
;; export the content of headlines ;; export the content of headlines
@ -917,7 +1029,13 @@ when PUB-DIR is set, use this as the publishing directory."
(file (buffer-file-name lbuf)) (file (buffer-file-name lbuf))
(base (file-name-sans-extension (buffer-file-name lbuf))) (base (file-name-sans-extension (buffer-file-name lbuf)))
(pdffile (concat base ".pdf")) (pdffile (concat base ".pdf"))
(cmds org-latex-to-pdf-process) (cmds (if (eq org-export-latex-listings 'minted)
;; automatically add -shell-escape when needed
(mapcar (lambda (cmd)
(replace-regexp-in-string
"pdflatex " "pdflatex -shell-escape " cmd))
org-latex-to-pdf-process)
org-latex-to-pdf-process))
(outbuf (get-buffer-create "*Org PDF LaTeX Output*")) (outbuf (get-buffer-create "*Org PDF LaTeX Output*"))
(bibtex-p (with-current-buffer lbuf (bibtex-p (with-current-buffer lbuf
(save-excursion (save-excursion
@ -927,6 +1045,8 @@ when PUB-DIR is set, use this as the publishing directory."
(with-current-buffer outbuf (erase-buffer)) (with-current-buffer outbuf (erase-buffer))
(message (concat "Processing LaTeX file " file "...")) (message (concat "Processing LaTeX file " file "..."))
(setq output-dir (file-name-directory file)) (setq output-dir (file-name-directory file))
(with-current-buffer lbuf
(save-excursion
(if (and cmds (symbolp cmds)) (if (and cmds (symbolp cmds))
(funcall cmds (shell-quote-argument file)) (funcall cmds (shell-quote-argument file))
(while cmds (while cmds
@ -946,7 +1066,7 @@ when PUB-DIR is set, use this as the publishing directory."
(save-match-data (save-match-data
(shell-quote-argument output-dir)) (shell-quote-argument output-dir))
t t cmd))) t t cmd)))
(shell-command cmd outbuf))) (shell-command cmd outbuf)))))
(message (concat "Processing LaTeX file " file "...done")) (message (concat "Processing LaTeX file " file "...done"))
(setq errors (org-export-latex-get-error outbuf)) (setq errors (org-export-latex-get-error outbuf))
(if (not (file-exists-p pdffile)) (if (not (file-exists-p pdffile))
@ -1084,7 +1204,9 @@ and its content."
(defun org-export-latex-subcontent (subcontent num) (defun org-export-latex-subcontent (subcontent num)
"Export each cell of SUBCONTENT to LaTeX. "Export each cell of SUBCONTENT to LaTeX.
If NUM, export sections as numerical sections." If NUM is non-nil export numbered sections, otherwise use unnumbered
sections. If NUM is an integer, export the highest NUM levels as
numbered sections and lower levels as unnumbered sections."
(let* ((heading (cdr (assoc 'heading subcontent))) (let* ((heading (cdr (assoc 'heading subcontent)))
(level (- (cdr (assoc 'level subcontent)) (level (- (cdr (assoc 'level subcontent))
org-export-latex-add-level)) org-export-latex-add-level))
@ -1120,6 +1242,9 @@ If NUM, export sections as numerical sections."
;; Normal conversion ;; Normal conversion
((<= level depth) ((<= level depth)
(let* ((sec (nth (1- level) sectioning)) (let* ((sec (nth (1- level) sectioning))
(num (if (integerp num)
(>= num level)
num))
start end) start end)
(if (consp (cdr sec)) (if (consp (cdr sec))
(setq start (nth (if num 0 2) sec) (setq start (nth (if num 0 2) sec)
@ -1266,7 +1391,11 @@ TITLE is the current title from the buffer or region.
OPT-PLIST is the options plist for current buffer." OPT-PLIST is the options plist for current buffer."
(let ((toc (plist-get opt-plist :table-of-contents)) (let ((toc (plist-get opt-plist :table-of-contents))
(author (org-export-apply-macros-in-string (author (org-export-apply-macros-in-string
(plist-get opt-plist :author)))) (plist-get opt-plist :author)))
(email (replace-regexp-in-string
"_" "\\\\_"
(org-export-apply-macros-in-string
(plist-get opt-plist :email)))))
(concat (concat
(if (plist-get opt-plist :time-stamp-file) (if (plist-get opt-plist :time-stamp-file)
(format-time-string "%% Created %Y-%m-%d %a %H:%M\n")) (format-time-string "%% Created %Y-%m-%d %a %H:%M\n"))
@ -1281,17 +1410,18 @@ OPT-PLIST is the options plist for current buffer."
(org-export-apply-macros-in-string org-export-latex-append-header) (org-export-apply-macros-in-string org-export-latex-append-header)
;; define alert if not yet defined ;; define alert if not yet defined
"\n\\providecommand{\\alert}[1]{\\textbf{#1}}" "\n\\providecommand{\\alert}[1]{\\textbf{#1}}"
;; beginning of the document
"\n\\begin{document}\n\n"
;; insert the title ;; insert the title
(format (format
"\n\n\\title{%s}\n" "\n\n\\title{%s}\n"
;; convert the title
(org-export-latex-fontify-headline title)) (org-export-latex-fontify-headline title))
;; insert author info ;; insert author info
(if (plist-get opt-plist :author-info) (if (plist-get opt-plist :author-info)
(format "\\author{%s}\n" (format "\\author{%s%s}\n"
(org-export-latex-fontify-headline (or author user-full-name))) (org-export-latex-fontify-headline (or author user-full-name))
(if (and (plist-get opt-plist :email-info) email
(string-match "\\S-" email))
(format "\\thanks{%s}" email)
""))
(format "%%\\author{%s}\n" (format "%%\\author{%s}\n"
(org-export-latex-fontify-headline (or author user-full-name)))) (org-export-latex-fontify-headline (or author user-full-name))))
;; insert the date ;; insert the date
@ -1299,6 +1429,8 @@ OPT-PLIST is the options plist for current buffer."
(format-time-string (format-time-string
(or (plist-get opt-plist :date) (or (plist-get opt-plist :date)
org-export-latex-date-format))) org-export-latex-date-format)))
;; beginning of the document
"\n\\begin{document}\n\n"
;; insert the title command ;; insert the title command
(when (string-match "\\S-" title) (when (string-match "\\S-" title)
(if (string-match "%s" org-export-latex-title-command) (if (string-match "%s" org-export-latex-title-command)
@ -1325,14 +1457,15 @@ If END is non-nil, it is the end of the region."
(save-excursion (save-excursion
(goto-char (or beg (point-min))) (goto-char (or beg (point-min)))
(let* ((pt (point)) (let* ((pt (point))
(end (if (re-search-forward (org-get-limited-outline-regexp) end t) (end (if (re-search-forward
(concat "^" (org-get-limited-outline-regexp)) end t)
(goto-char (match-beginning 0)) (goto-char (match-beginning 0))
(goto-char (or end (point-max)))))) (goto-char (or end (point-max))))))
(prog1 (prog1
(org-export-latex-content (org-export-latex-content
(org-export-preprocess-string (org-export-preprocess-string
(buffer-substring pt end) (buffer-substring pt end)
:for-LaTeX t :for-backend 'latex
:emph-multiline t :emph-multiline t
:add-text nil :add-text nil
:comments nil :comments nil
@ -1358,8 +1491,6 @@ If END is non-nil, it is the end of the region."
(defvar org-export-latex-header-defs nil (defvar org-export-latex-header-defs nil
"The header definitions that might be used in the LaTeX body.") "The header definitions that might be used in the LaTeX body.")
(defvar org-export-latex-header-defs-re nil
"The header definitions that might be used in the LaTeX body.")
(defun org-export-latex-content (content &optional exclude-list) (defun org-export-latex-content (content &optional exclude-list)
"Convert CONTENT string to LaTeX. "Convert CONTENT string to LaTeX.
@ -1367,6 +1498,7 @@ Don't perform conversions that are in EXCLUDE-LIST. Recognized
conversion types are: quotation-marks, emphasis, sub-superscript, conversion types are: quotation-marks, emphasis, sub-superscript,
links, keywords, lists, tables, fixed-width" links, keywords, lists, tables, fixed-width"
(with-temp-buffer (with-temp-buffer
(org-install-letbind)
(insert content) (insert content)
(unless (memq 'timestamps exclude-list) (unless (memq 'timestamps exclude-list)
(org-export-latex-time-stamps)) (org-export-latex-time-stamps))
@ -1443,7 +1575,7 @@ links, keywords, lists, tables, fixed-width"
(format org-export-latex-tag-markup (format org-export-latex-tag-markup
(save-match-data (save-match-data
(replace-regexp-in-string (replace-regexp-in-string
"_" "\\\\_" (match-string 0))))) "\\([_#]\\)" "\\\\\\1" (match-string 0)))))
t t))))) t t)))))
(defun org-export-latex-fontify-headline (string) (defun org-export-latex-fontify-headline (string)
@ -1498,6 +1630,8 @@ links, keywords, lists, tables, fixed-width"
'(org-protected t))))) '(org-protected t)))))
(when (plist-get org-export-latex-options-plist :emphasize) (when (plist-get org-export-latex-options-plist :emphasize)
(org-export-latex-fontify)) (org-export-latex-fontify))
(org-export-latex-time-stamps)
(org-export-latex-quotation-marks)
(org-export-latex-keywords-maybe) (org-export-latex-keywords-maybe)
(org-export-latex-special-chars (org-export-latex-special-chars
(plist-get org-export-latex-options-plist :sub-superscript)) (plist-get org-export-latex-options-plist :sub-superscript))
@ -1512,27 +1646,26 @@ links, keywords, lists, tables, fixed-width"
(org-if-unprotected-at (1- (point)) (org-if-unprotected-at (1- (point))
(replace-match (replace-match
(org-export-latex-protect-string (org-export-latex-protect-string
(format org-export-latex-timestamp-markup (format (if (string= "<" (substring (match-string 0) 0 1))
org-export-latex-timestamp-markup
org-export-latex-timestamp-inactive-markup)
(substring (org-translate-time (match-string 0)) 1 -1))) (substring (org-translate-time (match-string 0)) 1 -1)))
t t))))) t t)))))
(defun org-export-latex-quotation-marks () (defun org-export-latex-quotation-marks ()
"Export quotation marks depending on language conventions." "Export quotation marks depending on language conventions."
(let* ((lang (plist-get org-export-latex-options-plist :language)) (mapc (lambda(l)
(quote-rpl (if (equal lang "fr") (goto-char (point-min))
'(("\\(\\s-\\)\"" "«~")
("\\(\\S-\\)\"" "")
("\\(\\s-\\)'" "`"))
'(("\\(\\s-\\|[[(]\\)\"" "``")
("\\(\\S-\\)\"" "''")
("\\(\\s-\\|(\\)'" "`")))))
(mapc (lambda(l) (goto-char (point-min))
(while (re-search-forward (car l) nil t) (while (re-search-forward (car l) nil t)
(let ((rpl (concat (match-string 1) (let ((rpl (concat (match-string 1)
(org-export-latex-protect-string (org-export-latex-protect-string
(copy-sequence (cadr l)))))) (copy-sequence (cdr l))))))
(org-if-unprotected-1 (org-if-unprotected-1
(replace-match rpl t t))))) quote-rpl))) (replace-match rpl t t)))))
(cdr (or (assoc (plist-get org-export-latex-options-plist :language)
org-export-latex-quotes)
;; falls back on english
(assoc "en" org-export-latex-quotes)))))
(defun org-export-latex-special-chars (sub-superscript) (defun org-export-latex-special-chars (sub-superscript)
"Export special characters to LaTeX. "Export special characters to LaTeX.
@ -1543,7 +1676,8 @@ See the `org-export-latex.el' code for a complete conversion table."
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward c nil t) (while (re-search-forward c nil t)
;; Put the point where to check for org-protected ;; Put the point where to check for org-protected
(unless (get-text-property (match-beginning 2) 'org-protected) (unless (or (get-text-property (match-beginning 2) 'org-protected)
(save-match-data (org-at-table.el-p)))
(cond ((member (match-string 2) '("\\$" "$")) (cond ((member (match-string 2) '("\\$" "$"))
(if (equal (match-string 2) "\\$") (if (equal (match-string 2) "\\$")
nil nil
@ -1602,13 +1736,7 @@ See the `org-export-latex.el' code for a complete conversion table."
"\\(\\(\\\\?\\$\\)\\)" "\\(\\(\\\\?\\$\\)\\)"
"\\([a-zA-Z0-9()]+\\|[ \t\n]\\|\\b\\|\\\\\\)\\(_\\|\\^\\)\\({[^{}]+}\\|[a-zA-Z0-9]+\\|[ \t\n]\\|[:punct:]\\|)\\|{[a-zA-Z0-9]+}\\|([a-zA-Z0-9]+)\\)" "\\([a-zA-Z0-9()]+\\|[ \t\n]\\|\\b\\|\\\\\\)\\(_\\|\\^\\)\\({[^{}]+}\\|[a-zA-Z0-9]+\\|[ \t\n]\\|[:punct:]\\|)\\|{[a-zA-Z0-9]+}\\|([a-zA-Z0-9]+)\\)"
"\\(.\\|^\\)\\(\\\\\\)\\([ \t\n]\\|\\([&#%{}\"]\\|[a-zA-Z][a-zA-Z0-9]*\\)\\)" "\\(.\\|^\\)\\(\\\\\\)\\([ \t\n]\\|\\([&#%{}\"]\\|[a-zA-Z][a-zA-Z0-9]*\\)\\)"
"\\(.\\|^\\)\\(&\\)" "\\(^\\|.\\)\\([&#%{}~]\\|\\.\\.\\.\\)"
"\\(.\\|^\\)\\(#\\)"
"\\(.\\|^\\)\\(%\\)"
"\\(.\\|^\\)\\({\\)"
"\\(.\\|^\\)\\(}\\)"
"\\(.\\|^\\)\\(~\\)"
"\\(.\\|^\\)\\(\\.\\.\\.\\)"
;; (?\< . "\\textless{}") ;; (?\< . "\\textless{}")
;; (?\> . "\\textgreater{}") ;; (?\> . "\\textgreater{}")
))) )))
@ -1740,7 +1868,8 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(org-table-last-column-widths (copy-sequence (org-table-last-column-widths (copy-sequence
org-table-last-column-widths)) org-table-last-column-widths))
fnum fields line lines olines gr colgropen line-fmt align fnum fields line lines olines gr colgropen line-fmt align
caption shortn label attr floatp placement longtblp) caption width shortn label attr floatp placement
longtblp tblenv tabular-env)
(if org-export-latex-tables-verbatim (if org-export-latex-tables-verbatim
(let* ((tbl (concat "\\begin{verbatim}\n" raw-table (let* ((tbl (concat "\\begin{verbatim}\n" raw-table
"\\end{verbatim}\n"))) "\\end{verbatim}\n")))
@ -1757,15 +1886,28 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
'org-label raw-table) 'org-label raw-table)
longtblp (and attr (stringp attr) longtblp (and attr (stringp attr)
(string-match "\\<longtable\\>" attr)) (string-match "\\<longtable\\>" attr))
tblenv (if (and attr (stringp attr)
(or (string-match (regexp-quote "table*") attr)
(string-match "\\<multicolumn\\>" attr)))
"table*" "table")
tabular-env
(if (and attr (stringp attr)
(string-match "\\(tabular.\\)" attr))
(match-string 1 attr)
org-export-latex-tabular-environment)
width (and attr (stringp attr)
(string-match "\\<width=\\([^ \t\n\r]+\\)" attr)
(match-string 1 attr))
align (and attr (stringp attr) align (and attr (stringp attr)
(string-match "\\<align=\\([^ \t\n\r]+\\)" attr) (string-match "\\<align=\\([^ \t\n\r]+\\)" attr)
(match-string 1 attr)) (match-string 1 attr))
floatp (or caption label) floatp (or caption label (string= "table*" tblenv))
placement (if (and attr placement (if (and attr
(stringp attr) (stringp attr)
(string-match "[ \t]*\\<placement=\\(\\S-+\\)" attr)) (string-match "[ \t]*\\<placement=\\(\\S-+\\)" attr))
(match-string 1 attr) (match-string 1 attr)
"[htb]")) (concat
"[" org-latex-default-figure-position "]")))
(setq caption (and caption (org-export-latex-fontify-headline caption))) (setq caption (and caption (org-export-latex-fontify-headline caption)))
(setq lines (org-split-string raw-table "\n")) (setq lines (org-split-string raw-table "\n"))
(apply 'delete-region (list beg end)) (apply 'delete-region (list beg end))
@ -1813,14 +1955,17 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(mapcar (mapcar
(lambda(elem) (lambda(elem)
(or (and (string-match "[ \t]*|-+" elem) 'hline) (or (and (string-match "[ \t]*|-+" elem) 'hline)
(org-split-string (org-trim elem) "|"))) (org-split-string
(progn (set-text-properties 0 (length elem) nil elem)
(org-trim elem)) "|")))
lines)) lines))
(when insert (when insert
(insert (org-export-latex-protect-string (insert (org-export-latex-protect-string
(concat (concat
(if longtblp (if longtblp
(concat "\\begin{longtable}{" align "}\n") (concat "\\begin{longtable}{" align "}\n")
(if floatp (format "\\begin{table}%s\n" placement))) (if floatp
(format "\\begin{%s}%s\n" tblenv placement)))
(if floatp (if floatp
(format (format
"\\caption%s{%s} %s" "\\caption%s{%s} %s"
@ -1831,8 +1976,10 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(if (and org-export-latex-tables-centered (not longtblp)) (if (and org-export-latex-tables-centered (not longtblp))
"\\begin{center}\n") "\\begin{center}\n")
(if (not longtblp) (if (not longtblp)
(format "\\begin{%s}{%s}\n" (format "\\begin{%s}%s{%s}\n"
org-export-latex-tabular-environment align)) tabular-env
(if width (format "{%s}" width) "")
align))
(orgtbl-to-latex (orgtbl-to-latex
lines lines
`(:tstart nil :tend nil `(:tstart nil :tend nil
@ -1844,14 +1991,12 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
\\endfoot \\endfoot
\\endlastfoot" (length org-table-last-alignment)) \\endlastfoot" (length org-table-last-alignment))
nil))) nil)))
(if (not longtblp) (if (not longtblp) (format "\n\\end{%s}" tabular-env))
(format "\n\\end{%s}"
org-export-latex-tabular-environment))
(if longtblp "\n" (if org-export-latex-tables-centered (if longtblp "\n" (if org-export-latex-tables-centered
"\n\\end{center}\n" "\n")) "\n\\end{center}\n" "\n"))
(if longtblp (if longtblp
"\\end{longtable}" "\\end{longtable}"
(if floatp "\\end{table}")))) (if floatp (format "\\end{%s}" tblenv)))))
"\n\n")))))))) "\n\n"))))))))
(defun org-export-latex-convert-table.el-table () (defun org-export-latex-convert-table.el-table ()
@ -1898,7 +2043,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(setq tbl (concat "\\begin{center}\n" tbl "\\end{center}"))) (setq tbl (concat "\\begin{center}\n" tbl "\\end{center}")))
(when floatp (when floatp
(setq tbl (concat "\\begin{table}\n" (setq tbl (concat "\\begin{table}\n"
(format "\\caption%s{%s}%s\n" (format "\\caption%s{%s%s}\n"
(if shortn (format "[%s]" shortn) "") (if shortn (format "[%s]" shortn) "")
(if label (format "\\label{%s}" label) "") (if label (format "\\label{%s}" label) "")
(or caption "")) (or caption ""))
@ -1950,12 +2095,11 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(replace-match rpl t t))) (replace-match rpl t t)))
(backward-char))) (backward-char)))
(defvar org-export-latex-use-verb nil)
(defun org-export-latex-emph-format (format string) (defun org-export-latex-emph-format (format string)
"Format an emphasis string and handle the \\verb special case." "Format an emphasis string and handle the \\verb special case."
(when (equal format "\\verb") (when (member format '("\\verb" "\\protectedtexttt"))
(save-match-data (save-match-data
(if org-export-latex-use-verb (if (equal format "\\verb")
(let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}")) (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}"))
(catch 'exit (catch 'exit
(loop for i from 0 to (1- (length ll)) do (loop for i from 0 to (1- (length ll)) do
@ -1978,7 +2122,9 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(setq string (substring string (1+ (match-beginning 0)))) (setq string (substring string (1+ (match-beginning 0))))
(setq char (or (cdr (assoc char trans)) (concat "\\" char)) (setq char (or (cdr (assoc char trans)) (concat "\\" char))
rtn (concat rtn char))) rtn (concat rtn char)))
(setq string (concat rtn string) format "\\texttt{%s}"))))) (setq string (concat rtn string) format "\\texttt{%s}")
(while (string-match "--" string)
(setq string (replace-match "-{}-" t t string)))))))
(format format string)) (format format string))
(defun org-export-latex-links () (defun org-export-latex-links ()
@ -2057,7 +2203,10 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
;; a LaTeX issue, but we here implement a work-around anyway. ;; a LaTeX issue, but we here implement a work-around anyway.
(setq path (org-export-latex-protect-amp path) (setq path (org-export-latex-protect-amp path)
desc (org-export-latex-protect-amp desc))) desc (org-export-latex-protect-amp desc)))
(insert (format org-export-latex-href-format path desc))) (insert
(if (string-match "%s.*%s" org-export-latex-href-format)
(format org-export-latex-href-format path desc)
(format org-export-latex-href-format path))))
((functionp (setq fnc (nth 2 (assoc type org-link-protocols)))) ((functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
;; The link protocol has a function for formatting the link ;; The link protocol has a function for formatting the link
@ -2084,7 +2233,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(setq placement (setq placement
(cond (cond
(wrapp "{l}{0.5\\textwidth}") (wrapp "{l}{0.5\\textwidth}")
(floatp "[htb]") (floatp (concat "[" org-latex-default-figure-position "]"))
(t ""))) (t "")))
(when (and attr (stringp attr) (when (and attr (stringp attr)
@ -2106,12 +2255,12 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(multicolumnp "\\begin{figure*}%placement (multicolumnp "\\begin{figure*}%placement
\\centering \\centering
\\includegraphics[%attr]{%path} \\includegraphics[%attr]{%path}
\\caption{%labelcmd%caption} \\caption%shortn{%labelcmd%caption}
\\end{figure*}") \\end{figure*}")
(floatp "\\begin{figure}%placement (floatp "\\begin{figure}%placement
\\centering \\centering
\\includegraphics[%attr]{%path} \\includegraphics[%attr]{%path}
\\caption{%labelcmd%caption} \\caption%shortn{%labelcmd%caption}
\\end{figure}") \\end{figure}")
(t "\\includegraphics[%attr]{%path}"))) (t "\\includegraphics[%attr]{%path}")))
@ -2154,6 +2303,68 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(defun org-export-latex-preprocess (parameters) (defun org-export-latex-preprocess (parameters)
"Clean stuff in the LaTeX export." "Clean stuff in the LaTeX export."
;; Replace footnotes.
(when (plist-get parameters :footnotes)
(goto-char (point-min))
(let (ref)
(while (setq ref (org-footnote-get-next-reference))
(let* ((beg (nth 1 ref))
(lbl (car ref))
(def (nth 1 (assoc (string-to-number lbl)
(mapcar (lambda (e) (cdr e))
org-export-footnotes-seen)))))
;; Fix body for footnotes ending on a link or a list and
;; remove definition from buffer.
(setq def
(concat def
(if (string-match "ORG-LIST-END-MARKER\\'" def)
"\n" " ")))
(org-footnote-delete-definitions lbl)
;; Compute string to insert (FNOTE), and protect the outside
;; macro from further transformation. When footnote at
;; point is referring to a previously defined footnote, use
;; \footnotemark. Otherwise, use \footnote.
(let ((fnote (if (member lbl org-export-latex-footmark-seen)
(org-export-latex-protect-string
(format "\\footnotemark[%s]" lbl))
(push lbl org-export-latex-footmark-seen)
(concat (org-export-latex-protect-string "\\footnote{")
def
(org-export-latex-protect-string "}"))))
;; Check if another footnote is immediately following.
;; If so, add a separator in-between.
(sep (org-export-latex-protect-string
(if (save-excursion (goto-char (1- (nth 2 ref)))
(let ((next (org-footnote-get-next-reference)))
(and next (= (nth 1 next) (nth 2 ref)))))
org-export-latex-footnote-separator ""))))
(when (org-on-heading-p)
(setq fnote (concat (org-export-latex-protect-string "\\protect")
fnote)))
;; Ensure a footnote at column 0 cannot end a list
;; containing it.
(put-text-property 0 (length fnote) 'original-indentation 1000 fnote)
;; Replace footnote reference with FNOTE and, maybe, SEP.
;; `save-excursion' is required if there are two footnotes
;; in a row. In that case, point would be left at the
;; beginning of the second one, and
;; `org-footnote-get-next-reference' would then skip it.
(goto-char beg)
(delete-region beg (nth 2 ref))
(save-excursion (insert fnote sep)))))))
;; Remove footnote section tag for LaTeX
(goto-char (point-min))
(while (re-search-forward
(concat "^" footnote-section-tag-regexp) nil t)
(org-if-unprotected
(replace-match "")))
;; Remove any left-over footnote definition.
(mapc (lambda (fn) (org-footnote-delete-definitions (car fn)))
org-export-footnotes-data)
(mapc (lambda (fn) (org-footnote-delete-definitions fn))
org-export-latex-footmark-seen)
;; Preserve line breaks ;; Preserve line breaks
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward "\\\\\\\\" nil t) (while (re-search-forward "\\\\\\\\" nil t)
@ -2175,7 +2386,6 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(goto-char (point-at-eol)))))) (goto-char (point-at-eol))))))
;; Preserve math snippets ;; Preserve math snippets
(let* ((matchers (plist-get org-format-latex-options :matchers)) (let* ((matchers (plist-get org-format-latex-options :matchers))
(re-list org-latex-regexps) (re-list org-latex-regexps)
beg end re e m n block off) beg end re e m n block off)
@ -2229,6 +2439,18 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(and (looking-at "[ \t]*ORG-VERSE-END.*") (and (looking-at "[ \t]*ORG-VERSE-END.*")
(org-replace-match-keep-properties "\\end{verse}" t t))) (org-replace-match-keep-properties "\\end{verse}" t t)))
;; Convert #+INDEX to LaTeX \\index.
(goto-char (point-min))
(let ((case-fold-search t) entry)
(while (re-search-forward
"^[ \t]*#\\+index:[ \t]*\\([^ \t\r\n].*?\\)[ \t]*$"
nil t)
(setq entry
(save-match-data
(org-export-latex-protect-string
(org-export-latex-fontify-headline (match-string 1)))))
(replace-match (format "\\index{%s}" entry) t t)))
;; Convert center ;; Convert center
(goto-char (point-min)) (goto-char (point-min))
(while (search-forward "ORG-CENTER-START" nil t) (while (search-forward "ORG-CENTER-START" nil t)
@ -2241,26 +2463,31 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
;; Convert horizontal rules ;; Convert horizontal rules
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward "^----+.$" nil t) (while (re-search-forward "^[ \t]*-\\{5,\\}[ \t]*$" nil t)
(org-if-unprotected (org-if-unprotected
(replace-match (org-export-latex-protect-string "\\hrule") t t))) (replace-match (org-export-latex-protect-string "\\hrule") t t)))
;; Protect LaTeX commands like \command[...]{...} or \command{...} ;; Protect LaTeX commands like \command[...]{...} or \command{...}
(goto-char (point-min)) (goto-char (point-min))
(let ((re (concat (let ((re (concat
"\\\\\\([a-zA-Z]+\\)" "\\\\\\([a-zA-Z]+\\*?\\)"
"\\(?:<[^<>\n]*>\\)*" "\\(?:<[^<>\n]*>\\)*"
"\\(?:\\[[^][\n]*?\\]\\)*" "\\(?:\\[[^][\n]*?\\]\\)*"
"\\(?:<[^<>\n]*>\\)*" "\\(?:<[^<>\n]*>\\)*"
"\\(" (org-create-multibrace-regexp "{" "}" 3) "\\)\\{1,3\\}"))) "\\(" (org-create-multibrace-regexp "{" "}" 3) "\\)\\{1,3\\}")))
(while (re-search-forward re nil t) (while (re-search-forward re nil t)
(unless (or (unless (or
;; check for comment line ;; Check for comment line.
(save-excursion (goto-char (match-beginning 0)) (save-excursion (goto-char (match-beginning 0))
(org-in-indented-comment-line)) (org-in-indented-comment-line))
;; Check if this is a defined entity, so that is may need conversion ;; Check if this is a defined entity, so that is may
;; need conversion.
(org-entity-get (match-string 1)) (org-entity-get (match-string 1))
) ;; Do not protect interior of footnotes. Those have
;; already been taken care of earlier in the function.
;; Yet, keep looking inside them for more commands.
(and (equal (match-string 1) "footnote")
(goto-char (match-end 1))))
(add-text-properties (match-beginning 0) (match-end 0) (add-text-properties (match-beginning 0) (match-end 0)
'(org-protected t))))) '(org-protected t)))))
@ -2296,55 +2523,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward "@<\\(?:[^\"\n]\\|\".*\"\\)*?>" nil t) (while (re-search-forward "@<\\(?:[^\"\n]\\|\".*\"\\)*?>" nil t)
(org-if-unprotected (org-if-unprotected
(replace-match ""))) (replace-match ""))))
;; When converting to LaTeX, replace footnotes
;; FIXME: don't protect footnotes from conversion
(when (plist-get org-export-latex-options-plist :footnotes)
(goto-char (point-min))
(while (re-search-forward "\\[\\([0-9]+\\)\\]" nil t)
(org-if-unprotected
(when (and (save-match-data
(save-excursion (beginning-of-line)
(looking-at "[^:|#]")))
(not (org-in-verbatim-emphasis)))
(let ((foot-beg (match-beginning 0))
(foot-end (match-end 0))
(foot-prefix (match-string 0))
footnote footnote-rpl)
(save-excursion
(if (not (re-search-forward (concat "^" (regexp-quote foot-prefix))
nil t))
(replace-match (org-export-latex-protect-string
(concat "$^{" (match-string 1) "}$")))
(replace-match "")
(let ((end (save-excursion
(if (re-search-forward "^$\\|^#.*$\\|\\[[0-9]+\\]" nil t)
(match-beginning 0) (point-max)))))
(setq footnote (concat (org-trim (buffer-substring (point) end))
" ")) ; prevent last } being part of a link
(delete-region (point) end))
(goto-char foot-beg)
(delete-region foot-beg foot-end)
(unless (null footnote)
(setq footnote-rpl (format "\\footnote{%s}" footnote))
(add-text-properties 0 10 '(org-protected t) footnote-rpl)
(add-text-properties (1- (length footnote-rpl))
(length footnote-rpl)
'(org-protected t) footnote-rpl)
(if (org-on-heading-p)
(setq footnote-rpl
(concat (org-export-latex-protect-string "\\protect")
footnote-rpl)))
(insert footnote-rpl)))
)))))
;; Remove footnote section tag for LaTeX
(goto-char (point-min))
(while (re-search-forward
(concat "^" footnote-section-tag-regexp) nil t)
(org-if-unprotected
(replace-match "")))))
(defun org-export-latex-fix-inputenc () (defun org-export-latex-fix-inputenc ()
"Set the coding system in inputenc to what the buffer is." "Set the coding system in inputenc to what the buffer is."
@ -2368,22 +2547,38 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(defun org-export-latex-lists () (defun org-export-latex-lists ()
"Convert plain text lists in current buffer into LaTeX lists." "Convert plain text lists in current buffer into LaTeX lists."
;; `org-list-end-re' output has changed since preprocess from
;; org-exp.el. Make sure it is taken into account.
(let ((org-list-ending-method
(if (eq org-list-ending-method 'regexp) 'regexp 'both))
(org-list-end-re "^ORG-LIST-END-MARKER\n"))
(mapc
(lambda (e)
;; For each type of context allowed for list export (E), find
;; every list, parse it, delete it and insert resulting
;; conversion to latex (RES), while keeping the same
;; `original-indentation' property.
(let (res) (let (res)
(goto-char (point-min)) (goto-char (point-min))
(while (org-search-forward-unenclosed org-item-beginning-re nil t) (while (re-search-forward (org-item-beginning-re) nil t)
(when (and (eq (get-text-property (point) 'list-context) e)
(not (get-text-property (point) 'org-example)))
(beginning-of-line) (beginning-of-line)
(setq res (org-list-to-latex (org-list-parse-list t) (setq res
(org-list-to-latex
;; Narrowing is needed because we're converting
;; from inner functions to outer ones.
(save-restriction
(narrow-to-region (point) (point-max))
(org-list-parse-list t))
org-export-latex-list-parameters)) org-export-latex-list-parameters))
(while (string-match "^\\(\\\\item[ \t]+\\)\\[@\\(?:start:\\)?\\([0-9]+\\)\\]" ;; Extend previous value of original-indentation to the
res) ;; whole string
(setq res (replace-match (insert (org-add-props res nil 'original-indentation
(concat (format "\\setcounter{enumi}{%d}" (org-find-text-property-in-string
(1- (string-to-number 'original-indentation res)))))))
(match-string 2 res)))) ;; List of allowed contexts for export, and the default one.
"\n" (append org-list-export-context '(nil)))))
(match-string 1 res))
t t res)))
(insert res))))
(defconst org-latex-entities (defconst org-latex-entities
'("\\!" '("\\!"
@ -2402,6 +2597,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
"\\Styles" "\\Styles"
"\\\\" "\\\\"
"\\`" "\\`"
"\\\""
"\\addcontentsline" "\\addcontentsline"
"\\address" "\\address"
"\\addtocontents" "\\addtocontents"
@ -2573,5 +2769,6 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(provide 'org-export-latex) (provide 'org-export-latex)
(provide 'org-latex) (provide 'org-latex)
;; arch-tag: 23c2b87d-da04-4c2d-ad2d-1eb6487bc3ad
;;; org-latex.el ends here ;;; org-latex.el ends here

File diff suppressed because it is too large Load diff

View file

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

View file

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

View file

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

View file

@ -1,11 +1,12 @@
;;; org-mhe.el --- Support for links to MH-E messages from within Org-mode ;;; org-mhe.el --- Support for links to MH-E messages from within Org-mode
;; Copyright (C) 2004-2011 Free Software Foundation, Inc. ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: Thomas Baumann <thomas dot baumann at ch dot tum dot de> ;; Author: Thomas Baumann <thomas dot baumann at ch dot tum dot de>
;; Keywords: outlines, hypermedia, calendar, wp ;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org ;; Homepage: http://orgmode.org
;; Version: 7.4 ;; Version: 7.7
;; ;;
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
;; ;;
@ -82,6 +83,7 @@ supported by MH-E."
"Store a link to an MH-E folder or message." "Store a link to an MH-E folder or message."
(when (or (equal major-mode 'mh-folder-mode) (when (or (equal major-mode 'mh-folder-mode)
(equal major-mode 'mh-show-mode)) (equal major-mode 'mh-show-mode))
(save-window-excursion
(let* ((from (org-mhe-get-header "From:")) (let* ((from (org-mhe-get-header "From:"))
(to (org-mhe-get-header "To:")) (to (org-mhe-get-header "To:"))
(message-id (org-mhe-get-header "Message-Id:")) (message-id (org-mhe-get-header "Message-Id:"))
@ -102,7 +104,7 @@ supported by MH-E."
(setq link (org-make-link "mhe:" (org-mhe-get-message-real-folder) "#" (setq link (org-make-link "mhe:" (org-mhe-get-message-real-folder) "#"
(org-remove-angle-brackets message-id))) (org-remove-angle-brackets message-id)))
(org-add-link-props :link link :description desc) (org-add-link-props :link link :description desc)
link))) link))))
(defun org-mhe-open (path) (defun org-mhe-open (path)
"Follow an MH-E message link specified by PATH." "Follow an MH-E message link specified by PATH."
@ -224,5 +226,6 @@ folders."
(provide 'org-mhe) (provide 'org-mhe)
;; arch-tag: dcb05484-8627-491d-a8c1-01dbd2bde4ae
;;; org-mhe.el ends here ;;; org-mhe.el ends here

View file

@ -1,11 +1,11 @@
;;; org-mks.el --- Multi-key-selection for Org-mode ;;; org-mks.el --- Multi-key-selection for Org-mode
;; Copyright (C) 2010-2011 Free Software Foundation, Inc. ;; Copyright (C) 2010 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp ;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org ;; Homepage: http://orgmode.org
;; Version: 7.4 ;; Version: 7.7
;; ;;
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
;; ;;
@ -132,5 +132,6 @@ only the bare key is returned."
(provide 'org-mks) (provide 'org-mks)
;; arch-tag: 4ea90d0e-c6e4-4684-bd61-baf878712f9f
;;; org-mks.el ends here ;;; org-mks.el ends here

View file

@ -1,10 +1,10 @@
;;; org-mobile.el --- Code for asymmetric sync with a mobile device ;;; org-mobile.el --- Code for asymmetric sync with a mobile device
;; Copyright (C) 2009-2011 Free Software Foundation, Inc. ;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; ;;
;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp ;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org ;; Homepage: http://orgmode.org
;; Version: 7.4 ;; Version: 7.7
;; ;;
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
;; ;;
@ -38,6 +38,9 @@
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl))
(declare-function org-pop-to-buffer-same-window
"org-compat" (&optional buffer-or-name norecord label))
(defgroup org-mobile nil (defgroup org-mobile nil
"Options concerning support for a viewer/editor on a mobile device." "Options concerning support for a viewer/editor on a mobile device."
:tag "Org Mobile" :tag "Org Mobile"
@ -63,6 +66,11 @@ org-agenda-text-search-extra-files
(repeat :inline t :tag "Additional files" (repeat :inline t :tag "Additional files"
(file)))) (file))))
(defcustom org-mobile-files-exclude-regexp ""
"A regexp to exclude files from `org-mobile-files'."
:group 'org-mobile
:type 'regexp)
(defcustom org-mobile-directory "" (defcustom org-mobile-directory ""
"The WebDAV directory where the interaction with the mobile takes place." "The WebDAV directory where the interaction with the mobile takes place."
:group 'org-mobile :group 'org-mobile
@ -128,7 +136,7 @@ been appended to the file given here. This file should be in
This should not be changed, because MobileOrg assumes this name.") This should not be changed, because MobileOrg assumes this name.")
(defcustom org-mobile-index-file "index.org" (defcustom org-mobile-index-file "index.org"
"The index file with inks to all Org files that should be loaded by MobileOrg. "The index file with links to all Org files that should be loaded by MobileOrg.
Relative to `org-mobile-directory'. The Address field in the MobileOrg setup Relative to `org-mobile-directory'. The Address field in the MobileOrg setup
should point to this file." should point to this file."
:group 'org-mobile :group 'org-mobile
@ -241,7 +249,8 @@ using `rsync' or `scp'.")
(setq org-mobile-checksum-files nil)) (setq org-mobile-checksum-files nil))
(defun org-mobile-files-alist () (defun org-mobile-files-alist ()
"Expand the list in `org-mobile-files' to a list of existing files." "Expand the list in `org-mobile-files' to a list of existing files.
Also exclude files matching `org-mobile-files-exclude-regexp'."
(let* ((include-archives (let* ((include-archives
(and (member 'org-agenda-text-search-extra-files org-mobile-files) (and (member 'org-agenda-text-search-extra-files org-mobile-files)
(member 'agenda-archives org-agenda-text-search-extra-files) (member 'agenda-archives org-agenda-text-search-extra-files)
@ -263,6 +272,13 @@ using `rsync' or `scp'.")
(list f)) (list f))
(t nil))) (t nil)))
org-mobile-files))) org-mobile-files)))
(files (delete
nil
(mapcar (lambda (f)
(unless (and (not (string= org-mobile-files-exclude-regexp ""))
(string-match org-mobile-files-exclude-regexp f))
(identity f)))
files)))
(orgdir-uname (file-name-as-directory (file-truename org-directory))) (orgdir-uname (file-name-as-directory (file-truename org-directory)))
(orgdir-re (concat "\\`" (regexp-quote orgdir-uname))) (orgdir-re (concat "\\`" (regexp-quote orgdir-uname)))
uname seen rtn file link-name) uname seen rtn file link-name)
@ -292,9 +308,9 @@ create all custom agenda views, for upload to the mobile phone."
(org-agenda-redo-command org-agenda-redo-command)) (org-agenda-redo-command org-agenda-redo-command))
(save-excursion (save-excursion
(save-window-excursion (save-window-excursion
(run-hooks 'org-mobile-pre-push-hook)
(org-mobile-check-setup) (org-mobile-check-setup)
(org-mobile-prepare-file-lists) (org-mobile-prepare-file-lists)
(run-hooks 'org-mobile-pre-push-hook)
(message "Creating agendas...") (message "Creating agendas...")
(let ((inhibit-redisplay t)) (org-mobile-create-sumo-agenda)) (let ((inhibit-redisplay t)) (org-mobile-create-sumo-agenda))
(message "Creating agendas...done") (message "Creating agendas...done")
@ -562,8 +578,9 @@ The table of checksums is written to the file mobile-checksums."
" " match "</after>")) " " match "</after>"))
settings)) settings))
(push (list type match settings) new)) (push (list type match settings) new))
((symbolp (nth 2 e)) ((or (functionp (nth 2 e)) (symbolp (nth 2 e)))
;; A user-defined function, not sure how to handle that yet ;; A user-defined function, which can do anything, so simply
;; ignore it.
) )
(t (t
;; a block agenda ;; a block agenda
@ -617,12 +634,12 @@ The table of checksums is written to the file mobile-checksums."
(get-text-property (point) 'org-marker))) (get-text-property (point) 'org-marker)))
(setq sexp (member (get-text-property (point) 'type) (setq sexp (member (get-text-property (point) 'type)
'("diary" "sexp"))) '("diary" "sexp")))
(if (setq pl (get-text-property (point) 'prefix-length)) (if (setq pl (text-property-any (point) (point-at-eol) 'org-heading t))
(progn (progn
(setq prefix (org-trim (buffer-substring (setq prefix (org-trim (buffer-substring
(point) (+ (point) pl))) (point) pl))
line (org-trim (buffer-substring line (org-trim (buffer-substring
(+ (point) pl) pl
(point-at-eol)))) (point-at-eol))))
(delete-region (point-at-bol) (point-at-eol)) (delete-region (point-at-bol) (point-at-eol))
(insert line "<before>" prefix "</before>") (insert line "<before>" prefix "</before>")
@ -660,7 +677,7 @@ The table of checksums is written to the file mobile-checksums."
(org-mobile-escape-olp (nth 4 (org-heading-components)))))) (org-mobile-escape-olp (nth 4 (org-heading-components))))))
(defun org-mobile-escape-olp (s) (defun org-mobile-escape-olp (s)
(let ((table '((?: . "%3a") (?\[ . "%5b") (?\] . "%5d") (?/ . "%2f")))) (let ((table '(?: ?/)))
(org-link-escape s table))) (org-link-escape s table)))
;;;###autoload ;;;###autoload
@ -895,7 +912,7 @@ If BEG and END are given, only do this in that region."
(buffer-file-name (current-buffer)))))) (buffer-file-name (current-buffer))))))
(error (setq org-mobile-error msg)))) (error (setq org-mobile-error msg))))
(when org-mobile-error (when org-mobile-error
(switch-to-buffer (marker-buffer marker)) (org-pop-to-buffer-same-window (marker-buffer marker))
(goto-char marker) (goto-char marker)
(incf cnt-error) (incf cnt-error)
(insert (if (stringp (nth 1 org-mobile-error)) (insert (if (stringp (nth 1 org-mobile-error))
@ -969,11 +986,10 @@ is currently a noop.")
(if (not (string-match "\\`olp:\\(.*?\\):\\(.*\\)$" link)) (if (not (string-match "\\`olp:\\(.*?\\):\\(.*\\)$" link))
nil nil
(let ((file (match-string 1 link)) (let ((file (match-string 1 link))
(path (match-string 2 link)) (path (match-string 2 link)))
(table '((?: . "%3a") (?\[ . "%5b") (?\] . "%5d") (?/ . "%2f")))) (setq file (org-link-unescape file))
(setq file (org-link-unescape file table))
(setq file (expand-file-name file org-directory)) (setq file (expand-file-name file org-directory))
(setq path (mapcar (lambda (x) (org-link-unescape x table)) (setq path (mapcar 'org-link-unescape
(org-split-string path "/"))) (org-split-string path "/")))
(org-find-olp (cons file path)))))) (org-find-olp (cons file path))))))
@ -1083,6 +1099,7 @@ A and B must be strings or nil."
(provide 'org-mobile) (provide 'org-mobile)
;; arch-tag: ace0e26c-58f2-4309-8a61-05ec1535f658
;;; org-mobile.el ends here ;;; org-mobile.el ends here

View file

@ -1,10 +1,10 @@
;;; org-mouse.el --- Better mouse support for org-mode ;;; org-mouse.el --- Better mouse support for org-mode
;; Copyright (C) 2006-2011 Free Software Foundation ;; Copyright (C) 2006, 2007, 2008, 2009, 2010 Free Software Foundation
;; ;;
;; Author: Piotr Zielinski <piotr dot zielinski at gmail dot com> ;; Author: Piotr Zielinski <piotr dot zielinski at gmail dot com>
;; Maintainer: Carsten Dominik <carsten at orgmode dot org> ;; Maintainer: Carsten Dominik <carsten at orgmode dot org>
;; Version: 7.4 ;; Version: 7.7
;; ;;
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
;; ;;
@ -149,6 +149,8 @@
(newhead hdmarker &optional fixface just-this)) (newhead hdmarker &optional fixface just-this))
(declare-function org-verify-change-for-undo "org-agenda" (l1 l2)) (declare-function org-verify-change-for-undo "org-agenda" (l1 l2))
(declare-function org-apply-on-list "org-list" (function init-value &rest args)) (declare-function org-apply-on-list "org-list" (function init-value &rest args))
(declare-function org-agenda-earlier "org-agenda" (arg))
(declare-function org-agenda-later "org-agenda" (arg))
(defvar org-mouse-plain-list-regexp "\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) " (defvar org-mouse-plain-list-regexp "\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) "
"Regular expression that matches a plain list.") "Regular expression that matches a plain list.")
@ -476,11 +478,11 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
(defun org-mouse-agenda-type (type) (defun org-mouse-agenda-type (type)
(case type (case type
(tags "Tags: ") ('tags "Tags: ")
(todo "TODO: ") ('todo "TODO: ")
(tags-tree "Tags tree: ") ('tags-tree "Tags tree: ")
(todo-tree "TODO tree: ") ('todo-tree "TODO tree: ")
(occur-tree "Occur tree: ") ('occur-tree "Occur tree: ")
(t "Agenda command ???"))) (t "Agenda command ???")))
@ -526,7 +528,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
("Check Tags" ("Check Tags"
,@(org-mouse-keyword-menu ,@(org-mouse-keyword-menu
(sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp) (sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp)
(lambda (tag) (org-tags-sparse-tree nil tag))) #'(lambda (tag) (org-tags-sparse-tree nil tag)))
"--" "--"
["Custom Tag ..." org-tags-sparse-tree t]) ["Custom Tag ..." org-tags-sparse-tree t])
["Check Phrase ..." org-occur] ["Check Phrase ..." org-occur]
@ -537,18 +539,18 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
("Display Tags" ("Display Tags"
,@(org-mouse-keyword-menu ,@(org-mouse-keyword-menu
(sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp) (sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp)
(lambda (tag) (org-tags-view nil tag))) #'(lambda (tag) (org-tags-view nil tag)))
"--" "--"
["Custom Tag ..." org-tags-view t]) ["Custom Tag ..." org-tags-view t])
["Display Calendar" org-goto-calendar t] ["Display Calendar" org-goto-calendar t]
"--" "--"
,@(org-mouse-keyword-menu ,@(org-mouse-keyword-menu
(mapcar 'car org-agenda-custom-commands) (mapcar 'car org-agenda-custom-commands)
(lambda (key) #'(lambda (key)
(eval `(flet ((read-char-exclusive () (string-to-char ,key))) (eval `(flet ((read-char-exclusive () (string-to-char ,key)))
(org-agenda nil)))) (org-agenda nil))))
nil nil
(lambda (key) #'(lambda (key)
(let ((entry (assoc key org-agenda-custom-commands))) (let ((entry (assoc key org-agenda-custom-commands)))
(org-mouse-clip-text (org-mouse-clip-text
(cond (cond
@ -580,8 +582,8 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
(defun org-mouse-for-each-item (funct) (defun org-mouse-for-each-item (funct)
;; Functions called by `org-apply-on-list' need an argument ;; Functions called by `org-apply-on-list' need an argument
(let ((wrap-fun (lambda (c) (funcall funct)))) (let ((wrap-fun (lambda (c) (funcall funct))))
(when (org-in-item-p) (when (ignore-errors (goto-char (org-in-item-p)))
(org-apply-on-list wrap-fun nil)))) (save-excursion (org-apply-on-list wrap-fun nil)))))
(defun org-mouse-bolp () (defun org-mouse-bolp ()
"Return true if there only spaces, tabs, and '*' before point. "Return true if there only spaces, tabs, and '*' before point.
@ -614,12 +616,12 @@ This means, between the beginning of line and the point."
(beginning-of-line)) (beginning-of-line))
(defadvice dnd-insert-text (around org-mouse-dnd-insert-text activate) (defadvice dnd-insert-text (around org-mouse-dnd-insert-text activate)
(if (eq major-mode 'org-mode) (if (org-mode-p)
(org-mouse-insert-item text) (org-mouse-insert-item text)
ad-do-it)) ad-do-it))
(defadvice dnd-open-file (around org-mouse-dnd-open-file activate) (defadvice dnd-open-file (around org-mouse-dnd-open-file activate)
(if (eq major-mode 'org-mode) (if (org-mode-p)
(org-mouse-insert-item uri) (org-mouse-insert-item uri)
ad-do-it)) ad-do-it))
@ -633,7 +635,7 @@ This means, between the beginning of line and the point."
(defun org-mouse-match-todo-keyword () (defun org-mouse-match-todo-keyword ()
(save-excursion (save-excursion
(org-back-to-heading) (org-back-to-heading)
(if (looking-at outline-regexp) (goto-char (match-end 0))) (if (looking-at org-outline-regexp) (goto-char (match-end 0)))
(or (looking-at (concat " +" org-todo-regexp " *")) (or (looking-at (concat " +" org-todo-regexp " *"))
(looking-at " \\( *\\)")))) (looking-at " \\( *\\)"))))
@ -832,7 +834,7 @@ This means, between the beginning of line and the point."
("Tags and Priorities" ("Tags and Priorities"
,@(org-mouse-keyword-menu ,@(org-mouse-keyword-menu
(org-mouse-priority-list) (org-mouse-priority-list)
(lambda (keyword) #'(lambda (keyword)
(org-mouse-set-priority (string-to-char keyword))) (org-mouse-set-priority (string-to-char keyword)))
priority "Priority %s") priority "Priority %s")
"--" "--"
@ -905,7 +907,7 @@ This means, between the beginning of line and the point."
(mouse-drag-region event))) (mouse-drag-region event)))
(add-hook 'org-mode-hook (add-hook 'org-mode-hook
(lambda () #'(lambda ()
(setq org-mouse-context-menu-function 'org-mouse-context-menu) (setq org-mouse-context-menu-function 'org-mouse-context-menu)
(when (memq 'context-menu org-mouse-features) (when (memq 'context-menu org-mouse-features)
@ -925,7 +927,7 @@ This means, between the beginning of line and the point."
(when (memq 'activate-stars org-mouse-features) (when (memq 'activate-stars org-mouse-features)
(font-lock-add-keywords (font-lock-add-keywords
nil nil
`((,outline-regexp `((,org-outline-regexp
0 `(face org-link mouse-face highlight keymap ,org-mouse-map) 0 `(face org-link mouse-face highlight keymap ,org-mouse-map)
'prepend)) 'prepend))
t)) t))
@ -997,7 +999,7 @@ This means, between the beginning of line and the point."
(end-of-line) (end-of-line)
(if (eobp) (newline) (forward-char))) (if (eobp) (newline) (forward-char)))
(when (looking-at outline-regexp) (when (looking-at org-outline-regexp)
(let ((level (- (match-end 0) (match-beginning 0)))) (let ((level (- (match-end 0) (match-beginning 0))))
(when (> end (match-end 0)) (when (> end (match-end 0))
(outline-end-of-subtree) (outline-end-of-subtree)
@ -1017,11 +1019,11 @@ This means, between the beginning of line and the point."
(replace-text (concat (match-string 0) "* "))) (replace-text (concat (match-string 0) "* ")))
(beginning-of-line 2) (beginning-of-line 2)
(save-excursion (save-excursion
(while (not (or (eobp) (looking-at outline-regexp))) (while (not (or (eobp) (looking-at org-outline-regexp)))
(when (looking-at org-mouse-plain-list-regexp) (when (looking-at org-mouse-plain-list-regexp)
(setq minlevel (min minlevel (- (match-end 1) (match-beginning 1))))) (setq minlevel (min minlevel (- (match-end 1) (match-beginning 1)))))
(forward-line))) (forward-line)))
(while (not (or (eobp) (looking-at outline-regexp))) (while (not (or (eobp) (looking-at org-outline-regexp)))
(when (and (looking-at org-mouse-plain-list-regexp) (when (and (looking-at org-mouse-plain-list-regexp)
(eq minlevel (- (match-end 1) (match-beginning 1)))) (eq minlevel (- (match-end 1) (match-beginning 1))))
(replace-match replace-text)) (replace-match replace-text))
@ -1128,20 +1130,22 @@ This means, between the beginning of line and the point."
; (setq org-agenda-mode-hook nil) ; (setq org-agenda-mode-hook nil)
(defvar org-agenda-mode-map)
(add-hook 'org-agenda-mode-hook (add-hook 'org-agenda-mode-hook
(lambda () #'(lambda ()
(setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu) (setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu)
(org-defkey org-agenda-mode-map [mouse-3] 'org-mouse-show-context-menu) (org-defkey org-agenda-mode-map [mouse-3] 'org-mouse-show-context-menu)
(org-defkey org-agenda-mode-map [down-mouse-3] 'org-mouse-move-tree-start) (org-defkey org-agenda-mode-map [down-mouse-3] 'org-mouse-move-tree-start)
(org-defkey org-agenda-mode-map [C-mouse-4] 'org-agenda-earlier) (org-defkey org-agenda-mode-map [C-mouse-4] 'org-agenda-earlier)
(org-defkey org-agenda-mode-map [C-mouse-5] 'org-agenda-later) (org-defkey org-agenda-mode-map [C-mouse-5] 'org-agenda-later)
(org-defkey org-agenda-mode-map [drag-mouse-3] (org-defkey org-agenda-mode-map [drag-mouse-3]
(lambda (event) (interactive "e") #'(lambda (event) (interactive "e")
(case (org-mouse-get-gesture event) (case (org-mouse-get-gesture event)
(:left (org-agenda-earlier 1)) (:left (org-agenda-earlier 1))
(:right (org-agenda-later 1))))))) (:right (org-agenda-later 1)))))))
(provide 'org-mouse) (provide 'org-mouse)
;; arch-tag: ff1ae557-3529-41a3-95c6-baaebdcc280f
;;; org-mouse.el ends here ;;; org-mouse.el ends here

282
lisp/org/org-pcomplete.el Normal file
View file

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

View file

@ -1,11 +1,11 @@
;;; org-plot.el --- Support for plotting from Org-mode ;;; org-plot.el --- Support for plotting from Org-mode
;; Copyright (C) 2008-2011 Free Software Foundation, Inc. ;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc.
;; ;;
;; Author: Eric Schulte <schulte dot eric at gmail dot com> ;; Author: Eric Schulte <schulte dot eric at gmail dot com>
;; Keywords: tables, plotting ;; Keywords: tables, plotting
;; Homepage: http://orgmode.org ;; Homepage: http://orgmode.org
;; Version: 7.4 ;; Version: 7.7
;; ;;
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
;; ;;
@ -206,18 +206,18 @@ manner suitable for prepending to a user-specified script."
(y-labels (plist-get params :ylabels)) (y-labels (plist-get params :ylabels))
(plot-str "'%s' using %s%d%s with %s title '%s'") (plot-str "'%s' using %s%d%s with %s title '%s'")
(plot-cmd (case type (plot-cmd (case type
(2d "plot") ('2d "plot")
(3d "splot") ('3d "splot")
(grid "splot"))) ('grid "splot")))
(script "reset") plot-lines) (script "reset") plot-lines)
(flet ((add-to-script (line) (setf script (format "%s\n%s" script line)))) (flet ((add-to-script (line) (setf script (format "%s\n%s" script line))))
(when file ;; output file (when file ;; output file
(add-to-script (format "set term %s" (file-name-extension file))) (add-to-script (format "set term %s" (file-name-extension file)))
(add-to-script (format "set output '%s'" file))) (add-to-script (format "set output '%s'" file)))
(case type ;; type (case type ;; type
(2d ()) ('2d ())
(3d (if map (add-to-script "set map"))) ('3d (if map (add-to-script "set map")))
(grid (if map ('grid (if map
(add-to-script "set pm3d map") (add-to-script "set pm3d map")
(add-to-script "set pm3d")))) (add-to-script "set pm3d"))))
(when title (add-to-script (format "set title '%s'" title))) ;; title (when title (add-to-script (format "set title '%s'" title))) ;; title
@ -243,7 +243,7 @@ manner suitable for prepending to a user-specified script."
"%Y-%m-%d-%H:%M:%S") "\""))) "%Y-%m-%d-%H:%M:%S") "\"")))
(unless preface (unless preface
(case type ;; plot command (case type ;; plot command
(2d (dotimes (col num-cols) ('2d (dotimes (col num-cols)
(unless (and (equal type '2d) (unless (and (equal type '2d)
(or (and ind (equal (+ 1 col) ind)) (or (and ind (equal (+ 1 col) ind))
(and deps (not (member (+ 1 col) deps))))) (and deps (not (member (+ 1 col) deps)))))
@ -258,10 +258,10 @@ manner suitable for prepending to a user-specified script."
with with
(or (nth col col-labels) (format "%d" (+ 1 col)))) (or (nth col col-labels) (format "%d" (+ 1 col))))
plot-lines))))) plot-lines)))))
(3d ('3d
(setq plot-lines (list (format "'%s' matrix with %s title ''" (setq plot-lines (list (format "'%s' matrix with %s title ''"
data-file with)))) data-file with))))
(grid ('grid
(setq plot-lines (list (format "'%s' with %s title ''" (setq plot-lines (list (format "'%s' with %s title ''"
data-file with))))) data-file with)))))
(add-to-script (add-to-script
@ -305,9 +305,9 @@ line directly before or after the table."
(setf params (org-plot/collect-options params)))) (setf params (org-plot/collect-options params))))
;; dump table to datafile (very different for grid) ;; dump table to datafile (very different for grid)
(case (plist-get params :plot-type) (case (plist-get params :plot-type)
(2d (org-plot/gnuplot-to-data table data-file params)) ('2d (org-plot/gnuplot-to-data table data-file params))
(3d (org-plot/gnuplot-to-data table data-file params)) ('3d (org-plot/gnuplot-to-data table data-file params))
(grid (let ((y-labels (org-plot/gnuplot-to-grid-data ('grid (let ((y-labels (org-plot/gnuplot-to-grid-data
table data-file params))) table data-file params)))
(when y-labels (plist-put params :ylabels y-labels))))) (when y-labels (plist-put params :ylabels y-labels)))))
;; check for timestamp ind column ;; check for timestamp ind column
@ -350,4 +350,5 @@ line directly before or after the table."
(provide 'org-plot) (provide 'org-plot)
;; arch-tag: 5763f7c6-0c75-416d-b070-398ee4ec0eca
;;; org-plot.el ends here ;;; org-plot.el ends here

View file

@ -1,6 +1,7 @@
;;; org-protocol.el --- Intercept calls from emacsclient to trigger custom actions. ;;; org-protocol.el --- Intercept calls from emacsclient to trigger custom actions.
;; ;;
;; Copyright (C) 2008-2011 Free Software Foundation, Inc. ;; Copyright (C) 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; ;;
;; Author: Bastien Guerry <bzg AT altern DOT org> ;; Author: Bastien Guerry <bzg AT altern DOT org>
;; Author: Daniel M German <dmg AT uvic DOT org> ;; Author: Daniel M German <dmg AT uvic DOT org>
@ -8,7 +9,7 @@
;; Author: Ross Patterson <me AT rpatterson DOT net> ;; Author: Ross Patterson <me AT rpatterson DOT net>
;; Maintainer: Sebastian Rose <sebastian_rose AT gmx DOT de> ;; Maintainer: Sebastian Rose <sebastian_rose AT gmx DOT de>
;; Keywords: org, emacsclient, wp ;; Keywords: org, emacsclient, wp
;; Version: 7.4 ;; Version: 7.7
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
;; ;;
@ -129,6 +130,18 @@
(filename &optional up)) (filename &optional up))
(declare-function server-edit "server" (&optional arg)) (declare-function server-edit "server" (&optional arg))
(define-obsolete-function-alias
'org-protocol-unhex-compound 'org-link-unescape-compound
"2011-02-17")
(define-obsolete-function-alias
'org-protocol-unhex-string 'org-link-unescape
"2011-02-17")
(define-obsolete-function-alias
'org-protocol-unhex-single-byte-sequence
'org-link-unescape-single-byte-sequence
"2011-02-17")
(defgroup org-protocol nil (defgroup org-protocol nil
"Intercept calls from emacsclient to trigger custom actions. "Intercept calls from emacsclient to trigger custom actions.
@ -151,7 +164,6 @@ for `org-protocol-the-protocol' and sub-procols defined in
"Default protocols to use. "Default protocols to use.
See `org-protocol-protocol-alist' for a description of this variable.") See `org-protocol-protocol-alist' for a description of this variable.")
(defconst org-protocol-the-protocol "org-protocol" (defconst org-protocol-the-protocol "org-protocol"
"This is the protocol to detect if org-protocol.el is loaded. "This is the protocol to detect if org-protocol.el is loaded.
`org-protocol-protocol-alist-default' and `org-protocol-protocol-alist' hold `org-protocol-protocol-alist-default' and `org-protocol-protocol-alist' hold
@ -159,11 +171,10 @@ the sub-protocols that trigger the required action. You will have to define
just one protocol handler OS-wide (MS-Windows) or per application (Linux). just one protocol handler OS-wide (MS-Windows) or per application (Linux).
That protocol handler should call emacsclient.") That protocol handler should call emacsclient.")
;;; User variables: ;;; User variables:
(defcustom org-protocol-reverse-list-of-files t (defcustom org-protocol-reverse-list-of-files t
"* Non-nil means re-reverse the list of filenames passed on the command line. "Non-nil means re-reverse the list of filenames passed on the command line.
The filenames passed on the command line are passed to the emacs-server in The filenames passed on the command line are passed to the emacs-server in
reverse order. Set to t (default) to re-reverse the list, i.e. use the reverse order. Set to t (default) to re-reverse the list, i.e. use the
sequence on the command line. If nil, the sequence of the filenames is sequence on the command line. If nil, the sequence of the filenames is
@ -171,9 +182,8 @@ unchanged."
:group 'org-protocol :group 'org-protocol
:type 'boolean) :type 'boolean)
(defcustom org-protocol-project-alist nil (defcustom org-protocol-project-alist nil
"* Map URLs to local filenames for `org-protocol-open-source' (open-source). "Map URLs to local filenames for `org-protocol-open-source' (open-source).
Each element of this list must be of the form: Each element of this list must be of the form:
@ -216,7 +226,6 @@ Consider using the interactive functions `org-protocol-create' and
:group 'org-protocol :group 'org-protocol
:type 'alist) :type 'alist)
(defcustom org-protocol-protocol-alist nil (defcustom org-protocol-protocol-alist nil
"* Register custom handlers for org-protocol. "* Register custom handlers for org-protocol.
@ -260,7 +269,9 @@ Here is an example:
:type '(alist)) :type '(alist))
(defcustom org-protocol-default-template-key nil (defcustom org-protocol-default-template-key nil
"The default org-remember-templates key to use." "The default template key to use.
This is usually a single character string but can also be a
string with two characters."
:group 'org-protocol :group 'org-protocol
:type 'string) :type 'string)
@ -274,95 +285,27 @@ Slashes are sanitized to double slashes here."
(setq uri (concat (car splitparts) "//" (mapconcat 'identity (cdr splitparts) "/"))))) (setq uri (concat (car splitparts) "//" (mapconcat 'identity (cdr splitparts) "/")))))
uri) uri)
(defun org-protocol-split-data (data &optional unhexify separator) (defun org-protocol-split-data (data &optional unhexify separator)
"Split, what an org-protocol handler function gets as only argument. "Split what an org-protocol handler function gets as only argument.
DATA is that one argument. DATA is split at each occurrence of DATA is that one argument. DATA is split at each occurrence of
SEPARATOR (regexp). If no SEPARATOR is specified or SEPARATOR is SEPARATOR (regexp). If no SEPARATOR is specified or SEPARATOR is
nil, assume \"/+\". The results of that splitting are returned nil, assume \"/+\". The results of that splitting are returned
as a list. If UNHEXIFY is non-nil, hex-decode each split part. If as a list. If UNHEXIFY is non-nil, hex-decode each split part.
UNHEXIFY is a function, use that function to decode each split If UNHEXIFY is a function, use that function to decode each split
part." part."
(let* ((sep (or separator "/+")) (let* ((sep (or separator "/+"))
(split-parts (split-string data sep))) (split-parts (split-string data sep)))
(if unhexify (if unhexify
(if (fboundp unhexify) (if (fboundp unhexify)
(mapcar unhexify split-parts) (mapcar unhexify split-parts)
(mapcar 'org-protocol-unhex-string split-parts)) (mapcar 'org-link-unescape split-parts))
split-parts))) split-parts)))
;; This inline function is needed in org-protocol-unhex-compound to do
;; the right thing to decode UTF-8 char integer values.
(eval-when-compile
(if (>= emacs-major-version 23)
(defsubst org-protocol-char-to-string(c)
"Defsubst to decode UTF-8 character values in emacs 23 and beyond."
(char-to-string c))
(defsubst org-protocol-char-to-string (c)
"Defsubst to decode UTF-8 character values in emacs 22."
(string (decode-char 'ucs c)))))
(defun org-protocol-unhex-string(str)
"Unhex hexified unicode strings as returned from the JavaScript function
encodeURIComponent. E.g. `%C3%B6' is the german Umlaut `ü'."
(setq str (or str ""))
(let ((tmp "")
(case-fold-search t))
(while (string-match "\\(%[0-9a-f][0-9a-f]\\)+" str)
(let* ((start (match-beginning 0))
(end (match-end 0))
(hex (match-string 0 str))
(replacement (org-protocol-unhex-compound (upcase hex))))
(setq tmp (concat tmp (substring str 0 start) replacement))
(setq str (substring str end))))
(setq tmp (concat tmp str))
tmp))
(defun org-protocol-unhex-compound (hex)
"Unhexify unicode hex-chars. E.g. `%C3%B6' is the German Umlaut `ü'."
(let* ((bytes (remove "" (split-string hex "%")))
(ret "")
(eat 0)
(sum 0))
(while bytes
(let* ((b (pop bytes))
(a (elt b 0))
(b (elt b 1))
(c1 (if (> a ?9) (+ 10 (- a ?A)) (- a ?0)))
(c2 (if (> b ?9) (+ 10 (- b ?A)) (- b ?0)))
(val (+ (lsh c1 4) c2))
(shift
(if (= 0 eat) ;; new byte
(if (>= val 252) 6
(if (>= val 248) 5
(if (>= val 240) 4
(if (>= val 224) 3
(if (>= val 192) 2 0)))))
6))
(xor
(if (= 0 eat) ;; new byte
(if (>= val 252) 252
(if (>= val 248) 248
(if (>= val 240) 240
(if (>= val 224) 224
(if (>= val 192) 192 0)))))
128)))
(if (>= val 192) (setq eat shift))
(setq val (logxor val xor))
(setq sum (+ (lsh sum shift) val))
(if (> eat 0) (setq eat (- eat 1)))
(when (= 0 eat)
(setq ret (concat ret (org-protocol-char-to-string sum)))
(setq sum 0))
)) ;; end (while bytes
ret ))
(defun org-protocol-flatten-greedy (param-list &optional strip-path replacement) (defun org-protocol-flatten-greedy (param-list &optional strip-path replacement)
"Greedy handlers might receive a list like this from emacsclient: "Greedy handlers might receive a list like this from emacsclient:
'((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\") '((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\")
where \"/dir/\" is the absolute path to emacsclients working directory. This where \"/dir/\" is the absolute path to emacsclients working directory. This
function transforms it into a flat list utilizing `org-protocol-flatten' and function transforms it into a flat list using `org-protocol-flatten' and
transforms the elements of that list as follows: transforms the elements of that list as follows:
If strip-path is non-nil, remove the \"/dir/\" prefix from all members of If strip-path is non-nil, remove the \"/dir/\" prefix from all members of
@ -402,7 +345,6 @@ returned list."
ret) ret)
l))) l)))
(defun org-protocol-flatten (l) (defun org-protocol-flatten (l)
"Greedy handlers might receive a list like this from emacsclient: "Greedy handlers might receive a list like this from emacsclient:
'( (\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\") '( (\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\")
@ -413,6 +355,7 @@ This function transforms it into a flat list."
(append (org-protocol-flatten (car l)) (org-protocol-flatten (cdr l))) (append (org-protocol-flatten (car l)) (org-protocol-flatten (cdr l)))
(list l)))) (list l))))
;;; Standard protocol handlers: ;;; Standard protocol handlers:
(defun org-protocol-store-link (fname) (defun org-protocol-store-link (fname)
@ -457,9 +400,9 @@ The location for a browser's bookmark has to look like this:
See the docs for `org-protocol-capture' for more information." See the docs for `org-protocol-capture' for more information."
(if (and (boundp 'org-stored-links) (if (and (boundp 'org-stored-links)
(or (fboundp 'org-capture)) (fboundp 'org-capture)
(org-protocol-do-capture info 'org-remember)) (org-protocol-do-capture info 'org-remember))
(message "Org-mode not loaded.")) (message "Item remembered."))
nil) nil)
(defun org-protocol-capture (info) (defun org-protocol-capture (info)
@ -484,16 +427,16 @@ But you may prepend the encoded URL with a character and a slash like so:
Now template ?b will be used." Now template ?b will be used."
(if (and (boundp 'org-stored-links) (if (and (boundp 'org-stored-links)
(or (fboundp 'org-capture)) (fboundp 'org-capture)
(org-protocol-do-capture info 'org-capture)) (org-protocol-do-capture info 'org-capture))
(message "Org-mode not loaded.")) (message "Item captured."))
nil) nil)
(defun org-protocol-do-capture (info capture-func) (defun org-protocol-do-capture (info capture-func)
"Support `org-capture' and `org-remember' alike. "Support `org-capture' and `org-remember' alike.
CAPTURE-FUNC is either the symbol `org-remember' or `org-capture'." CAPTURE-FUNC is either the symbol `org-remember' or `org-capture'."
(let* ((parts (org-protocol-split-data info t)) (let* ((parts (org-protocol-split-data info t))
(template (or (and (= 1 (length (car parts))) (pop parts)) (template (or (and (>= 2 (length (car parts))) (pop parts))
org-protocol-default-template-key)) org-protocol-default-template-key))
(url (org-protocol-sanitize-uri (car parts))) (url (org-protocol-sanitize-uri (car parts)))
(type (if (string-match "^\\([a-z]+\\):" url) (type (if (string-match "^\\([a-z]+\\):" url)
@ -515,7 +458,6 @@ CAPTURE-FUNC is either the symbol `org-remember' or `org-capture'."
(raise-frame) (raise-frame)
(funcall capture-func nil template))) (funcall capture-func nil template)))
(defun org-protocol-open-source (fname) (defun org-protocol-open-source (fname)
"Process an org-protocol://open-source:// style url. "Process an org-protocol://open-source:// style url.
@ -526,11 +468,10 @@ The location for a browser's bookmark should look like this:
javascript:location.href='org-protocol://open-source://'+ \\ javascript:location.href='org-protocol://open-source://'+ \\
encodeURIComponent(location.href)" encodeURIComponent(location.href)"
;; As we enter this function for a match on our protocol, the return value ;; As we enter this function for a match on our protocol, the return value
;; defaults to nil. ;; defaults to nil.
(let ((result nil) (let ((result nil)
(f (org-protocol-unhex-string fname))) (f (org-link-unescape fname)))
(catch 'result (catch 'result
(dolist (prolist org-protocol-project-alist) (dolist (prolist org-protocol-project-alist)
(let* ((base-url (plist-get (cdr prolist) :base-url)) (let* ((base-url (plist-get (cdr prolist) :base-url))
@ -595,12 +536,14 @@ function returns nil, the filename is removed from the list of filenames
passed from emacsclient to the server. passed from emacsclient to the server.
If the function returns a non nil value, that value is passed to the server If the function returns a non nil value, that value is passed to the server
as filename." as filename."
(let ((sub-protocols (append org-protocol-protocol-alist org-protocol-protocol-alist-default))) (let ((sub-protocols (append org-protocol-protocol-alist
org-protocol-protocol-alist-default)))
(catch 'fname (catch 'fname
(let ((the-protocol (concat (regexp-quote org-protocol-the-protocol) ":/+"))) (let ((the-protocol (concat (regexp-quote org-protocol-the-protocol) ":/+")))
(when (string-match the-protocol fname) (when (string-match the-protocol fname)
(dolist (prolist sub-protocols) (dolist (prolist sub-protocols)
(let ((proto (concat the-protocol (regexp-quote (plist-get (cdr prolist) :protocol)) ":/+"))) (let ((proto (concat the-protocol
(regexp-quote (plist-get (cdr prolist) :protocol)) ":/+")))
(when (string-match proto fname) (when (string-match proto fname)
(let* ((func (plist-get (cdr prolist) :function)) (let* ((func (plist-get (cdr prolist) :function))
(greedy (plist-get (cdr prolist) :greedy)) (greedy (plist-get (cdr prolist) :greedy))
@ -617,7 +560,6 @@ as filename."
;; (message "fname: %s" fname) ;; (message "fname: %s" fname)
fname))) fname)))
(defadvice server-visit-files (before org-protocol-detect-protocol-server activate) (defadvice server-visit-files (before org-protocol-detect-protocol-server activate)
"Advice server-visit-flist to call `org-protocol-modify-filename-for-protocol'." "Advice server-visit-flist to call `org-protocol-modify-filename-for-protocol'."
(let ((flist (if org-protocol-reverse-list-of-files (let ((flist (if org-protocol-reverse-list-of-files
@ -626,16 +568,17 @@ as filename."
(client (ad-get-arg 1))) (client (ad-get-arg 1)))
(catch 'greedy (catch 'greedy
(dolist (var flist) (dolist (var flist)
(let ((fname (expand-file-name (car var)))) ;; `\' to `/' on windows. FIXME: could this be done any better? ;; `\' to `/' on windows. FIXME: could this be done any better?
(setq fname (org-protocol-check-filename-for-protocol fname (member var flist) client)) (let ((fname (expand-file-name (car var))))
(setq fname (org-protocol-check-filename-for-protocol
fname (member var flist) client))
(if (eq fname t) ;; greedy? We need the `t' return value. (if (eq fname t) ;; greedy? We need the `t' return value.
(progn (progn
(ad-set-arg 0 nil) (ad-set-arg 0 nil)
(throw 'greedy t)) (throw 'greedy t))
(if (stringp fname) ;; probably filename (if (stringp fname) ;; probably filename
(setcar var fname) (setcar var fname)
(ad-set-arg 0 (delq var (ad-get-arg 0)))))) (ad-set-arg 0 (delq var (ad-get-arg 0))))))))))
))))
;;; Org specific functions: ;;; Org specific functions:
@ -651,7 +594,6 @@ most of the work."
(message "Not in an org-project. Did mean %s?" (message "Not in an org-project. Did mean %s?"
(substitute-command-keys"\\[org-protocol-create]"))))) (substitute-command-keys"\\[org-protocol-create]")))))
(defun org-protocol-create (&optional project-plist) (defun org-protocol-create (&optional project-plist)
"Create a new org-protocol project interactively. "Create a new org-protocol project interactively.
An org-protocol project is an entry in `org-protocol-project-alist' An org-protocol project is an entry in `org-protocol-project-alist'
@ -660,15 +602,15 @@ Optionally use project-plist to initialize the defaults for this project. If
project-plist is the CDR of an element in `org-publish-project-alist', reuse project-plist is the CDR of an element in `org-publish-project-alist', reuse
:base-directory, :html-extension and :base-extension." :base-directory, :html-extension and :base-extension."
(interactive) (interactive)
(let ((working-dir (expand-file-name(or (plist-get project-plist :base-directory) default-directory))) (let ((working-dir (expand-file-name
(or (plist-get project-plist :base-directory)
default-directory)))
(base-url "http://orgmode.org/worg/") (base-url "http://orgmode.org/worg/")
(strip-suffix (or (plist-get project-plist :html-extension) ".html")) (strip-suffix (or (plist-get project-plist :html-extension) ".html"))
(working-suffix (if (plist-get project-plist :base-extension) (working-suffix (if (plist-get project-plist :base-extension)
(concat "." (plist-get project-plist :base-extension)) (concat "." (plist-get project-plist :base-extension))
".org")) ".org"))
(worglet-buffer nil) (worglet-buffer nil)
(insert-default-directory t) (insert-default-directory t)
(minibuffer-allow-text-properties nil)) (minibuffer-allow-text-properties nil))
@ -703,4 +645,5 @@ project-plist is the CDR of an element in `org-publish-project-alist', reuse
(provide 'org-protocol) (provide 'org-protocol)
;; arch-tag: b5c5c2ac-77cf-4a94-a649-2163dff95846
;;; org-protocol.el ends here ;;; org-protocol.el ends here

View file

@ -1,10 +1,11 @@
;;; org-publish.el --- publish related org-mode files as a website ;;; org-publish.el --- publish related org-mode files as a website
;; Copyright (C) 2006-2011 Free Software Foundation, Inc. ;; Copyright (C) 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: David O'Toole <dto@gnu.org> ;; Author: David O'Toole <dto@gnu.org>
;; Maintainer: Carsten Dominik <carsten DOT dominik AT gmail DOT com> ;; Maintainer: Carsten Dominik <carsten DOT dominik AT gmail DOT com>
;; Keywords: hypermedia, outlines, wp ;; Keywords: hypermedia, outlines, wp
;; Version: 7.4 ;; Version: 7.7
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
;; ;;
@ -40,25 +41,27 @@
;;; Code: ;;; Code:
(defun org-publish-sanitize-plist (plist)
(mapcar (lambda (x)
(or (cdr (assq x '((:index-filename . :sitemap-filename)
(:index-title . :sitemap-title)
(:index-function . :sitemap-function)
(:index-style . :sitemap-style)
(:auto-index . :auto-sitemap))))
x))
plist))
(eval-when-compile (eval-when-compile
(require 'cl)) (require 'cl))
(require 'org) (require 'org)
(require 'org-exp) (require 'org-exp)
(require 'format-spec)
(eval-and-compile (eval-and-compile
(unless (fboundp 'declare-function) (unless (fboundp 'declare-function)
(defmacro declare-function (fn file &optional arglist fileonly)))) (defmacro declare-function (fn file &optional arglist fileonly))))
(defvar org-publish-initial-buffer nil
"The buffer `org-publish' has been called from.")
(defvar org-publish-temp-files nil
"Temporary list of files to be published.")
;; Here, so you find the variable right before it's used the first time:
(defvar org-publish-cache nil
"This will cache timestamps and titles for files in publishing projects.
Blocks could hash sha1 values here.")
(defgroup org-publish nil (defgroup org-publish nil
"Options for publishing a set of Org-mode and related files." "Options for publishing a set of Org-mode and related files."
:tag "Org Publishing" :tag "Org Publishing"
@ -154,10 +157,8 @@ learn more about their use and default values.
:expand-quoted-html `org-export-html-expand' :expand-quoted-html `org-export-html-expand'
:timestamp `org-export-html-with-timestamp' :timestamp `org-export-html-with-timestamp'
:publishing-directory `org-export-publishing-directory' :publishing-directory `org-export-publishing-directory'
:preamble `org-export-html-preamble' :html-preamble `org-export-html-preamble'
:postamble `org-export-html-postamble' :html-postamble `org-export-html-postamble'
:auto-preamble `org-export-html-auto-preamble'
:auto-postamble `org-export-html-auto-postamble'
:author `user-full-name' :author `user-full-name'
:email `user-mail-address' :email `user-mail-address'
@ -178,6 +179,11 @@ sitemap of files or summary page for a given project.
`tree' (the directory structure of the source `tree' (the directory structure of the source
files is reflected in the sitemap). Defaults to files is reflected in the sitemap). Defaults to
`tree'. `tree'.
:sitemap-sans-extension Remove extension from sitemap's
filenames. Useful to have cool
URIs (see
http://www.w3.org/Provider/Style/URI).
Defaults to nil.
If you create a sitemap file, adjust the sorting like this: If you create a sitemap file, adjust the sorting like this:
@ -185,8 +191,9 @@ sitemap of files or summary page for a given project.
Set this to `first' (default) or `last' to Set this to `first' (default) or `last' to
display folders first or last, respectively. display folders first or last, respectively.
Any other value will mix files and folders. Any other value will mix files and folders.
:sitemap-alphabetically The site map is normally sorted alphabetically. :sitemap-sort-files The site map is normally sorted alphabetically.
Set this explicitly to nil to turn off sorting. You can change this behaviour setting this to
`chronologically', `anti-chronologically' or nil.
:sitemap-ignore-case Should sorting be case-sensitive? Default nil. :sitemap-ignore-case Should sorting be case-sensitive? Default nil.
The following properties control the creation of a concept index. The following properties control the creation of a concept index.
@ -232,13 +239,18 @@ Any changes made by this hook will be saved."
:group 'org-publish :group 'org-publish
:type 'hook) :type 'hook)
(defcustom org-publish-sitemap-sort-alphabetically t (defcustom org-publish-sitemap-sort-files 'alphabetically
"Should sitemaps be sorted alphabetically by default? "How sitemaps files should be sorted by default?
Possible values are `alphabetically', `chronologically', `anti-chronologically' and nil.
If `alphabetically', files will be sorted alphabetically.
If `chronologically', files will be sorted with older modification time first.
If `anti-chronologically', files will be sorted with newer modification time first.
nil won't sort files.
You can overwrite this default per project in your You can overwrite this default per project in your
`org-publish-project-alist', using `:sitemap-alphabetically'." `org-publish-project-alist', using `:sitemap-sort-files'."
:group 'org-publish :group 'org-publish
:type 'boolean) :type 'symbol)
(defcustom org-publish-sitemap-sort-folders 'first (defcustom org-publish-sitemap-sort-folders 'first
"A symbol, denoting if folders are sorted first in sitemaps. "A symbol, denoting if folders are sorted first in sitemaps.
@ -260,6 +272,37 @@ You can overwrite this default per project in your
:group 'org-publish :group 'org-publish
:type 'boolean) :type 'boolean)
(defcustom org-publish-sitemap-date-format "%Y-%m-%d"
"Format for `format-time-string' which is used to print a date
in the sitemap."
:group 'org-publish
:type 'string)
(defcustom org-publish-sitemap-file-entry-format "%t"
"How a sitemap file entry is formated.
You could use brackets to delimit on what part the link will be.
%t is the title.
%a is the author.
%d is the date formated using `org-publish-sitemap-date-format'."
:group 'org-publish
:type 'string)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Sanitize-plist (FIXME why?)
(defun org-publish-sanitize-plist (plist)
;; FIXME document
(mapcar (lambda (x)
(or (cdr (assq x '((:index-filename . :sitemap-filename)
(:index-title . :sitemap-title)
(:index-function . :sitemap-function)
(:index-style . :sitemap-style)
(:auto-index . :auto-sitemap))))
x))
plist))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Timestamp-related functions ;;; Timestamp-related functions
@ -273,7 +316,7 @@ You can overwrite this default per project in your
"Return t if FILENAME should be published in PUB-DIR using PUB-FUNC. "Return t if FILENAME should be published in PUB-DIR using PUB-FUNC.
TRUE-PUB-DIR is where the file will truly end up. Currently we are not using TRUE-PUB-DIR is where the file will truly end up. Currently we are not using
this - maybe it can eventually be used to check if the file is present at this - maybe it can eventually be used to check if the file is present at
the target location, and how old it is. Right ow we cannot do this, because the target location, and how old it is. Right now we cannot do this, because
we do not know under what file name the file will be stored - the publishing we do not know under what file name the file will be stored - the publishing
function can still decide about that independently." function can still decide about that independently."
(let ((rtn (let ((rtn
@ -305,20 +348,6 @@ If there is no timestamp, create one."
(org-publish-reset-cache)))) (org-publish-reset-cache))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
(defvar org-publish-initial-buffer nil
"The buffer `org-publish' has been called from.")
(defvar org-publish-temp-files nil
"Temporary list of files to be published.")
;; Here, so you find the variable right before it's used the first time:
(defvar org-publish-cache nil
"This will cache timestamps and titles for files in publishing projects.
Blocks could hash sha1 values here.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Compatibility aliases ;;; Compatibility aliases
@ -341,6 +370,8 @@ This is a compatibility function for Emacsen without `delete-dups'."
(declare-function org-publish-delete-dups "org-publish" (list)) (declare-function org-publish-delete-dups "org-publish" (list))
(declare-function find-lisp-find-files "find-lisp" (directory regexp)) (declare-function find-lisp-find-files "find-lisp" (directory regexp))
(declare-function org-pop-to-buffer-same-window
"org-compat" (&optional buffer-or-name norecord label))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Getting project information out of org-publish-project-alist ;;; Getting project information out of org-publish-project-alist
@ -358,17 +389,19 @@ This splices all the components into the list."
(push p rtn))) (push p rtn)))
(nreverse (org-publish-delete-dups (delq nil rtn))))) (nreverse (org-publish-delete-dups (delq nil rtn)))))
(defvar org-sitemap-sort-files)
(defvar sitemap-alphabetically) (defvar org-sitemap-sort-folders)
(defvar sitemap-sort-folders) (defvar org-sitemap-ignore-case)
(defvar sitemap-ignore-case) (defvar org-sitemap-requested)
(defvar sitemap-requested) (defvar org-sitemap-date-format)
(defvar org-sitemap-file-entry-format)
(defun org-publish-compare-directory-files (a b) (defun org-publish-compare-directory-files (a b)
"Predicate for `sort', that sorts folders-first/last and alphabetically." "Predicate for `sort', that sorts folders and files for sitemap."
(let ((retval t)) (let ((retval t))
(when (or sitemap-alphabetically sitemap-sort-folders) (when (or org-sitemap-sort-files org-sitemap-sort-folders)
;; First we sort alphabetically: ;; First we sort files:
(when sitemap-alphabetically (when org-sitemap-sort-files
(cond ((equal org-sitemap-sort-files 'alphabetically)
(let* ((adir (file-directory-p a)) (let* ((adir (file-directory-p a))
(aorg (and (string-match "\\.org$" a) (not adir))) (aorg (and (string-match "\\.org$" a) (not adir)))
(bdir (file-directory-p b)) (bdir (file-directory-p b))
@ -379,19 +412,27 @@ This splices all the components into the list."
(B (if borg (B (if borg
(concat (file-name-directory b) (concat (file-name-directory b)
(org-publish-find-title b)) b))) (org-publish-find-title b)) b)))
(setq retval (if sitemap-ignore-case (setq retval (if org-sitemap-ignore-case
(not (string-lessp (upcase B) (upcase A))) (not (string-lessp (upcase B) (upcase A)))
(not (string-lessp B A)))))) (not (string-lessp B A))))))
((or (equal org-sitemap-sort-files 'chronologically)
(equal org-sitemap-sort-files 'anti-chronologically))
(let* ((adate (org-publish-find-date a))
(bdate (org-publish-find-date b))
(A (+ (lsh (car adate) 16) (cadr adate)))
(B (+ (lsh (car bdate) 16) (cadr bdate))))
(setq retval (if (equal org-sitemap-sort-files 'chronologically)
(<= A B)
(>= A B)))))))
;; Directory-wise wins: ;; Directory-wise wins:
(when sitemap-sort-folders (when org-sitemap-sort-folders
;; a is directory, b not: ;; a is directory, b not:
(cond (cond
((and (file-directory-p a) (not (file-directory-p b))) ((and (file-directory-p a) (not (file-directory-p b)))
(setq retval (equal sitemap-sort-folders 'first))) (setq retval (equal org-sitemap-sort-folders 'first)))
;; a is not a directory, but b is: ;; a is not a directory, but b is:
((and (not (file-directory-p a)) (file-directory-p b)) ((and (not (file-directory-p a)) (file-directory-p b))
(setq retval (equal sitemap-sort-folders 'last)))))) (setq retval (equal org-sitemap-sort-folders 'last))))))
retval)) retval))
(defun org-publish-get-base-files-1 (base-dir &optional recurse match skip-file skip-dir) (defun org-publish-get-base-files-1 (base-dir &optional recurse match skip-file skip-dir)
@ -414,7 +455,7 @@ matching the regexp SKIP-DIR when recursing through BASE-DIR."
(not (string-match match fnd))) (not (string-match match fnd)))
(pushnew f org-publish-temp-files))))) (pushnew f org-publish-temp-files)))))
(if sitemap-requested (if org-sitemap-requested
(sort (directory-files base-dir t (unless recurse match)) (sort (directory-files base-dir t (unless recurse match))
'org-publish-compare-directory-files) 'org-publish-compare-directory-files)
(directory-files base-dir t (unless recurse match))))) (directory-files base-dir t (unless recurse match)))))
@ -431,28 +472,38 @@ matching filenames."
(extension (or (plist-get project-plist :base-extension) "org")) (extension (or (plist-get project-plist :base-extension) "org"))
;; sitemap-... variables are dynamically scoped for ;; sitemap-... variables are dynamically scoped for
;; org-publish-compare-directory-files: ;; org-publish-compare-directory-files:
(sitemap-requested (org-sitemap-requested
(plist-get project-plist :auto-sitemap)) (plist-get project-plist :auto-sitemap))
(sitemap-sort-folders (sitemap-filename
(or (plist-get project-plist :sitemap-filename)
"sitemap.org"))
(org-sitemap-sort-folders
(if (plist-member project-plist :sitemap-sort-folders) (if (plist-member project-plist :sitemap-sort-folders)
(plist-get project-plist :sitemap-sort-folders) (plist-get project-plist :sitemap-sort-folders)
org-publish-sitemap-sort-folders)) org-publish-sitemap-sort-folders))
(sitemap-alphabetically (org-sitemap-sort-files
(if (plist-member project-plist :sitemap-alphabetically) (cond ((plist-member project-plist :sitemap-sort-files)
(plist-get project-plist :sitemap-alphabetically) (plist-get project-plist :sitemap-sort-files))
org-publish-sitemap-sort-alphabetically)) ;; For backward compatibility:
(sitemap-ignore-case ((plist-member project-plist :sitemap-alphabetically)
(if (plist-get project-plist :sitemap-alphabetically)
'alphabetically nil))
(t org-publish-sitemap-sort-files)))
(org-sitemap-ignore-case
(if (plist-member project-plist :sitemap-ignore-case) (if (plist-member project-plist :sitemap-ignore-case)
(plist-get project-plist :sitemap-ignore-case) (plist-get project-plist :sitemap-ignore-case)
org-publish-sitemap-sort-ignore-case)) org-publish-sitemap-sort-ignore-case))
(match (if (eq extension 'any) (match (if (eq extension 'any)
"^[^\\.]" "^[^\\.]"
(concat "^[^\\.].*\\.\\(" extension "\\)$")))) (concat "^[^\\.].*\\.\\(" extension "\\)$"))))
;; Make sure sitemap-sort-folders' has an accepted value ;; Make sure `org-sitemap-sort-folders' has an accepted value
(unless (memq sitemap-sort-folders '(first last)) (unless (memq org-sitemap-sort-folders '(first last))
(setq sitemap-sort-folders nil)) (setq org-sitemap-sort-folders nil))
(setq org-publish-temp-files nil) (setq org-publish-temp-files nil)
(if org-sitemap-requested
(pushnew (expand-file-name (concat base-dir sitemap-filename))
org-publish-temp-files))
(org-publish-get-base-files-1 base-dir recurse match (org-publish-get-base-files-1 base-dir recurse match
;; FIXME distinguish exclude regexp ;; FIXME distinguish exclude regexp
;; for skip-file and skip-dir? ;; for skip-file and skip-dir?
@ -480,10 +531,10 @@ matching filenames."
(e (plist-get (cdr prj) :exclude)) (e (plist-get (cdr prj) :exclude))
(i (plist-get (cdr prj) :include)) (i (plist-get (cdr prj) :include))
(xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$"))) (xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$")))
(when (or (when
(or
(and (and
i i (member filename
(member filename
(mapcar (mapcar
(lambda (file) (expand-file-name file b)) (lambda (file) (expand-file-name file b))
i))) i)))
@ -511,7 +562,7 @@ PUB-DIR is the publishing directory."
(make-directory pub-dir t)) (make-directory pub-dir t))
(let ((visiting (find-buffer-visiting filename))) (let ((visiting (find-buffer-visiting filename)))
(save-excursion (save-excursion
(switch-to-buffer (or visiting (find-file filename))) (org-pop-to-buffer-same-window (or visiting (find-file filename)))
(let* ((plist (cons :buffer-will-be-killed (cons t plist))) (let* ((plist (cons :buffer-will-be-killed (cons t plist)))
(init-buf (current-buffer)) (init-buf (current-buffer))
(init-point (point)) (init-point (point))
@ -677,6 +728,10 @@ If :makeindex is set, also produce a file theindex.org."
"sitemap.org")) "sitemap.org"))
(sitemap-function (or (plist-get project-plist :sitemap-function) (sitemap-function (or (plist-get project-plist :sitemap-function)
'org-publish-org-sitemap)) 'org-publish-org-sitemap))
(org-sitemap-date-format (or (plist-get project-plist :sitemap-date-format)
org-publish-sitemap-date-format))
(org-sitemap-file-entry-format (or (plist-get project-plist :sitemap-file-entry-format)
org-publish-sitemap-file-entry-format))
(preparation-function (plist-get project-plist :preparation-function)) (preparation-function (plist-get project-plist :preparation-function))
(completion-function (plist-get project-plist :completion-function)) (completion-function (plist-get project-plist :completion-function))
(files (org-publish-get-base-files project exclude-regexp)) file) (files (org-publish-get-base-files project exclude-regexp)) file)
@ -685,7 +740,7 @@ If :makeindex is set, also produce a file theindex.org."
(while (setq file (pop files)) (while (setq file (pop files))
(org-publish-file file project t)) (org-publish-file file project t))
(when (plist-get project-plist :makeindex) (when (plist-get project-plist :makeindex)
(org-publish-index-generate-theindex.inc (org-publish-index-generate-theindex
(plist-get project-plist :base-directory)) (plist-get project-plist :base-directory))
(org-publish-file (expand-file-name (org-publish-file (expand-file-name
"theindex.org" "theindex.org"
@ -711,6 +766,7 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
(concat "Sitemap for project " (car project)))) (concat "Sitemap for project " (car project))))
(sitemap-style (or (plist-get project-plist :sitemap-style) (sitemap-style (or (plist-get project-plist :sitemap-style)
'tree)) 'tree))
(sitemap-sans-extension (plist-get project-plist :sitemap-sans-extension))
(visiting (find-buffer-visiting sitemap-filename)) (visiting (find-buffer-visiting sitemap-filename))
(ifn (file-name-nondirectory sitemap-filename)) (ifn (file-name-nondirectory sitemap-filename))
file sitemap-buffer) file sitemap-buffer)
@ -722,6 +778,8 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
(let ((fn (file-name-nondirectory file)) (let ((fn (file-name-nondirectory file))
(link (file-relative-name file dir)) (link (file-relative-name file dir))
(oldlocal localdir)) (oldlocal localdir))
(when sitemap-sans-extension
(setq link (file-name-sans-extension link)))
;; sitemap shouldn't list itself ;; sitemap shouldn't list itself
(unless (equal (file-truename sitemap-filename) (unless (equal (file-truename sitemap-filename)
(file-truename file)) (file-truename file))
@ -752,16 +810,34 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
(setq indent-str (make-string (setq indent-str (make-string
(+ (length indent-str) 2) ?\ ))))))) (+ (length indent-str) 2) ?\ )))))))
;; This is common to 'flat and 'tree ;; This is common to 'flat and 'tree
(let ((entry
(org-publish-format-file-entry org-sitemap-file-entry-format
file project-plist))
(regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)"))
(cond ((string-match-p regexp entry)
(string-match regexp entry)
(insert (concat indent-str " + " (match-string 1 entry)
"[[file:" link "]["
(match-string 2 entry)
"]]" (match-string 3 entry) "\n")))
(t
(insert (concat indent-str " + [[file:" link "][" (insert (concat indent-str " + [[file:" link "]["
(org-publish-find-title file) entry
"]]\n"))))) "]]\n"))))))))
(save-buffer)) (save-buffer))
(or visiting (kill-buffer sitemap-buffer)))) (or visiting (kill-buffer sitemap-buffer))))
(defun org-publish-find-title (file) (defun org-publish-format-file-entry (fmt file project-plist)
(format-spec fmt
`((?t . ,(org-publish-find-title file t))
(?d . ,(format-time-string org-sitemap-date-format
(org-publish-find-date file)))
(?a . ,(or (plist-get project-plist :author) user-full-name)))))
(defun org-publish-find-title (file &optional reset)
"Find the title of FILE in project." "Find the title of FILE in project."
(or (or
(org-publish-cache-get-file-property file :title nil t) (and (not reset) (org-publish-cache-get-file-property file :title nil t))
(let* ((visiting (find-buffer-visiting file)) (let* ((visiting (find-buffer-visiting file))
(buffer (or visiting (find-file-noselect file))) (buffer (or visiting (find-file-noselect file)))
title) title)
@ -779,6 +855,24 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
(org-publish-cache-set-file-property file :title title) (org-publish-cache-set-file-property file :title title)
title))) title)))
(defun org-publish-find-date (file)
"Find the date of FILE in project.
If FILE provides a #+date keyword use it else use the file
system's modification time.
It returns time in `current-time' format."
(let ((visiting (find-buffer-visiting file)))
(save-excursion
(org-pop-to-buffer-same-window (or visiting (find-file-noselect file nil t)))
(let* ((plist (org-infile-export-plist))
(date (plist-get plist :date)))
(unless visiting
(kill-buffer (current-buffer)))
(if date
(org-time-string-to-time date)
(when (file-exists-p file)
(nth 5 (file-attributes file))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Interactive publishing functions ;;; Interactive publishing functions
@ -848,7 +942,6 @@ the project."
;;; Index generation ;;; Index generation
(defvar backend) ; dynamically scoped
(defun org-publish-aux-preprocess () (defun org-publish-aux-preprocess ()
"Find index entries and write them to an .orgx file." "Find index entries and write them to an .orgx file."
(let ((case-fold-search t) (let ((case-fold-search t)
@ -859,7 +952,7 @@ the project."
(re-search-forward "^[ \t]*#\\+index:[ \t]*\\(.*?\\)[ \t]*$" nil t) (re-search-forward "^[ \t]*#\\+index:[ \t]*\\(.*?\\)[ \t]*$" nil t)
(> (match-end 1) (match-beginning 1))) (> (match-end 1) (match-beginning 1)))
(setq entry (match-string 1)) (setq entry (match-string 1))
(when (eq backend 'latex) (when (eq org-export-current-backend 'latex)
(replace-match (format "\\index{%s}" entry) t t)) (replace-match (format "\\index{%s}" entry) t t))
(save-excursion (save-excursion
(ignore-errors (org-back-to-heading t)) (ignore-errors (org-back-to-heading t))
@ -869,12 +962,15 @@ the project."
target "")) target ""))
(push (cons entry target) index))) (push (cons entry target) index)))
(with-temp-file (with-temp-file
(concat (file-name-sans-extension org-current-export-file) ".orgx") (concat
(file-name-directory org-current-export-file) "."
(file-name-sans-extension
(file-name-nondirectory org-current-export-file)) ".orgx")
(dolist (entry (nreverse index)) (dolist (entry (nreverse index))
(insert (format "INDEX: (%s) %s\n" (cdr entry) (car entry))))))) (insert (format "INDEX: (%s) %s\n" (cdr entry) (car entry)))))))
(defun org-publish-index-generate-theindex.inc (directory) (defun org-publish-index-generate-theindex (directory)
"Generate the index from all .orgx files in the current directory and below." "Generate the index from all .orgx files in DIRECTORY."
(require 'find-lisp) (require 'find-lisp)
(let* ((fulldir (file-name-as-directory (let* ((fulldir (file-name-as-directory
(expand-file-name directory))) (expand-file-name directory)))
@ -889,7 +985,7 @@ the project."
main last-main letter last-letter file sub link tgext) main last-main letter last-letter file sub link tgext)
;; `files' contains the list of relative file names ;; `files' contains the list of relative file names
(dolist (file files) (dolist (file files)
(setq origfile (substring file 0 -1)) (setq origfile (substring file 1 -1))
(setq buf (find-file-noselect file)) (setq buf (find-file-noselect file))
(with-current-buffer buf (with-current-buffer buf
(goto-char (point-min)) (goto-char (point-min))
@ -900,7 +996,7 @@ the project."
(kill-buffer buf)) (kill-buffer buf))
(setq index (sort index (lambda (a b) (string< (downcase (car a)) (setq index (sort index (lambda (a b) (string< (downcase (car a))
(downcase (car b)))))) (downcase (car b))))))
(setq ibuffer (find-file-noselect (expand-file-name "theindex.inc" directory))) (setq ibuffer (find-file-noselect (expand-file-name "theindex.org" directory)))
(with-current-buffer ibuffer (with-current-buffer ibuffer
(erase-buffer) (erase-buffer)
(insert "* Index\n") (insert "* Index\n")
@ -927,17 +1023,7 @@ the project."
(insert " - " link "\n") (insert " - " link "\n")
(insert " - " link "\n"))) (insert " - " link "\n")))
(save-buffer)) (save-buffer))
(kill-buffer ibuffer) (kill-buffer ibuffer)))
(let ((index-file (expand-file-name "theindex.org" directory)))
(unless (file-exists-p index-file)
(setq ibuffer (find-file-noselect index-file))
(with-current-buffer ibuffer
(erase-buffer)
(insert "\n\n#+include: \"theindex.inc\"\n\n")
(save-buffer))
(kill-buffer ibuffer)))))
;; Caching functions: ;; Caching functions:
@ -1006,15 +1092,33 @@ If FREE-CACHE, empty the cache."
(defun org-publish-cache-file-needs-publishing (filename &optional pub-dir pub-func) (defun org-publish-cache-file-needs-publishing (filename &optional pub-dir pub-func)
"Check the timestamp of the last publishing of FILENAME. "Check the timestamp of the last publishing of FILENAME.
Return `t', if the file needs publishing" Return `t', if the file needs publishing. The function also
checks if any included files have been more recently published,
so that the file including them will be republished as well."
(unless org-publish-cache (unless org-publish-cache
(error "%s" "`org-publish-cache-file-needs-publishing' called, but no cache present")) (error "%s" "`org-publish-cache-file-needs-publishing' called, but no cache present"))
(let* ((key (org-publish-timestamp-filename filename pub-dir pub-func)) (let* ((key (org-publish-timestamp-filename filename pub-dir pub-func))
(pstamp (org-publish-cache-get key))) (pstamp (org-publish-cache-get key))
(visiting (find-buffer-visiting filename))
included-files-ctime buf)
(when (equal (file-name-extension filename) "org")
(setq buf (find-file (expand-file-name filename)))
(with-current-buffer buf
(goto-char (point-min))
(while (re-search-forward "^#\\+INCLUDE:[ \t]+\"?\\([^ \t\"]*\\)\"?[ \t]*.*$" nil t)
(let* ((included-file (expand-file-name (match-string 1))))
(add-to-list 'included-files-ctime
(org-publish-cache-ctime-of-src included-file) t))))
;; FIXME don't kill current buffer
(unless visiting (kill-buffer buf)))
(if (null pstamp) (if (null pstamp)
t t
(let ((ctime (org-publish-cache-ctime-of-src filename))) (let ((ctime (org-publish-cache-ctime-of-src filename)))
(< pstamp ctime))))) (or (< pstamp ctime)
(when included-files-ctime
(not (null (delq nil (mapcar (lambda(ct) (< ctime ct))
included-files-ctime))))))))))
(defun org-publish-cache-set-file-property (filename property value &optional project-name) (defun org-publish-cache-set-file-property (filename property value &optional project-name)
"Set the VALUE for a PROPERTY of file FILENAME in publishing cache to VALUE. "Set the VALUE for a PROPERTY of file FILENAME in publishing cache to VALUE.
@ -1066,15 +1170,19 @@ Returns value on success, else nil."
(puthash key value org-publish-cache)) (puthash key value org-publish-cache))
(defun org-publish-cache-ctime-of-src (filename) (defun org-publish-cache-ctime-of-src (filename)
"Get the files ctime as integer." "Get the FILENAME ctime as an integer."
(let ((src-attr (file-attributes filename))) (let* ((symlink-maybe (or (file-symlink-p filename) filename))
(src-attr (file-attributes (if (file-name-absolute-p symlink-maybe)
symlink-maybe
(expand-file-name
symlink-maybe
(file-name-directory filename))))))
(+ (+
(lsh (car (nth 5 src-attr)) 16) (lsh (car (nth 5 src-attr)) 16)
(cadr (nth 5 src-attr))))) (cadr (nth 5 src-attr)))))
(provide 'org-publish) (provide 'org-publish)
;; arch-tag: 72807f3c-8af0-4a6b-8dca-c3376eb25adb
;;; org-publish.el ends here ;;; org-publish.el ends here

View file

@ -1,11 +1,12 @@
;;; org-remember.el --- Fast note taking in Org-mode ;;; org-remember.el --- Fast note taking in Org-mode
;; Copyright (C) 2004-2011 Free Software Foundation, Inc. ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp ;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org ;; Homepage: http://orgmode.org
;; Version: 7.4 ;; Version: 7.7
;; ;;
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
;; ;;
@ -33,12 +34,16 @@
(eval-when-compile (eval-when-compile
(require 'cl)) (require 'cl))
(require 'org) (require 'org)
(require 'org-compat)
(require 'org-datetree) (require 'org-datetree)
(declare-function remember-mode "remember" ()) (declare-function remember-mode "remember" ())
(declare-function remember "remember" (&optional initial)) (declare-function remember "remember" (&optional initial))
(declare-function remember-buffer-desc "remember" ()) (declare-function remember-buffer-desc "remember" ())
(declare-function remember-finalize "remember" ()) (declare-function remember-finalize "remember" ())
(declare-function org-pop-to-buffer-same-window
"org-compat" (&optional buffer-or-name norecord label))
(defvar remember-save-after-remembering) (defvar remember-save-after-remembering)
(defvar remember-register) (defvar remember-register)
(defvar remember-buffer) (defvar remember-buffer)
@ -214,11 +219,7 @@ The remember buffer is still current when this hook runs."
:group 'org-remember :group 'org-remember
:type 'hook) :type 'hook)
(defvar org-remember-mode-map (defvar org-remember-mode-map (make-sparse-keymap)
(let ((map (make-sparse-keymap)))
(define-key map "\C-c\C-c" 'org-remember-finalize)
(define-key map "\C-c\C-k" 'org-remember-kill)
map)
"Keymap for `org-remember-mode', a minor mode. "Keymap for `org-remember-mode', a minor mode.
Use this map to set additional keybindings for when Org-mode is used Use this map to set additional keybindings for when Org-mode is used
for a Remember buffer.") for a Remember buffer.")
@ -227,7 +228,10 @@ for a Remember buffer.")
(define-minor-mode org-remember-mode (define-minor-mode org-remember-mode
"Minor mode for special key bindings in a remember buffer." "Minor mode for special key bindings in a remember buffer."
nil " Rem" org-remember-mode-map) nil " Rem" org-remember-mode-map
(run-hooks 'org-remember-mode-hook))
(define-key org-remember-mode-map "\C-c\C-c" 'org-remember-finalize)
(define-key org-remember-mode-map "\C-c\C-k" 'org-remember-kill)
(defcustom org-remember-clock-out-on-exit 'query (defcustom org-remember-clock-out-on-exit 'query
"Non-nil means stop the clock when exiting a clocking remember buffer. "Non-nil means stop the clock when exiting a clocking remember buffer.
@ -785,7 +789,7 @@ The user is queried for the template."
(setq heading org-remember-default-headline)) (setq heading org-remember-default-headline))
(setq visiting (org-find-base-buffer-visiting file)) (setq visiting (org-find-base-buffer-visiting file))
(if (not visiting) (find-file-noselect file)) (if (not visiting) (find-file-noselect file))
(switch-to-buffer (or visiting (get-file-buffer file))) (org-pop-to-buffer-same-window (or visiting (get-file-buffer file)))
(widen) (widen)
(goto-char (point-min)) (goto-char (point-min))
(if (re-search-forward (if (re-search-forward
@ -1004,7 +1008,7 @@ See also the variable `org-reverse-note-order'."
((eq org-remember-interactive-interface 'outline-path-completion) ((eq org-remember-interactive-interface 'outline-path-completion)
(let ((org-refile-targets '((nil . (:maxlevel . 10)))) (let ((org-refile-targets '((nil . (:maxlevel . 10))))
(org-refile-use-outline-path t)) (org-refile-use-outline-path t))
(setq spos (org-refile-get-location "Heading: ") (setq spos (org-refile-get-location "Heading")
exitcmd 'return exitcmd 'return
spos (nth 3 spos)))) spos (nth 3 spos))))
(t (error "This should not happen"))) (t (error "This should not happen")))
@ -1072,7 +1076,7 @@ See also the variable `org-reverse-note-order'."
(save-restriction (save-restriction
(widen) (widen)
(goto-char (point-min)) (goto-char (point-min))
(re-search-forward "^\\*+ " nil t) (re-search-forward org-outline-regexp-bol nil t)
(beginning-of-line 1) (beginning-of-line 1)
(org-paste-subtree 1 txt) (org-paste-subtree 1 txt)
(and org-auto-align-tags (org-set-tags nil t)) (and org-auto-align-tags (org-set-tags nil t))
@ -1149,6 +1153,7 @@ See also the variable `org-reverse-note-order'."
(provide 'org-remember) (provide 'org-remember)
;; arch-tag: 497f30d0-4bc3-4097-8622-2d27ac5f2698
;;; org-remember.el ends here ;;; org-remember.el ends here

View file

@ -1,11 +1,12 @@
;;; org-rmail.el --- Support for links to Rmail messages from within Org-mode ;;; org-rmail.el --- Support for links to Rmail messages from within Org-mode
;; Copyright (C) 2004-2011 Free Software Foundation, Inc. ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp ;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org ;; Homepage: http://orgmode.org
;; Version: 7.4 ;; Version: 7.7
;; ;;
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
;; ;;
@ -114,5 +115,6 @@
(provide 'org-rmail) (provide 'org-rmail)
;; arch-tag: c6cf4a8b-6639-4b7f-821f-bdf10746b173
;;; org-rmail.el ends here ;;; org-rmail.el ends here

View file

@ -0,0 +1,99 @@
;;; org-special-blocks.el --- Turn blocks into LaTeX envs and HTML divs
;; Copyright (C) 2009 Chris Gray
;; Author: Chris Gray <chrismgray@gmail.com>
;; This file is 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 package generalizes the #+begin_foo and #+end_foo tokens.
;; To use, put the following in your init file:
;;
;; (require 'org-special-blocks)
;; The tokens #+begin_center, #+begin_verse, etc. existed previously.
;; This package generalizes them (at least for the LaTeX and html
;; exporters). When a #+begin_foo token is encountered by the LaTeX
;; exporter, it is expanded into \begin{foo}. The text inside the
;; environment is not protected, as text inside environments generally
;; is. When #+begin_foo is encountered by the html exporter, a div
;; with class foo is inserted into the HTML file. It is up to the
;; user to add this class to his or her stylesheet if this div is to
;; mean anything.
(require 'org-compat)
(defvar org-special-blocks-ignore-regexp "^\\(LaTeX\\|HTML\\)$"
"A regexp indicating the names of blocks that should be ignored
by org-special-blocks. These blocks will presumably be
interpreted by other mechanisms.")
(defvar org-export-current-backend) ; dynamically bound in org-exp.el
(defun org-special-blocks-make-special-cookies ()
"Adds special cookies when #+begin_foo and #+end_foo tokens are
seen. This is run after a few special cases are taken care of."
(when (or (eq org-export-current-backend 'html)
(eq org-export-current-backend 'latex))
(goto-char (point-min))
(while (re-search-forward "^[ \t]*#\\+\\(begin\\|end\\)_\\(.*\\)$" nil t)
(unless (org-string-match-p org-special-blocks-ignore-regexp (match-string 2))
(replace-match
(if (equal (downcase (match-string 1)) "begin")
(concat "ORG-" (match-string 2) "-START")
(concat "ORG-" (match-string 2) "-END"))
t t)))))
(add-hook 'org-export-preprocess-after-blockquote-hook
'org-special-blocks-make-special-cookies)
(defun org-special-blocks-convert-latex-special-cookies ()
"Converts the special cookies into LaTeX blocks."
(goto-char (point-min))
(while (re-search-forward "^ORG-\\([^ \t\n]*\\)[ \t]*\\(.*\\)-\\(START\\|END\\)$" nil t)
(replace-match
(if (equal (match-string 3) "START")
(concat "\\begin{" (match-string 1) "}" (match-string 2))
(concat "\\end{" (match-string 1) "}"))
t t)))
(add-hook 'org-export-latex-after-blockquotes-hook
'org-special-blocks-convert-latex-special-cookies)
(defvar line)
(defun org-special-blocks-convert-html-special-cookies ()
"Converts the special cookies into div blocks."
;; Uses the dynamically-bound variable `line'.
(when (string-match "^ORG-\\(.*\\)-\\(START\\|END\\)$" line)
; (org-close-par-maybe)
(message "%s" (match-string 1))
(if (equal (match-string 2 line) "START")
(insert "<div class=\"" (match-string 1 line) "\">\n")
(insert "</div>\n"))
(throw 'nextline nil)))
(add-hook 'org-export-html-after-blockquotes-hook
'org-special-blocks-convert-html-special-cookies)
(provide 'org-special-blocks)
;;; org-special-blocks.el ends here

View file

@ -1,13 +1,14 @@
;;; org-src.el --- Source code examples in Org ;;; org-src.el --- Source code examples in Org
;; ;;
;; Copyright (C) 2004-2011 Free Software Foundation, Inc. ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; ;;
;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Bastien Guerry <bzg AT altern DOT org> ;; Bastien Guerry <bzg AT altern DOT org>
;; Dan Davison <davison at stats dot ox dot ac dot uk> ;; Dan Davison <davison at stats dot ox dot ac dot uk>
;; Keywords: outlines, hypermedia, calendar, wp ;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org ;; Homepage: http://orgmode.org
;; Version: 7.4 ;; Version: 7.7
;; ;;
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
;; ;;
@ -42,6 +43,8 @@
(declare-function org-at-table.el-p "org" ()) (declare-function org-at-table.el-p "org" ())
(declare-function org-get-indentation "org" (&optional line)) (declare-function org-get-indentation "org" (&optional line))
(declare-function org-switch-to-buffer-other-window "org" (&rest args)) (declare-function org-switch-to-buffer-other-window "org" (&rest args))
(declare-function org-pop-to-buffer-same-window
"org-compat" (&optional buffer-or-name norecord label))
(defcustom org-edit-src-region-extra nil (defcustom org-edit-src-region-extra nil
"Additional regexps to identify regions for editing with `org-edit-src-code'. "Additional regexps to identify regions for editing with `org-edit-src-code'.
@ -115,8 +118,7 @@ buffer.")
(defcustom org-edit-src-persistent-message t (defcustom org-edit-src-persistent-message t
"Non-nil means show persistent exit help message while editing src examples. "Non-nil means show persistent exit help message while editing src examples.
The message is shown in the header-line, which will be created in the The message is shown in the header-line, which will be created in the
first line of the window showing the editing buffer. first line of the window showing the editing buffer."
When nil, the message will only be shown intermittently in the echo area."
:group 'org-edit-structure :group 'org-edit-structure
:type 'boolean) :type 'boolean)
@ -153,7 +155,7 @@ but which mess up the display of a snippet in Org exported files.")
(defcustom org-src-lang-modes (defcustom org-src-lang-modes
'(("ocaml" . tuareg) ("elisp" . emacs-lisp) ("ditaa" . artist) '(("ocaml" . tuareg) ("elisp" . emacs-lisp) ("ditaa" . artist)
("asymptote" . asy) ("dot" . fundamental) ("sqlite" . sql) ("asymptote" . asy) ("dot" . fundamental) ("sqlite" . sql)
("calc" . fundamental)) ("calc" . fundamental) ("C" . c))
"Alist mapping languages to their major mode. "Alist mapping languages to their major mode.
The key is the language name, the value is the string that should The key is the language name, the value is the string that should
be inserted as the name of the major mode. For many languages this is be inserted as the name of the major mode. For many languages this is
@ -169,10 +171,8 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is
;;; Editing source examples ;;; Editing source examples
(defvar org-src-mode-map (defvar org-src-mode-map (make-sparse-keymap))
(let ((map (make-sparse-keymap))) (define-key org-src-mode-map "\C-c'" 'org-edit-src-exit)
(define-key map "\C-c'" 'org-edit-src-exit)
map))
(defvar org-edit-src-force-single-line nil) (defvar org-edit-src-force-single-line nil)
(defvar org-edit-src-from-org-mode nil) (defvar org-edit-src-from-org-mode nil)
@ -200,7 +200,7 @@ This minor mode is turned on in two situations:
There is a mode hook, and keybindings for `org-edit-src-exit' and There is a mode hook, and keybindings for `org-edit-src-exit' and
`org-edit-src-save'") `org-edit-src-save'")
(defun org-edit-src-code (&optional context code edit-buffer-name quietp) (defun org-edit-src-code (&optional context code edit-buffer-name)
"Edit the source code example at point. "Edit the source code example at point.
The example is copied to a separate buffer, and that buffer is The example is copied to a separate buffer, and that buffer is
switched to the correct language mode. When done, exit with switched to the correct language mode. When done, exit with
@ -216,14 +216,13 @@ buffer."
(let ((mark (and (org-region-active-p) (mark))) (let ((mark (and (org-region-active-p) (mark)))
(case-fold-search t) (case-fold-search t)
(info (org-edit-src-find-region-and-lang)) (info (org-edit-src-find-region-and-lang))
(babel-info (org-babel-get-src-block-info 'light)) (full-info (org-babel-get-src-block-info))
(org-mode-p (eq major-mode 'org-mode)) (org-mode-p (or (org-mode-p) (derived-mode-p 'org-mode)))
(beg (make-marker)) (beg (make-marker))
(end (make-marker)) (end (make-marker))
(preserve-indentation org-src-preserve-indentation)
(allow-write-back-p (null code)) (allow-write-back-p (null code))
block-nindent total-nindent ovl lang lang-f single lfmt buffer msg block-nindent total-nindent ovl lang lang-f single lfmt buffer msg
begline markline markcol line col) begline markline markcol line col transmitted-variables)
(if (not info) (if (not info)
nil nil
(setq beg (move-marker beg (nth 0 info)) (setq beg (move-marker beg (nth 0 info))
@ -237,10 +236,22 @@ buffer."
(nth 2 info)) (nth 2 info))
lang (if (symbolp lang) (symbol-name lang) lang) lang (if (symbolp lang) (symbol-name lang) lang)
single (nth 3 info) single (nth 3 info)
lfmt (nth 4 info)
block-nindent (nth 5 info) block-nindent (nth 5 info)
lang-f (intern (concat lang "-mode")) lang-f (intern (concat lang "-mode"))
begline (save-excursion (goto-char beg) (org-current-line))) begline (save-excursion (goto-char beg) (org-current-line))
transmitted-variables
`((org-edit-src-content-indentation
,org-edit-src-content-indentation)
(org-edit-src-force-single-line ,single)
(org-edit-src-from-org-mode ,org-mode-p)
(org-edit-src-allow-write-back-p ,allow-write-back-p)
(org-src-preserve-indentation ,org-src-preserve-indentation)
(org-src-babel-info ,(org-babel-get-src-block-info 'light))
(org-coderef-label-format
,(or (nth 4 info) org-coderef-label-format))
(org-edit-src-beg-marker ,beg)
(org-edit-src-end-marker ,end)
(org-edit-src-block-indentation ,block-nindent)))
(if (and mark (>= mark beg) (<= mark (1+ end))) (if (and mark (>= mark beg) (<= mark (1+ end)))
(save-excursion (goto-char (min mark end)) (save-excursion (goto-char (min mark end))
(setq markline (org-current-line) (setq markline (org-current-line)
@ -280,27 +291,23 @@ buffer."
(define-key map [mouse-1] 'org-edit-src-continue) (define-key map [mouse-1] 'org-edit-src-continue)
map)) map))
(overlay-put ovl :read-only "Leave me alone") (overlay-put ovl :read-only "Leave me alone")
(setq transmitted-variables
(append transmitted-variables `((org-edit-src-overlay ,ovl))))
(org-src-switch-to-buffer buffer 'edit) (org-src-switch-to-buffer buffer 'edit)
(if (eq single 'macro-definition) (if (eq single 'macro-definition)
(setq code (replace-regexp-in-string "\\\\n" "\n" code t t))) (setq code (replace-regexp-in-string "\\\\n" "\n" code t t)))
(insert code) (insert code)
(remove-text-properties (point-min) (point-max) (remove-text-properties (point-min) (point-max)
'(display nil invisible nil intangible nil)) '(display nil invisible nil intangible nil))
(unless preserve-indentation (unless (cadr (assq 'org-src-preserve-indentation transmitted-variables))
(setq total-nindent (or (org-do-remove-indentation) 0))) (setq total-nindent (or (org-do-remove-indentation) 0)))
(let ((org-inhibit-startup t)) (let ((org-inhibit-startup t))
(condition-case e (condition-case e
(funcall lang-f) (funcall lang-f)
(error (error
(error "Language mode `%s' fails with: %S" lang-f (nth 1 e))))) (error "Language mode `%s' fails with: %S" lang-f (nth 1 e)))))
(set (make-local-variable 'org-edit-src-force-single-line) single) (dolist (pair transmitted-variables)
(set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p) (org-set-local (car pair) (cadr pair)))
(set (make-local-variable 'org-edit-src-allow-write-back-p) allow-write-back-p)
(set (make-local-variable 'org-src-preserve-indentation) preserve-indentation)
(when babel-info
(set (make-local-variable 'org-src-babel-info) babel-info))
(when lfmt
(set (make-local-variable 'org-coderef-label-format) lfmt))
(when org-mode-p (when org-mode-p
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward "^," nil t) (while (re-search-forward "^," nil t)
@ -309,21 +316,20 @@ buffer."
(when markline (when markline
(org-goto-line (1+ (- markline begline))) (org-goto-line (1+ (- markline begline)))
(org-move-to-column (org-move-to-column
(if preserve-indentation markcol (max 0 (- markcol total-nindent)))) (if org-src-preserve-indentation markcol
(max 0 (- markcol total-nindent))))
(push-mark (point) 'no-message t) (push-mark (point) 'no-message t)
(setq deactivate-mark nil)) (setq deactivate-mark nil))
(org-goto-line (1+ (- line begline))) (org-goto-line (1+ (- line begline)))
(org-move-to-column (org-move-to-column
(if preserve-indentation col (max 0 (- col total-nindent)))) (if org-src-preserve-indentation col (max 0 (- col total-nindent))))
(org-set-local 'org-edit-src-beg-marker beg)
(org-set-local 'org-edit-src-end-marker end)
(org-set-local 'org-edit-src-overlay ovl)
(org-set-local 'org-edit-src-block-indentation block-nindent)
(org-src-mode) (org-src-mode)
(set-buffer-modified-p nil) (set-buffer-modified-p nil)
(and org-edit-src-persistent-message (and org-edit-src-persistent-message
(org-set-local 'header-line-format msg))) (org-set-local 'header-line-format msg))
(unless quietp (message "%s" msg)) (let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang))))
(when (fboundp edit-prep-func)
(funcall edit-prep-func full-info))))
t))) t)))
(defun org-edit-src-continue (e) (defun org-edit-src-continue (e)
@ -335,31 +341,31 @@ buffer."
(defun org-src-switch-to-buffer (buffer context) (defun org-src-switch-to-buffer (buffer context)
(case org-src-window-setup (case org-src-window-setup
(current-window ('current-window
(switch-to-buffer buffer)) (org-pop-to-buffer-same-window buffer))
(other-window ('other-window
(switch-to-buffer-other-window buffer)) (switch-to-buffer-other-window buffer))
(other-frame ('other-frame
(case context (case context
(exit ('exit
(let ((frame (selected-frame))) (let ((frame (selected-frame)))
(switch-to-buffer-other-frame buffer) (switch-to-buffer-other-frame buffer)
(delete-frame frame))) (delete-frame frame)))
(save ('save
(kill-buffer (current-buffer)) (kill-buffer (current-buffer))
(switch-to-buffer buffer)) (org-pop-to-buffer-same-window buffer))
(t (t
(switch-to-buffer-other-frame buffer)))) (switch-to-buffer-other-frame buffer))))
(reorganize-frame ('reorganize-frame
(if (eq context 'edit) (delete-other-windows)) (if (eq context 'edit) (delete-other-windows))
(org-switch-to-buffer-other-window buffer) (org-switch-to-buffer-other-window buffer)
(if (eq context 'exit) (delete-other-windows))) (if (eq context 'exit) (delete-other-windows)))
(switch-invisibly ('switch-invisibly
(set-buffer buffer)) (set-buffer buffer))
(t (t
(message "Invalid value %s for org-src-window-setup" (message "Invalid value %s for org-src-window-setup"
(symbol-name org-src-window-setup)) (symbol-name org-src-window-setup))
(switch-to-buffer buffer)))) (org-pop-to-buffer-same-window buffer))))
(defun org-src-construct-edit-buffer-name (org-buffer-name lang) (defun org-src-construct-edit-buffer-name (org-buffer-name lang)
"Construct the buffer name for a source editing buffer." "Construct the buffer name for a source editing buffer."
@ -394,7 +400,7 @@ the fragment in the Org-mode buffer."
(case-fold-search t) (case-fold-search t)
(msg (substitute-command-keys (msg (substitute-command-keys
"Edit, then exit with C-c ' (C-c and single quote)")) "Edit, then exit with C-c ' (C-c and single quote)"))
(org-mode-p (eq major-mode 'org-mode)) (org-mode-p (org-mode-p))
(beg (make-marker)) (beg (make-marker))
(end (make-marker)) (end (make-marker))
(preserve-indentation org-src-preserve-indentation) (preserve-indentation org-src-preserve-indentation)
@ -419,7 +425,7 @@ the fragment in the Org-mode buffer."
begline (save-excursion (goto-char beg) (org-current-line))) begline (save-excursion (goto-char beg) (org-current-line)))
(if (and (setq buffer (org-edit-src-find-buffer beg end)) (if (and (setq buffer (org-edit-src-find-buffer beg end))
(y-or-n-p "Return to existing edit buffer? [n] will revert changes: ")) (y-or-n-p "Return to existing edit buffer? [n] will revert changes: "))
(switch-to-buffer buffer) (org-pop-to-buffer-same-window buffer)
(when buffer (when buffer
(with-current-buffer buffer (with-current-buffer buffer
(if (boundp 'org-edit-src-overlay) (if (boundp 'org-edit-src-overlay)
@ -439,7 +445,7 @@ the fragment in the Org-mode buffer."
(define-key map [mouse-1] 'org-edit-src-continue) (define-key map [mouse-1] 'org-edit-src-continue)
map)) map))
(overlay-put ovl :read-only "Leave me alone") (overlay-put ovl :read-only "Leave me alone")
(switch-to-buffer buffer) (org-pop-to-buffer-same-window buffer)
(insert code) (insert code)
(remove-text-properties (point-min) (point-max) (remove-text-properties (point-min) (point-max)
'(display nil invisible nil intangible nil)) '(display nil invisible nil intangible nil))
@ -674,7 +680,7 @@ the language, a switch telling if the content should be in a single line."
(defun org-src-mode-configure-edit-buffer () (defun org-src-mode-configure-edit-buffer ()
(when (org-bound-and-true-p org-edit-src-from-org-mode) (when (org-bound-and-true-p org-edit-src-from-org-mode)
(org-add-hook 'kill-buffer-hook (org-add-hook 'kill-buffer-hook
(lambda () (delete-overlay org-edit-src-overlay)) nil 'local) #'(lambda () (delete-overlay org-edit-src-overlay)) nil 'local)
(if (org-bound-and-true-p org-edit-src-allow-write-back-p) (if (org-bound-and-true-p org-edit-src-allow-write-back-p)
(progn (progn
(setq buffer-offer-save t) (setq buffer-offer-save t)
@ -760,8 +766,9 @@ This function is called by emacs automatic fontification, as long
as `org-src-fontify-natively' is non-nil. For manual as `org-src-fontify-natively' is non-nil. For manual
fontification of code blocks see `org-src-fontify-block' and fontification of code blocks see `org-src-fontify-block' and
`org-src-fontify-buffer'" `org-src-fontify-buffer'"
(let* ((lang-mode (org-src-get-lang-mode lang)) (let ((lang-mode (org-src-get-lang-mode lang)))
(string (buffer-substring-no-properties start end)) (if (fboundp lang-mode)
(let ((string (buffer-substring-no-properties start end))
(modified (buffer-modified-p)) (modified (buffer-modified-p))
(org-buffer (current-buffer)) pos next) (org-buffer (current-buffer)) pos next)
(remove-text-properties start end '(face nil)) (remove-text-properties start end '(face nil))
@ -769,7 +776,7 @@ fontification of code blocks see `org-src-fontify-block' and
(get-buffer-create (get-buffer-create
(concat " org-src-fontification:" (symbol-name lang-mode))) (concat " org-src-fontification:" (symbol-name lang-mode)))
(delete-region (point-min) (point-max)) (delete-region (point-min) (point-max))
(insert string) (insert (concat string " ")) ;; so there's a final property change
(unless (eq major-mode lang-mode) (funcall lang-mode)) (unless (eq major-mode lang-mode) (funcall lang-mode))
(font-lock-fontify-buffer) (font-lock-fontify-buffer)
(setq pos (point-min)) (setq pos (point-min))
@ -781,8 +788,7 @@ fontification of code blocks see `org-src-fontify-block' and
(add-text-properties (add-text-properties
start end start end
'(font-lock-fontified t fontified t font-lock-multiline t)) '(font-lock-fontified t fontified t font-lock-multiline t))
(set-buffer-modified-p modified)) (set-buffer-modified-p modified)))))
t) ;; Tell `org-fontify-meta-lines-and-blocks' that we fontified
(defun org-src-fontify-block () (defun org-src-fontify-block ()
"Fontify code block at point." "Fontify code block at point."
@ -808,4 +814,5 @@ LANG is a string, and the returned major mode is a symbol."
(provide 'org-src) (provide 'org-src)
;; arch-tag: 6a1fc84f-dec7-47be-a416-64be56bea5d8
;;; org-src.el ends here ;;; org-src.el ends here

View file

@ -1,11 +1,12 @@
;;; org-table.el --- The table editor for Org-mode ;;; org-table.el --- The table editor for Org-mode
;; Copyright (C) 2004-2011 Free Software Foundation, Inc. ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp ;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org ;; Homepage: http://orgmode.org
;; Version: 7.4 ;; Version: 7.7
;; ;;
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
;; ;;
@ -46,6 +47,7 @@
(defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized (defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized
(defvar org-export-html-table-tag) ; defined in org-exp.el (defvar org-export-html-table-tag) ; defined in org-exp.el
(defvar constants-unit-system) (defvar constants-unit-system)
(defvar org-table-follow-field-mode)
(defvar orgtbl-after-send-table-hook nil (defvar orgtbl-after-send-table-hook nil
"Hook for functions attaching to `C-c C-c', if the table is sent. "Hook for functions attaching to `C-c C-c', if the table is sent.
@ -161,6 +163,27 @@ Only relevant when `org-enable-table-editor' is equal to `optimized'."
:group 'org-table-editing :group 'org-table-editing
:type 'boolean) :type 'boolean)
(defcustom org-table-exit-follow-field-mode-when-leaving-table t
"Non-nil means automatically exit the follow mode.
When nil, the follow mode will stay on and be active in any table
the cursor enters. Since the table follow filed mode messes with the
window configuration, it is not recommended to set this variable to nil,
except maybe locally in a special file that has mostly tables with long
fields."
:group 'org-table
:type 'boolean)
(defcustom org-table-fix-formulas-confirm nil
"Whether the user should confirm when Org fixes formulas."
:group 'org-table-editing
:type '(choice
(const :tag "with yes-or-no" yes-or-no-p)
(const :tag "with y-or-n" y-or-n-p)
(const :tag "no confirmation" nil)))
(put 'org-table-fix-formulas-confirm
'safe-local-variable
#'(lambda (x) (member x '(yes-or-no-p y-or-n-p))))
(defcustom org-table-tab-jumps-over-hlines t (defcustom org-table-tab-jumps-over-hlines t
"Non-nil means tab in the last column of a table with jump over a hline. "Non-nil means tab in the last column of a table with jump over a hline.
If a horizontal separator line is following the current line, If a horizontal separator line is following the current line,
@ -175,17 +198,17 @@ this line."
:tag "Org Table Calculation" :tag "Org Table Calculation"
:group 'org-table) :group 'org-table)
(defcustom org-table-use-standard-references t (defcustom org-table-use-standard-references 'from
"Should org-mode work with table references like B3 instead of @3$2? "Should org-mode work with table references like B3 instead of @3$2?
Possible values are: Possible values are:
nil never use them nil never use them
from accept as input, do not present for editing from accept as input, do not present for editing
t: accept as input and present for editing" t accept as input and present for editing"
:group 'org-table-calculation :group 'org-table-calculation
:type '(choice :type '(choice
(const :tag "Never, don't even check user input for them" nil) (const :tag "Never, don't even check user input for them" nil)
(const :tag "Always, both as user input, and when editing" t) (const :tag "Always, both as user input, and when editing" t)
(const :tag "Convert user input, don't offer during editing" 'from))) (const :tag "Convert user input, don't offer during editing" from)))
(defcustom org-table-copy-increment t (defcustom org-table-copy-increment t
"Non-nil means increment when copying current field with \\[org-table-copy-down]." "Non-nil means increment when copying current field with \\[org-table-copy-down]."
@ -208,6 +231,18 @@ relies on the variables to be present in the list."
:group 'org-table-calculation :group 'org-table-calculation
:type 'plist) :type 'plist)
(defcustom org-table-duration-custom-format 'hours
"Format for the output of calc computations like $1+$2;t.
The default value is 'hours, and will output the results as a
number of hours. Other allowed values are 'seconds, 'minutes and
'days, and the output will be a fraction of seconds, minutes or
days."
:group 'org-table-calculation
:type '(choice (symbol :tag "Seconds" 'seconds)
(symbol :tag "Minutes" 'minutes)
(symbol :tag "Hours " 'hours)
(symbol :tag "Days " 'days)))
(defcustom org-table-formula-evaluate-inline t (defcustom org-table-formula-evaluate-inline t
"Non-nil means TAB and RET evaluate a formula in current table field. "Non-nil means TAB and RET evaluate a formula in current table field.
If the current field starts with an equal sign, it is assumed to be a formula If the current field starts with an equal sign, it is assumed to be a formula
@ -315,6 +350,8 @@ available parameters."
"Table begin line, non-nil only for the duration of a command.") "Table begin line, non-nil only for the duration of a command.")
(defvar org-table-current-begin-pos nil (defvar org-table-current-begin-pos nil
"Table begin position, non-nil only for the duration of a command.") "Table begin position, non-nil only for the duration of a command.")
(defvar org-table-current-ncol nil
"Number of columns in table, non-nil only for the duration of a command.")
(defvar org-table-dlines nil (defvar org-table-dlines nil
"Vector of data line line numbers in the current table.") "Vector of data line line numbers in the current table.")
(defvar org-table-hlines nil (defvar org-table-hlines nil
@ -478,7 +515,9 @@ nil When nil, the command tries to be smart and figure out the
((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?") ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?")
((equal separator '(16)) "^\\|\t") ((equal separator '(16)) "^\\|\t")
((integerp separator) ((integerp separator)
(format "^ *\\| *\t *\\| \\{%d,\\}" separator)) (if (< separator 1)
(error "Number of spaces in separator must be >= 1")
(format "^ *\\| *\t *\\| \\{%d,\\}" separator)))
(t (error "This should not happen")))) (t (error "This should not happen"))))
(while (re-search-forward re end t) (while (re-search-forward re end t)
(replace-match "| " t t))) (replace-match "| " t t)))
@ -519,14 +558,9 @@ property, locally or anywhere up in the hierarchy."
(let* ((beg (org-table-begin)) (let* ((beg (org-table-begin))
(end (org-table-end)) (end (org-table-end))
(txt (buffer-substring-no-properties beg end)) (txt (buffer-substring-no-properties beg end))
(file (or file (file (or file (org-entry-get beg "TABLE_EXPORT_FILE" t)))
(condition-case nil
(org-entry-get beg "TABLE_EXPORT_FILE" t)
(error nil))))
(format (or format (format (or format
(condition-case nil (org-entry-get beg "TABLE_EXPORT_FORMAT" t)))
(org-entry-get beg "TABLE_EXPORT_FORMAT" t)
(error nil))))
buf deffmt-readable) buf deffmt-readable)
(unless file (unless file
(setq file (read-file-name "Export table to: ")) (setq file (read-file-name "Export table to: "))
@ -984,16 +1018,15 @@ Before doing so, re-align the table if necessary."
(defun org-table-copy-down (n) (defun org-table-copy-down (n)
"Copy a field down in the current column. "Copy a field down in the current column.
If the field at the cursor is empty, copy into it the content of the nearest If the field at the cursor is empty, copy into it the content of
non-empty field above. With argument N, use the Nth non-empty field. the nearest non-empty field above. With argument N, use the Nth
If the current field is not empty, it is copied down to the next row, and non-empty field. If the current field is not empty, it is copied
the cursor is moved with it. Therefore, repeating this command causes the down to the next row, and the cursor is moved with it.
column to be filled row-by-row. Therefore, repeating this command causes the column to be filled
If the variable `org-table-copy-increment' is non-nil and the field is an row-by-row.
integer or a timestamp, it will be incremented while copying. In the case of If the variable `org-table-copy-increment' is non-nil and the
a timestamp, if the cursor is on the year, change the year. If it is on the field is an integer or a timestamp, it will be incremented while
month or the day, change that. Point will stay on the current date field copying. In the case of a timestamp, increment by one day."
in order to easily repeat the interval."
(interactive "p") (interactive "p")
(let* ((colpos (org-table-current-column)) (let* ((colpos (org-table-current-column))
(col (current-column)) (col (current-column))
@ -1035,7 +1068,7 @@ in order to easily repeat the interval."
(org-move-to-column col)) (org-move-to-column col))
(error "No non-empty field found")))) (error "No non-empty field found"))))
(defun org-table-check-inside-data-field () (defun org-table-check-inside-data-field (&optional noerror)
"Is point inside a table data field? "Is point inside a table data field?
I.e. not on a hline or before the first or after the last column? I.e. not on a hline or before the first or after the last column?
This actually throws an error, so it aborts the current command." This actually throws an error, so it aborts the current command."
@ -1043,7 +1076,10 @@ This actually throws an error, so it aborts the current command."
(= (org-table-current-column) 0) (= (org-table-current-column) 0)
(org-at-table-hline-p) (org-at-table-hline-p)
(looking-at "[ \t]*$")) (looking-at "[ \t]*$"))
(error "Not in table data field"))) (if noerror
nil
(error "Not in table data field"))
t))
(defvar org-table-clip nil (defvar org-table-clip nil
"Clipboard for table regions.") "Clipboard for table regions.")
@ -1093,7 +1129,7 @@ Return t when the line exists, nil if it does not exist."
"Blank the current table field or active region." "Blank the current table field or active region."
(interactive) (interactive)
(org-table-check-inside-data-field) (org-table-check-inside-data-field)
(if (and (interactive-p) (org-region-active-p)) (if (and (org-called-interactively-p 'any) (org-region-active-p))
(let (org-table-clip) (let (org-table-clip)
(org-table-cut-region (region-beginning) (region-end))) (org-table-cut-region (region-beginning) (region-end)))
(skip-chars-backward "^|") (skip-chars-backward "^|")
@ -1118,7 +1154,8 @@ is always the old value."
(let* ((pos (match-beginning 0)) (let* ((pos (match-beginning 0))
(val (buffer-substring (1+ pos) (match-end 0)))) (val (buffer-substring (1+ pos) (match-end 0))))
(if replace (if replace
(replace-match (concat "|" replace) t t)) (replace-match (concat "|" (if (equal replace "") " " replace))
t t))
(goto-char (min (point-at-eol) (+ 2 pos))) (goto-char (min (point-at-eol) (+ 2 pos)))
val) val)
(forward-char 1) "")) (forward-char 1) ""))
@ -1133,13 +1170,20 @@ is always the old value."
(cname (car (rassoc (int-to-string col) org-table-column-names))) (cname (car (rassoc (int-to-string col) org-table-column-names)))
(name (car (rassoc (list (org-current-line) col) (name (car (rassoc (list (org-current-line) col)
org-table-named-field-locations))) org-table-named-field-locations)))
(eql (org-table-get-stored-formulas)) (eql (org-table-expand-lhs-ranges
(mapcar
(lambda (e)
(cons (org-table-formula-handle-first/last-rc
(car e)) (cdr e)))
(org-table-get-stored-formulas))))
(dline (org-table-current-dline)) (dline (org-table-current-dline))
(ref (format "@%d$%d" dline col)) (ref (format "@%d$%d" dline col))
(ref1 (org-table-convert-refs-to-an ref)) (ref1 (org-table-convert-refs-to-an ref))
(fequation (or (assoc name eql) (assoc ref eql))) (fequation (or (assoc name eql) (assoc ref eql)))
(cequation (assoc (int-to-string col) eql)) (cequation (assoc (int-to-string col) eql))
(eqn (or fequation cequation))) (eqn (or fequation cequation)))
(if (and eqn (get-text-property 0 :orig-eqn (car eqn)))
(setq eqn (get-text-property 0 :orig-eqn (car eqn))))
(goto-char pos) (goto-char pos)
(condition-case nil (condition-case nil
(org-table-show-reference 'local) (org-table-show-reference 'local)
@ -1161,27 +1205,30 @@ is always the old value."
(defun org-table-current-column () (defun org-table-current-column ()
"Find out which column we are in." "Find out which column we are in."
(interactive) (interactive)
(if (interactive-p) (org-table-check-inside-data-field)) (if (org-called-interactively-p 'any) (org-table-check-inside-data-field))
(save-excursion (save-excursion
(let ((cnt 0) (pos (point))) (let ((cnt 0) (pos (point)))
(beginning-of-line 1) (beginning-of-line 1)
(while (search-forward "|" pos t) (while (search-forward "|" pos t)
(setq cnt (1+ cnt))) (setq cnt (1+ cnt)))
(if (interactive-p) (message "In table column %d" cnt)) (when (org-called-interactively-p 'interactive)
(message "In table column %d" cnt))
cnt))) cnt)))
(defun org-table-current-dline () (defun org-table-current-dline ()
"Find out what table data line we are in. "Find out what table data line we are in.
Only data lines count for this." Only data lines count for this."
(interactive) (interactive)
(if (interactive-p) (org-table-check-inside-data-field)) (when (org-called-interactively-p 'any)
(org-table-check-inside-data-field))
(save-excursion (save-excursion
(let ((cnt 0) (pos (point))) (let ((cnt 0) (pos (point)))
(goto-char (org-table-begin)) (goto-char (org-table-begin))
(while (<= (point) pos) (while (<= (point) pos)
(if (looking-at org-table-dataline-regexp) (setq cnt (1+ cnt))) (if (looking-at org-table-dataline-regexp) (setq cnt (1+ cnt)))
(beginning-of-line 2)) (beginning-of-line 2))
(if (interactive-p) (message "This is table line %d" cnt)) (when (org-called-interactively-p 'any)
(message "This is table line %d" cnt))
cnt))) cnt)))
(defun org-table-goto-column (n &optional on-delim force) (defun org-table-goto-column (n &optional on-delim force)
@ -1229,8 +1276,10 @@ However, when FORCE is non-nil, create new columns if necessary."
(org-goto-line linepos) (org-goto-line linepos)
(org-table-goto-column colpos) (org-table-goto-column colpos)
(org-table-align) (org-table-align)
(when (or (not org-table-fix-formulas-confirm)
(funcall org-table-fix-formulas-confirm "Fix formulas? "))
(org-table-fix-formulas "$" nil (1- col) 1) (org-table-fix-formulas "$" nil (1- col) 1)
(org-table-fix-formulas "$LR" nil (1- col) 1))) (org-table-fix-formulas "$LR" nil (1- col) 1))))
(defun org-table-find-dataline () (defun org-table-find-dataline ()
"Find a data line in the current table, which is needed for column commands." "Find a data line in the current table, which is needed for column commands."
@ -1251,6 +1300,28 @@ However, when FORCE is non-nil, create new columns if necessary."
(error (error
"Please position cursor in a data line for column operations"))))) "Please position cursor in a data line for column operations")))))
(defun org-table-line-to-dline (line &optional above)
"Turn a buffer line number into a data line number.
If there is no data line in this line, return nil.
If there is no matchin dline (most likely te refrence was a hline), the
first dline below it is used. When ABOVE is non-nil, the one above is used."
(catch 'exit
(let ((ll (length org-table-dlines))
i)
(if above
(progn
(setq i (1- ll))
(while (> i 0)
(if (<= (aref org-table-dlines i) line)
(throw 'exit i))
(setq i (1- i))))
(setq i 1)
(while (< i ll)
(if (>= (aref org-table-dlines i) line)
(throw 'exit i))
(setq i (1+ i)))))
nil))
(defun org-table-delete-column () (defun org-table-delete-column ()
"Delete a column from the table." "Delete a column from the table."
(interactive) (interactive)
@ -1276,10 +1347,12 @@ However, when FORCE is non-nil, create new columns if necessary."
(org-goto-line linepos) (org-goto-line linepos)
(org-table-goto-column colpos) (org-table-goto-column colpos)
(org-table-align) (org-table-align)
(when (or (not org-table-fix-formulas-confirm)
(funcall org-table-fix-formulas-confirm "Fix formulas? "))
(org-table-fix-formulas "$" (list (cons (number-to-string col) "INVALID")) (org-table-fix-formulas "$" (list (cons (number-to-string col) "INVALID"))
col -1 col) col -1 col)
(org-table-fix-formulas "$LR" (list (cons (number-to-string col) "INVALID")) (org-table-fix-formulas "$LR" (list (cons (number-to-string col) "INVALID"))
col -1 col))) col -1 col))))
(defun org-table-move-column-right () (defun org-table-move-column-right ()
"Move column to the right." "Move column to the right."
@ -1320,12 +1393,14 @@ However, when FORCE is non-nil, create new columns if necessary."
(org-goto-line linepos) (org-goto-line linepos)
(org-table-goto-column colpos) (org-table-goto-column colpos)
(org-table-align) (org-table-align)
(when (or (not org-table-fix-formulas-confirm)
(funcall org-table-fix-formulas-confirm "Fix formulas? "))
(org-table-fix-formulas (org-table-fix-formulas
"$" (list (cons (number-to-string col) (number-to-string colpos)) "$" (list (cons (number-to-string col) (number-to-string colpos))
(cons (number-to-string colpos) (number-to-string col)))) (cons (number-to-string colpos) (number-to-string col))))
(org-table-fix-formulas (org-table-fix-formulas
"$LR" (list (cons (number-to-string col) (number-to-string colpos)) "$LR" (list (cons (number-to-string col) (number-to-string colpos))
(cons (number-to-string colpos) (number-to-string col)))))) (cons (number-to-string colpos) (number-to-string col)))))))
(defun org-table-move-row-down () (defun org-table-move-row-down ()
"Move table row down." "Move table row down."
@ -1361,7 +1436,10 @@ However, when FORCE is non-nil, create new columns if necessary."
(insert txt) (insert txt)
(beginning-of-line 0) (beginning-of-line 0)
(org-move-to-column col) (org-move-to-column col)
(unless (or hline1p hline2p) (unless (or hline1p hline2p
(not (or (not org-table-fix-formulas-confirm)
(funcall org-table-fix-formulas-confirm
"Fix formulas? "))))
(org-table-fix-formulas (org-table-fix-formulas
"@" (list (cons (number-to-string dline1) (number-to-string dline2)) "@" (list (cons (number-to-string dline1) (number-to-string dline2))
(cons (number-to-string dline2) (number-to-string dline1))))))) (cons (number-to-string dline2) (number-to-string dline1)))))))
@ -1383,7 +1461,9 @@ With prefix ARG, insert below the current line."
(re-search-forward "| ?" (point-at-eol) t) (re-search-forward "| ?" (point-at-eol) t)
(and (or org-table-may-need-update org-table-overlay-coordinates) (and (or org-table-may-need-update org-table-overlay-coordinates)
(org-table-align)) (org-table-align))
(org-table-fix-formulas "@" nil (1- (org-table-current-dline)) 1))) (when (or (not org-table-fix-formulas-confirm)
(funcall org-table-fix-formulas-confirm "Fix formulas? "))
(org-table-fix-formulas "@" nil (1- (org-table-current-dline)) 1))))
(defun org-table-insert-hline (&optional above) (defun org-table-insert-hline (&optional above)
"Insert a horizontal-line below the current line into the table. "Insert a horizontal-line below the current line into the table.
@ -1444,8 +1524,10 @@ In particular, this does handle wide and invisible characters."
(kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))) (kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max)))
(if (not (org-at-table-p)) (beginning-of-line 0)) (if (not (org-at-table-p)) (beginning-of-line 0))
(org-move-to-column col) (org-move-to-column col)
(when (or (not org-table-fix-formulas-confirm)
(funcall org-table-fix-formulas-confirm "Fix formulas? "))
(org-table-fix-formulas "@" (list (cons (number-to-string dline) "INVALID")) (org-table-fix-formulas "@" (list (cons (number-to-string dline) "INVALID"))
dline -1 dline))) dline -1 dline))))
(defun org-table-sort-lines (with-case &optional sorting-type) (defun org-table-sort-lines (with-case &optional sorting-type)
"Sort table lines according to the column at point. "Sort table lines according to the column at point.
@ -1473,7 +1555,7 @@ should be done in reverse order."
(thiscol (org-table-current-column)) (thiscol (org-table-current-column))
beg end bcol ecol tend tbeg column lns pos) beg end bcol ecol tend tbeg column lns pos)
(when (equal thiscol 0) (when (equal thiscol 0)
(if (interactive-p) (if (org-called-interactively-p 'any)
(setq thiscol (setq thiscol
(string-to-number (string-to-number
(read-string "Use column N for sorting: "))) (read-string "Use column N for sorting: ")))
@ -1724,21 +1806,38 @@ This is mainly useful for fields that contain hidden parts.
When called with a \\[universal-argument] prefix, just make the full field visible so that When called with a \\[universal-argument] prefix, just make the full field visible so that
it can be edited in place." it can be edited in place."
(interactive "P") (interactive "P")
(if arg (cond
((equal arg '(16))
(org-table-follow-field-mode (if org-table-follow-field-mode -1 1)))
(arg
(let ((b (save-excursion (skip-chars-backward "^|") (point))) (let ((b (save-excursion (skip-chars-backward "^|") (point)))
(e (save-excursion (skip-chars-forward "^|\r\n") (point)))) (e (save-excursion (skip-chars-forward "^|\r\n") (point))))
(remove-text-properties b e '(org-cwidth t invisible t (remove-text-properties b e '(org-cwidth t invisible t
display t intangible t)) display t intangible t))
(if (and (boundp 'font-lock-mode) font-lock-mode) (if (and (boundp 'font-lock-mode) font-lock-mode)
(font-lock-fontify-block))) (font-lock-fontify-block))))
(t
(let ((pos (move-marker (make-marker) (point))) (let ((pos (move-marker (make-marker) (point)))
(coord
(if (eq org-table-use-standard-references t)
(concat (org-number-to-letters (org-table-current-column))
(int-to-string (org-table-current-dline)))
(concat "@" (int-to-string (org-table-current-dline))
"$" (int-to-string (org-table-current-column)))))
(field (org-table-get-field)) (field (org-table-get-field))
(cw (current-window-configuration)) (cw (current-window-configuration))
p) p)
(org-switch-to-buffer-other-window "*Org tmp*") (goto-char pos)
(org-switch-to-buffer-other-window "*Org Table Edit Field*")
(when (and (local-variable-p 'org-field-marker)
(markerp org-field-marker))
(move-marker org-field-marker nil))
(erase-buffer) (erase-buffer)
(insert "#\n# Edit field and finish with C-c C-c\n#\n") (insert "#\n# Edit field " coord " and finish with C-c C-c\n#\n")
(let ((org-inhibit-startup t)) (org-mode)) (let ((org-inhibit-startup t)) (org-mode))
(auto-fill-mode -1)
(setq truncate-lines nil)
(setq word-wrap t)
(goto-char (setq p (point-max))) (goto-char (setq p (point-max)))
(insert (org-trim field)) (insert (org-trim field))
(remove-text-properties p (point-max) (remove-text-properties p (point-max)
@ -1748,7 +1847,7 @@ it can be edited in place."
(org-set-local 'org-finish-function 'org-table-finish-edit-field) (org-set-local 'org-finish-function 'org-table-finish-edit-field)
(org-set-local 'org-window-configuration cw) (org-set-local 'org-window-configuration cw)
(org-set-local 'org-field-marker pos) (org-set-local 'org-field-marker pos)
(message "Edit and finish with C-c C-c")))) (message "Edit and finish with C-c C-c")))))
(defun org-table-finish-edit-field () (defun org-table-finish-edit-field ()
"Finish editing a table data field. "Finish editing a table data field.
@ -1773,6 +1872,35 @@ the table and kill the editing buffer."
(org-table-align) (org-table-align)
(message "New field value inserted"))) (message "New field value inserted")))
(define-minor-mode org-table-follow-field-mode
"Minor mode to make the table field editor window follow the cursor.
When this mode is active, the field editor window will always show the
current field. The mode exits automatically when the cursor leaves the
table (but see `org-table-exit-follow-field-mode-when-leaving-table')."
nil " TblFollow" nil
(if org-table-follow-field-mode
(org-add-hook 'post-command-hook 'org-table-follow-fields-with-editor
'append 'local)
(remove-hook 'post-command-hook 'org-table-follow-fields-with-editor 'local)
(let* ((buf (get-buffer "*Org Table Edit Field*"))
(win (and buf (get-buffer-window buf))))
(when win (delete-window win))
(when buf
(with-current-buffer buf
(move-marker org-field-marker nil))
(kill-buffer buf)))))
(defun org-table-follow-fields-with-editor ()
(if (and org-table-exit-follow-field-mode-when-leaving-table
(not (org-at-table-p)))
;; We have left the table, exit the follow mode
(org-table-follow-field-mode -1)
(when (org-table-check-inside-data-field 'noerror)
(let ((win (selected-window)))
(org-table-edit-field nil)
(org-fit-window-to-buffer)
(select-window win)))))
(defvar org-timecnt) ; dynamically scoped parameter (defvar org-timecnt) ; dynamically scoped parameter
(defun org-table-sum (&optional beg end nlast) (defun org-table-sum (&optional beg end nlast)
@ -1826,7 +1954,7 @@ If NLAST is a number, only the NLAST fields will actually be summed."
s diff) s diff)
(format "%d:%02d:%02d" h m s)))) (format "%d:%02d:%02d" h m s))))
(kill-new sres) (kill-new sres)
(if (interactive-p) (if (org-called-interactively-p 'interactive)
(message "%s" (message "%s"
(substitute-command-keys (substitute-command-keys
(format "Sum of %d items: %-20s (\\[yank] will insert result into buffer)" (format "Sum of %d items: %-20s (\\[yank] will insert result into buffer)"
@ -1950,11 +2078,23 @@ When NAMED is non-nil, look for a named equation."
"\n"))) "\n")))
(defsubst org-table-formula-make-cmp-string (a) (defsubst org-table-formula-make-cmp-string (a)
(when (string-match "^\\(@\\([0-9]+\\)\\)?\\(\\$?\\([0-9]+\\)\\)?\\(\\$?[a-zA-Z0-9]+\\)?" a) (when (string-match "\\`$[<>]" a)
(let ((arrow (string-to-char (substring a 1))))
;; Fake a high number to make sure this is sorted at the end.
(setq a (org-table-formula-handle-first/last-rc a))
(setq a (format "$%d" (+ 10000
(if (= arrow ?<) -1000 0)
(string-to-number (substring a 1)))))))
(when (string-match
"^\\(@\\([0-9]+\\)\\)?\\(\\$?\\([0-9]+\\)\\)?\\(\\$?[a-zA-Z0-9]+\\)?"
a)
(concat (concat
(if (match-end 2) (format "@%05d" (string-to-number (match-string 2 a))) "") (if (match-end 2)
(if (match-end 4) (format "$%05d" (string-to-number (match-string 4 a))) "") (format "@%05d" (string-to-number (match-string 2 a))) "")
(if (match-end 5) (concat "@@" (match-string 5 a)))))) (if (match-end 4)
(format "$%05d" (string-to-number (match-string 4 a))) "")
(if (match-end 5)
(concat "@@" (match-string 5 a))))))
(defun org-table-formula-less-p (a b) (defun org-table-formula-less-p (a b)
"Compare two formulas for sorting." "Compare two formulas for sorting."
@ -1969,12 +2109,15 @@ When NAMED is non-nil, look for a named equation."
(save-excursion (save-excursion
(goto-char (org-table-end)) (goto-char (org-table-end))
(when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+TBLFM: *\\(.*\\)") (when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+TBLFM: *\\(.*\\)")
(setq strings (org-split-string (match-string 2) " *:: *")) (setq strings (org-split-string (org-match-string-no-properties 2)
" *:: *"))
(while (setq string (pop strings)) (while (setq string (pop strings))
(when (string-match "\\`\\(@[0-9]+\\$[0-9]+\\|\\$\\([a-zA-Z0-9]+\\)\\) *= *\\(.*[^ \t]\\)" string) (when (string-match "\\`\\(@[-+I<>0-9.$@]+\\|@?[0-9]+\\|\\$\\([a-zA-Z0-9]+\\|[<>]+\\)\\) *= *\\(.*[^ \t]\\)" string)
(setq scol (if (match-end 2) (setq scol (if (match-end 2)
(match-string 2 string) (match-string 2 string)
(match-string 1 string)) (match-string 1 string))
scol (if (member (string-to-char scol) '(?< ?>))
(concat "$" scol) scol)
eq (match-string 3 string) eq (match-string 3 string)
eq-alist (cons (cons scol eq) eq-alist)) eq-alist (cons (cons scol eq) eq-alist))
(if (member scol seen) (if (member scol seen)
@ -2027,7 +2170,8 @@ For all numbers larger than LIMIT, shift them by DELTA."
org-table-named-field-locations nil org-table-named-field-locations nil
org-table-current-begin-line nil org-table-current-begin-line nil
org-table-current-begin-pos nil org-table-current-begin-pos nil
org-table-current-line-types nil) org-table-current-line-types nil
org-table-current-ncol 0)
(goto-char beg) (goto-char beg)
(when (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t) (when (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t)
(setq names (org-split-string (match-string 1) " *| *") (setq names (org-split-string (match-string 1) " *| *")
@ -2083,6 +2227,7 @@ For all numbers larger than LIMIT, shift them by DELTA."
"[ \t]*|[ \t]*")) "[ \t]*|[ \t]*"))
(nfields (length fields)) (nfields (length fields))
al al2) al al2)
(setq org-table-current-ncol nfields)
(loop for i from 1 to nfields do (loop for i from 1 to nfields do
(push (list (format "LR%d" i) l i) al) (push (list (format "LR%d" i) l i) al)
(push (cons (format "LR%d" i) (nth (1- i) fields)) al2)) (push (cons (format "LR%d" i) (nth (1- i) fields)) al2))
@ -2091,7 +2236,6 @@ For all numbers larger than LIMIT, shift them by DELTA."
(setq org-table-local-parameters (setq org-table-local-parameters
(append org-table-local-parameters al2)))))) (append org-table-local-parameters al2))))))
(defun org-table-maybe-eval-formula () (defun org-table-maybe-eval-formula ()
"Check if the current field starts with \"=\" or \":=\". "Check if the current field starts with \"=\" or \":=\".
If yes, store the formula and apply it." If yes, store the formula and apply it."
@ -2180,7 +2324,8 @@ of the new mark."
(org-goto-line l1))) (org-goto-line l1)))
(if (not (= epos (point-at-eol))) (org-table-align)) (if (not (= epos (point-at-eol))) (org-table-align))
(org-goto-line l) (org-goto-line l)
(and (interactive-p) (message "%s" (cdr (assoc new org-recalc-marks)))))) (and (org-called-interactively-p 'interactive)
(message "%s" (cdr (assoc new org-recalc-marks))))))
(defun org-table-maybe-recalculate-line () (defun org-table-maybe-recalculate-line ()
"Recompute the current line if marked for it, and if we haven't just done it." "Recompute the current line if marked for it, and if we haven't just done it."
@ -2264,7 +2409,7 @@ not overwrite the stored one."
(modes (copy-sequence org-calc-default-modes)) (modes (copy-sequence org-calc-default-modes))
(numbers nil) ; was a variable, now fixed default (numbers nil) ; was a variable, now fixed default
(keep-empty nil) (keep-empty nil)
n form form0 bw fmt x ev orig c lispp literal) n form form0 formrpl formrg bw fmt x ev orig c lispp literal duration)
;; Parse the format string. Since we have a lot of modes, this is ;; Parse the format string. Since we have a lot of modes, this is
;; a lot of work. However, I think calc still uses most of the time. ;; a lot of work. However, I think calc still uses most of the time.
(if (string-match ";" formula) (if (string-match ";" formula)
@ -2283,8 +2428,17 @@ not overwrite the stored one."
(?s . sci) (?e . eng)))) (?s . sci) (?e . eng))))
n)))) n))))
(setq fmt (replace-match "" t t fmt))) (setq fmt (replace-match "" t t fmt)))
(if (string-match "[NT]" fmt) (if (string-match "T" fmt)
(setq numbers (equal (match-string 0 fmt) "N") (setq duration t numbers t
duration-output-format nil
fmt (replace-match "" t t fmt)))
(if (string-match "t" fmt)
(setq duration t
duration-output-format org-table-duration-custom-format
numbers t
fmt (replace-match "" t t fmt)))
(if (string-match "N" fmt)
(setq numbers t
fmt (replace-match "" t t fmt))) fmt (replace-match "" t t fmt)))
(if (string-match "L" fmt) (if (string-match "L" fmt)
(setq literal t (setq literal t
@ -2305,6 +2459,11 @@ not overwrite the stored one."
(org-no-properties (org-no-properties
(buffer-substring (point-at-bol) (point-at-eol))) (buffer-substring (point-at-bol) (point-at-eol)))
" *| *")) " *| *"))
;; replace fields with duration values if relevant
(if duration
(setq fields
(mapcar (lambda (x) (org-table-time-string-to-seconds x))
fields)))
(if (eq numbers t) (if (eq numbers t)
(setq fields (mapcar (setq fields (mapcar
(lambda (x) (number-to-string (string-to-number x))) (lambda (x) (number-to-string (string-to-number x)))
@ -2342,13 +2501,22 @@ not overwrite the stored one."
;; Insert complex ranges ;; Insert complex ranges
(while (and (string-match org-table-range-regexp form) (while (and (string-match org-table-range-regexp form)
(> (length (match-string 0 form)) 1)) (> (length (match-string 0 form)) 1))
(setq form (setq formrg (save-match-data
(replace-match (org-table-get-range (match-string 0 form) nil n0)))
(setq formrpl
(save-match-data (save-match-data
(org-table-make-reference (org-table-make-reference
(org-table-get-range (match-string 0 form) nil n0) ;; possibly handle durations
keep-empty numbers lispp)) (if duration
t t form))) (if (listp formrg)
(mapcar (lambda(x) (org-table-time-string-to-seconds x)) formrg)
(org-table-time-string-to-seconds formrg))
formrg)
keep-empty numbers lispp)))
(if (not (save-match-data
(string-match (regexp-quote form) formrpl)))
(setq form (replace-match formrpl t t form))
(error "Spreadsheet error: invalid reference \"%s\"" form)))
;; Insert simple ranges ;; Insert simple ranges
(while (string-match "\\$\\([0-9]+\\)\\.\\.\\$\\([0-9]+\\)" form) (while (string-match "\\$\\([0-9]+\\)\\.\\.\\$\\([0-9]+\\)" form)
(setq form (setq form
@ -2362,9 +2530,10 @@ not overwrite the stored one."
t t form))) t t form)))
(setq form0 form) (setq form0 form)
;; Insert the references to fields in same row ;; Insert the references to fields in same row
(while (string-match "\\$\\([0-9]+\\)" form) (while (string-match "\\$\\(\\([-+]\\)?[0-9]+\\)" form)
(setq n (string-to-number (match-string 1 form)) (setq n (+ (string-to-number (match-string 1 form))
x (nth (1- (if (= n 0) n0 n)) fields)) (if (match-end 2) n0 0))
x (nth (1- (if (= n 0) n0 (max n 1))) fields))
(unless x (error "Invalid field specifier \"%s\"" (unless x (error "Invalid field specifier \"%s\""
(match-string 0 form))) (match-string 0 form)))
(setq form (replace-match (setq form (replace-match
@ -2376,11 +2545,16 @@ not overwrite the stored one."
(setq ev (condition-case nil (setq ev (condition-case nil
(eval (eval (read form))) (eval (eval (read form)))
(error "#ERROR")) (error "#ERROR"))
ev (if (numberp ev) (number-to-string ev) ev)) ev (if (numberp ev) (number-to-string ev) ev)
ev (if duration (org-table-time-seconds-to-string
(string-to-number ev)
duration-output-format) ev))
(or (fboundp 'calc-eval) (or (fboundp 'calc-eval)
(error "Calc does not seem to be installed, and is needed to evaluate the formula")) (error "Calc does not seem to be installed, and is needed to evaluate the formula"))
(setq ev (calc-eval (cons form modes) (setq ev (calc-eval (cons form modes) (if numbers 'num))
(if numbers 'num)))) ev (if duration (org-table-time-seconds-to-string
(string-to-number ev)
duration-output-format) ev)))
(when org-table-formula-debug (when org-table-formula-debug
(with-output-to-temp-buffer "*Substitution History*" (with-output-to-temp-buffer "*Substitution History*"
@ -2397,7 +2571,7 @@ $1-> %s\n" orig formula form0 form))
(if fmt (format fmt (string-to-number ev)) ev))))) (if fmt (format fmt (string-to-number ev)) ev)))))
(setq bw (get-buffer-window "*Substitution History*")) (setq bw (get-buffer-window "*Substitution History*"))
(org-fit-window-to-buffer bw) (org-fit-window-to-buffer bw)
(unless (and (interactive-p) (not ndown)) (unless (and (org-called-interactively-p 'any) (not ndown))
(unless (let (inhibit-redisplay) (unless (let (inhibit-redisplay)
(y-or-n-p "Debugging Formula. Continue to next? ")) (y-or-n-p "Debugging Formula. Continue to next? "))
(org-table-align) (org-table-align)
@ -2420,11 +2594,16 @@ $1-> %s\n" orig formula form0 form))
(progn (skip-chars-forward "^|") (point)) (progn (skip-chars-forward "^|") (point))
prop value))) prop value)))
(defun org-table-get-range (desc &optional tbeg col highlight) (defun org-table-get-range (desc &optional tbeg col highlight corners-only)
"Get a calc vector from a column, according to descriptor DESC. "Get a calc vector from a column, according to descriptor DESC.
Optional arguments TBEG and COL can give the beginning of the table and Optional arguments TBEG and COL can give the beginning of the table and
the current column, to avoid unnecessary parsing. the current column, to avoid unnecessary parsing.
HIGHLIGHT means just highlight the range."
HIGHLIGHT means just highlight the range.
When CORNERS-ONLY is set, only return the corners of the range as
a list (line1 column1 line2 column2) where line1 and line2 are line numbers
in the buffer and column1 and column2 are table column numbers."
(if (not (equal (string-to-char desc) ?@)) (if (not (equal (string-to-char desc) ?@))
(setq desc (concat "@" desc))) (setq desc (concat "@" desc)))
(save-excursion (save-excursion
@ -2453,7 +2632,8 @@ HIGHLIGHT means just highlight the range."
(if (not r2) (setq r2 thisline)) (if (not r2) (setq r2 thisline))
(if (not c1) (setq c1 col)) (if (not c1) (setq c1 col))
(if (not c2) (setq c2 col)) (if (not c2) (setq c2 col))
(if (or (not rangep) (and (= r1 r2) (= c1 c2))) (if (and (not corners-only)
(or (not rangep) (and (= r1 r2) (= c1 c2))))
;; just one field ;; just one field
(progn (progn
(org-goto-line r1) (org-goto-line r1)
@ -2465,6 +2645,10 @@ HIGHLIGHT means just highlight the range."
;; First sort the numbers to get a regular ractangle ;; First sort the numbers to get a regular ractangle
(if (< r2 r1) (setq tmp r1 r1 r2 r2 tmp)) (if (< r2 r1) (setq tmp r1 r1 r2 r2 tmp))
(if (< c2 c1) (setq tmp c1 c1 c2 c2 tmp)) (if (< c2 c1) (setq tmp c1 c1 c2 c2 tmp))
(if corners-only
;; Only return the corners of the range
(list r1 c1 r2 c2)
;; Copy the range values into a list
(org-goto-line r1) (org-goto-line r1)
(while (not (looking-at org-table-dataline-regexp)) (while (not (looking-at org-table-dataline-regexp))
(beginning-of-line 2)) (beginning-of-line 2))
@ -2480,7 +2664,7 @@ HIGHLIGHT means just highlight the range."
beg (progn (skip-chars-forward "^|\n") (point)))) beg (progn (skip-chars-forward "^|\n") (point))))
;; return string representation of calc vector ;; return string representation of calc vector
(mapcar 'org-trim (mapcar 'org-trim
(apply 'append (org-table-copy-region beg end))))))) (apply 'append (org-table-copy-region beg end))))))))
(defun org-table-get-descriptor-line (desc &optional cline bline table) (defun org-table-get-descriptor-line (desc &optional cline bline table)
"Analyze descriptor DESC and retrieve the corresponding line number. "Analyze descriptor DESC and retrieve the corresponding line number.
@ -2596,16 +2780,29 @@ known that the table will be realigned a little later anyway."
(org-table-get-specials) (org-table-get-specials)
(let* ((eqlist (sort (org-table-get-stored-formulas) (let* ((eqlist (sort (org-table-get-stored-formulas)
(lambda (a b) (string< (car a) (car b))))) (lambda (a b) (string< (car a) (car b)))))
(eqlist1 (copy-sequence eqlist))
(inhibit-redisplay (not debug-on-error)) (inhibit-redisplay (not debug-on-error))
(line-re org-table-dataline-regexp) (line-re org-table-dataline-regexp)
(thisline (org-current-line)) (thisline (org-current-line))
(thiscol (org-table-current-column)) (thiscol (org-table-current-column))
beg end entry eqlnum eqlname eqlname1 eql (cnt 0) eq a name) seen-fields lhs1
beg end entry eqlnum eqlname eqlname1 eql (cnt 0) eq a name name1)
;; Insert constants in all formulas ;; Insert constants in all formulas
(setq eqlist (setq eqlist
(mapcar (lambda (x) (mapcar (lambda (x)
(setcdr x (org-table-formula-substitute-names (cdr x))) (when (string-match "\\`$[<>]" (car x))
x) (setq lhs1 (car x))
(setq x (cons (substring
(org-table-formula-handle-first/last-rc
(car x)) 1)
(cdr x)))
(if (assoc (car x) eqlist1)
(error "\"%s=\" formula tries to overwrite existing formula for column %s"
lhs1 (car x))))
(cons
(org-table-formula-handle-first/last-rc (car x))
(org-table-formula-substitute-names
(org-table-formula-handle-first/last-rc (cdr x)))))
eqlist)) eqlist))
;; Split the equation list ;; Split the equation list
(while (setq eq (pop eqlist)) (while (setq eq (pop eqlist))
@ -2613,6 +2810,10 @@ known that the table will be realigned a little later anyway."
(push eq eqlnum) (push eq eqlnum)
(push eq eqlname))) (push eq eqlname)))
(setq eqlnum (nreverse eqlnum) eqlname (nreverse eqlname)) (setq eqlnum (nreverse eqlnum) eqlname (nreverse eqlname))
;; Expand ranges in lhs of formulas
(setq eqlname (org-table-expand-lhs-ranges eqlname))
;; Get the correct line range to process
(if all (if all
(progn (progn
(setq end (move-marker (make-marker) (1+ (org-table-end)))) (setq end (move-marker (make-marker) (1+ (org-table-end))))
@ -2631,11 +2832,19 @@ known that the table will be realigned a little later anyway."
(goto-char beg) (goto-char beg)
(and all (message "Re-applying formulas to full table...")) (and all (message "Re-applying formulas to full table..."))
;; First find the named fields, and mark them untouchable ;; First find the named fields, and mark them untouchable.
;; Also check if several field/range formulas try to set the same field.
(remove-text-properties beg end '(org-untouchable t)) (remove-text-properties beg end '(org-untouchable t))
(while (setq eq (pop eqlname)) (while (setq eq (pop eqlname))
(setq name (car eq) (setq name (car eq)
a (assoc name org-table-named-field-locations)) a (assoc name org-table-named-field-locations))
(setq name1 name)
(if a (setq name1 (format "@%d$%d" (org-table-line-to-dline (nth 1 a))
(nth 2 a))))
(when (member name1 seen-fields)
(error "Several field/range formulas try to set %s" name1))
(push name1 seen-fields)
(and (not a) (and (not a)
(string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" name) (string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" name)
(setq a (list name (setq a (list name
@ -2651,6 +2860,7 @@ known that the table will be realigned a little later anyway."
(org-table-goto-column (nth 2 a)) (org-table-goto-column (nth 2 a))
(push (append a (list (cdr eq))) eqlname1) (push (append a (list (cdr eq))) eqlname1)
(org-table-put-field-property :org-untouchable t))) (org-table-put-field-property :org-untouchable t)))
(setq eqlname1 (nreverse eqlname1))
;; Now evaluate the column formulas, but skip fields covered by ;; Now evaluate the column formulas, but skip fields covered by
;; field formulas ;; field formulas
@ -2691,7 +2901,9 @@ known that the table will be realigned a little later anyway."
(and all (message "Re-applying formulas...done")))))) (and all (message "Re-applying formulas...done"))))))
(defun org-table-iterate (&optional arg) (defun org-table-iterate (&optional arg)
"Recalculate the table until it does not change anymore." "Recalculate the table until it does not change anymore.
The maximun number of iterations is 10, but you can chose a different value
with the prefix ARG."
(interactive "P") (interactive "P")
(let ((imax (if arg (prefix-numeric-value arg) 10)) (let ((imax (if arg (prefix-numeric-value arg) 10))
(i 0) (i 0)
@ -2740,6 +2952,64 @@ known that the table will be realigned a little later anyway."
(setq checksum c1))) (setq checksum c1)))
(error "No convergence after %d iterations" imax)))))) (error "No convergence after %d iterations" imax))))))
(defun org-table-expand-lhs-ranges (equations)
"Expand list of formulas.
If some of the RHS in the formulas are ranges or a row reference, expand
them to individual field equations for each field."
(let (e res lhs rhs range r1 r2 c1 c2)
(while (setq e (pop equations))
(setq lhs (car e) rhs (cdr e))
(cond
((string-match "^@-?[-+I0-9]+\\$-?[0-9]+$" lhs)
;; This just refers to one fixed field
(push e res))
((string-match "^[a-zA-Z][a-zA-Z0-9]*$" lhs)
;; This just refers to one fixed named field
(push e res))
((string-match "^@[0-9]+$" lhs)
(loop for ic from 1 to org-table-current-ncol do
(push (cons (format "%s$%d" lhs ic) rhs) res)
(put-text-property 0 (length (caar res))
:orig-eqn e (caar res))))
(t
(setq range (org-table-get-range lhs org-table-current-begin-pos
1 nil 'corners))
(setq r1 (nth 0 range) c1 (nth 1 range)
r2 (nth 2 range) c2 (nth 3 range))
(setq r1 (org-table-line-to-dline r1))
(setq r2 (org-table-line-to-dline r2 'above))
(loop for ir from r1 to r2 do
(loop for ic from c1 to c2 do
(push (cons (format "@%d$%d" ir ic) rhs) res)
(put-text-property 0 (length (caar res))
:orig-eqn e (caar res)))))))
(nreverse res)))
(defun org-table-formula-handle-first/last-rc (s)
"Replace @<, @>, $<, $> with first/last row/column of the table.
So @< and $< will always be replaced with @1 and $1, respectively.
The advantage of these special markers are that structure editing of
the table will not change them, while @1 and $1 will be modified
when a line/row is swaped out of that privileged position. So for
formulas that use a range of rows or columns, it may often be better
to anchor the formula with \"I\" row markers, or to offset from the
borders of the table using the @< @> $< $> makers."
(let (n nmax len char)
(while (string-match "\\([@$]\\)\\(<+\\|>+\\)" s)
(setq nmax (if (equal (match-string 1 s) "@")
(1- (length org-table-dlines))
org-table-current-ncol)
len (- (match-end 2) (match-beginning 2))
char (string-to-char (match-string 2 s))
n (if (= char ?<)
len
(- nmax len -1)))
(if (or (< n 1) (> n nmax))
(error "Reference \"%s\" in expression \"%s\" points outside table"
(match-string 0 s) s))
(setq s (replace-match (format "%s%d" (match-string 1 s) n) t t s))))
s)
(defun org-table-formula-substitute-names (f) (defun org-table-formula-substitute-names (f)
"Replace $const with values in string F." "Replace $const with values in string F."
(let ((start 0) a (f1 f) (pp (/= (string-to-char f) ?'))) (let ((start 0) a (f1 f) (pp (/= (string-to-char f) ?')))
@ -2842,7 +3112,7 @@ Parameters get priority."
(wc (current-window-configuration)) (wc (current-window-configuration))
(sel-win (selected-window)) (sel-win (selected-window))
(titles '((column . "# Column Formulas\n") (titles '((column . "# Column Formulas\n")
(field . "# Field Formulas\n") (field . "# Field and Range Formulas\n")
(named . "# Named Field Formulas\n"))) (named . "# Named Field Formulas\n")))
entry s type title) entry s type title)
(org-switch-to-buffer-other-window "*Edit Formulas*") (org-switch-to-buffer-other-window "*Edit Formulas*")
@ -2860,15 +3130,16 @@ Parameters get priority."
(setq startline (org-current-line)) (setq startline (org-current-line))
(while (setq entry (pop eql)) (while (setq entry (pop eql))
(setq type (cond (setq type (cond
((string-match "\\`$[<>]" (car entry)) 'column)
((equal (string-to-char (car entry)) ?@) 'field) ((equal (string-to-char (car entry)) ?@) 'field)
((string-match "^[0-9]" (car entry)) 'column) ((string-match "^[0-9]" (car entry)) 'column)
(t 'named))) (t 'named)))
(when (setq title (assq type titles)) (when (setq title (assq type titles))
(or (bobp) (insert "\n")) (or (bobp) (insert "\n"))
(insert (org-add-props (cdr title) nil 'face font-lock-comment-face)) (insert (org-add-props (cdr title) nil 'face font-lock-comment-face))
(setq titles (delq title titles))) (setq titles (remove title titles)))
(if (equal key (car entry)) (setq startline (org-current-line))) (if (equal key (car entry)) (setq startline (org-current-line)))
(setq s (concat (if (equal (string-to-char (car entry)) ?@) "" "$") (setq s (concat (if (member (string-to-char (car entry)) '(?@ ?$)) "" "$")
(car entry) " = " (cdr entry) "\n")) (car entry) " = " (cdr entry) "\n"))
(remove-text-properties 0 (length s) '(face nil) s) (remove-text-properties 0 (length s) '(face nil) s)
(insert s)) (insert s))
@ -2899,7 +3170,7 @@ Parameters get priority."
s)) s))
(defun org-table-convert-refs-to-rc (s) (defun org-table-convert-refs-to-rc (s)
"Convert spreadsheet references from AB7 to @7$28. "Convert spreadsheet references from A7 to @7$28.
Works for single references, but also for entire formulas and even the Works for single references, but also for entire formulas and even the
full TBLFM line." full TBLFM line."
(let ((start 0)) (let ((start 0))
@ -2967,6 +3238,45 @@ For example: 28 -> AB."
n (/ (1- n) 26))) n (/ (1- n) 26)))
s)) s))
(defun org-table-time-string-to-seconds (s)
"Convert a time string into numerical duration in seconds.
S can be a string matching either -?HH:MM:SS or -?HH:MM.
If S is a string representing a number, keep this number."
(let (hour min sec res)
(cond
((and (string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)" s))
(setq minus (< 0 (length (match-string 1 s)))
hour (string-to-number (match-string 2 s))
min (string-to-number (match-string 3 s))
sec (string-to-number (match-string 4 s)))
(if minus
(setq res (- (+ (* hour 3600) (* min 60) sec)))
(setq res (+ (* hour 3600) (* min 60) sec))))
((and (not (string-match org-ts-regexp-both s))
(string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\)" s))
(setq minus (< 0 (length (match-string 1 s)))
hour (string-to-number (match-string 2 s))
min (string-to-number (match-string 3 s)))
(if minus
(setq res (- (+ (* hour 3600) (* min 60))))
(setq res (+ (* hour 3600) (* min 60)))))
(t (setq res (string-to-number s))))
(number-to-string res)))
(defun org-table-time-seconds-to-string (secs &optional output-format)
"Convert a number of seconds to a time string.
If OUTPUT-FORMAT is non-nil, return a number of days, hours,
minutes or seconds."
(cond ((eq output-format 'days)
(format "%.3f" (/ (float secs) 86400)))
((eq output-format 'hours)
(format "%.2f" (/ (float secs) 3600)))
((eq output-format 'minutes)
(format "%.1f" (/ (float secs) 60)))
((eq output-format 'seconds)
(format "%d" secs))
(t (org-format-seconds "%.2h:%.2m:%.2s" secs))))
(defun org-table-fedit-convert-buffer (function) (defun org-table-fedit-convert-buffer (function)
"Convert all references in this buffer, using FUNCTION." "Convert all references in this buffer, using FUNCTION."
(let ((line (org-current-line))) (let ((line (org-current-line)))
@ -3083,7 +3393,7 @@ With prefix ARG, apply the new formulas to the table."
(let ((pos org-pos) (sel-win org-selected-window) eql var form) (let ((pos org-pos) (sel-win org-selected-window) eql var form)
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward (while (re-search-forward
"^\\(@[0-9]+\\$[0-9]+\\|\\$\\([a-zA-Z0-9]+\\)\\) *= *\\(.*\\(\n[ \t]+.*$\\)*\\)" "^\\(@[-+I<>0-9.$@]+\\|@?[0-9]+\\|\\$\\([a-zA-Z0-9]+\\|[<>]+\\)\\) *= *\\(.*\\(\n[ \t]+.*$\\)*\\)"
nil t) nil t)
(setq var (if (match-end 2) (match-string 2) (match-string 1)) (setq var (if (match-end 2) (match-string 2) (match-string 1))
form (match-string 3)) form (match-string 3))
@ -3172,6 +3482,12 @@ With prefix ARG, apply the new formulas to the table."
var name e what match dest) var name e what match dest)
(if local (org-table-get-specials)) (if local (org-table-get-specials))
(setq what (cond (setq what (cond
((org-at-regexp-p "^@[0-9]+[ \t=]")
(setq match (concat (substring (match-string 0) 0 -1)
"$1.."
(substring (match-string 0) 0 -1)
"$100"))
'range)
((or (org-at-regexp-p org-table-range-regexp2) ((or (org-at-regexp-p org-table-range-regexp2)
(org-at-regexp-p org-table-translate-regexp) (org-at-regexp-p org-table-translate-regexp)
(org-at-regexp-p org-table-range-regexp)) (org-at-regexp-p org-table-range-regexp))
@ -3530,14 +3846,14 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line."
(defun org-table-cleanup-narrow-column-properties () (defun org-table-cleanup-narrow-column-properties ()
"Remove all properties related to narrow-column invisibility." "Remove all properties related to narrow-column invisibility."
(let ((s 1)) (let ((s (point-min)))
(while (setq s (text-property-any s (point-max) (while (setq s (text-property-any s (point-max)
'display org-narrow-column-arrow)) 'display org-narrow-column-arrow))
(remove-text-properties s (1+ s) '(display t))) (remove-text-properties s (1+ s) '(display t)))
(setq s 1) (setq s (point-min))
(while (setq s (text-property-any s (point-max) 'org-cwidth 1)) (while (setq s (text-property-any s (point-max) 'org-cwidth 1))
(remove-text-properties s (1+ s) '(org-cwidth t))) (remove-text-properties s (1+ s) '(org-cwidth t)))
(setq s 1) (setq s (point-min))
(while (setq s (text-property-any s (point-max) 'invisible 'org-cwidth)) (while (setq s (text-property-any s (point-max) 'invisible 'org-cwidth))
(remove-text-properties s (1+ s) '(invisible t))))) (remove-text-properties s (1+ s) '(invisible t)))))
@ -3720,10 +4036,11 @@ to execute outside of tables."
If it is a table to be sent away to a receiver, do it. If it is a table to be sent away to a receiver, do it.
With prefix arg, also recompute table." With prefix arg, also recompute table."
(interactive "P") (interactive "P")
(let ((pos (point)) action) (let ((pos (point)) action consts-str consts cst const-str)
(save-excursion (save-excursion
(beginning-of-line 1) (beginning-of-line 1)
(setq action (cond ((looking-at "[ \t]*#\\+ORGTBL:.*\n[ \t]*|") (match-end 0)) (setq action (cond
((looking-at "[ \t]*#\\+ORGTBL:.*\n[ \t]*|") (match-end 0))
((looking-at "[ \t]*|") pos) ((looking-at "[ \t]*|") pos)
((looking-at "[ \t]*#\\+TBLFM:") 'recalc)))) ((looking-at "[ \t]*#\\+TBLFM:") 'recalc))))
(cond (cond
@ -3737,6 +4054,17 @@ With prefix arg, also recompute table."
(when (orgtbl-send-table 'maybe) (when (orgtbl-send-table 'maybe)
(run-hooks 'orgtbl-after-send-table-hook))) (run-hooks 'orgtbl-after-send-table-hook)))
((eq action 'recalc) ((eq action 'recalc)
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^[ \t]*#\\+CONSTANTS: \\(.*\\)" nil t)
(setq const-str (substring-no-properties (match-string 1)))
(setq consts (append consts (org-split-string const-str "[ \t]+")))
(when consts
(let (e)
(while (setq e (pop consts))
(if (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" e)
(push (cons (match-string 1 e) (match-string 2 e)) cst)))
(setq org-table-formula-constants-local cst)))))
(save-excursion (save-excursion
(beginning-of-line 1) (beginning-of-line 1)
(skip-chars-backward " \r\n\t") (skip-chars-backward " \r\n\t")
@ -3792,7 +4120,7 @@ overwritten, and the table is not marked as requiring realignment."
(looking-at "[^|\n]* +|")) (looking-at "[^|\n]* +|"))
(let (org-table-may-need-update) (let (org-table-may-need-update)
(goto-char (1- (match-end 0))) (goto-char (1- (match-end 0)))
(delete-backward-char 1) (delete-char -1)
(goto-char (match-beginning 0)) (goto-char (match-beginning 0))
(self-insert-command N)) (self-insert-command N))
(setq org-table-may-need-update t) (setq org-table-may-need-update t)
@ -3910,7 +4238,7 @@ this table."
(catch 'exit (catch 'exit
(unless (org-at-table-p) (error "Not at a table")) (unless (org-at-table-p) (error "Not at a table"))
;; when non-interactive, we assume align has just happened. ;; when non-interactive, we assume align has just happened.
(when (interactive-p) (org-table-align)) (when (org-called-interactively-p 'any) (org-table-align))
(let ((dests (orgtbl-gather-send-defs)) (let ((dests (orgtbl-gather-send-defs))
(txt (buffer-substring-no-properties (org-table-begin) (txt (buffer-substring-no-properties (org-table-begin)
(org-table-end))) (org-table-end)))
@ -4080,7 +4408,7 @@ This generic routine can be used for many standard cases.
TABLE is a list, each entry either the symbol `hline' for a horizontal TABLE is a list, each entry either the symbol `hline' for a horizontal
separator line, or a list of fields for that line. separator line, or a list of fields for that line.
PARAMS is a property list of parameters that can influence the conversion. PARAMS is a property list of parameters that can influence the conversion.
For the generic converter, some parameters are obligatory: You need to For the generic converter, some parameters are obligatory: you need to
specify either :lfmt, or all of (:lstart :lend :sep). specify either :lfmt, or all of (:lstart :lend :sep).
Valid parameters are Valid parameters are
@ -4352,6 +4680,7 @@ list of the fields in the rectangle ."
org-table-local-parameters org-table-named-field-locations org-table-local-parameters org-table-named-field-locations
org-table-current-line-types org-table-current-begin-line org-table-current-line-types org-table-current-begin-line
org-table-current-begin-pos org-table-dlines org-table-current-begin-pos org-table-dlines
org-table-current-ncol
org-table-hlines org-table-last-alignment org-table-hlines org-table-last-alignment
org-table-last-column-widths org-table-last-alignment org-table-last-column-widths org-table-last-alignment
org-table-last-column-widths tbeg org-table-last-column-widths tbeg
@ -4392,5 +4721,7 @@ list of the fields in the rectangle ."
(provide 'org-table) (provide 'org-table)
;; arch-tag: 4d21cfdd-0268-440a-84b0-09237a0fe0ef
;;; org-table.el ends here ;;; org-table.el ends here

View file

@ -1,10 +1,10 @@
;;; org-taskjuggler.el --- TaskJuggler exporter for org-mode ;;; org-taskjuggler.el --- TaskJuggler exporter for org-mode
;; ;;
;; Copyright (C) 2007-2011 Free Software Foundation, Inc. ;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; ;;
;; Emacs Lisp Archive Entry ;; Emacs Lisp Archive Entry
;; Filename: org-taskjuggler.el ;; Filename: org-taskjuggler.el
;; Version: 7.4 ;; Version: 7.7
;; Author: Christian Egli ;; Author: Christian Egli
;; Maintainer: Christian Egli ;; Maintainer: Christian Egli
;; Keywords: org, taskjuggler, project planning ;; Keywords: org, taskjuggler, project planning
@ -126,15 +126,15 @@
;; :END: ;; :END:
;; ** Markup Guidelines ;; ** Markup Guidelines
;; :PROPERTIES: ;; :PROPERTIES:
;; :Effort: 2.0 ;; :Effort: 2d
;; :END: ;; :END:
;; ** Workflow Guidelines ;; ** Workflow Guidelines
;; :PROPERTIES: ;; :PROPERTIES:
;; :Effort: 2.0 ;; :Effort: 2d
;; :END: ;; :END:
;; * Presentation ;; * Presentation
;; :PROPERTIES: ;; :PROPERTIES:
;; :Effort: 2.0 ;; :Effort: 2d
;; :BLOCKER: training_material { gapduration 1d } some_other_task ;; :BLOCKER: training_material { gapduration 1d } some_other_task
;; :END: ;; :END:
;; ;;
@ -181,6 +181,11 @@ resources for the project."
:group 'org-export-taskjuggler :group 'org-export-taskjuggler
:type 'string) :type 'string)
(defcustom org-export-taskjuggler-target-version 2.4
"Which version of TaskJuggler the exporter is targeting."
:group 'org-export-taskjuggler
:type 'number)
(defcustom org-export-taskjuggler-default-project-version "1.0" (defcustom org-export-taskjuggler-default-project-version "1.0"
"Default version string for the project." "Default version string for the project."
:group 'org-export-taskjuggler :group 'org-export-taskjuggler
@ -258,13 +263,14 @@ defined in `org-export-taskjuggler-default-reports'."
(let* ((tasks (let* ((tasks
(org-taskjuggler-resolve-dependencies (org-taskjuggler-resolve-dependencies
(org-taskjuggler-assign-task-ids (org-taskjuggler-assign-task-ids
(org-taskjuggler-compute-task-leafiness
(org-map-entries (org-map-entries
'(org-taskjuggler-components) 'org-taskjuggler-components
org-export-taskjuggler-project-tag nil 'archive 'comment)))) org-export-taskjuggler-project-tag nil 'archive 'comment)))))
(resources (resources
(org-taskjuggler-assign-resource-ids (org-taskjuggler-assign-resource-ids
(org-map-entries (org-map-entries
'(org-taskjuggler-components) 'org-taskjuggler-components
org-export-taskjuggler-resource-tag nil 'archive 'comment))) org-export-taskjuggler-resource-tag nil 'archive 'comment)))
(filename (expand-file-name (filename (expand-file-name
(concat (concat
@ -331,6 +337,10 @@ with the TaskJuggler GUI."
(command (concat process-name " " file-name))) (command (concat process-name " " file-name)))
(start-process-shell-command process-name nil command))) (start-process-shell-command process-name nil command)))
(defun org-taskjuggler-targeting-tj3-p ()
"Return true if we are targeting TaskJuggler III."
(>= org-export-taskjuggler-target-version 3.0))
(defun org-taskjuggler-parent-is-ordered-p () (defun org-taskjuggler-parent-is-ordered-p ()
"Return true if the parent of the current node has a property "Return true if the parent of the current node has a property
\"ORDERED\". Return nil otherwise." \"ORDERED\". Return nil otherwise."
@ -344,7 +354,9 @@ information, all the properties, etc."
(let* ((props (org-entry-properties)) (let* ((props (org-entry-properties))
(components (org-heading-components)) (components (org-heading-components))
(level (nth 1 components)) (level (nth 1 components))
(headline (nth 4 components)) (headline
(replace-regexp-in-string
"\"" "\\\"" (nth 4 components) t t)) ; quote double quotes in headlines
(parent-ordered (org-taskjuggler-parent-is-ordered-p))) (parent-ordered (org-taskjuggler-parent-is-ordered-p)))
(push (cons "level" level) props) (push (cons "level" level) props)
(push (cons "headline" headline) props) (push (cons "headline" headline) props)
@ -383,18 +395,36 @@ a path to the current task."
(setq previous-level level) (setq previous-level level)
(setq resolved-tasks (append resolved-tasks (list task))))))) (setq resolved-tasks (append resolved-tasks (list task)))))))
(defun org-taskjuggler-assign-resource-ids (resources &optional unique-ids) (defun org-taskjuggler-compute-task-leafiness (tasks)
"Figure out if each task is a leaf by looking at it's level,
and the level of its successor. If the successor is higher (ie
deeper), then it's not a leaf."
(let (new-list)
(while (car tasks)
(let ((task (car tasks))
(successor (car (cdr tasks))))
(cond
;; if a task has no successors it is a leaf
((null successor)
(push (cons (cons "leaf-node" t) task) new-list))
;; if the successor has a lower level than task it is a leaf
((<= (cdr (assoc "level" successor)) (cdr (assoc "level" task)))
(push (cons (cons "leaf-node" t) task) new-list))
;; otherwise examine the rest of the tasks
(t (push task new-list))))
(setq tasks (cdr tasks)))
(nreverse new-list)))
(defun org-taskjuggler-assign-resource-ids (resources)
"Given a list of resources return the same list, assigning a "Given a list of resources return the same list, assigning a
unique id to each resource." unique id to each resource."
(cond (let (unique-ids new-list)
((null resources) nil) (dolist (resource resources new-list)
(t (let ((unique-id (org-taskjuggler-get-unique-id resource unique-ids)))
(let* ((resource (car resources))
(unique-id (org-taskjuggler-get-unique-id resource unique-ids)))
(push (cons "unique-id" unique-id) resource) (push (cons "unique-id" unique-id) resource)
(cons resource (push unique-id unique-ids)
(org-taskjuggler-assign-resource-ids (cdr resources) (push resource new-list)))
(cons unique-id unique-ids))))))) (nreverse new-list)))
(defun org-taskjuggler-resolve-dependencies (tasks) (defun org-taskjuggler-resolve-dependencies (tasks)
(let ((previous-level 0) (let ((previous-level 0)
@ -512,7 +542,12 @@ finally add more underscore characters (\"_\")."
(defun org-taskjuggler-clean-id (id) (defun org-taskjuggler-clean-id (id)
"Clean and return ID to make it acceptable for taskjuggler." "Clean and return ID to make it acceptable for taskjuggler."
(and id (replace-regexp-in-string "[^a-zA-Z0-9_]" "_" id))) (and id
;; 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))))
(defun org-taskjuggler-open-project (project) (defun org-taskjuggler-open-project (project)
"Insert the beginning of a project declaration. All valid "Insert the beginning of a project declaration. All valid
@ -578,20 +613,13 @@ is defined it will calculate a unique id for the resource using
(defun org-taskjuggler-clean-effort (effort) (defun org-taskjuggler-clean-effort (effort)
"Translate effort strings into a format acceptable to taskjuggler, "Translate effort strings into a format acceptable to taskjuggler,
i.e. REAL UNIT. If the effort string is something like 5:30 it i.e. REAL UNIT. A valid effort string can be anything that is
will be assumed to be hours and will be translated into 5.5h. accepted by `org-duration-string-to-minutes´."
Otherwise if it contains something like 3.0 it is assumed to be
days and will be translated into 3.0d. Other formats that
taskjuggler supports (like weeks, months and years) are currently
not supported."
(cond (cond
((null effort) effort) ((null effort) effort)
((string-match "\\([0-9]+\\):\\([0-9]+\\)" effort) (t (let* ((minutes (org-duration-string-to-minutes effort))
(let ((hours (string-to-number (match-string 1 effort))) (hours (/ minutes 60.0)))
(minutes (string-to-number (match-string 2 effort)))) (format "%.1fh" hours)))))
(format "%dh" (+ hours (/ minutes 60.0)))))
((string-match "\\([0-9]+\\).\\([0-9]+\\)" effort) (concat effort "d"))
(t (error "Not a valid effort (%s)" effort))))
(defun org-taskjuggler-get-priority (priority) (defun org-taskjuggler-get-priority (priority)
"Return a priority between 1 and 1000 based on PRIORITY, an "Return a priority between 1 and 1000 based on PRIORITY, an
@ -612,21 +640,31 @@ org-mode priority string."
(cdr (assoc "complete" task)))) (cdr (assoc "complete" task))))
(parent-ordered (cdr (assoc "parent-ordered" task))) (parent-ordered (cdr (assoc "parent-ordered" task)))
(previous-sibling (cdr (assoc "previous-sibling" task))) (previous-sibling (cdr (assoc "previous-sibling" task)))
(milestone (or (cdr (assoc "milestone" task))
(and (assoc "leaf-node" task)
(not (or effort
(cdr (assoc "duration" task))
(cdr (assoc "end" task))
(cdr (assoc "period" task)))))))
(attributes (attributes
'(account start note duration endbuffer endcredit end '(account start note duration endbuffer endcredit end
flags journalentry length maxend maxstart milestone flags journalentry length maxend maxstart minend
minend minstart period reference responsible minstart period reference responsible scheduling
scheduling startbuffer startcredit statusnote))) startbuffer startcredit statusnote)))
(insert (insert
(concat (concat
"task " unique-id " \"" headline "\" {\n" "task " unique-id " \"" headline "\" {\n"
(if (and parent-ordered previous-sibling) (if (and parent-ordered previous-sibling)
(format " depends %s\n" previous-sibling) (format " depends %s\n" previous-sibling)
(and depends (format " depends %s\n" depends))) (and depends (format " depends %s\n" depends)))
(and allocate (format " purge allocations\n allocate %s\n" allocate)) (and allocate (format " purge %s\n allocate %s\n"
(or (and (org-taskjuggler-targeting-tj3-p) "allocate")
"allocations")
allocate))
(and complete (format " complete %s\n" complete)) (and complete (format " complete %s\n" complete))
(and effort (format " effort %s\n" effort)) (and effort (format " effort %s\n" effort))
(and priority (format " priority %s\n" priority)) (and priority (format " priority %s\n" priority))
(and milestone (format " milestone\n"))
(org-taskjuggler-get-attributes task attributes) (org-taskjuggler-get-attributes task attributes)
"\n")))) "\n"))))

View file

@ -1,11 +1,11 @@
;;; org-timer.el --- The relative timer code for Org-mode ;;; org-timer.el --- The relative timer code for Org-mode
;; Copyright (C) 2008-2011 Free Software Foundation, Inc. ;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp ;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org ;; Homepage: http://orgmode.org
;; Version: 7.4 ;; Version: 7.7
;; ;;
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
;; ;;
@ -65,6 +65,9 @@ When 0, the user is prompted for a value."
(defvar org-timer-pause-hook nil (defvar org-timer-pause-hook nil
"Hook run before relative timer is paused.") "Hook run before relative timer is paused.")
(defvar org-timer-continue-hook nil
"Hook run after relative timer is continued.")
(defvar org-timer-set-hook nil (defvar org-timer-set-hook nil
"Hook run after countdown timer is set.") "Hook run after countdown timer is set.")
@ -128,6 +131,7 @@ With prefix arg STOP, stop it entirely."
(org-float-time org-timer-start-time)))) (org-float-time org-timer-start-time))))
org-timer-pause-time nil) org-timer-pause-time nil)
(org-timer-set-mode-line 'on) (org-timer-set-mode-line 'on)
(run-hooks 'org-timer-continue-hook)
(message "Timer continues at %s" (org-timer-value-string))) (message "Timer continues at %s" (org-timer-value-string)))
(t (t
;; pause timer ;; pause timer
@ -203,22 +207,27 @@ it in the buffer."
(defun org-timer-item (&optional arg) (defun org-timer-item (&optional arg)
"Insert a description-type item with the current timer value." "Insert a description-type item with the current timer value."
(interactive "P") (interactive "P")
(let ((itemp (org-in-item-p)) (pos (point)))
(cond (cond
;; In a timer list, insert with `org-list-insert-item-generic'. ;; In a timer list, insert with `org-list-insert-item',
((and (org-in-item-p) ;; then fix the list.
(save-excursion (org-beginning-of-item) (org-at-item-timer-p))) ((and itemp (goto-char itemp) (org-at-item-timer-p))
(org-list-insert-item-generic (let* ((struct (org-list-struct))
(point) nil (concat (org-timer (when arg '(4)) t) ":: "))) (prevs (org-list-prevs-alist struct))
(s (concat (org-timer (when arg '(4)) t) ":: ")))
(setq struct (org-list-insert-item pos struct prevs nil s))
(org-list-write-struct struct (org-list-parents-alist struct))
(looking-at org-list-full-item-re)
(goto-char (match-end 0))))
;; In a list of another type, don't break anything: throw an error. ;; In a list of another type, don't break anything: throw an error.
((org-in-item-p) (itemp (goto-char pos) (error "This is not a timer list"))
(error "This is not a timer list")) ;; Else, start a new list.
;; Else, insert the timer correctly indented at bol.
(t (t
(beginning-of-line) (beginning-of-line)
(org-indent-line-function) (org-indent-line-function)
(insert "- ") (insert "- ")
(org-timer (when arg '(4))) (org-timer (when arg '(4)))
(insert ":: ")))) (insert ":: ")))))
(defun org-timer-fix-incomplete (hms) (defun org-timer-fix-incomplete (hms)
"If hms is a H:MM:SS string with missing hour or hour and minute, fix it." "If hms is a H:MM:SS string with missing hour or hour and minute, fix it."
@ -364,7 +373,7 @@ replace any running timer."
(org-show-entry) (org-show-entry)
(or (ignore-errors (org-get-heading)) (or (ignore-errors (org-get-heading))
(concat "File:" (file-name-nondirectory (buffer-file-name))))))) (concat "File:" (file-name-nondirectory (buffer-file-name)))))))
((eq major-mode 'org-mode) ((org-mode-p)
(or (ignore-errors (org-get-heading)) (or (ignore-errors (org-get-heading))
(concat "File:" (file-name-nondirectory (buffer-file-name))))) (concat "File:" (file-name-nondirectory (buffer-file-name)))))
(t (error "Not in an Org buffer")))) (t (error "Not in an Org buffer"))))
@ -394,5 +403,6 @@ replace any running timer."
(provide 'org-timer) (provide 'org-timer)
;; arch-tag: 97538f8c-3871-4509-8f23-1e7b3ff3d107
;;; org-timer.el ends here ;;; org-timer.el ends here

View file

@ -1,11 +1,12 @@
;;; org-vm.el --- Support for links to VM messages from within Org-mode ;;; org-vm.el --- Support for links to VM messages from within Org-mode
;; Copyright (C) 2004-2011 Free Software Foundation, Inc. ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp ;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org ;; Homepage: http://orgmode.org
;; Version: 7.4 ;; Version: 7.7
;; ;;
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
;; ;;
@ -53,8 +54,10 @@
;; Implementation ;; Implementation
(defun org-vm-store-link () (defun org-vm-store-link ()
"Store a link to a VM folder or message." "Store a link to a VM folder or message."
(when (or (eq major-mode 'vm-summary-mode) (when (and (or (eq major-mode 'vm-summary-mode)
(eq major-mode 'vm-presentation-mode)) (eq major-mode 'vm-presentation-mode))
(save-window-excursion
(vm-select-folder-buffer) buffer-file-name))
(and (eq major-mode 'vm-presentation-mode) (vm-summarize)) (and (eq major-mode 'vm-presentation-mode) (vm-summarize))
(vm-follow-summary-cursor) (vm-follow-summary-cursor)
(save-excursion (save-excursion
@ -137,5 +140,6 @@
(provide 'org-vm) (provide 'org-vm)
;; arch-tag: cbc3047b-935e-4d2a-96e7-c5b0117aaa6d
;;; org-vm.el ends here ;;; org-vm.el ends here

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