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

Merge changes from Org 7.4 to current Org 7.7.

Browse source
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
Download patch file Download diff file Expand all files Collapse all files

265
doc/misc/ChangeLog
View file

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

16
etc/ChangeLog
View file

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

5191
lisp/org/ChangeLog
View file

File diff suppressed because it is too large Load diff

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

580
lisp/org/ob.el
View file

File diff suppressed because it is too large Load diff

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

File diff suppressed because it is too large Load diff

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

File diff suppressed because it is too large Load diff

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

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

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

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

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

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

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

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

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

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

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

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

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

File diff suppressed because it is too large Load diff

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

@ -1,10 +1,10 @@
;;; 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
;; Filename: org-latex.el
;; Version: 7.4
;; Version: 7.7
;; Author: Bastien Guerry <bzg AT altern DOT org>
;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com>
;; Keywords: org, wp, tex
@ -65,6 +65,8 @@
(defvar org-export-latex-display-custom-times nil)
(defvar org-export-latex-all-targets-re nil)
(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-depth 0)
(defvar org-export-latex-special-keyword-regexp
@ -73,9 +75,8 @@
org-closed-string"\\)")
"Regexp matching special time planning keywords plus the time after it.")
(defvar latexp) ; dynamically scoped from org.el
(defvar re-quote) ; dynamically scoped from org.el
(defvar commentsp) ; dynamically scoped from org.el
(defvar org-re-quote) ; dynamically scoped from org.el
(defvar org-commentsp) ; dynamically scoped from org.el
;;; User variables:
@ -230,14 +231,15 @@ are written as utf8 files."
("/" "\\emph{%s}" nil)
("_" "\\underline{%s}" nil)
("+" "\\st{%s}" nil)
("=" "\\verb" t)
("=" "\\protectedtexttt" t)
("~" "\\verb" t))
"Alist of LaTeX expressions to convert emphasis fontifiers.
Each element of the list is a list of three elements.
The first element is the character used as a marker for fontification.
The second element is a formatting string to wrap fontified text with.
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
conversions."
:group 'org-export-latex
@ -258,7 +260,7 @@ For example \orgTITLE for #+TITLE."
:type 'boolean)
(defcustom org-export-latex-date-format
"%d %B %Y"
"\\today"
"Format string for \\date{...}."
:group 'org-export-latex
:type 'string)
@ -290,6 +292,11 @@ markup defined, the first one in the association list will be used."
:group 'org-export-latex
: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}"
"A printf format string to be applied to time stamps."
: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}"
"A printf format string to be applied to href links.
The format must contain two %s instances. The first will be filled with
the link, the second with the link description."
The format must contain either two %s instances or just one.
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
:type 'string)
(defcustom org-export-latex-hyperref-format "\\hyperref[%s]{%s}"
"A printf format string to be applied to hyperref links.
The format must contain two %s instances. The first will be filled with
the link, the second with the link description."
The format must contain one or two %s instances. The first one
will be filled with the link, the second with its description."
:group 'org-export-latex
: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
"When non-nil, tables are exported verbatim."
:group 'org-export-latex
@ -353,7 +393,7 @@ string should be like \"\\end{itemize\"."
(string :tag "Use a section string" :value "\\subparagraph{%s}")))
(defcustom org-export-latex-list-parameters
'(:cbon "$\\boxtimes$" :cboff "$\\Box$")
'(:cbon "$\\boxtimes$" :cboff "$\\Box$" :cbtrans "$\\boxminus$")
"Parameters for the LaTeX list exporter.
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
@ -397,8 +437,8 @@ example using customize, or with
(require 'org-latex)
(add-to-list 'org-export-latex-packages-alist '(\"\" \"minted\"))
In addition, it is neccessary to install
pygments (http://pygments.org), and to configure
In addition, it is necessary to install
pygments (http://pygments.org), and to configure the variable
`org-latex-to-pdf-process' so that the -shell-escape option is
passed to pdflatex.
"
@ -460,6 +500,67 @@ pygmentize -L lexers
(symbol :tag "Major mode ")
(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
'(:todo nil :priority nil :tags nil)
"A plist of keywords to remove from headlines. OBSOLETE.
@ -473,11 +574,16 @@ and `org-export-with-tags' instead."
:type 'plist
: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."
:group 'org-export-latex
: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"
"Default environment used to build tables."
: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
in a window. A non-interactive call will only return the buffer."
(interactive "r\nP")
(when (interactive-p)
(when (org-called-interactively-p 'any)
(setq buffer "*Org LaTeX Export*"))
(let ((transient-mark-mode t) (zmacs-regions t)
ext-plist rtn)
@ -656,7 +762,7 @@ in a window. A non-interactive call will only return the buffer."
nil nil ext-plist
buffer body-only))
(if (fboundp 'deactivate-mark) (deactivate-mark))
(if (and (interactive-p) (bufferp rtn))
(if (and (org-called-interactively-p 'any) (bufferp rtn))
(switch-to-buffer-other-window rtn)
rtn)))
@ -700,11 +806,15 @@ when PUB-DIR is set, use this as the publishing directory."
'(:org-license-to-kill nil))))
(org-update-radio-target-regexp)
(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)
(run-hooks 'org-export-latex-after-initial-vars-hook)
(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))
(rbeg (and region-p (region-beginning)))
(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
text
:emph-multiline t
:for-LaTeX t
:for-backend 'latex
:comments nil
:tags (plist-get opt-plist :tags)
: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)
:timestamps (plist-get opt-plist :timestamps)
:todo-keywords (plist-get opt-plist :todo-keywords)
:tasks (plist-get opt-plist :tasks)
:add-text nil
:skip-before-1st-heading skip
:select-tags nil
@ -811,7 +922,7 @@ when PUB-DIR is set, use this as the publishing directory."
(org-export-preprocess-string
region
:emph-multiline t
:for-LaTeX t
:for-backend 'latex
:comments nil
:tags (plist-get opt-plist :tags)
: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)
:timestamps (plist-get opt-plist :timestamps)
:todo-keywords (plist-get opt-plist :todo-keywords)
:tasks (plist-get opt-plist :tasks)
:add-text (if (eq to-buffer 'string) nil text)
:skip-before-1st-heading skip
: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"))
;; insert lines before the first headline
(unless skip
(unless (or skip (string-match "^\\*" first-lines))
(insert first-lines))
;; 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))
(base (file-name-sans-extension (buffer-file-name lbuf)))
(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*"))
(bibtex-p (with-current-buffer lbuf
(save-excursion
@ -927,6 +1045,8 @@ when PUB-DIR is set, use this as the publishing directory."
(with-current-buffer outbuf (erase-buffer))
(message (concat "Processing LaTeX file " file "..."))
(setq output-dir (file-name-directory file))
(with-current-buffer lbuf
(save-excursion
(if (and cmds (symbolp cmds))
(funcall cmds (shell-quote-argument file))
(while cmds
@ -946,7 +1066,7 @@ when PUB-DIR is set, use this as the publishing directory."
(save-match-data
(shell-quote-argument output-dir))
t t cmd)))
(shell-command cmd outbuf)))
(shell-command cmd outbuf)))))
(message (concat "Processing LaTeX file " file "...done"))
(setq errors (org-export-latex-get-error outbuf))
(if (not (file-exists-p pdffile))
@ -1084,7 +1204,9 @@ and its content."
(defun org-export-latex-subcontent (subcontent num)
"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)))
(level (- (cdr (assoc 'level subcontent))
org-export-latex-add-level))
@ -1120,6 +1242,9 @@ If NUM, export sections as numerical sections."
;; Normal conversion
((<= level depth)
(let* ((sec (nth (1- level) sectioning))
(num (if (integerp num)
(>= num level)
num))
start end)
(if (consp (cdr 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."
(let ((toc (plist-get opt-plist :table-of-contents))
(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
(if (plist-get opt-plist :time-stamp-file)
(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)
;; define alert if not yet defined
"\n\\providecommand{\\alert}[1]{\\textbf{#1}}"
;; beginning of the document
"\n\\begin{document}\n\n"
;; insert the title
(format
"\n\n\\title{%s}\n"
;; convert the title
(org-export-latex-fontify-headline title))
;; insert author info
(if (plist-get opt-plist :author-info)
(format "\\author{%s}\n"
(org-export-latex-fontify-headline (or author user-full-name)))
(format "\\author{%s%s}\n"
(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"
(org-export-latex-fontify-headline (or author user-full-name))))
;; insert the date
@ -1299,6 +1429,8 @@ OPT-PLIST is the options plist for current buffer."
(format-time-string
(or (plist-get opt-plist :date)
org-export-latex-date-format)))
;; beginning of the document
"\n\\begin{document}\n\n"
;; insert the title command
(when (string-match "\\S-" title)
(if (string-match "%s" org-export-latex-title-command)
@ -1325,14 +1457,15 @@ If END is non-nil, it is the end of the region."
(save-excursion
(goto-char (or beg (point-min)))
(let* ((pt (point))
(end (if (re-search-forward (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 (or end (point-max))))))
(prog1
(org-export-latex-content
(org-export-preprocess-string
(buffer-substring pt end)
:for-LaTeX t
:for-backend 'latex
:emph-multiline t
:add-text 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
"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)
"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,
links, keywords, lists, tables, fixed-width"
(with-temp-buffer
(org-install-letbind)
(insert content)
(unless (memq 'timestamps exclude-list)
(org-export-latex-time-stamps))
@ -1443,7 +1575,7 @@ links, keywords, lists, tables, fixed-width"
(format org-export-latex-tag-markup
(save-match-data
(replace-regexp-in-string
"_" "\\\\_" (match-string 0)))))
"\\([_#]\\)" "\\\\\\1" (match-string 0)))))
t t)))))
(defun org-export-latex-fontify-headline (string)
@ -1498,6 +1630,8 @@ links, keywords, lists, tables, fixed-width"
'(org-protected t)))))
(when (plist-get org-export-latex-options-plist :emphasize)
(org-export-latex-fontify))
(org-export-latex-time-stamps)
(org-export-latex-quotation-marks)
(org-export-latex-keywords-maybe)
(org-export-latex-special-chars
(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))
(replace-match
(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)))
t t)))))
(defun org-export-latex-quotation-marks ()
"Export quotation marks depending on language conventions."
(let* ((lang (plist-get org-export-latex-options-plist :language))
(quote-rpl (if (equal lang "fr")
'(("\\(\\s-\\)\"" "«~")
("\\(\\S-\\)\"" "~»")
("\\(\\s-\\)'" "`"))
'(("\\(\\s-\\|[[(]\\)\"" "``")
("\\(\\S-\\)\"" "''")
("\\(\\s-\\|(\\)'" "`")))))
(mapc (lambda(l) (goto-char (point-min))
(mapc (lambda(l)
(goto-char (point-min))
(while (re-search-forward (car l) nil t)
(let ((rpl (concat (match-string 1)
(org-export-latex-protect-string
(copy-sequence (cadr l))))))
(copy-sequence (cdr l))))))
(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)
"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))
(while (re-search-forward c nil t)
;; 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) '("\\$" "$"))
(if (equal (match-string 2) "\\$")
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]+)\\)"
"\\(.\\|^\\)\\(\\\\\\)\\([ \t\n]\\|\\([&#%{}\"]\\|[a-zA-Z][a-zA-Z0-9]*\\)\\)"
"\\(.\\|^\\)\\(&\\)"
"\\(.\\|^\\)\\(#\\)"
"\\(.\\|^\\)\\(%\\)"
"\\(.\\|^\\)\\({\\)"
"\\(.\\|^\\)\\(}\\)"
"\\(.\\|^\\)\\(~\\)"
"\\(.\\|^\\)\\(\\.\\.\\.\\)"
"\\(^\\|.\\)\\([&#%{}~]\\|\\.\\.\\.\\)"
;; (?\< . "\\textless{}")
;; (?\> . "\\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))
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
(let* ((tbl (concat "\\begin{verbatim}\n" raw-table
"\\end{verbatim}\n")))
@ -1757,15 +1886,28 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
'org-label raw-table)
longtblp (and attr (stringp 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)
(string-match "\\<align=\\([^ \t\n\r]+\\)" attr)
(match-string 1 attr))
floatp (or caption label)
floatp (or caption label (string= "table*" tblenv))
placement (if (and attr
(stringp attr)
(string-match "[ \t]*\\<placement=\\(\\S-+\\)" attr))
(match-string 1 attr)
"[htb]"))
(concat
"[" org-latex-default-figure-position "]")))
(setq caption (and caption (org-export-latex-fontify-headline caption)))
(setq lines (org-split-string raw-table "\n"))
(apply 'delete-region (list beg end))
@ -1813,14 +1955,17 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(mapcar
(lambda(elem)
(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))
(when insert
(insert (org-export-latex-protect-string
(concat
(if longtblp
(concat "\\begin{longtable}{" align "}\n")
(if floatp (format "\\begin{table}%s\n" placement)))
(if floatp
(format "\\begin{%s}%s\n" tblenv placement)))
(if floatp
(format
"\\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))
"\\begin{center}\n")
(if (not longtblp)
(format "\\begin{%s}{%s}\n"
org-export-latex-tabular-environment align))
(format "\\begin{%s}%s{%s}\n"
tabular-env
(if width (format "{%s}" width) "")
align))
(orgtbl-to-latex
lines
`(:tstart nil :tend nil
@ -1844,14 +1991,12 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
\\endfoot
\\endlastfoot" (length org-table-last-alignment))
nil)))
(if (not longtblp)
(format "\n\\end{%s}"
org-export-latex-tabular-environment))
(if (not longtblp) (format "\n\\end{%s}" tabular-env))
(if longtblp "\n" (if org-export-latex-tables-centered
"\n\\end{center}\n" "\n"))
(if longtblp
"\\end{longtable}"
(if floatp "\\end{table}"))))
(if floatp (format "\\end{%s}" tblenv)))))
"\n\n"))))))))
(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}")))
(when floatp
(setq tbl (concat "\\begin{table}\n"
(format "\\caption%s{%s}%s\n"
(format "\\caption%s{%s%s}\n"
(if shortn (format "[%s]" shortn) "")
(if label (format "\\label{%s}" label) "")
(or caption ""))
@ -1950,12 +2095,11 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(replace-match rpl t t)))
(backward-char)))
(defvar org-export-latex-use-verb nil)
(defun org-export-latex-emph-format (format string)
"Format an emphasis string and handle the \\verb special case."
(when (equal format "\\verb")
(when (member format '("\\verb" "\\protectedtexttt"))
(save-match-data
(if org-export-latex-use-verb
(if (equal format "\\verb")
(let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}"))
(catch 'exit
(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 char (or (cdr (assoc char trans)) (concat "\\" 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))
(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.
(setq path (org-export-latex-protect-amp path)
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))))
;; 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
(cond
(wrapp "{l}{0.5\\textwidth}")
(floatp "[htb]")
(floatp (concat "[" org-latex-default-figure-position "]"))
(t "")))
(when (and attr (stringp attr)
@ -2106,12 +2255,12 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(multicolumnp "\\begin{figure*}%placement
\\centering
\\includegraphics[%attr]{%path}
\\caption{%labelcmd%caption}
\\caption%shortn{%labelcmd%caption}
\\end{figure*}")
(floatp "\\begin{figure}%placement
\\centering
\\includegraphics[%attr]{%path}
\\caption{%labelcmd%caption}
\\caption%shortn{%labelcmd%caption}
\\end{figure}")
(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)
"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
(goto-char (point-min))
(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))))))
;; Preserve math snippets
(let* ((matchers (plist-get org-format-latex-options :matchers))
(re-list org-latex-regexps)
beg end re e m n block off)
@ -2229,6 +2439,18 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(and (looking-at "[ \t]*ORG-VERSE-END.*")
(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
(goto-char (point-min))
(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
(goto-char (point-min))
(while (re-search-forward "^----+.$" nil t)
(while (re-search-forward "^[ \t]*-\\{5,\\}[ \t]*$" nil t)
(org-if-unprotected
(replace-match (org-export-latex-protect-string "\\hrule") t t)))
;; Protect LaTeX commands like \command[...]{...} or \command{...}
(goto-char (point-min))
(let ((re (concat
"\\\\\\([a-zA-Z]+\\)"
"\\\\\\([a-zA-Z]+\\*?\\)"
"\\(?:<[^<>\n]*>\\)*"
"\\(?:\\[[^][\n]*?\\]\\)*"
"\\(?:<[^<>\n]*>\\)*"
"\\(" (org-create-multibrace-regexp "{" "}" 3) "\\)\\{1,3\\}")))
(while (re-search-forward re nil t)
(unless (or
;; check for comment line
;; Check for comment line.
(save-excursion (goto-char (match-beginning 0))
(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))
)
;; 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)
'(org-protected t)))))
@ -2296,55 +2523,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(goto-char (point-min))
(while (re-search-forward "@<\\(?:[^\"\n]\\|\".*\"\\)*?>" nil t)
(org-if-unprotected
(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 "")))))
(replace-match ""))))
(defun org-export-latex-fix-inputenc ()
"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 ()
"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)
(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)
(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))
(while (string-match "^\\(\\\\item[ \t]+\\)\\[@\\(?:start:\\)?\\([0-9]+\\)\\]"
res)
(setq res (replace-match
(concat (format "\\setcounter{enumi}{%d}"
(1- (string-to-number
(match-string 2 res))))
"\n"
(match-string 1 res))
t t res)))
(insert res))))
;; Extend previous value of original-indentation to the
;; whole string
(insert (org-add-props res nil 'original-indentation
(org-find-text-property-in-string
'original-indentation res)))))))
;; List of allowed contexts for export, and the default one.
(append org-list-export-context '(nil)))))
(defconst org-latex-entities
'("\\!"
@ -2402,6 +2597,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
"\\Styles"
"\\\\"
"\\`"
"\\\""
"\\addcontentsline"
"\\address"
"\\addtocontents"
@ -2573,5 +2769,6 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(provide 'org-export-latex)
(provide 'org-latex)
;; arch-tag: 23c2b87d-da04-4c2d-ad2d-1eb6487bc3ad
;;; org-latex.el ends here

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

File diff suppressed because it is too large Load diff

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

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

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

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

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

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

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

@ -1,11 +1,12 @@
;;; 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>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;
;; 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."
(when (or (equal major-mode 'mh-folder-mode)
(equal major-mode 'mh-show-mode))
(save-window-excursion
(let* ((from (org-mhe-get-header "From:"))
(to (org-mhe-get-header "To:"))
(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) "#"
(org-remove-angle-brackets message-id)))
(org-add-link-props :link link :description desc)
link)))
link))))
(defun org-mhe-open (path)
"Follow an MH-E message link specified by PATH."
@ -224,5 +226,6 @@ folders."
(provide 'org-mhe)
;; arch-tag: dcb05484-8627-491d-a8c1-01dbd2bde4ae
;;; org-mhe.el ends here

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

@ -1,11 +1,11 @@
;;; 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>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -132,5 +132,6 @@ only the bare key is returned."
(provide 'org-mks)
;; arch-tag: 4ea90d0e-c6e4-4684-bd61-baf878712f9f
;;; org-mks.el ends here

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

@ -1,10 +1,10 @@
;;; 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>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -38,6 +38,9 @@
(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
"Options concerning support for a viewer/editor on a mobile device."
:tag "Org Mobile"
@ -63,6 +66,11 @@ org-agenda-text-search-extra-files
(repeat :inline t :tag "Additional files"
(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 ""
"The WebDAV directory where the interaction with the mobile takes place."
: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.")
(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
should point to this file."
:group 'org-mobile
@ -241,7 +249,8 @@ using `rsync' or `scp'.")
(setq org-mobile-checksum-files nil))
(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
(and (member 'org-agenda-text-search-extra-files org-mobile-files)
(member 'agenda-archives org-agenda-text-search-extra-files)
@ -263,6 +272,13 @@ using `rsync' or `scp'.")
(list f))
(t nil)))
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-re (concat "\\`" (regexp-quote orgdir-uname)))
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))
(save-excursion
(save-window-excursion
(run-hooks 'org-mobile-pre-push-hook)
(org-mobile-check-setup)
(org-mobile-prepare-file-lists)
(run-hooks 'org-mobile-pre-push-hook)
(message "Creating agendas...")
(let ((inhibit-redisplay t)) (org-mobile-create-sumo-agenda))
(message "Creating agendas...done")
@ -562,8 +578,9 @@ The table of checksums is written to the file mobile-checksums."
" " match "</after>"))
settings))
(push (list type match settings) new))
((symbolp (nth 2 e))
;; A user-defined function, not sure how to handle that yet
((or (functionp (nth 2 e)) (symbolp (nth 2 e)))
;; A user-defined function, which can do anything, so simply
;; ignore it.
)
(t
;; a block agenda
@ -617,12 +634,12 @@ The table of checksums is written to the file mobile-checksums."
(get-text-property (point) 'org-marker)))
(setq sexp (member (get-text-property (point) 'type)
'("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
(setq prefix (org-trim (buffer-substring
(point) (+ (point) pl)))
(point) pl))
line (org-trim (buffer-substring
(+ (point) pl)
pl
(point-at-eol))))
(delete-region (point-at-bol) (point-at-eol))
(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))))))
(defun org-mobile-escape-olp (s)
(let ((table '((?: . "%3a") (?\[ . "%5b") (?\] . "%5d") (?/ . "%2f"))))
(let ((table '(?: ?/)))
(org-link-escape s table)))
;;;###autoload
@ -895,7 +912,7 @@ If BEG and END are given, only do this in that region."
(buffer-file-name (current-buffer))))))
(error (setq org-mobile-error msg))))
(when org-mobile-error
(switch-to-buffer (marker-buffer marker))
(org-pop-to-buffer-same-window (marker-buffer marker))
(goto-char marker)
(incf cnt-error)
(insert (if (stringp (nth 1 org-mobile-error))
@ -969,11 +986,10 @@ is currently a noop.")
(if (not (string-match "\\`olp:\\(.*?\\):\\(.*\\)$" link))
nil
(let ((file (match-string 1 link))
(path (match-string 2 link))
(table '((?: . "%3a") (?\[ . "%5b") (?\] . "%5d") (?/ . "%2f"))))
(setq file (org-link-unescape file table))
(path (match-string 2 link)))
(setq file (org-link-unescape file))
(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-find-olp (cons file path))))))
@ -1083,6 +1099,7 @@ A and B must be strings or nil."
(provide 'org-mobile)
;; arch-tag: ace0e26c-58f2-4309-8a61-05ec1535f658
;;; org-mobile.el ends here

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

@ -1,10 +1,10 @@
;;; 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>
;; Maintainer: Carsten Dominik <carsten at orgmode dot org>
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -149,6 +149,8 @@
(newhead hdmarker &optional fixface just-this))
(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-agenda-earlier "org-agenda" (arg))
(declare-function org-agenda-later "org-agenda" (arg))
(defvar org-mouse-plain-list-regexp "\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) "
"Regular expression that matches a plain list.")
@ -476,11 +478,11 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
(defun org-mouse-agenda-type (type)
(case type
(tags "Tags: ")
(todo "TODO: ")
(tags-tree "Tags tree: ")
(todo-tree "TODO tree: ")
(occur-tree "Occur tree: ")
('tags "Tags: ")
('todo "TODO: ")
('tags-tree "Tags tree: ")
('todo-tree "TODO tree: ")
('occur-tree "Occur tree: ")
(t "Agenda command ???")))
@ -526,7 +528,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
("Check Tags"
,@(org-mouse-keyword-menu
(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])
["Check Phrase ..." org-occur]
@ -537,18 +539,18 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
("Display Tags"
,@(org-mouse-keyword-menu
(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])
["Display Calendar" org-goto-calendar t]
"--"
,@(org-mouse-keyword-menu
(mapcar 'car org-agenda-custom-commands)
(lambda (key)
#'(lambda (key)
(eval `(flet ((read-char-exclusive () (string-to-char ,key)))
(org-agenda nil))))
nil
(lambda (key)
#'(lambda (key)
(let ((entry (assoc key org-agenda-custom-commands)))
(org-mouse-clip-text
(cond
@ -580,8 +582,8 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
(defun org-mouse-for-each-item (funct)
;; Functions called by `org-apply-on-list' need an argument
(let ((wrap-fun (lambda (c) (funcall funct))))
(when (org-in-item-p)
(org-apply-on-list wrap-fun nil))))
(when (ignore-errors (goto-char (org-in-item-p)))
(save-excursion (org-apply-on-list wrap-fun nil)))))
(defun org-mouse-bolp ()
"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))
(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)
ad-do-it))
(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)
ad-do-it))
@ -633,7 +635,7 @@ This means, between the beginning of line and the point."
(defun org-mouse-match-todo-keyword ()
(save-excursion
(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 " *"))
(looking-at " \\( *\\)"))))
@ -832,7 +834,7 @@ This means, between the beginning of line and the point."
("Tags and Priorities"
,@(org-mouse-keyword-menu
(org-mouse-priority-list)
(lambda (keyword)
#'(lambda (keyword)
(org-mouse-set-priority (string-to-char keyword)))
priority "Priority %s")
"--"
@ -905,7 +907,7 @@ This means, between the beginning of line and the point."
(mouse-drag-region event)))
(add-hook 'org-mode-hook
(lambda ()
#'(lambda ()
(setq org-mouse-context-menu-function 'org-mouse-context-menu)
(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)
(font-lock-add-keywords
nil
`((,outline-regexp
`((,org-outline-regexp
0 `(face org-link mouse-face highlight keymap ,org-mouse-map)
'prepend))
t))
@ -997,7 +999,7 @@ This means, between the beginning of line and the point."
(end-of-line)
(if (eobp) (newline) (forward-char)))
(when (looking-at outline-regexp)
(when (looking-at org-outline-regexp)
(let ((level (- (match-end 0) (match-beginning 0))))
(when (> end (match-end 0))
(outline-end-of-subtree)
@ -1017,11 +1019,11 @@ This means, between the beginning of line and the point."
(replace-text (concat (match-string 0) "* ")))
(beginning-of-line 2)
(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)
(setq minlevel (min minlevel (- (match-end 1) (match-beginning 1)))))
(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)
(eq minlevel (- (match-end 1) (match-beginning 1))))
(replace-match replace-text))
@ -1128,20 +1130,22 @@ This means, between the beginning of line and the point."
; (setq org-agenda-mode-hook nil)
(defvar org-agenda-mode-map)
(add-hook 'org-agenda-mode-hook
(lambda ()
#'(lambda ()
(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 [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-5] 'org-agenda-later)
(org-defkey org-agenda-mode-map [drag-mouse-3]
(lambda (event) (interactive "e")
#'(lambda (event) (interactive "e")
(case (org-mouse-get-gesture event)
(:left (org-agenda-earlier 1))
(:right (org-agenda-later 1)))))))
(provide 'org-mouse)
;; arch-tag: ff1ae557-3529-41a3-95c6-baaebdcc280f
;;; 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

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

@ -1,11 +1,11 @@
;;; 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>
;; Keywords: tables, plotting
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;
;; 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))
(plot-str "'%s' using %s%d%s with %s title '%s'")
(plot-cmd (case type
(2d "plot")
(3d "splot")
(grid "splot")))
('2d "plot")
('3d "splot")
('grid "splot")))
(script "reset") plot-lines)
(flet ((add-to-script (line) (setf script (format "%s\n%s" script line))))
(when file ;; output file
(add-to-script (format "set term %s" (file-name-extension file)))
(add-to-script (format "set output '%s'" file)))
(case type ;; type
(2d ())
(3d (if map (add-to-script "set map")))
(grid (if map
('2d ())
('3d (if map (add-to-script "set map")))
('grid (if map
(add-to-script "set pm3d map")
(add-to-script "set pm3d"))))
(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") "\"")))
(unless preface
(case type ;; plot command
(2d (dotimes (col num-cols)
('2d (dotimes (col num-cols)
(unless (and (equal type '2d)
(or (and ind (equal (+ 1 col) ind))
(and deps (not (member (+ 1 col) deps)))))
@ -258,10 +258,10 @@ manner suitable for prepending to a user-specified script."
with
(or (nth col col-labels) (format "%d" (+ 1 col))))
plot-lines)))))
(3d
('3d
(setq plot-lines (list (format "'%s' matrix with %s title ''"
data-file with))))
(grid
('grid
(setq plot-lines (list (format "'%s' with %s title ''"
data-file with)))))
(add-to-script
@ -305,9 +305,9 @@ line directly before or after the table."
(setf params (org-plot/collect-options params))))
;; dump table to datafile (very different for grid)
(case (plist-get params :plot-type)
(2d (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
('2d (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
table data-file params)))
(when y-labels (plist-put params :ylabels y-labels)))))
;; check for timestamp ind column
@ -350,4 +350,5 @@ line directly before or after the table."
(provide 'org-plot)
;; arch-tag: 5763f7c6-0c75-416d-b070-398ee4ec0eca
;;; org-plot.el ends here

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

@ -1,6 +1,7 @@
;;; 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: Daniel M German <dmg AT uvic DOT org>
@ -8,7 +9,7 @@
;; Author: Ross Patterson <me AT rpatterson DOT net>
;; Maintainer: Sebastian Rose <sebastian_rose AT gmx DOT de>
;; Keywords: org, emacsclient, wp
;; Version: 7.4
;; Version: 7.7
;; This file is part of GNU Emacs.
;;
@ -129,6 +130,18 @@
(filename &optional up))
(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
"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.
See `org-protocol-protocol-alist' for a description of this variable.")
(defconst org-protocol-the-protocol "org-protocol"
"This is the protocol to detect if org-protocol.el is loaded.
`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).
That protocol handler should call emacsclient.")
;;; User variables:
(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
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
@ -171,9 +182,8 @@ unchanged."
:group 'org-protocol
:type 'boolean)
(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:
@ -216,7 +226,6 @@ Consider using the interactive functions `org-protocol-create' and
:group 'org-protocol
:type 'alist)
(defcustom org-protocol-protocol-alist nil
"* Register custom handlers for org-protocol.
@ -260,7 +269,9 @@ Here is an example:
:type '(alist))
(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
:type 'string)
@ -274,95 +285,27 @@ Slashes are sanitized to double slashes here."
(setq uri (concat (car splitparts) "//" (mapconcat 'identity (cdr splitparts) "/")))))
uri)
(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
SEPARATOR (regexp). If no SEPARATOR is specified or SEPARATOR is
nil, assume \"/+\". The results of that splitting are returned
as a list. If UNHEXIFY is non-nil, hex-decode each split part. If
UNHEXIFY is a function, use that function to decode each split
as a list. If UNHEXIFY is non-nil, hex-decode each split part.
If UNHEXIFY is a function, use that function to decode each split
part."
(let* ((sep (or separator "/+"))
(split-parts (split-string data sep)))
(if unhexify
(if (fboundp unhexify)
(mapcar unhexify split-parts)
(mapcar 'org-protocol-unhex-string split-parts))
(mapcar 'org-link-unescape 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)
"Greedy handlers might receive a list like this from emacsclient:
'((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\")
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:
If strip-path is non-nil, remove the \"/dir/\" prefix from all members of
@ -402,7 +345,6 @@ returned list."
ret)
l)))
(defun org-protocol-flatten (l)
"Greedy handlers might receive a list like this from emacsclient:
'( (\"/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)))
(list l))))
;;; Standard protocol handlers:
(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."
(if (and (boundp 'org-stored-links)
(or (fboundp 'org-capture))
(fboundp 'org-capture)
(org-protocol-do-capture info 'org-remember))
(message "Org-mode not loaded."))
(message "Item remembered."))
nil)
(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."
(if (and (boundp 'org-stored-links)
(or (fboundp 'org-capture))
(fboundp 'org-capture)
(org-protocol-do-capture info 'org-capture))
(message "Org-mode not loaded."))
(message "Item captured."))
nil)
(defun org-protocol-do-capture (info capture-func)
"Support `org-capture' and `org-remember' alike.
CAPTURE-FUNC is either the symbol `org-remember' or `org-capture'."
(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))
(url (org-protocol-sanitize-uri (car parts)))
(type (if (string-match "^\\([a-z]+\\):" url)
@ -515,7 +458,6 @@ CAPTURE-FUNC is either the symbol `org-remember' or `org-capture'."
(raise-frame)
(funcall capture-func nil template)))
(defun org-protocol-open-source (fname)
"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://'+ \\
encodeURIComponent(location.href)"
;; As we enter this function for a match on our protocol, the return value
;; defaults to nil.
(let ((result nil)
(f (org-protocol-unhex-string fname)))
(f (org-link-unescape fname)))
(catch 'result
(dolist (prolist org-protocol-project-alist)
(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.
If the function returns a non nil value, that value is passed to the server
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
(let ((the-protocol (concat (regexp-quote org-protocol-the-protocol) ":/+")))
(when (string-match the-protocol fname)
(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)
(let* ((func (plist-get (cdr prolist) :function))
(greedy (plist-get (cdr prolist) :greedy))
@ -617,7 +560,6 @@ as filename."
;; (message "fname: %s" fname)
fname)))
(defadvice server-visit-files (before org-protocol-detect-protocol-server activate)
"Advice server-visit-flist to call `org-protocol-modify-filename-for-protocol'."
(let ((flist (if org-protocol-reverse-list-of-files
@ -626,16 +568,17 @@ as filename."
(client (ad-get-arg 1)))
(catch 'greedy
(dolist (var flist)
(let ((fname (expand-file-name (car var)))) ;; `\' to `/' on windows. FIXME: could this be done any better?
(setq fname (org-protocol-check-filename-for-protocol fname (member var flist) client))
;; `\' to `/' on windows. FIXME: could this be done any better?
(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.
(progn
(ad-set-arg 0 nil)
(throw 'greedy t))
(if (stringp fname) ;; probably filename
(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:
@ -651,7 +594,6 @@ most of the work."
(message "Not in an org-project. Did mean %s?"
(substitute-command-keys"\\[org-protocol-create]")))))
(defun org-protocol-create (&optional project-plist)
"Create a new org-protocol project interactively.
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
:base-directory, :html-extension and :base-extension."
(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/")
(strip-suffix (or (plist-get project-plist :html-extension) ".html"))
(working-suffix (if (plist-get project-plist :base-extension)
(concat "." (plist-get project-plist :base-extension))
".org"))
(worglet-buffer nil)
(insert-default-directory t)
(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)
;; arch-tag: b5c5c2ac-77cf-4a94-a649-2163dff95846
;;; org-protocol.el ends here

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

@ -1,10 +1,11 @@
;;; 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>
;; Maintainer: Carsten Dominik <carsten DOT dominik AT gmail DOT com>
;; Keywords: hypermedia, outlines, wp
;; Version: 7.4
;; Version: 7.7
;; This file is part of GNU Emacs.
;;
@ -40,25 +41,27 @@
;;; 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
(require 'cl))
(require 'org)
(require 'org-exp)
(require 'format-spec)
(eval-and-compile
(unless (fboundp 'declare-function)
(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
"Options for publishing a set of Org-mode and related files."
:tag "Org Publishing"
@ -154,10 +157,8 @@ learn more about their use and default values.
:expand-quoted-html `org-export-html-expand'
:timestamp `org-export-html-with-timestamp'
:publishing-directory `org-export-publishing-directory'
:preamble `org-export-html-preamble'
:postamble `org-export-html-postamble'
:auto-preamble `org-export-html-auto-preamble'
:auto-postamble `org-export-html-auto-postamble'
:html-preamble `org-export-html-preamble'
:html-postamble `org-export-html-postamble'
:author `user-full-name'
: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
files is reflected in the sitemap). Defaults to
`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:
@ -185,8 +191,9 @@ sitemap of files or summary page for a given project.
Set this to `first' (default) or `last' to
display folders first or last, respectively.
Any other value will mix files and folders.
:sitemap-alphabetically The site map is normally sorted alphabetically.
Set this explicitly to nil to turn off sorting.
:sitemap-sort-files The site map is normally sorted alphabetically.
You can change this behaviour setting this to
`chronologically', `anti-chronologically' or nil.
:sitemap-ignore-case Should sorting be case-sensitive? Default nil.
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
:type 'hook)
(defcustom org-publish-sitemap-sort-alphabetically t
"Should sitemaps be sorted alphabetically by default?
(defcustom org-publish-sitemap-sort-files 'alphabetically
"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
`org-publish-project-alist', using `:sitemap-alphabetically'."
`org-publish-project-alist', using `:sitemap-sort-files'."
:group 'org-publish
:type 'boolean)
:type 'symbol)
(defcustom org-publish-sitemap-sort-folders 'first
"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
: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
@ -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.
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
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
function can still decide about that independently."
(let ((rtn
@ -305,20 +348,6 @@ If there is no timestamp, create one."
(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
@ -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 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
@ -358,17 +389,19 @@ This splices all the components into the list."
(push p rtn)))
(nreverse (org-publish-delete-dups (delq nil rtn)))))
(defvar sitemap-alphabetically)
(defvar sitemap-sort-folders)
(defvar sitemap-ignore-case)
(defvar sitemap-requested)
(defvar org-sitemap-sort-files)
(defvar org-sitemap-sort-folders)
(defvar org-sitemap-ignore-case)
(defvar org-sitemap-requested)
(defvar org-sitemap-date-format)
(defvar org-sitemap-file-entry-format)
(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))
(when (or sitemap-alphabetically sitemap-sort-folders)
;; First we sort alphabetically:
(when sitemap-alphabetically
(when (or org-sitemap-sort-files org-sitemap-sort-folders)
;; First we sort files:
(when org-sitemap-sort-files
(cond ((equal org-sitemap-sort-files 'alphabetically)
(let* ((adir (file-directory-p a))
(aorg (and (string-match "\\.org$" a) (not adir)))
(bdir (file-directory-p b))
@ -379,19 +412,27 @@ This splices all the components into the list."
(B (if borg
(concat (file-name-directory 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 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:
(when sitemap-sort-folders
(when org-sitemap-sort-folders
;; a is directory, b not:
(cond
((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:
((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))
(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)))
(pushnew f org-publish-temp-files)))))
(if sitemap-requested
(if org-sitemap-requested
(sort (directory-files base-dir t (unless recurse match))
'org-publish-compare-directory-files)
(directory-files base-dir t (unless recurse match)))))
@ -431,28 +472,38 @@ matching filenames."
(extension (or (plist-get project-plist :base-extension) "org"))
;; sitemap-... variables are dynamically scoped for
;; org-publish-compare-directory-files:
(sitemap-requested
(org-sitemap-requested
(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)
(plist-get project-plist :sitemap-sort-folders)
org-publish-sitemap-sort-folders))
(sitemap-alphabetically
(if (plist-member project-plist :sitemap-alphabetically)
(plist-get project-plist :sitemap-alphabetically)
org-publish-sitemap-sort-alphabetically))
(sitemap-ignore-case
(org-sitemap-sort-files
(cond ((plist-member project-plist :sitemap-sort-files)
(plist-get project-plist :sitemap-sort-files))
;; For backward compatibility:
((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)
(plist-get project-plist :sitemap-ignore-case)
org-publish-sitemap-sort-ignore-case))
(match (if (eq extension 'any)
"^[^\\.]"
(concat "^[^\\.].*\\.\\(" extension "\\)$"))))
;; Make sure sitemap-sort-folders' has an accepted value
(unless (memq sitemap-sort-folders '(first last))
(setq sitemap-sort-folders nil))
;; Make sure `org-sitemap-sort-folders' has an accepted value
(unless (memq org-sitemap-sort-folders '(first last))
(setq org-sitemap-sort-folders 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
;; FIXME distinguish exclude regexp
;; for skip-file and skip-dir?
@ -480,10 +531,10 @@ matching filenames."
(e (plist-get (cdr prj) :exclude))
(i (plist-get (cdr prj) :include))
(xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$")))
(when (or
(when
(or
(and
i
(member filename
i (member filename
(mapcar
(lambda (file) (expand-file-name file b))
i)))
@ -511,7 +562,7 @@ PUB-DIR is the publishing directory."
(make-directory pub-dir t))
(let ((visiting (find-buffer-visiting filename)))
(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)))
(init-buf (current-buffer))
(init-point (point))
@ -677,6 +728,10 @@ If :makeindex is set, also produce a file theindex.org."
"sitemap.org"))
(sitemap-function (or (plist-get project-plist :sitemap-function)
'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))
(completion-function (plist-get project-plist :completion-function))
(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))
(org-publish-file file project t))
(when (plist-get project-plist :makeindex)
(org-publish-index-generate-theindex.inc
(org-publish-index-generate-theindex
(plist-get project-plist :base-directory))
(org-publish-file (expand-file-name
"theindex.org"
@ -711,6 +766,7 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
(concat "Sitemap for project " (car project))))
(sitemap-style (or (plist-get project-plist :sitemap-style)
'tree))
(sitemap-sans-extension (plist-get project-plist :sitemap-sans-extension))
(visiting (find-buffer-visiting sitemap-filename))
(ifn (file-name-nondirectory sitemap-filename))
file sitemap-buffer)
@ -722,6 +778,8 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
(let ((fn (file-name-nondirectory file))
(link (file-relative-name file dir))
(oldlocal localdir))
(when sitemap-sans-extension
(setq link (file-name-sans-extension link)))
;; sitemap shouldn't list itself
(unless (equal (file-truename sitemap-filename)
(file-truename file))
@ -752,16 +810,34 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
(setq indent-str (make-string
(+ (length indent-str) 2) ?\ )))))))
;; 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 "]["
(org-publish-find-title file)
"]]\n")))))
entry
"]]\n"))))))))
(save-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."
(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))
(buffer (or visiting (find-file-noselect file)))
title)
@ -779,6 +855,24 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
(org-publish-cache-set-file-property file :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
@ -848,7 +942,6 @@ the project."
;;; Index generation
(defvar backend) ; dynamically scoped
(defun org-publish-aux-preprocess ()
"Find index entries and write them to an .orgx file."
(let ((case-fold-search t)
@ -859,7 +952,7 @@ the project."
(re-search-forward "^[ \t]*#\\+index:[ \t]*\\(.*?\\)[ \t]*$" nil t)
(> (match-end 1) (match-beginning 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))
(save-excursion
(ignore-errors (org-back-to-heading t))
@ -869,12 +962,15 @@ the project."
target ""))
(push (cons entry target) index)))
(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))
(insert (format "INDEX: (%s) %s\n" (cdr entry) (car entry)))))))
(defun org-publish-index-generate-theindex.inc (directory)
"Generate the index from all .orgx files in the current directory and below."
(defun org-publish-index-generate-theindex (directory)
"Generate the index from all .orgx files in DIRECTORY."
(require 'find-lisp)
(let* ((fulldir (file-name-as-directory
(expand-file-name directory)))
@ -889,7 +985,7 @@ the project."
main last-main letter last-letter file sub link tgext)
;; `files' contains the list of relative file names
(dolist (file files)
(setq origfile (substring file 0 -1))
(setq origfile (substring file 1 -1))
(setq buf (find-file-noselect file))
(with-current-buffer buf
(goto-char (point-min))
@ -900,7 +996,7 @@ the project."
(kill-buffer buf))
(setq index (sort index (lambda (a b) (string< (downcase (car a))
(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
(erase-buffer)
(insert "* Index\n")
@ -927,17 +1023,7 @@ the project."
(insert " - " link "\n")
(insert " - " link "\n")))
(save-buffer))
(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)))))
(kill-buffer ibuffer)))
;; 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)
"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
(error "%s" "`org-publish-cache-file-needs-publishing' called, but no cache present"))
(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)
t
(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)
"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))
(defun org-publish-cache-ctime-of-src (filename)
"Get the files ctime as integer."
(let ((src-attr (file-attributes filename)))
"Get the FILENAME ctime as an integer."
(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)
(cadr (nth 5 src-attr)))))
(provide 'org-publish)
;; arch-tag: 72807f3c-8af0-4a6b-8dca-c3376eb25adb
;;; org-publish.el ends here

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

@ -1,11 +1,12 @@
;;; 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>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -33,12 +34,16 @@
(eval-when-compile
(require 'cl))
(require 'org)
(require 'org-compat)
(require 'org-datetree)
(declare-function remember-mode "remember" ())
(declare-function remember "remember" (&optional initial))
(declare-function remember-buffer-desc "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-register)
(defvar remember-buffer)
@ -214,11 +219,7 @@ The remember buffer is still current when this hook runs."
:group 'org-remember
:type 'hook)
(defvar org-remember-mode-map
(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)
(defvar org-remember-mode-map (make-sparse-keymap)
"Keymap for `org-remember-mode', a minor mode.
Use this map to set additional keybindings for when Org-mode is used
for a Remember buffer.")
@ -227,7 +228,10 @@ for a Remember buffer.")
(define-minor-mode org-remember-mode
"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
"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 visiting (org-find-base-buffer-visiting 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)
(goto-char (point-min))
(if (re-search-forward
@ -1004,7 +1008,7 @@ See also the variable `org-reverse-note-order'."
((eq org-remember-interactive-interface 'outline-path-completion)
(let ((org-refile-targets '((nil . (:maxlevel . 10))))
(org-refile-use-outline-path t))
(setq spos (org-refile-get-location "Heading: ")
(setq spos (org-refile-get-location "Heading")
exitcmd 'return
spos (nth 3 spos))))
(t (error "This should not happen")))
@ -1072,7 +1076,7 @@ See also the variable `org-reverse-note-order'."
(save-restriction
(widen)
(goto-char (point-min))
(re-search-forward "^\\*+ " nil t)
(re-search-forward org-outline-regexp-bol nil t)
(beginning-of-line 1)
(org-paste-subtree 1 txt)
(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)
;; arch-tag: 497f30d0-4bc3-4097-8622-2d27ac5f2698
;;; org-remember.el ends here

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

@ -1,11 +1,12 @@
;;; 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>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -114,5 +115,6 @@
(provide 'org-rmail)
;; arch-tag: c6cf4a8b-6639-4b7f-821f-bdf10746b173
;;; org-rmail.el ends here

99
lisp/org/org-special-blocks.el Normal file
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

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

@ -1,13 +1,14 @@
;;; 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>
;; Bastien Guerry <bzg AT altern DOT org>
;; Dan Davison <davison at stats dot ox dot ac dot uk>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -42,6 +43,8 @@
(declare-function org-at-table.el-p "org" ())
(declare-function org-get-indentation "org" (&optional line))
(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
"Additional regexps to identify regions for editing with `org-edit-src-code'.
@ -115,8 +118,7 @@ buffer.")
(defcustom org-edit-src-persistent-message t
"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
first line of the window showing the editing buffer.
When nil, the message will only be shown intermittently in the echo area."
first line of the window showing the editing buffer."
:group 'org-edit-structure
:type 'boolean)
@ -153,7 +155,7 @@ but which mess up the display of a snippet in Org exported files.")
(defcustom org-src-lang-modes
'(("ocaml" . tuareg) ("elisp" . emacs-lisp) ("ditaa" . artist)
("asymptote" . asy) ("dot" . fundamental) ("sqlite" . sql)
("calc" . fundamental))
("calc" . fundamental) ("C" . c))
"Alist mapping languages to their major mode.
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
@ -169,10 +171,8 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is
;;; Editing source examples
(defvar org-src-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-c'" 'org-edit-src-exit)
map))
(defvar org-src-mode-map (make-sparse-keymap))
(define-key org-src-mode-map "\C-c'" 'org-edit-src-exit)
(defvar org-edit-src-force-single-line 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
`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.
The example is copied to a separate buffer, and that buffer is
switched to the correct language mode. When done, exit with
@ -216,14 +216,13 @@ buffer."
(let ((mark (and (org-region-active-p) (mark)))
(case-fold-search t)
(info (org-edit-src-find-region-and-lang))
(babel-info (org-babel-get-src-block-info 'light))
(org-mode-p (eq major-mode 'org-mode))
(full-info (org-babel-get-src-block-info))
(org-mode-p (or (org-mode-p) (derived-mode-p 'org-mode)))
(beg (make-marker))
(end (make-marker))
(preserve-indentation org-src-preserve-indentation)
(allow-write-back-p (null code))
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)
nil
(setq beg (move-marker beg (nth 0 info))
@ -237,10 +236,22 @@ buffer."
(nth 2 info))
lang (if (symbolp lang) (symbol-name lang) lang)
single (nth 3 info)
lfmt (nth 4 info)
block-nindent (nth 5 info)
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)))
(save-excursion (goto-char (min mark end))
(setq markline (org-current-line)
@ -280,27 +291,23 @@ buffer."
(define-key map [mouse-1] 'org-edit-src-continue)
map))
(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)
(if (eq single 'macro-definition)
(setq code (replace-regexp-in-string "\\\\n" "\n" code t t)))
(insert code)
(remove-text-properties (point-min) (point-max)
'(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)))
(let ((org-inhibit-startup t))
(condition-case e
(funcall lang-f)
(error
(error "Language mode `%s' fails with: %S" lang-f (nth 1 e)))))
(set (make-local-variable 'org-edit-src-force-single-line) single)
(set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p)
(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))
(dolist (pair transmitted-variables)
(org-set-local (car pair) (cadr pair)))
(when org-mode-p
(goto-char (point-min))
(while (re-search-forward "^," nil t)
@ -309,21 +316,20 @@ buffer."
(when markline
(org-goto-line (1+ (- markline begline)))
(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)
(setq deactivate-mark nil))
(org-goto-line (1+ (- line begline)))
(org-move-to-column
(if 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)
(if org-src-preserve-indentation col (max 0 (- col total-nindent))))
(org-src-mode)
(set-buffer-modified-p nil)
(and org-edit-src-persistent-message
(org-set-local 'header-line-format msg)))
(unless quietp (message "%s" msg))
(org-set-local 'header-line-format msg))
(let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang))))
(when (fboundp edit-prep-func)
(funcall edit-prep-func full-info))))
t)))
(defun org-edit-src-continue (e)
@ -335,31 +341,31 @@ buffer."
(defun org-src-switch-to-buffer (buffer context)
(case org-src-window-setup
(current-window
(switch-to-buffer buffer))
(other-window
('current-window
(org-pop-to-buffer-same-window buffer))
('other-window
(switch-to-buffer-other-window buffer))
(other-frame
('other-frame
(case context
(exit
('exit
(let ((frame (selected-frame)))
(switch-to-buffer-other-frame buffer)
(delete-frame frame)))
(save
('save
(kill-buffer (current-buffer))
(switch-to-buffer buffer))
(org-pop-to-buffer-same-window buffer))
(t
(switch-to-buffer-other-frame buffer))))
(reorganize-frame
('reorganize-frame
(if (eq context 'edit) (delete-other-windows))
(org-switch-to-buffer-other-window buffer)
(if (eq context 'exit) (delete-other-windows)))
(switch-invisibly
('switch-invisibly
(set-buffer buffer))
(t
(message "Invalid value %s for 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)
"Construct the buffer name for a source editing buffer."
@ -394,7 +400,7 @@ the fragment in the Org-mode buffer."
(case-fold-search t)
(msg (substitute-command-keys
"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))
(end (make-marker))
(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)))
(if (and (setq buffer (org-edit-src-find-buffer beg end))
(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
(with-current-buffer buffer
(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)
map))
(overlay-put ovl :read-only "Leave me alone")
(switch-to-buffer buffer)
(org-pop-to-buffer-same-window buffer)
(insert code)
(remove-text-properties (point-min) (point-max)
'(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 ()
(when (org-bound-and-true-p org-edit-src-from-org-mode)
(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)
(progn
(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
fontification of code blocks see `org-src-fontify-block' and
`org-src-fontify-buffer'"
(let* ((lang-mode (org-src-get-lang-mode lang))
(string (buffer-substring-no-properties start end))
(let ((lang-mode (org-src-get-lang-mode lang)))
(if (fboundp lang-mode)
(let ((string (buffer-substring-no-properties start end))
(modified (buffer-modified-p))
(org-buffer (current-buffer)) pos next)
(remove-text-properties start end '(face nil))
@ -769,7 +776,7 @@ fontification of code blocks see `org-src-fontify-block' and
(get-buffer-create
(concat " org-src-fontification:" (symbol-name lang-mode)))
(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))
(font-lock-fontify-buffer)
(setq pos (point-min))
@ -781,8 +788,7 @@ fontification of code blocks see `org-src-fontify-block' and
(add-text-properties
start end
'(font-lock-fontified t fontified t font-lock-multiline t))
(set-buffer-modified-p modified))
t) ;; Tell `org-fontify-meta-lines-and-blocks' that we fontified
(set-buffer-modified-p modified)))))
(defun org-src-fontify-block ()
"Fontify code block at point."
@ -808,4 +814,5 @@ LANG is a string, and the returned major mode is a symbol."
(provide 'org-src)
;; arch-tag: 6a1fc84f-dec7-47be-a416-64be56bea5d8
;;; org-src.el ends here

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

@ -1,11 +1,12 @@
;;; 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>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -46,6 +47,7 @@
(defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized
(defvar org-export-html-table-tag) ; defined in org-exp.el
(defvar constants-unit-system)
(defvar org-table-follow-field-mode)
(defvar orgtbl-after-send-table-hook nil
"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
: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
"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,
@ -175,17 +198,17 @@ this line."
:tag "Org Table Calculation"
: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?
Possible values are:
nil never use them
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
:type '(choice
(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 "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
"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
: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
"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
@ -315,6 +350,8 @@ available parameters."
"Table begin line, non-nil only for the duration of a command.")
(defvar org-table-current-begin-pos nil
"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
"Vector of data line line numbers in the current table.")
(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 '(16)) "^\\|\t")
((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"))))
(while (re-search-forward re end t)
(replace-match "| " t t)))
@ -519,14 +558,9 @@ property, locally or anywhere up in the hierarchy."
(let* ((beg (org-table-begin))
(end (org-table-end))
(txt (buffer-substring-no-properties beg end))
(file (or file
(condition-case nil
(org-entry-get beg "TABLE_EXPORT_FILE" t)
(error nil))))
(file (or file (org-entry-get beg "TABLE_EXPORT_FILE" t)))
(format (or format
(condition-case nil
(org-entry-get beg "TABLE_EXPORT_FORMAT" t)
(error nil))))
(org-entry-get beg "TABLE_EXPORT_FORMAT" t)))
buf deffmt-readable)
(unless file
(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)
"Copy a field down in the current column.
If the field at the cursor is empty, copy into it the content of the nearest
non-empty field above. With argument N, use the Nth non-empty field.
If the current field is not empty, it is copied down to the next row, and
the cursor is moved with it. Therefore, repeating this command causes the
column to be filled row-by-row.
If the variable `org-table-copy-increment' is non-nil and the field is an
integer or a timestamp, it will be incremented while copying. In the case of
a timestamp, if the cursor is on the year, change the year. If it is on the
month or the day, change that. Point will stay on the current date field
in order to easily repeat the interval."
If the field at the cursor is empty, copy into it the content of
the nearest non-empty field above. With argument N, use the Nth
non-empty field. If the current field is not empty, it is copied
down to the next row, and the cursor is moved with it.
Therefore, repeating this command causes the column to be filled
row-by-row.
If the variable `org-table-copy-increment' is non-nil and the
field is an integer or a timestamp, it will be incremented while
copying. In the case of a timestamp, increment by one day."
(interactive "p")
(let* ((colpos (org-table-current-column))
(col (current-column))
@ -1035,7 +1068,7 @@ in order to easily repeat the interval."
(org-move-to-column col))
(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?
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."
@ -1043,7 +1076,10 @@ This actually throws an error, so it aborts the current command."
(= (org-table-current-column) 0)
(org-at-table-hline-p)
(looking-at "[ \t]*$"))
(error "Not in table data field")))
(if noerror
nil
(error "Not in table data field"))
t))
(defvar org-table-clip nil
"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."
(interactive)
(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)
(org-table-cut-region (region-beginning) (region-end)))
(skip-chars-backward "^|")
@ -1118,7 +1154,8 @@ is always the old value."
(let* ((pos (match-beginning 0))
(val (buffer-substring (1+ pos) (match-end 0))))
(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)))
val)
(forward-char 1) ""))
@ -1133,13 +1170,20 @@ is always the old value."
(cname (car (rassoc (int-to-string col) org-table-column-names)))
(name (car (rassoc (list (org-current-line) col)
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))
(ref (format "@%d$%d" dline col))
(ref1 (org-table-convert-refs-to-an ref))
(fequation (or (assoc name eql) (assoc ref eql)))
(cequation (assoc (int-to-string col) eql))
(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)
(condition-case nil
(org-table-show-reference 'local)
@ -1161,27 +1205,30 @@ is always the old value."
(defun org-table-current-column ()
"Find out which column we are in."
(interactive)
(if (interactive-p) (org-table-check-inside-data-field))
(if (org-called-interactively-p 'any) (org-table-check-inside-data-field))
(save-excursion
(let ((cnt 0) (pos (point)))
(beginning-of-line 1)
(while (search-forward "|" pos t)
(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)))
(defun org-table-current-dline ()
"Find out what table data line we are in.
Only data lines count for this."
(interactive)
(if (interactive-p) (org-table-check-inside-data-field))
(when (org-called-interactively-p 'any)
(org-table-check-inside-data-field))
(save-excursion
(let ((cnt 0) (pos (point)))
(goto-char (org-table-begin))
(while (<= (point) pos)
(if (looking-at org-table-dataline-regexp) (setq cnt (1+ cnt)))
(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)))
(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-table-goto-column colpos)
(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 "$LR" nil (1- col) 1)))
(org-table-fix-formulas "$LR" nil (1- col) 1))))
(defun org-table-find-dataline ()
"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
"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 ()
"Delete a column from the table."
(interactive)
@ -1276,10 +1347,12 @@ However, when FORCE is non-nil, create new columns if necessary."
(org-goto-line linepos)
(org-table-goto-column colpos)
(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"))
col -1 col)
(org-table-fix-formulas "$LR" (list (cons (number-to-string col) "INVALID"))
col -1 col)))
col -1 col))))
(defun org-table-move-column-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-table-goto-column colpos)
(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) (number-to-string colpos))
(cons (number-to-string colpos) (number-to-string col))))
(org-table-fix-formulas
"$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 ()
"Move table row down."
@ -1361,7 +1436,10 @@ However, when FORCE is non-nil, create new columns if necessary."
(insert txt)
(beginning-of-line 0)
(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
"@" (list (cons (number-to-string dline1) (number-to-string dline2))
(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)
(and (or org-table-may-need-update org-table-overlay-coordinates)
(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)
"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)))
(if (not (org-at-table-p)) (beginning-of-line 0))
(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"))
dline -1 dline)))
dline -1 dline))))
(defun org-table-sort-lines (with-case &optional sorting-type)
"Sort table lines according to the column at point.
@ -1473,7 +1555,7 @@ should be done in reverse order."
(thiscol (org-table-current-column))
beg end bcol ecol tend tbeg column lns pos)
(when (equal thiscol 0)
(if (interactive-p)
(if (org-called-interactively-p 'any)
(setq thiscol
(string-to-number
(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
it can be edited in place."
(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)))
(e (save-excursion (skip-chars-forward "^|\r\n") (point))))
(remove-text-properties b e '(org-cwidth t invisible t
display t intangible t))
(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)))
(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))
(cw (current-window-configuration))
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)
(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))
(auto-fill-mode -1)
(setq truncate-lines nil)
(setq word-wrap t)
(goto-char (setq p (point-max)))
(insert (org-trim field))
(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-window-configuration cw)
(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 ()
"Finish editing a table data field.
@ -1773,6 +1872,35 @@ the table and kill the editing buffer."
(org-table-align)
(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
(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)
(format "%d:%02d:%02d" h m s))))
(kill-new sres)
(if (interactive-p)
(if (org-called-interactively-p 'interactive)
(message "%s"
(substitute-command-keys
(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")))
(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
(if (match-end 2) (format "@%05d" (string-to-number (match-string 2 a))) "")
(if (match-end 4) (format "$%05d" (string-to-number (match-string 4 a))) "")
(if (match-end 5) (concat "@@" (match-string 5 a))))))
(if (match-end 2)
(format "@%05d" (string-to-number (match-string 2 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)
"Compare two formulas for sorting."
@ -1969,12 +2109,15 @@ When NAMED is non-nil, look for a named equation."
(save-excursion
(goto-char (org-table-end))
(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))
(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)
(match-string 2 string)
(match-string 1 string))
scol (if (member (string-to-char scol) '(?< ?>))
(concat "$" scol) scol)
eq (match-string 3 string)
eq-alist (cons (cons scol eq) eq-alist))
(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-current-begin-line 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)
(when (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t)
(setq names (org-split-string (match-string 1) " *| *")
@ -2083,6 +2227,7 @@ For all numbers larger than LIMIT, shift them by DELTA."
"[ \t]*|[ \t]*"))
(nfields (length fields))
al al2)
(setq org-table-current-ncol nfields)
(loop for i from 1 to nfields do
(push (list (format "LR%d" i) l i) al)
(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
(append org-table-local-parameters al2))))))
(defun org-table-maybe-eval-formula ()
"Check if the current field starts with \"=\" or \":=\".
If yes, store the formula and apply it."
@ -2180,7 +2324,8 @@ of the new mark."
(org-goto-line l1)))
(if (not (= epos (point-at-eol))) (org-table-align))
(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 ()
"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))
(numbers nil) ; was a variable, now fixed default
(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
;; a lot of work. However, I think calc still uses most of the time.
(if (string-match ";" formula)
@ -2283,8 +2428,17 @@ not overwrite the stored one."
(?s . sci) (?e . eng))))
n))))
(setq fmt (replace-match "" t t fmt)))
(if (string-match "[NT]" fmt)
(setq numbers (equal (match-string 0 fmt) "N")
(if (string-match "T" fmt)
(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)))
(if (string-match "L" fmt)
(setq literal t
@ -2305,6 +2459,11 @@ not overwrite the stored one."
(org-no-properties
(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)
(setq fields (mapcar
(lambda (x) (number-to-string (string-to-number x)))
@ -2342,13 +2501,22 @@ not overwrite the stored one."
;; Insert complex ranges
(while (and (string-match org-table-range-regexp form)
(> (length (match-string 0 form)) 1))
(setq form
(replace-match
(setq formrg (save-match-data
(org-table-get-range (match-string 0 form) nil n0)))
(setq formrpl
(save-match-data
(org-table-make-reference
(org-table-get-range (match-string 0 form) nil n0)
keep-empty numbers lispp))
t t form)))
;; possibly handle durations
(if duration
(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
(while (string-match "\\$\\([0-9]+\\)\\.\\.\\$\\([0-9]+\\)" form)
(setq form
@ -2362,9 +2530,10 @@ not overwrite the stored one."
t t form)))
(setq form0 form)
;; Insert the references to fields in same row
(while (string-match "\\$\\([0-9]+\\)" form)
(setq n (string-to-number (match-string 1 form))
x (nth (1- (if (= n 0) n0 n)) fields))
(while (string-match "\\$\\(\\([-+]\\)?[0-9]+\\)" form)
(setq n (+ (string-to-number (match-string 1 form))
(if (match-end 2) n0 0))
x (nth (1- (if (= n 0) n0 (max n 1))) fields))
(unless x (error "Invalid field specifier \"%s\""
(match-string 0 form)))
(setq form (replace-match
@ -2376,11 +2545,16 @@ not overwrite the stored one."
(setq ev (condition-case nil
(eval (eval (read form)))
(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)
(error "Calc does not seem to be installed, and is needed to evaluate the formula"))
(setq ev (calc-eval (cons form modes)
(if numbers 'num))))
(setq ev (calc-eval (cons form modes) (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
(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)))))
(setq bw (get-buffer-window "*Substitution History*"))
(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)
(y-or-n-p "Debugging Formula. Continue to next? "))
(org-table-align)
@ -2420,11 +2594,16 @@ $1-> %s\n" orig formula form0 form))
(progn (skip-chars-forward "^|") (point))
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.
Optional arguments TBEG and COL can give the beginning of the table and
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) ?@))
(setq desc (concat "@" desc)))
(save-excursion
@ -2453,7 +2632,8 @@ HIGHLIGHT means just highlight the range."
(if (not r2) (setq r2 thisline))
(if (not c1) (setq c1 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
(progn
(org-goto-line r1)
@ -2465,6 +2645,10 @@ HIGHLIGHT means just highlight the range."
;; First sort the numbers to get a regular ractangle
(if (< r2 r1) (setq tmp r1 r1 r2 r2 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)
(while (not (looking-at org-table-dataline-regexp))
(beginning-of-line 2))
@ -2480,7 +2664,7 @@ HIGHLIGHT means just highlight the range."
beg (progn (skip-chars-forward "^|\n") (point))))
;; return string representation of calc vector
(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)
"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)
(let* ((eqlist (sort (org-table-get-stored-formulas)
(lambda (a b) (string< (car a) (car b)))))
(eqlist1 (copy-sequence eqlist))
(inhibit-redisplay (not debug-on-error))
(line-re org-table-dataline-regexp)
(thisline (org-current-line))
(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
(setq eqlist
(mapcar (lambda (x)
(setcdr x (org-table-formula-substitute-names (cdr x)))
x)
(when (string-match "\\`$[<>]" (car 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))
;; Split the equation list
(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 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
(progn
(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)
(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))
(while (setq eq (pop eqlname))
(setq name (car eq)
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)
(string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" 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))
(push (append a (list (cdr eq))) eqlname1)
(org-table-put-field-property :org-untouchable t)))
(setq eqlname1 (nreverse eqlname1))
;; Now evaluate the column formulas, but skip fields covered by
;; field formulas
@ -2691,7 +2901,9 @@ known that the table will be realigned a little later anyway."
(and all (message "Re-applying formulas...done"))))))
(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")
(let ((imax (if arg (prefix-numeric-value arg) 10))
(i 0)
@ -2740,6 +2952,64 @@ known that the table will be realigned a little later anyway."
(setq checksum c1)))
(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)
"Replace $const with values in string F."
(let ((start 0) a (f1 f) (pp (/= (string-to-char f) ?')))
@ -2842,7 +3112,7 @@ Parameters get priority."
(wc (current-window-configuration))
(sel-win (selected-window))
(titles '((column . "# Column Formulas\n")
(field . "# Field Formulas\n")
(field . "# Field and Range Formulas\n")
(named . "# Named Field Formulas\n")))
entry s type title)
(org-switch-to-buffer-other-window "*Edit Formulas*")
@ -2860,15 +3130,16 @@ Parameters get priority."
(setq startline (org-current-line))
(while (setq entry (pop eql))
(setq type (cond
((string-match "\\`$[<>]" (car entry)) 'column)
((equal (string-to-char (car entry)) ?@) 'field)
((string-match "^[0-9]" (car entry)) 'column)
(t 'named)))
(when (setq title (assq type titles))
(or (bobp) (insert "\n"))
(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)))
(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"))
(remove-text-properties 0 (length s) '(face nil) s)
(insert s))
@ -2899,7 +3170,7 @@ Parameters get priority."
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
full TBLFM line."
(let ((start 0))
@ -2967,6 +3238,45 @@ For example: 28 -> AB."
n (/ (1- n) 26)))
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)
"Convert all references in this buffer, using FUNCTION."
(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)
(goto-char (point-min))
(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)
(setq var (if (match-end 2) (match-string 2) (match-string 1))
form (match-string 3))
@ -3172,6 +3482,12 @@ With prefix ARG, apply the new formulas to the table."
var name e what match dest)
(if local (org-table-get-specials))
(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)
(org-at-regexp-p org-table-translate-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 ()
"Remove all properties related to narrow-column invisibility."
(let ((s 1))
(let ((s (point-min)))
(while (setq s (text-property-any s (point-max)
'display org-narrow-column-arrow))
(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))
(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))
(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.
With prefix arg, also recompute table."
(interactive "P")
(let ((pos (point)) action)
(let ((pos (point)) action consts-str consts cst const-str)
(save-excursion
(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]*#\\+TBLFM:") 'recalc))))
(cond
@ -3737,6 +4054,17 @@ With prefix arg, also recompute table."
(when (orgtbl-send-table 'maybe)
(run-hooks 'orgtbl-after-send-table-hook)))
((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
(beginning-of-line 1)
(skip-chars-backward " \r\n\t")
@ -3792,7 +4120,7 @@ overwritten, and the table is not marked as requiring realignment."
(looking-at "[^|\n]* +|"))
(let (org-table-may-need-update)
(goto-char (1- (match-end 0)))
(delete-backward-char 1)
(delete-char -1)
(goto-char (match-beginning 0))
(self-insert-command N))
(setq org-table-may-need-update t)
@ -3910,7 +4238,7 @@ this table."
(catch 'exit
(unless (org-at-table-p) (error "Not at a table"))
;; 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))
(txt (buffer-substring-no-properties (org-table-begin)
(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
separator line, or a list of fields for that line.
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).
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-current-line-types org-table-current-begin-line
org-table-current-begin-pos org-table-dlines
org-table-current-ncol
org-table-hlines org-table-last-alignment
org-table-last-column-widths org-table-last-alignment
org-table-last-column-widths tbeg
@ -4392,5 +4721,7 @@ list of the fields in the rectangle ."
(provide 'org-table)
;; arch-tag: 4d21cfdd-0268-440a-84b0-09237a0fe0ef
;;; org-table.el ends here

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

@ -1,10 +1,10 @@
;;; 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
;; Filename: org-taskjuggler.el
;; Version: 7.4
;; Version: 7.7
;; Author: Christian Egli
;; Maintainer: Christian Egli
;; Keywords: org, taskjuggler, project planning
@ -126,15 +126,15 @@
;; :END:
;; ** Markup Guidelines
;; :PROPERTIES:
;; :Effort: 2.0
;; :Effort: 2d
;; :END:
;; ** Workflow Guidelines
;; :PROPERTIES:
;; :Effort: 2.0
;; :Effort: 2d
;; :END:
;; * Presentation
;; :PROPERTIES:
;; :Effort: 2.0
;; :Effort: 2d
;; :BLOCKER: training_material { gapduration 1d } some_other_task
;; :END:
;;
@ -181,6 +181,11 @@ resources for the project."
:group 'org-export-taskjuggler
: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"
"Default version string for the project."
:group 'org-export-taskjuggler
@ -258,13 +263,14 @@ defined in `org-export-taskjuggler-default-reports'."
(let* ((tasks
(org-taskjuggler-resolve-dependencies
(org-taskjuggler-assign-task-ids
(org-taskjuggler-compute-task-leafiness
(org-map-entries
'(org-taskjuggler-components)
org-export-taskjuggler-project-tag nil 'archive 'comment))))
'org-taskjuggler-components
org-export-taskjuggler-project-tag nil 'archive 'comment)))))
(resources
(org-taskjuggler-assign-resource-ids
(org-map-entries
'(org-taskjuggler-components)
'org-taskjuggler-components
org-export-taskjuggler-resource-tag nil 'archive 'comment)))
(filename (expand-file-name
(concat
@ -331,6 +337,10 @@ with the TaskJuggler GUI."
(command (concat process-name " " file-name)))
(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 ()
"Return true if the parent of the current node has a property
\"ORDERED\". Return nil otherwise."
@ -344,7 +354,9 @@ information, all the properties, etc."
(let* ((props (org-entry-properties))
(components (org-heading-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)))
(push (cons "level" level) props)
(push (cons "headline" headline) props)
@ -383,18 +395,36 @@ a path to the current task."
(setq previous-level level)
(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
unique id to each resource."
(cond
((null resources) nil)
(t
(let* ((resource (car resources))
(unique-id (org-taskjuggler-get-unique-id resource unique-ids)))
(let (unique-ids new-list)
(dolist (resource resources new-list)
(let ((unique-id (org-taskjuggler-get-unique-id resource unique-ids)))
(push (cons "unique-id" unique-id) resource)
(cons resource
(org-taskjuggler-assign-resource-ids (cdr resources)
(cons unique-id unique-ids)))))))
(push unique-id unique-ids)
(push resource new-list)))
(nreverse new-list)))
(defun org-taskjuggler-resolve-dependencies (tasks)
(let ((previous-level 0)
@ -512,7 +542,12 @@ finally add more underscore characters (\"_\")."
(defun org-taskjuggler-clean-id (id)
"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)
"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)
"Translate effort strings into a format acceptable to taskjuggler,
i.e. REAL UNIT. If the effort string is something like 5:30 it
will be assumed to be hours and will be translated into 5.5h.
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."
i.e. REAL UNIT. A valid effort string can be anything that is
accepted by `org-duration-string-to-minutes´."
(cond
((null effort) effort)
((string-match "\\([0-9]+\\):\\([0-9]+\\)" effort)
(let ((hours (string-to-number (match-string 1 effort)))
(minutes (string-to-number (match-string 2 effort))))
(format "%dh" (+ hours (/ minutes 60.0)))))
((string-match "\\([0-9]+\\).\\([0-9]+\\)" effort) (concat effort "d"))
(t (error "Not a valid effort (%s)" effort))))
(t (let* ((minutes (org-duration-string-to-minutes effort))
(hours (/ minutes 60.0)))
(format "%.1fh" hours)))))
(defun org-taskjuggler-get-priority (priority)
"Return a priority between 1 and 1000 based on PRIORITY, an
@ -612,21 +640,31 @@ org-mode priority string."
(cdr (assoc "complete" task))))
(parent-ordered (cdr (assoc "parent-ordered" 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
'(account start note duration endbuffer endcredit end
flags journalentry length maxend maxstart milestone
minend minstart period reference responsible
scheduling startbuffer startcredit statusnote)))
flags journalentry length maxend maxstart minend
minstart period reference responsible scheduling
startbuffer startcredit statusnote)))
(insert
(concat
"task " unique-id " \"" headline "\" {\n"
(if (and parent-ordered previous-sibling)
(format " depends %s\n" previous-sibling)
(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 effort (format " effort %s\n" effort))
(and priority (format " priority %s\n" priority))
(and milestone (format " milestone\n"))
(org-taskjuggler-get-attributes task attributes)
"\n"))))

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

@ -1,11 +1,11 @@
;;; 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>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;
;; 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
"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
"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-timer-pause-time nil)
(org-timer-set-mode-line 'on)
(run-hooks 'org-timer-continue-hook)
(message "Timer continues at %s" (org-timer-value-string)))
(t
;; pause timer
@ -203,22 +207,27 @@ it in the buffer."
(defun org-timer-item (&optional arg)
"Insert a description-type item with the current timer value."
(interactive "P")
(let ((itemp (org-in-item-p)) (pos (point)))
(cond
;; In a timer list, insert with `org-list-insert-item-generic'.
((and (org-in-item-p)
(save-excursion (org-beginning-of-item) (org-at-item-timer-p)))
(org-list-insert-item-generic
(point) nil (concat (org-timer (when arg '(4)) t) ":: ")))
;; In a timer list, insert with `org-list-insert-item',
;; then fix the list.
((and itemp (goto-char itemp) (org-at-item-timer-p))
(let* ((struct (org-list-struct))
(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.
((org-in-item-p)
(error "This is not a timer list"))
;; Else, insert the timer correctly indented at bol.
(itemp (goto-char pos) (error "This is not a timer list"))
;; Else, start a new list.
(t
(beginning-of-line)
(org-indent-line-function)
(insert "- ")
(org-timer (when arg '(4)))
(insert ":: "))))
(insert ":: ")))))
(defun org-timer-fix-incomplete (hms)
"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)
(or (ignore-errors (org-get-heading))
(concat "File:" (file-name-nondirectory (buffer-file-name)))))))
((eq major-mode 'org-mode)
((org-mode-p)
(or (ignore-errors (org-get-heading))
(concat "File:" (file-name-nondirectory (buffer-file-name)))))
(t (error "Not in an Org buffer"))))
@ -394,5 +403,6 @@ replace any running timer."
(provide 'org-timer)
;; arch-tag: 97538f8c-3871-4509-8f23-1e7b3ff3d107
;;; org-timer.el ends here

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

@ -1,11 +1,12 @@
;;; 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>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.4
;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@ -53,8 +54,10 @@
;; Implementation
(defun org-vm-store-link ()
"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))
(save-window-excursion
(vm-select-folder-buffer) buffer-file-name))
(and (eq major-mode 'vm-presentation-mode) (vm-summarize))
(vm-follow-summary-cursor)
(save-excursion
@ -137,5 +140,6 @@
(provide 'org-vm)
;; arch-tag: cbc3047b-935e-4d2a-96e7-c5b0117aaa6d
;;; org-vm.el ends here

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