Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 17:24:23 +00:00
Code Issues Projects Releases Packages Wiki Activity

Install org-mode version 7.3

Browse source
This commit is contained in:
Carsten Dominik 2010-11-11 22:10:19 -06:00
parent df26e1f58a
commit afe98dfa70
100 changed files with 11298 additions and 4003 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

141
doc/misc/ChangeLog
View file

@ -1,3 +1,144 @@
2010-11-11 Noorul Islam <noorul@noorul.com>
* org.texi: Fix typo
2010-11-11 Carsten Dominik <carsten.dominik@gmail.com>
* org.texi (Using capture): Explain that refiling is
sensitive to cursor position.
2010-11-11 Carsten Dominik <carsten.dominik@gmail.com>
* org.texi (Images and tables): Add cross reference to
link section.
2010-11-11 Carsten Dominik <carsten.dominik@gmail.com>
* org.texi: Document the <c> cookie.
2010-11-11 Eric Schulte <schulte.eric@gmail.com>
* multi-line header arguments :PROPERTIES: :ID:
b77c8857-6c76-4ea9-8a61-ddc2648d96c4 :END:
2010-11-11 Carsten Dominik <carsten.dominik@gmail.com>
* org.texi (CSS support): Document :HTML_CONTAINER_CLASS:
property
2010-11-11 Carsten Dominik <carsten.dominik@gmail.com>
* org.texi (Project alist): Mention that this is a
property list
2010-11-11 Carsten Dominik <carsten.dominik@gmail.com>
* org.texi (Setting up the staging area): Document that
file names remain visible when encrypting the MobileOrg files.
2010-11-11 Carsten Dominik <carsten.dominik@gmail.com>
* org.texi (Setting up the staging area): Document which
versions are needed for encryption.
2010-11-11 Eric Schulte <schulte.eric@gmail.com>
* org.texi (noweb): updating :noweb documentation to
reflect the new "tangle" argument
2010-11-11 Sebastian Rose, Hannover, Germany <sebastian_rose@gmx.de>
* org-test-which-func: New function. Find name of defun
around point.
2010-11-11 Eric Schulte <schulte.eric@gmail.com>
* org.texi (Batch execution): improved tangling script in
documentation
2010-11-11 Carsten Dominik <carsten.dominik@gmail.com>
* org.texi (Handling links):
(In-buffer settings): Document inlining images on startup.
2010-11-11 Carsten Dominik <carsten.dominik@gmail.com>
* org.texi (Setting up the staging area): Document use of
crypt password.
2010-11-11 David Maus <dmaus@ictsoc.de>
* org.texi (Template expansion): Add date related link
type escapes
2010-11-11 David Maus <dmaus@ictsoc.de>
* org.texi (Template expansion): Add mew in table for
link type escapes.
2010-11-11 David Maus <dmaus@ictsoc.de>
* org.texi (Template expansion): Fix typo in link type
escapes.
2010-11-11 Eric Schulte <schulte.eric@gmail.com>
* org.texi (Structure of code blocks): another
documentation tweak
2010-11-11 Eric Schulte <schulte.eric@gmail.com>
* org.texi (Structure of code blocks): documentation
tweak
2010-11-11 Eric Schulte <schulte.eric@gmail.com>
* org.texi (Structure of code blocks): updating
documentation to mention inline code block syntax
2010-11-11 Eric Schulte <schulte.eric@gmail.com>
* org.texi (comments): improved wording
2010-11-11 Eric Schulte <schulte.eric@gmail.com>
* org.texi (comments): documenting the new :comments
header arguments
2010-11-11 Carsten Dominik <carsten.dominik@gmail.com>
* org.texi (Installation): Remove the special
installation instructions for XEmacs.
2010-11-11 Jambunathan K <kjambunathan@gmail.com> (tiny change)
* org.texi (Easy Templates): New section. Documents quick
insertion of empty structural elements.
2010-11-11 Noorul Islam <noorul@noorul.com>
* org.texi: Fix doc
2010-11-11 Jambunathan K <kjambunathan@gmail.com> (tiny change)
* org.texi (The date/time prompt): Document specification
of time ranges.
2010-11-11 Carsten Dominik <carsten.dominik@gmail.com>
* org.texi (Internal links): Document the changes in
internal links.
2010-11-11 Carsten Dominik <carsten.dominik@gmail.com>
* org.texi (Agenda commands): Document the limitation for
the filter preset - it can only be used for an entire agenda
view, not in an individual block in a block agenda.
2010-11-11 Eric S Fraga <e.fraga@ucl.ac.uk>
* org.texi (iCalendar export): Document alarm creation.
2010-11-10 Michael Albinus <michael.albinus@gmx.de>
* dbus.texi (Type Conversion): Introduce `:unix-fd' type mapping.

961
doc/misc/org.texi
View file

File diff suppressed because it is too large Load diff

5
etc/ChangeLog
View file

@ -1,3 +1,8 @@
2010-11-11 Eric Schulte <schulte.eric@gmail.com>
* refcards/orgcard.tex: adding new Babel key sequences to the
org refcard
2010-10-26 Glenn Morris <rgm@gnu.org>
* images/README: Add (un)checked.xpm

8
etc/refcards/orgcard.tex
View file

@ -1,5 +1,5 @@
% Reference Card for Org Mode
\def\orgversionnumber{7.01}
\def\orgversionnumber{7.3}
\def\versionyear{2010} % latest update
\def\year{2010} % latest copyright year
@ -480,14 +480,18 @@ \section{Working with Code (Babel)}
\key{view expanded body of code block at point}{C-c C-v v}
\key{go to named code block}{C-c C-v g}
\key{go to named result}{C-c C-v r}
\key{go to the head of the current code block}{C-c C-v u}
\key{go to the next code block}{C-c C-v n}
\key{go to the previous code block}{C-c C-v p}
\key{demarcate a code block}{C-c C-v d}
\key{execute the next key sequence in the code edit buffer}{C-c C-v x}
\key{execute all code blocks in current buffer}{C-c C-v b}
\key{execute all code blocks in current subtree}{C-c C-v s}
\key{tangle code blocks in current file}{C-c C-v t}
\key{tangle code blocks in supplied file}{C-c C-v f}
\key{ingest all code blocks in supplied file into the Library of Babel}{C-c C-v l}
\key{ingest all code blocks in supplied file into the Library of Babel}{C-c C-v i}
\key{switch to the session of the current code block}{C-c C-v z}
\key{load expanded body of the current code block into a session}{C-c C-v l}
\key{view sha1 hash of the current code block}{C-c C-v a}
% \section{Remember-mode Integration}

3333
lisp/org/ChangeLog
View file

File diff suppressed because it is too large Load diff

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

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
@ -33,7 +33,6 @@
;;; Code:
(require 'ob)
(require 'ob-eval)
(require 'org)
(require 'cc-mode)
(declare-function org-entry-get "org"
@ -65,31 +64,30 @@ is currently being evaluated.")
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 &optional processed-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 processed-params)))
(let ((org-babel-c-variant 'cpp)) (org-babel-C-expand body params)))
(defun org-babel-execute:C (body params)
"Execute a block of C code with org-babel. This function is
called by `org-babel-execute-src-block'."
(let ((org-babel-c-variant 'c)) (org-babel-C-execute body params)))
(defun org-babel-expand-body:c (body params &optional processed-params)
(defun org-babel-expand-body:c (body params)
"Expand a block of C code with org-babel according to it's
header arguments (calls `org-babel-C-expand')."
(let ((org-babel-c-variant 'c)) (org-babel-C-expand body params processed-params)))
(let ((org-babel-c-variant 'c)) (org-babel-C-expand body params)))
(defun org-babel-C-execute (body params)
"This function should only be called by `org-babel-execute:C'
or `org-babel-execute:c++'."
(let* ((processed-params (org-babel-process-params params))
(tmp-src-file (make-temp-file "org-babel-C-src" nil
(cond
((equal org-babel-c-variant 'c) ".c")
((equal org-babel-c-variant 'cpp) ".cpp"))))
(tmp-bin-file (make-temp-file "org-babel-C-bin"))
(tmp-out-file (make-temp-file "org-babel-C-out"))
(let* ((tmp-src-file (org-babel-temp-file
"C-src-"
(cond
((equal org-babel-c-variant 'c) ".c")
((equal org-babel-c-variant 'cpp) ".cpp"))))
(tmp-bin-file (org-babel-temp-file "C-bin-"))
(cmdline (cdr (assoc :cmdline params)))
(flags (cdr (assoc :flags params)))
(full-body (org-babel-C-expand body params))
@ -101,37 +99,35 @@ or `org-babel-execute:c++'."
(cond
((equal org-babel-c-variant 'c) org-babel-C-compiler)
((equal org-babel-c-variant 'cpp) org-babel-c++-compiler))
tmp-bin-file
(org-babel-process-file-name tmp-bin-file)
(mapconcat 'identity
(if (listp flags) flags (list flags)) " ")
tmp-src-file) ""))))
(org-babel-process-file-name tmp-src-file)) ""))))
((lambda (results)
(org-babel-reassemble-table
(if (member "vector" (nth 2 processed-params))
(let ((tmp-file (make-temp-file "ob-c")))
(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
(nth 4 processed-params) (cdr (assoc :colnames params)))
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
(nth 5 processed-params) (cdr (assoc :rownames params)))))
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))
(org-babel-trim
(org-babel-eval
(concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))))
(defun org-babel-C-expand (body params &optional processed-params)
(defun org-babel-C-expand (body params)
"Expand a block of C or C++ code with org-babel according to
it's header arguments."
(let ((vars (nth 1 (or processed-params
(org-babel-process-params params))))
(let ((vars (mapcar #'cdr (org-babel-get-header params :var)))
(main-p (not (string= (cdr (assoc :main params)) "no")))
(includes (or (cdr (assoc :includes params))
(org-babel-read (org-entry-get nil "includes" t))))
(defines (org-babel-read
(or (cdr (assoc :defines params))
(org-babel-read (org-entry-get nil "defines" t))))))
(org-babel-trim
(mapconcat 'identity
(list
;; includes
@ -147,11 +143,11 @@ it's header arguments."
;; body
(if main-p
(org-babel-C-ensure-main-wrap body)
body) "\n") "\n"))))
body) "\n") "\n")))
(defun org-babel-C-ensure-main-wrap (body)
"Wrap body in a \"main\" function call if none exists."
(if (string-match "^[ \t]*[intvod]+[ \t]*main[ \t]*(.*)" body)
(if (string-match "^[ \t]*[intvod]+[ \t\n\r]*main[ \t]*(.*)" body)
body
(format "int main() {\n%s\n}\n" body)))

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

@ -5,7 +5,7 @@
;; Author: Eric Schulte, Dan Davison
;; Keywords: literate programming, reproducible research, R, statistics
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
@ -36,6 +36,9 @@
(declare-function orgtbl-to-tsv "org-table" (table params))
(declare-function R "ext:essd-r" (&optional start-args))
(declare-function inferior-ess-send-input "ext:ess-inf" ())
(declare-function ess-make-buffer-current "ext:ess-inf" ())
(declare-function ess-eval-buffer "ext:ess-inf" (vis))
(declare-function org-number-sequence "org-compat" (from &optional to inc))
(defconst org-babel-header-arg-names:R
'(width height bg units pointsize antialias quality compression
@ -48,21 +51,11 @@
(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 &optional processed-params)
(defun org-babel-expand-body:R (body params)
"Expand BODY according to PARAMS, return the expanded body."
(let* ((processed-params (or processed-params
(org-babel-process-params params)))
(vars (mapcar
(lambda (i)
(cons (car (nth i (nth 1 processed-params)))
(org-babel-reassemble-table
(cdr (nth i (nth 1 processed-params)))
(cdr (nth i (nth 4 processed-params)))
(cdr (nth i (nth 5 processed-params))))))
(number-sequence 0 (1- (length (nth 1 processed-params))))))
(out-file (cdr (assoc :file params))))
(mapconcat ;; define any variables
#'org-babel-trim
(let ((out-file (cdr (assoc :file params))))
(mapconcat
#'identity
((lambda (inside)
(if out-file
(append
@ -70,49 +63,36 @@
inside
(list "dev.off()"))
inside))
(append
(mapcar
(lambda (pair)
(org-babel-R-assign-elisp
(car pair) (cdr pair)
(equal "yes" (cdr (assoc :colnames params)))
(equal "yes" (cdr (assoc :rownames params)))))
vars)
(list body))) "\n")))
(append (org-babel-variable-assignments:R params)
(list body))) "\n")))
(defun org-babel-execute:R (body params)
"Execute a block of R code.
This function is called by `org-babel-execute-src-block'."
(save-excursion
(let* ((processed-params (org-babel-process-params params))
(result-type (nth 3 processed-params))
(let* ((result-type (cdr (assoc :result-type params)))
(session (org-babel-R-initiate-session
(first processed-params) params))
(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 processed-params))
(full-body (org-babel-expand-body:R body params))
(result
(org-babel-R-evaluate
session full-body result-type
(or (equal "yes" colnames-p)
(org-babel-pick-name (nth 4 processed-params) colnames-p))
(org-babel-pick-name
(cdr (assoc :colname-names params)) colnames-p))
(or (equal "yes" rownames-p)
(org-babel-pick-name (nth 5 processed-params) rownames-p)))))
(org-babel-pick-name
(cdr (assoc :rowname-names params)) rownames-p)))))
(message "result is %S" result)
(or out-file result))))
(defun org-babel-prep-session:R (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(let* ((session (org-babel-R-initiate-session session params))
(vars (org-babel-ref-variables params))
(var-lines
(mapcar
(lambda (pair) (org-babel-R-assign-elisp
(car pair) (cdr pair)
(equal (cdr (assoc :colnames params)) "yes")
(equal (cdr (assoc :rownames params)) "yes")))
vars)))
(var-lines (org-babel-variable-assignments:R params)))
(org-babel-comint-in-buffer session
(mapc (lambda (var)
(end-of-line 1) (insert var) (comint-send-input nil t)
@ -130,6 +110,24 @@ This function is called by `org-babel-execute-src-block'."
;; helper functions
(defun org-babel-variable-assignments:R (params)
"Return list of R statements assigning the block's variables"
(let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
(mapcar
(lambda (pair)
(org-babel-R-assign-elisp
(car pair) (cdr pair)
(equal "yes" (cdr (assoc :colnames params)))
(equal "yes" (cdr (assoc :rownames params)))))
(mapcar
(lambda (i)
(cons (car (nth i vars))
(org-babel-reassemble-table
(cdr (nth i vars))
(cdr (nth i (cdr (assoc :colname-names params))))
(cdr (nth i (cdr (assoc :rowname-names params)))))))
(org-number-sequence 0 (1- (length vars)))))))
(defun org-babel-R-quote-tsv-field (s)
"Quote field S for export to R."
(if (stringp s)
@ -139,23 +137,25 @@ This function is called by `org-babel-execute-src-block'."
(defun org-babel-R-assign-elisp (name value colnames-p rownames-p)
"Construct R code assigning the elisp VALUE to a variable named NAME."
(if (listp value)
(let ((transition-file (make-temp-file "org-babel-R-import")))
(let ((transition-file (org-babel-temp-file "R-import-")))
;; ensure VALUE has an orgtbl structure (depth of at least 2)
(unless (listp (car value)) (setq value (list value)))
(with-temp-file (org-babel-maybe-remote-file transition-file)
(with-temp-file transition-file
(insert (orgtbl-to-tsv value '(:fmt org-babel-R-quote-tsv-field)))
(insert "\n"))
(format "%s <- read.table(\"%s\", header=%s, row.names=%s, sep=\"\\t\", as.is=TRUE)"
name transition-file
name (org-babel-process-file-name transition-file 'noquote)
(if (or (eq (nth 1 value) 'hline) colnames-p) "TRUE" "FALSE")
(if rownames-p "1" "NULL")))
(format "%s <- %s" name (org-babel-R-quote-tsv-field value))))
(defvar ess-ask-for-ess-directory nil)
(defun org-babel-R-initiate-session (session params)
"If there is not a current R process then create one."
(unless (string= session "none")
(let ((session (or session "*R*"))
(ess-ask-for-ess-directory (not (cdr (assoc :dir params)))))
(ess-ask-for-ess-directory
(and ess-ask-for-ess-directory (not (cdr (assoc :dir params))))))
(if (org-babel-comint-buffer-livep session)
session
(save-window-excursion
@ -168,6 +168,15 @@ This function is called by `org-babel-execute-src-block'."
(buffer-name))))
(current-buffer))))))
(defvar ess-local-process-name nil)
(defun org-babel-R-associate-session (session)
"Associate R code buffer with an R session.
Make SESSION be the inferior ESS process associated with the
current code buffer."
(setq ess-local-process-name
(process-name (get-buffer-process session)))
(ess-make-buffer-current))
(defun org-babel-R-construct-graphics-device-call (out-file params)
"Construct the call to the graphics device."
(let ((devices
@ -205,65 +214,78 @@ This function is called by `org-babel-execute-src-block'."
(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-wrapper-method "main <- function ()\n{\n%s\n}
write.table(main(), file=\"%s\", sep=\"\\t\", na=\"nil\",row.names=%s, col.names=%s, quote=FALSE)")
(defvar org-babel-R-wrapper-lastvar "write.table(.Last.value, file=\"%s\", sep=\"\\t\", na=\"nil\",row.names=%s, col.names=%s, quote=FALSE)")
(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\")")
(defun org-babel-R-evaluate
(session body result-type column-names-p row-names-p)
"Pass BODY to the R process in SESSION.
If RESULT-TYPE equals 'output then return a list of the outputs
of the statements in BODY, if RESULT-TYPE equals 'value then
return the value of the last statement in BODY, as elisp."
(if (not session)
;; external process evaluation
(case result-type
(output (org-babel-eval org-babel-R-command body))
(value
(let ((tmp-file (make-temp-file "org-babel-R-results-")))
(org-babel-eval org-babel-R-command
(format org-babel-R-wrapper-method
body tmp-file
(if row-names-p "TRUE" "FALSE")
(if column-names-p
(if row-names-p "NA" "TRUE")
"FALSE")))
(org-babel-R-process-value-result
(org-babel-import-elisp-from-file
(org-babel-maybe-remote-file tmp-file)) column-names-p))))
;; comint session evaluation
(case result-type
(value
(let ((tmp-file (make-temp-file "org-babel-R"))
broke)
(org-babel-comint-with-output (session org-babel-R-eoe-output)
(insert (mapconcat
#'org-babel-chomp
(list
body
(format org-babel-R-wrapper-lastvar
tmp-file
(if row-names-p "TRUE" "FALSE")
(if column-names-p
(if row-names-p "NA" "TRUE")
"FALSE"))
org-babel-R-eoe-indicator) "\n"))
(inferior-ess-send-input))
(org-babel-R-process-value-result
(org-babel-import-elisp-from-file
(org-babel-maybe-remote-file tmp-file)) column-names-p)))
(output
(mapconcat
#'org-babel-chomp
(butlast
(delq nil
(mapcar
#'identity
(org-babel-comint-with-output (session org-babel-R-eoe-output)
(insert (mapconcat #'org-babel-chomp
(list body org-babel-R-eoe-indicator)
"\n"))
(inferior-ess-send-input)))) 2) "\n")))))
"Evaluate R code in BODY."
(if session
(org-babel-R-evaluate-session
session body result-type column-names-p row-names-p)
(org-babel-R-evaluate-external-process
body result-type column-names-p row-names-p)))
(defun org-babel-R-evaluate-external-process
(body result-type column-names-p row-names-p)
"Evaluate BODY in external R process.
If RESULT-TYPE equals 'output then return standard output as a
string. If RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp."
(case result-type
(value
(let ((tmp-file (org-babel-temp-file "R-")))
(org-babel-eval org-babel-R-command
(format org-babel-R-write-object-command
(if row-names-p "TRUE" "FALSE")
(if column-names-p
(if row-names-p "NA" "TRUE")
"FALSE")
(format "{function ()\n{\n%s\n}}()" body)
(org-babel-process-file-name tmp-file 'noquote)))
(org-babel-R-process-value-result
(org-babel-import-elisp-from-file tmp-file '(16)) column-names-p)))
(output (org-babel-eval org-babel-R-command body))))
(defun org-babel-R-evaluate-session
(session body result-type column-names-p row-names-p)
"Evaluate BODY in SESSION.
If RESULT-TYPE equals 'output then return standard output as a
string. If RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp."
(case result-type
(value
(with-temp-buffer
(insert (org-babel-chomp body))
(let ((ess-local-process-name
(process-name (get-buffer-process session))))
(ess-eval-buffer nil)))
(let ((tmp-file (org-babel-temp-file "R-")))
(org-babel-comint-eval-invisibly-and-wait-for-file
session tmp-file
(format org-babel-R-write-object-command
(if row-names-p "TRUE" "FALSE")
(if column-names-p
(if row-names-p "NA" "TRUE")
"FALSE")
".Last.value" (org-babel-process-file-name tmp-file 'noquote)))
(org-babel-R-process-value-result
(org-babel-import-elisp-from-file tmp-file '(16)) column-names-p)))
(output
(mapconcat
#'org-babel-chomp
(butlast
(delq nil
(mapcar
(lambda (line) ;; cleanup extra prompts left in output
(if (string-match
"^\\([ ]*[>+][ ]?\\)+\\([[0-9]+\\|[ ]\\)" line)
(substring line (match-end 1))
line))
(org-babel-comint-with-output (session org-babel-R-eoe-output)
(insert (mapconcat #'org-babel-chomp
(list body org-babel-R-eoe-indicator)
"\n"))
(inferior-ess-send-input)))) 2) "\n"))))
(defun org-babel-R-process-value-result (result column-names-p)
"R-specific processing of return value.

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

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
@ -55,32 +55,30 @@
'((:results . "file") (:exports . "results"))
"Default arguments when evaluating an Asymptote source block.")
(defun org-babel-expand-body:asymptote (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (nth 1 (or processed-params
(org-babel-process-params params)))))
(concat (mapconcat 'org-babel-asymptote-var-to-asymptote vars "\n")
"\n" body "\n")))
(defun org-babel-execute:asymptote (body params)
"Execute a block of Asymptote code.
This function is called by `org-babel-execute-src-block'."
(let* ((processed-params (org-babel-process-params params))
(result-params (split-string (or (cdr (assoc :results params)) "")))
(let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
(out-file (cdr (assoc :file params)))
(format (or (and out-file
(string-match ".+\\.\\(.+\\)" out-file)
(match-string 1 out-file))
"pdf"))
(cmdline (cdr (assoc :cmdline params)))
(in-file (make-temp-file "org-babel-asymptote"))
(cmd (concat "asy "
(if out-file
(concat "-globalwrite -f " format " -o " out-file)
"-V")
" " cmdline " " in-file)))
(in-file (org-babel-temp-file "asymptote-"))
(cmd
(concat "asy "
(if out-file
(concat
"-globalwrite -f " format
" -o " (org-babel-process-file-name out-file))
"-V")
" " cmdline
" " (org-babel-process-file-name in-file))))
(with-temp-file in-file
(insert (org-babel-expand-body:asymptote body params processed-params)))
(insert (org-babel-expand-body:generic
body params
(org-babel-variable-assignments:asymptote params))))
(message cmd) (shell-command cmd)
out-file))
@ -89,6 +87,11 @@ This function is called by `org-babel-execute-src-block'."
Asymptote does not support sessions"
(error "Asymptote does not support sessions"))
(defun org-babel-variable-assignments:asymptote (params)
"Return list of asymptote statements assigning the block's variables"
(mapcar #'org-babel-asymptote-var-to-asymptote
(mapcar #'cdr (org-babel-get-header params :var))))
(defun org-babel-asymptote-var-to-asymptote (pair)
"Convert an elisp value into an Asymptote variable.
The elisp value PAIR is converted into Asymptote code specifying

67
lisp/org/ob-calc.el Normal file
View file

@ -0,0 +1,67 @@
;;; ob-calc.el --- org-babel functions for calc code evaluation
;; Copyright (C) 2010 Free Software Foundation, Inc
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Org-Babel support for evaluating calc code
;;; Code:
(require 'ob)
(require 'calc)
(require 'calc-trail)
(eval-when-compile (require 'ob-comint))
(defvar org-babel-default-header-args:calc nil
"Default arguments for evaluating an calc source block.")
(defun org-babel-expand-body:calc (body params)
"Expand BODY according to PARAMS, return the expanded body." body)
(defun org-babel-execute:calc (body params)
"Execute a block of calc code with Babel."
(mapcar
(lambda (line)
(when (> (length line) 0)
(if (string= "'" (substring line 0 1))
(funcall (lookup-key calc-mode-map (substring line 1)) nil)
(calc-push-list
(list ((lambda (res)
(cond
((numberp res) res)
((listp res) (error "calc error \"%s\" on input \"%s\""
(cadr res) line))
(t res))
(if (numberp res) res (math-read-number res)))
(calc-eval line)))))))
(mapcar #'org-babel-trim
(split-string (org-babel-expand-body:calc body params) "[\n\r]")))
(save-excursion
(set-buffer (get-buffer "*Calculator*"))
(calc-eval (calc-top 1))))
(provide 'ob-calc)
;; arch-tag: 5c57a3b7-5818-4c6c-acda-7a94831a6449
;;; ob-calc.el ends here

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

@ -5,7 +5,7 @@
;; Author: Joel Boehland
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
@ -45,7 +45,6 @@
(declare-function slime-eval-async "ext:slime" (sexp &optional cont package))
(declare-function slime-eval "ext:slime" (sexp &optional package))
(declare-function swank-clojure-concat-paths "ext:slime" (paths))
(declare-function org-babel-ref-variables "ext:slime" (params))
(declare-function slime "ext:slime" (&optional command coding-system))
(declare-function slime-output-buffer "ext:slime" (&optional noprompt))
(declare-function slime-filter-buffers "ext:slime" (predicate))
@ -92,28 +91,28 @@
(defvar swank-clojure-extra-classpaths)
(defun org-babel-clojure-babel-clojure-cmd ()
"Create the command to start clojure according to current settings."
(if (and (not swank-clojure-binary) (not swank-clojure-classpath))
(or (when swank-clojure-binary
(if (listp swank-clojure-binary)
swank-clojure-binary
(list swank-clojure-binary)))
(when swank-clojure-classpath
(delq
nil
(append
(list swank-clojure-java-path)
swank-clojure-extra-vm-args
(list
(when swank-clojure-library-paths
(concat "-Djava.library.path="
(swank-clojure-concat-paths swank-clojure-library-paths)))
"-classpath"
(swank-clojure-concat-paths
(append
swank-clojure-classpath
swank-clojure-extra-classpaths))
"clojure.main"))))
(error "%s" (concat "You must specifiy either a `swank-clojure-binary' "
"or a `swank-clojure-jar-path'"))
(if swank-clojure-binary
(if (listp swank-clojure-binary)
swank-clojure-binary
(list swank-clojure-binary))
(delq
nil
(append
(list swank-clojure-java-path)
swank-clojure-extra-vm-args
(list
(when swank-clojure-library-paths
(concat "-Djava.library.path="
(swank-clojure-concat-paths swank-clojure-library-paths)))
"-classpath"
(swank-clojure-concat-paths
(append
swank-clojure-classpath
swank-clojure-extra-classpaths))
"clojure.main"))))))
"or a `swank-clojure-classpath'"))))
(defun org-babel-clojure-table-or-string (results)
"Convert RESULTS to an elisp value.
@ -155,7 +154,7 @@ code specifying a variable of the same value."
"Prepare SESSION according to the header arguments specified in PARAMS."
(require 'slime) (require 'swank-clojure)
(let* ((session-buf (org-babel-clojure-initiate-session session))
(vars (org-babel-ref-variables params))
(vars (mapcar #'cdr (org-babel-get-header params :var)))
(var-lines (mapcar ;; define any top level session variables
(lambda (pair)
(format "(def %s %s)\n" (car pair)
@ -261,9 +260,13 @@ repl buffer."
" "))))
(case result-type
(output (org-babel-eval cmd body))
(value (let* ((tmp-file (make-temp-file "org-babel-clojure-results-")))
(org-babel-eval cmd (format org-babel-clojure-wrapper-method
body tmp-file tmp-file))
(value (let* ((tmp-file (org-babel-temp-file "clojure-")))
(org-babel-eval
cmd
(format
org-babel-clojure-wrapper-method
body
(org-babel-process-file-name tmp-file 'noquote)))
(org-babel-clojure-table-or-string
(org-babel-eval-read-file tmp-file)))))))
@ -290,24 +293,23 @@ return the value of the last statement in BODY as elisp."
(org-babel-clojure-evaluate-session buffer body result-type)
(org-babel-clojure-evaluate-external-process buffer body result-type)))
(defun org-babel-expand-body:clojure (body params &optional processed-params)
(defun org-babel-expand-body:clojure (body params)
"Expand BODY according to PARAMS, return the expanded body."
(org-babel-clojure-build-full-form
body (nth 1 (or processed-params (org-babel-process-params params)))))
body (mapcar #'cdr (org-babel-get-header params :var))))
(defun org-babel-execute:clojure (body params)
"Execute a block of Clojure code."
(require 'slime) (require 'swank-clojure)
(let* ((processed-params (org-babel-process-params params))
(body (org-babel-expand-body:clojure body params processed-params))
(let* ((body (org-babel-expand-body:clojure body params))
(session (org-babel-clojure-initiate-session
(first processed-params))))
(cdr (assoc :session params)))))
(org-babel-reassemble-table
(org-babel-clojure-evaluate session body (nth 3 processed-params))
(org-babel-clojure-evaluate session body (cdr (assoc :result-type params)))
(org-babel-pick-name
(nth 4 processed-params) (cdr (assoc :colnames params)))
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
(nth 5 processed-params) (cdr (assoc :rownames params))))))
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
(provide 'ob-clojure)

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

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, comint
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
@ -34,6 +34,8 @@
(require 'ob)
(require 'comint)
(eval-when-compile (require 'cl))
(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body))
(declare-function tramp-flush-directory-property "tramp" (vec directory))
(defun org-babel-comint-buffer-livep (buffer)
"Check if BUFFER is a comint buffer with a live process."
@ -43,7 +45,7 @@
(defmacro org-babel-comint-in-buffer (buffer &rest body)
"Check BUFFER and execute BODY.
BUFFER is checked with `org-babel-comint-buffer-livep'. BODY is
executed inside the protection of `save-window-excursion' and
executed inside the protection of `save-excursion' and
`save-match-data'."
(declare (indent 1))
`(save-excursion
@ -136,6 +138,24 @@ statement (not large blocks of code)."
"comint-highlight-prompt"))))
(accept-process-output (get-buffer-process buffer)))))
(defun org-babel-comint-eval-invisibly-and-wait-for-file
(buffer file string &optional period)
"Evaluate STRING in BUFFER invisibly.
Don't return until FILE exists. Code in STRING must ensure that
FILE exists at end of evaluation."
(unless (org-babel-comint-buffer-livep buffer)
(error "buffer %s doesn't exist or has no process" buffer))
(if (file-exists-p file) (delete-file file))
(process-send-string
(get-buffer-process buffer)
(if (string-match "\n$" string) string (concat string "\n")))
;; From Tramp 2.1.19 the following cache flush is not necessary
(if (file-remote-p default-directory)
(let (v)
(with-parsed-tramp-file-name default-directory nil
(tramp-flush-directory-property v ""))))
(while (not (file-exists-p file)) (sit-for (or period 0.25))))
(provide 'ob-comint)
;; arch-tag: 9adddce6-0864-4be3-b0b5-6c5157dc7889

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

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
@ -32,9 +32,6 @@
(defvar org-babel-default-header-args:css '())
(defun org-babel-expand-body:css (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body." body)
(defun org-babel-execute:css (body params)
"Execute a block of CSS code.
This function is called by `org-babel-execute-src-block'."

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

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
@ -43,22 +43,24 @@
'((:results . "file") (:exports . "results"))
"Default arguments for evaluating a ditaa source block.")
(defun org-babel-expand-body:ditaa (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body." body)
(defvar org-ditaa-jar-path)
(defun org-babel-execute:ditaa (body params)
"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)))
(cmdline (cdr (assoc :cmdline params)))
(in-file (make-temp-file "org-babel-ditaa")))
(let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
(out-file (cdr (assoc :file params)))
(cmdline (cdr (assoc :cmdline params)))
(in-file (org-babel-temp-file "ditaa-"))
(cmd (concat "java -jar "
(shell-quote-argument
(expand-file-name org-ditaa-jar-path))
" " cmdline
" " (org-babel-process-file-name in-file)
" " (org-babel-process-file-name out-file))))
(unless (file-exists-p org-ditaa-jar-path)
(error "Could not find ditaa.jar at %s" org-ditaa-jar-path))
(with-temp-file in-file (insert body))
(message (concat "java -jar " org-ditaa-jar-path " " cmdline " " in-file " " out-file))
(shell-command (concat "java -jar " (shell-quote-argument org-ditaa-jar-path) " " cmdline " " in-file " " out-file))
(message cmd) (shell-command cmd)
out-file))
(defun org-babel-prep-session:ditaa (session params)

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

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
@ -46,10 +46,9 @@
'((:results . "file") (:exports . "results"))
"Default arguments to use when evaluating a dot source block.")
(defun org-babel-expand-body:dot (body params &optional processed-params)
(defun org-babel-expand-body:dot (body params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (nth 1 (or processed-params
(org-babel-process-params params)))))
(let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
(mapc
(lambda (pair)
(let ((name (symbol-name (car pair)))
@ -65,15 +64,19 @@
(defun org-babel-execute:dot (body params)
"Execute a block of Dot code with org-babel.
This function is called by `org-babel-execute-src-block'."
(let ((processed-params (org-babel-process-params params))
(result-params (split-string (or (cdr (assoc :results params)) "")))
(out-file (cdr (assoc :file params)))
(cmdline (cdr (assoc :cmdline params)))
(cmd (or (cdr (assoc :cmd params)) "dot"))
(in-file (make-temp-file "org-babel-dot")))
(let* ((result-params (cdr (assoc :result-params params)))
(out-file (cdr (assoc :file params)))
(cmdline (or (cdr (assoc :cmdline params))
(format "-T%s" (file-name-extension out-file))))
(cmd (or (cdr (assoc :cmd params)) "dot"))
(in-file (org-babel-temp-file "dot-")))
(with-temp-file in-file
(insert (org-babel-expand-body:dot body params processed-params)))
(org-babel-eval (concat cmd " " in-file " " cmdline " -o " out-file) "")
(insert (org-babel-expand-body:dot body params)))
(org-babel-eval
(concat cmd
" " (org-babel-process-file-name in-file)
" " cmdline
" -o " (org-babel-process-file-name out-file)) "")
out-file))
(defun org-babel-prep-session:dot (session params)

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

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
@ -36,16 +36,16 @@
(declare-function orgtbl-to-generic "org-table" (table params))
(defun org-babel-expand-body:emacs-lisp (body params &optional processed-params)
(defun org-babel-expand-body:emacs-lisp (body params)
"Expand BODY according to PARAMS, return the expanded body."
(let* ((processed-params (or processed-params (org-babel-process-params params)))
(vars (nth 1 processed-params))
(result-params (nth 2 processed-params))
(let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
(result-params (cdr (assoc :result-params params)))
(print-level nil) (print-length nil)
(body (if (> (length vars) 0)
(concat "(let ("
(mapconcat
(lambda (var) (format "%S" (print `(,(car var) ',(cdr var)))))
(lambda (var)
(format "%S" (print `(,(car var) ',(cdr var)))))
vars "\n ")
")\n" body ")")
body)))
@ -56,13 +56,13 @@
(defun org-babel-execute:emacs-lisp (body params)
"Execute a block of emacs-lisp code with Babel."
(save-window-excursion
(let ((processed-params (org-babel-process-params params)))
(org-babel-reassemble-table
(eval (read (format "(progn %s)"
(org-babel-expand-body:emacs-lisp
body params processed-params))))
(org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params)))
(org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params)))))))
(org-babel-reassemble-table
(eval (read (format "(progn %s)"
(org-babel-expand-body:emacs-lisp body params))))
(org-babel-pick-name (cdr (assoc :colname-names params))
(cdr (assoc :colnames params)))
(org-babel-pick-name (cdr (assoc :rowname-names params))
(cdr (assoc :rownames params))))))
(provide 'ob-emacs-lisp)

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

@ -1,11 +1,11 @@
;;; ob-run.el --- org-babel functions for external code evaluation
;;; ob-eval.el --- org-babel functions for external code evaluation
;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, comint
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
@ -42,7 +42,7 @@
(defun org-babel-eval (cmd body)
"Run CMD on BODY.
If CMD succeeds then return it's results, otherwise display
If CMD succeeds then return its results, otherwise display
STDERR with `org-babel-eval-error-notify'."
(let ((err-buff (get-buffer-create "*Org-Babel Error*")) exit-code)
(with-current-buffer err-buff (erase-buffer))
@ -60,8 +60,7 @@ STDERR with `org-babel-eval-error-notify'."
(defun org-babel-eval-read-file (file)
"Return the contents of FILE as a string."
(with-temp-buffer (insert-file-contents
(org-babel-maybe-remote-file file))
(with-temp-buffer (insert-file-contents file)
(buffer-string)))
(defun org-babel-shell-command-on-region (start end command
@ -252,4 +251,4 @@ specifies the value of ERROR-BUFFER."
;; arch-tag: 5328b17f-957d-42d9-94da-a2952682d04d
;;; ob-comint.el ends here
;;; ob-eval.el ends here

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

@ -5,7 +5,7 @@
;; Author: Eric Schulte, Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
@ -49,7 +49,7 @@
(defcustom org-export-babel-evaluate t
"Switch controlling code evaluation during export.
When set to nil no code will be exported as part of the export
When set to nil no code will be evaluated as part of the export
process."
:group 'org-babel
:type 'boolean)
@ -77,6 +77,30 @@ be indented by this many characters. See
`org-babel-function-def-export-name' for the definition of a
source block function.")
(defmacro org-babel-exp-in-export-file (&rest body)
`(let* ((lang-headers (intern (concat "org-babel-default-header-args:" lang)))
(heading (nth 4 (ignore-errors (org-heading-components))))
(link (when org-current-export-file
(org-make-link-string
(if heading
(concat org-current-export-file "::" heading)
org-current-export-file))))
(export-buffer (current-buffer)) results)
(when link
;; resolve parameters in the original file so that
;; headline and file-wide parameters are included, attempt
;; to go to the same heading in the original file
(set-buffer (get-file-buffer org-current-export-file))
(save-restriction
(condition-case nil
(org-open-link-from-string link)
(error (when heading
(goto-char (point-min))
(re-search-forward (regexp-quote heading) nil t))))
(setq results ,@body))
(set-buffer export-buffer)
results)))
(defun org-babel-exp-src-blocks (body &rest headers)
"Process source block for export.
Depending on the 'export' headers argument in replace the source
@ -95,18 +119,27 @@ none ----- do not display either code or results upon export"
(message "org-babel-exp processing...")
(save-excursion
(goto-char (match-beginning 0))
(let* ((info (org-babel-get-src-block-info))
(params (nth 2 info)))
(let* ((info (org-babel-get-src-block-info 'light))
(lang (nth 0 info))
(raw-params (nth 2 info)))
;; bail if we couldn't get any info from the block
(when info
(org-babel-exp-in-export-file
(setf (nth 2 info)
(org-babel-merge-params
org-babel-default-header-args
(org-babel-params-from-buffer)
(org-babel-params-from-properties lang)
(if (boundp lang-headers) (eval lang-headers) nil)
raw-params)))
;; expand noweb references in the original file
(setf (nth 1 info)
(if (and (cdr (assoc :noweb params))
(string= "yes" (cdr (assoc :noweb params))))
(if (and (cdr (assoc :noweb (nth 2 info)))
(string= "yes" (cdr (assoc :noweb (nth 2 info)))))
(org-babel-expand-noweb-references
info (get-file-buffer org-current-export-file))
(nth 1 info))))
(org-babel-exp-do-export info 'block))))
(nth 1 info)))
(org-babel-exp-do-export info 'block)))))
(defun org-babel-exp-inline-src-blocks (start end)
"Process inline source blocks between START and END for export.
@ -178,6 +211,8 @@ options are taken from `org-babel-default-header-args'."
(list "emacs-lisp" "results"
(org-babel-merge-params
org-babel-default-header-args
(org-babel-params-from-buffer)
(org-babel-params-from-properties)
(org-babel-parse-header-arguments
(org-babel-clean-text-properties
(concat ":var results="
@ -193,8 +228,7 @@ options are taken from `org-babel-default-header-args'."
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))
(not (assoc :noeval (nth 2 info))))
(not (equal "none" session)))
(org-babel-exp-results info type 'silent))))
(clean () (org-babel-remove-result info)))
(case (intern (or (cdr (assoc :exports (nth 2 info))) "code"))
@ -208,16 +242,14 @@ The function respects the value of the :exports header argument."
(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 exportat by
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-remove-if-not (lambda (el) (eq :var (car el))) (nth 2 info)))))
(args (mapcar #'cdr (org-babel-get-header (nth 2 info) :var))))
(case type
('inline (format "=%s=" body))
('block
@ -249,62 +281,45 @@ 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."
(if org-export-babel-evaluate
(let ((lang (nth 0 info))
(body (nth 1 info))
(params
;; lets ensure that we lookup references in the original file
(mapcar
(lambda (pair)
(if (and org-current-export-file
(eq (car pair) :var)
(string-match org-babel-ref-split-regexp (cdr pair))
(equal :ob-must-be-reference
(org-babel-ref-literal
(match-string 2 (cdr pair)))))
`(:var . ,(concat (match-string 1 (cdr pair))
"=" org-current-export-file
":" (match-string 2 (cdr pair))))
pair))
(nth 2 info))))
;; skip code blocks which we can't evaluate
(if (fboundp (intern (concat "org-babel-execute:" lang)))
(case type
('inline
(let ((raw (org-babel-execute-src-block
nil info '((:results . "silent"))))
(result-params (split-string
(cdr (assoc :results params)))))
(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)))))))
('block
(org-babel-execute-src-block
nil info (org-babel-merge-params
params
`((:results . ,(if silent "silent" "replace")))))
"")
('lob
(or
(when org-export-babel-evaluate
(let ((lang (nth 0 info))
(body (nth 1 info)))
(setf (nth 2 info) (org-babel-exp-in-export-file
(org-babel-process-params (nth 2 info))))
;; skip code blocks which we can't evaluate
(when (fboundp (intern (concat "org-babel-execute:" lang)))
(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-merge-params
(nth 2 info)
`((:results . ,(if silent "silent" "replace")))))
(cond
((equal type 'block) (org-babel-execute-src-block nil info))
((equal type 'lob)
(save-excursion
(re-search-backward org-babel-lob-one-liner-regexp nil t)
(org-babel-execute-src-block
nil info (org-babel-merge-params
params
`((:results . ,(if silent "silent" "replace")))))
"")))
""))
""))
(org-babel-execute-src-block nil info)))))))))
""))
(provide 'ob-exp)

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

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
@ -68,11 +68,11 @@ code."
(car pair) ;; variable name
(if (listp (cdr pair)) ;; variable value
(org-babel-gnuplot-table-to-data
(cdr pair) (make-temp-file "org-babel-gnuplot") params)
(cdr pair) (org-babel-temp-file "gnuplot-") params)
(cdr pair))))
(org-babel-ref-variables params)))
(mapcar #'cdr (org-babel-get-header params :var))))
(defun org-babel-expand-body:gnuplot (body params &optional processed-params)
(defun org-babel-expand-body:gnuplot (body params)
"Expand BODY according to PARAMS, return the expanded body."
(save-window-excursion
(let* ((vars (org-babel-gnuplot-process-vars params))
@ -118,9 +118,9 @@ code."
;; insert variables into code body: this should happen last
;; placing the variables at the *top* of the code in case their
;; values are used later
(add-to-body (mapconcat
(lambda (pair) (format "%s = \"%s\"" (car pair) (cdr pair)))
vars "\n"))
(add-to-body (mapconcat #'identity
(org-babel-variable-assignments:gnuplot params)
"\n"))
;; replace any variable names preceded by '$' with the actual
;; value of the variable
(mapc (lambda (pair)
@ -141,12 +141,15 @@ This function is called by `org-babel-execute-src-block'."
(save-window-excursion
;; evaluate the code body with gnuplot
(if (string= session "none")
(let ((script-file (make-temp-file "org-babel-gnuplot-script")))
(let ((script-file (org-babel-temp-file "gnuplot-script-")))
(with-temp-file script-file
(insert (concat body "\n")))
(message "gnuplot \"%s\"" script-file)
(setq output
(shell-command-to-string (format "gnuplot \"%s\"" script-file)))
(shell-command-to-string
(format
"gnuplot \"%s\""
(org-babel-process-file-name script-file))))
(message output))
(with-temp-buffer
(insert (concat body "\n"))
@ -159,10 +162,7 @@ This function is called by `org-babel-execute-src-block'."
(defun org-babel-prep-session:gnuplot (session params)
"Prepare SESSION according to the header arguments in PARAMS."
(let* ((session (org-babel-gnuplot-initiate-session session))
(vars (org-babel-ref-variables params))
(var-lines (mapcar
(lambda (pair) (format "%s = \"%s\"" (car pair) (cdr pair)))
vars)))
(var-lines (org-babel-variable-assignments:gnuplot params)))
(message "%S" session)
(org-babel-comint-in-buffer session
(mapc (lambda (var-line)
@ -180,6 +180,12 @@ This function is called by `org-babel-execute-src-block'."
(insert (org-babel-chomp body)))
buffer)))
(defun org-babel-variable-assignments:gnuplot (params)
"Return list of gnuplot statements assigning the block's variables"
(mapcar
(lambda (pair) (format "%s = \"%s\"" (car pair) (cdr pair)))
(org-babel-gnuplot-process-vars params)))
(defvar gnuplot-buffer)
(defun org-babel-gnuplot-initiate-session (&optional session params)
"Initiate a gnuplot session.

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

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
@ -59,23 +59,14 @@
(defvar org-babel-haskell-eoe "\"org-babel-haskell-eoe\"")
(defun org-babel-expand-body:haskell (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (nth 1 (or processed-params (org-babel-process-params params)))))
(concat
(mapconcat
(lambda (pair) (format "let %s = %s"
(car pair)
(org-babel-haskell-var-to-haskell (cdr pair))))
vars "\n") "\n" body "\n")))
(defun org-babel-execute:haskell (body params)
"Execute a block of Haskell code."
(let* ((processed-params (org-babel-process-params params))
(session (nth 0 processed-params))
(vars (nth 1 processed-params))
(result-type (nth 3 processed-params))
(full-body (org-babel-expand-body:haskell body params processed-params))
(let* ((session (cdr (assoc :session params)))
(vars (mapcar #'cdr (org-babel-get-header params :var)))
(result-type (cdr (assoc :result-type params)))
(full-body (org-babel-expand-body:generic
body params
(org-babel-variable-assignments:haskell params)))
(session (org-babel-haskell-initiate-session session params))
(raw (org-babel-comint-with-output
(session org-babel-haskell-eoe t full-body)
@ -93,8 +84,10 @@
(mapconcat #'identity (reverse (cdr results)) "\n"))
((equal result-type 'value)
(org-babel-haskell-table-or-string (car results))))
(org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params)))
(org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params))))))
(org-babel-pick-name (cdr (assoc :colname-names params))
(cdr (assoc :colname-names params)))
(org-babel-pick-name (cdr (assoc :rowname-names params))
(cdr (assoc :rowname-names params))))))
(defun org-babel-haskell-read-string (string)
"Strip \\\"s from around a haskell string."
@ -110,34 +103,35 @@ then create one. Return the initialized session."
(or (get-buffer "*haskell*")
(save-window-excursion (run-haskell) (sleep-for 0.25) (current-buffer))))
(defun org-babel-load-session:haskell
(session body params &optional processed-params)
(defun org-babel-load-session:haskell (session body params)
"Load BODY into SESSION."
(save-window-excursion
(let* ((buffer (org-babel-prep-session:haskell
session params processed-params))
(load-file (concat (make-temp-file "org-babel-haskell-load") ".hs")))
(let* ((buffer (org-babel-prep-session:haskell session params))
(load-file (concat (org-babel-temp-file "haskell-load-") ".hs")))
(with-temp-buffer
(insert body) (write-file load-file)
(haskell-mode) (inferior-haskell-load-file))
buffer)))
(defun org-babel-prep-session:haskell
(session params &optional processed-params)
(defun org-babel-prep-session:haskell (session params)
"Prepare SESSION according to the header arguments in PARAMS."
(save-window-excursion
(let ((pp (or processed-params (org-babel-process-params params)))
(buffer (org-babel-haskell-initiate-session session)))
(let ((buffer (org-babel-haskell-initiate-session session)))
(org-babel-comint-in-buffer buffer
(mapc
(lambda (pair)
(insert (format "let %s = %s"
(car pair)
(org-babel-haskell-var-to-haskell (cdr pair))))
(comint-send-input nil t))
(nth 1 pp)))
(mapc (lambda (line)
(insert line)
(comint-send-input nil t))
(org-babel-variable-assignments:haskell params)))
(current-buffer))))
(defun org-babel-variable-assignments:haskell (params)
"Return list of haskell statements assigning the block's variables"
(mapcar (lambda (pair)
(format "let %s = %s"
(car pair)
(org-babel-haskell-var-to-haskell (cdr pair))))
(mapcar #'cdr (org-babel-get-header params :var))))
(defun org-babel-haskell-table-or-string (results)
"Convert RESULTS to an Emacs-lisp table or string.
If RESULTS look like a table, then convert them into an
@ -177,12 +171,14 @@ constructs (header arguments, no-web syntax etc...) are ignored."
(concat "^\\([ \t]*\\)#\\+begin_src[ \t]haskell*\\(.*\\)?[\r\n]"
"\\([^\000]*?\\)[\r\n][ \t]*#\\+end_src.*"))
(base-name (file-name-sans-extension (buffer-file-name)))
(tmp-file (make-temp-file "ob-haskell"))
(tmp-file (org-babel-temp-file "haskell-"))
(tmp-org-file (concat tmp-file ".org"))
(tmp-tex-file (concat tmp-file ".tex"))
(lhs-file (concat base-name ".lhs"))
(tex-file (concat base-name ".tex"))
(command (concat org-babel-haskell-lhs2tex-command " " lhs-file " > " tex-file))
(command (concat org-babel-haskell-lhs2tex-command
" " (org-babel-process-file-name lhs-file)
" > " (org-babel-process-file-name tex-file)))
(preserve-indentp org-src-preserve-indentation)
indentation)
;; escape haskell source-code blocks

165
lisp/org/ob-js.el Normal file
View file

@ -0,0 +1,165 @@
;;; ob-js.el --- org-babel functions for Javascript
;; Copyright (C) 2010 Free Software Foundation
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, js
;; Homepage: http://orgmode.org
;; Version: 7.3
;;; 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:
;; 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.
;;; Requirements:
;; - a non-browser javascript engine such as node.js http://nodejs.org/
;; or mozrepl http://wiki.github.com/bard/mozrepl/
;;
;; - for session based evaluation mozrepl and moz.el are required see
;; http://wiki.github.com/bard/mozrepl/emacs-integration for
;; configuration instructions
;;; Code:
(require 'ob)
(require 'ob-ref)
(require 'ob-comint)
(require 'ob-eval)
(eval-when-compile (require 'cl))
(declare-function run-mozilla "ext:moz" (arg))
(defvar org-babel-default-header-args:js '()
"Default header arguments for js code blocks.")
(defvar org-babel-js-eoe "org-babel-js-eoe"
"String to indicate that evaluation has completed.")
(defcustom org-babel-js-cmd "node"
"Name of command used to evaluate js blocks."
:group 'org-babel
:type 'string)
(defvar org-babel-js-function-wrapper
"require('sys').print(require('sys').inspect(function(){%s}()));"
"Javascript code to print value of body.")
(defun org-babel-execute:js (body params)
"Execute a block of Javascript code with org-babel.
This function is called by `org-babel-execute-src-block'"
(let* ((org-babel-js-cmd (or (cdr (assoc :cmd params)) org-babel-js-cmd))
(result-type (cdr (assoc :result-type params)))
(full-body (org-babel-expand-body:generic
body params (org-babel-variable-assignments:js params))))
(org-babel-js-read
(if (not (string= (cdr (assoc :session params)) "none"))
;; session evaluation
(let ((session (org-babel-prep-session:js
(cdr (assoc :session params)) params)))
(nth 1
(org-babel-comint-with-output
(session (format "%S" org-babel-js-eoe) t body)
(mapc
(lambda (line)
(insert (org-babel-chomp line)) (comint-send-input nil t))
(list body (format "%S" org-babel-js-eoe))))))
;; external evaluation
(let ((script-file (org-babel-temp-file "js-script-")))
(with-temp-file script-file
(insert
;; return the value or the output
(if (string= result-type "value")
(format org-babel-js-function-wrapper full-body)
full-body)))
(org-babel-eval
(format "%s %s" org-babel-js-cmd
(org-babel-process-file-name script-file)) ""))))))
(defun org-babel-js-read (results)
"Convert RESULTS into an appropriate elisp value.
If RESULTS look like a table, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
(org-babel-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)))
(defun org-babel-js-var-to-js (var)
"Convert VAR into a js variable.
Convert an elisp value into a string of js source code
specifying a variable of the same value."
(if (listp var)
(concat "[" (mapconcat #'org-babel-js-var-to-js var ", ") "]")
(format "%S" var)))
(defun org-babel-prep-session:js (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(let* ((session (org-babel-js-initiate-session session))
(var-lines (org-babel-variable-assignments:js params)))
(when session
(org-babel-comint-in-buffer session
(sit-for .5) (goto-char (point-max))
(mapc (lambda (var)
(insert var) (comint-send-input nil t)
(org-babel-comint-wait-for-output session)
(sit-for .1) (goto-char (point-max))) var-lines)))
session))
(defun org-babel-variable-assignments:js (params)
"Return list of Javascript statements assigning the block's variables"
(mapcar
(lambda (pair) (format "var %s=%s;"
(car pair) (org-babel-js-var-to-js (cdr pair))))
(mapcar #'cdr (org-babel-get-header params :var))))
(defun org-babel-js-initiate-session (&optional session)
"If there is not a current inferior-process-buffer in SESSION
then create. Return the initialized session."
(unless (string= session "none")
(cond
((string= "mozrepl" org-babel-js-cmd)
(require 'moz)
(let ((session-buffer (save-window-excursion
(run-mozilla nil)
(rename-buffer session)
(current-buffer))))
(if (org-babel-comint-buffer-livep session-buffer)
(progn (sit-for .25) session-buffer)
(sit-for .5)
(org-babel-js-initiate-session session))))
((string= "node" org-babel-js-cmd )
(error "session evaluation with node.js is not supported"))
(t
(error "sessions are only supported with mozrepl add \":cmd mozrepl\"")))))
(provide 'ob-js)
;; arch-tag: 84401fb3-b8d9-4bb6-9a90-cbe2d103d494
;;; ob-js.el ends here

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

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
@ -52,12 +52,14 @@ functions which are assigned key bindings, and see
("\C-p" . org-babel-previous-src-block)
("n" . org-babel-next-src-block)
("\C-n" . org-babel-next-src-block)
("e" . org-babel-execute-src-block)
("\C-e" . org-babel-execute-src-block)
("e" . org-babel-execute-maybe)
("\C-e" . org-babel-execute-maybe)
("o" . org-babel-open-src-block-result)
("\C-o" . org-babel-open-src-block-result)
("\C-v" . org-babel-expand-src-block)
("v" . org-babel-expand-src-block)
("u" . org-babel-goto-src-block-head)
("\C-u" . org-babel-goto-src-block-head)
("g" . org-babel-goto-named-src-block)
("r" . org-babel-goto-named-result)
("\C-r" . org-babel-goto-named-result)
@ -65,17 +67,24 @@ functions which are assigned key bindings, and see
("b" . org-babel-execute-buffer)
("\C-s" . org-babel-execute-subtree)
("s" . org-babel-execute-subtree)
("\C-d" . org-babel-demarcate-block)
("d" . org-babel-demarcate-block)
("\C-t" . org-babel-tangle)
("t" . org-babel-tangle)
("\C-f" . org-babel-tangle-file)
("f" . org-babel-tangle-file)
("\C-l" . org-babel-lob-ingest)
("l" . org-babel-lob-ingest)
("\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-z" . org-babel-switch-to-session)
("z" . org-babel-switch-to-session)
("z" . org-babel-switch-to-session-with-code)
("\C-a" . org-babel-sha1-hash)
("a" . org-babel-sha1-hash)
("h" . org-babel-describe-bindings))
("h" . org-babel-describe-bindings)
("\C-x" . org-babel-do-key-sequence-in-edit-buffer)
("x" . org-babel-do-key-sequence-in-edit-buffer)
("\C-\M-h" . org-babel-mark-block))
"Alist of key bindings and interactive Babel functions.
This list associates interactive Babel functions
with keys. Each element of this list will add an entry to the

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

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
@ -37,14 +37,23 @@
(declare-function org-splice-latex-header "org"
(tpl def-pkg pkg snippets-p &optional extra))
(declare-function org-export-latex-fix-inputenc "org-latex" ())
(add-to-list 'org-babel-tangle-lang-exts '("latex" . "tex"))
(defvar org-format-latex-header)
(defvar org-format-latex-header-extra)
(defvar org-export-latex-packages-alist)
(defvar org-export-latex-default-packages-alist)
(defvar org-export-pdf-logfiles)
(defvar org-latex-to-pdf-process)
(defvar org-export-pdf-remove-logfiles)
(defvar org-format-latex-options)
(defvar org-export-latex-packages-alist)
(defvar org-babel-default-header-args:latex
'((:results . "latex") (:exports . "results"))
"Default arguments to use when evaluating a LaTeX source block.")
(defun org-babel-expand-body:latex (body params &optional processed-params)
(defun org-babel-expand-body:latex (body params)
"Expand BODY according to PARAMS, return the expanded body."
(mapc (lambda (pair) ;; replace variables
(setq body
@ -52,30 +61,62 @@
(regexp-quote (format "%S" (car pair)))
(if (stringp (cdr pair))
(cdr pair) (format "%S" (cdr pair)))
body))) (nth 1 (org-babel-process-params params)))
body)
body))) (mapcar #'cdr (org-babel-get-header params :var)))
(org-babel-trim body))
(defvar org-format-latex-options)
(defvar org-export-latex-packages-alist)
(defun org-babel-execute:latex (body params)
"Execute a block of Latex code with Babel.
This function is called by `org-babel-execute-src-block'."
(setq body (org-babel-expand-body:latex body params))
(if (cdr (assoc :file params))
(let ((out-file (cdr (assoc :file params)))
(tex-file (make-temp-file "org-babel-latex" nil ".tex"))
(pdfheight (cdr (assoc :pdfheight params)))
(pdfwidth (cdr (assoc :pdfwidth params)))
(in-buffer (not (string= "no" (cdr (assoc :buffer params)))))
(org-export-latex-packages-alist
(append (cdr (assoc :packages params))
org-export-latex-packages-alist)))
(let* ((out-file (cdr (assoc :file params)))
(tex-file (org-babel-temp-file "latex-" ".tex"))
(border (cdr (assoc :border params)))
(fit (or (cdr (assoc :fit params)) border))
(height (and fit (cdr (assoc :pdfheight params))))
(width (and fit (cdr (assoc :pdfwidth params))))
(headers (cdr (assoc :headers params)))
(in-buffer (not (string= "no" (cdr (assoc :buffer params)))))
(org-export-latex-packages-alist
(append (cdr (assoc :packages params))
org-export-latex-packages-alist)))
(cond
((string-match "\\.png$" out-file)
(org-create-formula-image
body out-file org-format-latex-options in-buffer))
((string-match "\\.pdf$" out-file)
(org-babel-latex-body-to-tex-file tex-file body pdfheight pdfwidth)
(require 'org-latex)
(with-temp-file tex-file
(insert
(org-splice-latex-header
org-format-latex-header
(delq
nil
(mapcar
(lambda (el)
(unless (and (listp el) (string= "hyperref" (cadr el)))
el))
org-export-latex-default-packages-alist))
org-export-latex-packages-alist
org-format-latex-header-extra)
(if fit "\n\\usepackage[active, tightpage]{preview}\n" "")
(if border (format "\\setlength{\\PreviewBorder}{%s}" border) "")
(if height (concat "\n" (format "\\pdfpageheight %s" height)) "")
(if width (concat "\n" (format "\\pdfpagewidth %s" width)) "")
(if headers
(concat "\n"
(if (listp headers)
(mapconcat #'identity headers "\n")
headers) "\n")
"")
(if org-format-latex-header-extra
(concat "\n" org-format-latex-header-extra)
"")
(if fit
(concat "\n\\begin{document}\n\\begin{preview}\n" body
"\n\\end{preview}\n\\end{document}\n")
(concat "\n\\begin{document}\n" body "\n\\end{document}\n")))
(org-export-latex-fix-inputenc))
(when (file-exists-p out-file) (delete-file out-file))
(rename-file (org-babel-latex-tex-to-pdf tex-file) out-file))
((string-match "\\.\\([^\\.]+\\)$" out-file)
@ -84,67 +125,48 @@ This function is called by `org-babel-execute-src-block'."
out-file)
body))
(defvar org-format-latex-header)
(defvar org-format-latex-header-extra)
(defvar org-export-latex-packages-alist)
(defvar org-export-latex-default-packages-alist)
(defun org-babel-latex-body-to-tex-file (tex-file body &optional height width)
"Place the contents of BODY into TEX-FILE.
Extracted from `org-create-formula-image' in org.el."
(with-temp-file tex-file
(insert (org-splice-latex-header
org-format-latex-header
(delq
nil
(mapcar
(lambda (el) (unless (and (listp el) (string= "hyperref" (cadr el)))
el))
org-export-latex-default-packages-alist))
org-export-latex-packages-alist
org-format-latex-header-extra)
(if height (concat "\n" (format "\\pdfpageheight %s" height)) "")
(if width (concat "\n" (format "\\pdfpagewidth %s" width)) "")
(if org-format-latex-header-extra
(concat "\n" org-format-latex-header-extra)
"")
"\n\\begin{document}\n" body "\n\\end{document}\n")
(org-export-latex-fix-inputenc)))
(defvar org-export-pdf-logfiles)
(defvar org-latex-to-pdf-process)
(defvar org-export-pdf-remove-logfiles)
(defun org-babel-latex-tex-to-pdf (tex-file)
"Generate a pdf file according to the contents TEX-FILE.
(defun org-babel-latex-tex-to-pdf (file)
"Generate a pdf file according to the contents FILE.
Extracted from `org-export-as-pdf' in org-latex.el."
(let* ((wconfig (current-window-configuration))
(default-directory (file-name-directory tex-file))
(base (file-name-sans-extension tex-file))
(default-directory (file-name-directory file))
(base (file-name-sans-extension file))
(pdffile (concat base ".pdf"))
(cmds org-latex-to-pdf-process)
(outbuf (get-buffer-create "*Org PDF LaTeX Output*"))
cmd)
output-dir cmd)
(with-current-buffer outbuf (erase-buffer))
(message (concat "Processing LaTeX file " file "..."))
(setq output-dir (file-name-directory file))
(if (and cmds (symbolp cmds))
(funcall cmds tex-file)
(funcall cmds (shell-quote-argument file))
(while cmds
(setq cmd (pop cmds))
(while (string-match "%b" cmd)
(setq cmd (replace-match
(save-match-data
(shell-quote-argument base))
t t cmd)))
(while (string-match "%s" cmd)
(setq cmd (replace-match
(save-match-data
(shell-quote-argument tex-file))
t t cmd)))
(shell-command cmd outbuf outbuf)))
(setq cmd (pop cmds))
(while (string-match "%b" cmd)
(setq cmd (replace-match
(save-match-data
(shell-quote-argument base))
t t cmd)))
(while (string-match "%f" cmd)
(setq cmd (replace-match
(save-match-data
(shell-quote-argument file))
t t cmd)))
(while (string-match "%o" cmd)
(setq cmd (replace-match
(save-match-data
(shell-quote-argument output-dir))
t t cmd)))
(shell-command cmd outbuf)))
(message (concat "Processing LaTeX file " file "...done"))
(if (not (file-exists-p pdffile))
(error "PDF file was not produced from %s" tex-file)
(error (concat "PDF file " pdffile " was not produced"))
(set-window-configuration wconfig)
(when org-export-pdf-remove-logfiles
(dolist (ext org-export-pdf-logfiles)
(setq tex-file (concat base "." ext))
(and (file-exists-p tex-file) (delete-file tex-file))))
(dolist (ext org-export-pdf-logfiles)
(setq file (concat base "." ext))
(and (file-exists-p file) (delete-file file))))
(message "Exporting to PDF...done")
pdffile)))
(defun org-babel-prep-session:latex (session params)

72
lisp/org/ob-ledger.el Normal file
View file

@ -0,0 +1,72 @@
;;; ob-ledger.el --- org-babel functions for ledger evaluation
;; Copyright (C) 2010 Free Software Foundation, Inc.
;; Author: Eric S Fraga
;; Keywords: literate programming, reproducible research, accounting
;; Homepage: http://orgmode.org
;; Version: 7.3
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Org-Babel support for evaluating ledger entries.
;;
;; This differs from most standard languages in that
;;
;; 1) there is no such thing as a "session" in ledger
;;
;; 2) we are generally only going to return output from the leger program
;;
;; 3) we are adding the "cmdline" header argument
;;
;; 4) there are no variables
;;; Code:
(require 'ob)
(defvar org-babel-default-header-args:ledger
'((:results . "output") (:cmdline . "bal"))
"Default arguments to use when evaluating a ledger source block.")
(defun org-babel-execute:ledger (body params)
"Execute a block of Ledger entries with org-babel. This function is
called by `org-babel-execute-src-block'."
(message "executing Ledger source code block")
(let ((result-params (split-string (or (cdr (assoc :results params)) "")))
(cmdline (cdr (assoc :cmdline params)))
(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"
" -f " (org-babel-process-file-name in-file)
" " cmdline))
(with-output-to-string
(shell-command (concat "ledger"
" -f " (org-babel-process-file-name in-file)
" " cmdline
" > " (org-babel-process-file-name out-file))))
(with-temp-buffer (insert-file-contents out-file) (buffer-string))))
(defun org-babel-prep-session:ledger (session params)
(error "Ledger does not support sessions"))
(provide 'ob-ledger)
;; arch-tag: 7bbb529e-95a1-4236-9d29-b0000b918c7c
;;; ob-ledger.el ends here

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

@ -0,0 +1,106 @@
;;; ob-lisp.el --- org-babel functions for Common Lisp
;; Copyright (C) 2010 Free Software Foundation
;; Author: David T. O'Toole <dto@gnu.org>, Eric Schulte
;; Keywords: literate programming, reproducible research, lisp
;; Homepage: http://orgmode.org
;; Version: 7.3
;;; 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:
;; 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.
;;; Requirements:
;; Requires SLIME (Superior Lisp Interaction Mode for Emacs.)
;; See http://common-lisp.net/project/slime/
;;; Code:
(require 'ob)
(require 'ob-ref)
(require 'ob-comint)
(require 'ob-eval)
(require 'slime)
(defvar org-babel-default-header-args:lisp '()
"Default header arguments for lisp code blocks.")
(defcustom org-babel-lisp-cmd "sbcl --script"
"Name of command used to evaluate lisp blocks.")
(defun org-babel-expand-body:lisp (body params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
(if (> (length vars) 0)
(concat "(let ("
(mapconcat
(lambda (var) (format "%S" (print `(,(car var) ',(cdr var)))))
vars "\n ")
")\n" body ")")
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'"
(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)) ""))))))
;; 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."
(unless (string= session "none")
(save-window-excursion
(or (slime-connected-p)
(slime-process)))))
(provide 'ob-lisp)
;; arch-tag: 18086168-009f-4947-bbb5-3532375d851d
;;; ob-lisp.el ends here

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

@ -5,7 +5,7 @@
;; Author: Eric Schulte, Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
@ -45,15 +45,22 @@ To add files to this list use the `org-babel-lob-ingest' command."
;;;###autoload
(defun org-babel-lob-ingest (&optional file)
"Add all source-blocks defined in FILE to `org-babel-library-of-babel'."
"Add all named source-blocks defined in FILE to
`org-babel-library-of-babel'."
(interactive "f")
(org-babel-map-src-blocks file
(let* ((info (org-babel-get-src-block-info))
(source-name (intern (nth 4 info))))
(when source-name
(setq org-babel-library-of-babel
(cons (cons source-name info)
(assq-delete-all source-name org-babel-library-of-babel)))))))
(let ((lob-ingest-count 0))
(org-babel-map-src-blocks file
(let* ((info (org-babel-get-src-block-info 'light))
(source-name (nth 4 info)))
(when source-name
(setq source-name (intern source-name)
org-babel-library-of-babel
(cons (cons source-name info)
(assq-delete-all source-name org-babel-library-of-babel))
lob-ingest-count (1+ lob-ingest-count)))))
(message "%d src block%s added to Library of Babel"
lob-ingest-count (if (> lob-ingest-count 1) "s" ""))
lob-ingest-count))
(defconst org-babel-lob-call-aliases '("lob" "call")
"Aliases to call a source block function.
@ -61,9 +68,10 @@ 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
(concat "^\\([ \t]*\\)#\\+\\(?:"
(mapconcat #'regexp-quote org-babel-lob-call-aliases "\\|")
"\\):[ \t]+\\([^\(\)\n]+\\)\(\\([^\n]*\\)\)[ \t]*\\([^\n]*\\)")
(concat
"^\\([ \t]*\\)#\\+\\(?:"
(mapconcat #'regexp-quote org-babel-lob-call-aliases "\\|")
"\\):[ \t]+\\([^\(\)\n]+\\)\(\\([^\n]*\\)\)\\(\\[.+\\]\\|\\)[ \t]*\\([^\n]*\\)")
"Regexp to match calls to predefined source block functions.")
;; functions for executing lob one-liners
@ -76,36 +84,32 @@ if so then run the appropriate source block from the Library."
(let ((info (org-babel-lob-get-info)))
(if (nth 0 info) (progn (org-babel-lob-execute info) t) nil)))
(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-lob-execute-maybe)
;;;###autoload
(defun org-babel-lob-get-info ()
"Return a Library of Babel function call as a string.
This function is analogous to org-babel-get-src-block-name. For
both functions, after they are called, (match-string 1) matches
the function name, and (match-string 2) matches the function
arguments inside the parentheses. I think perhaps these functions
should be renamed to bring out this similarity, perhaps involving
the word 'call'."
"Return a Library of Babel function call as a string."
(let ((case-fold-search t))
(save-excursion
(beginning-of-line 1)
(if (looking-at org-babel-lob-one-liner-regexp)
(append (mapcar #'org-babel-clean-text-properties
(list (format "%s(%s)" (match-string 2) (match-string 3))
(match-string 4)))
(list (length (match-string 1))))))))
(append
(mapcar #'org-babel-clean-text-properties
(list
(format "%s(%s)%s"
(match-string 2) (match-string 3) (match-string 4))
(match-string 5)))
(list (length (match-string 1))))))))
(defun org-babel-lob-execute (info)
"Execute the lob call specified by INFO."
(let ((params (org-babel-merge-params
org-babel-default-header-args
(org-babel-params-from-buffer)
(org-babel-params-from-properties)
(org-babel-parse-header-arguments
(org-babel-clean-text-properties
(concat ":var results=" (mapconcat #'identity (butlast info) " ")))))))
(let ((params (org-babel-process-params
(org-babel-merge-params
org-babel-default-header-args
(org-babel-params-from-buffer)
(org-babel-params-from-properties)
(org-babel-parse-header-arguments
(org-babel-clean-text-properties
(concat ":var results="
(mapconcat #'identity (butlast info) " "))))))))
(org-babel-execute-src-block
nil (list "emacs-lisp" "results" params nil nil (nth 2 info)))))

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

@ -5,7 +5,7 @@
;; Author: Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.

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

@ -5,7 +5,7 @@
;; Author: Juan Pechiar
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
@ -62,9 +62,6 @@
'((:results . "file") (:exports . "results"))
"Default arguments to use when evaluating a mscgen source block.")
(defun org-babel-expand-body:mscgen (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body." body)
(defun org-babel-execute:mscgen (body params)
"Execute a block of Mscgen code with Babel.
This function is called by `org-babel-execute-src-block'.

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

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
@ -51,20 +51,12 @@
(defvar org-babel-ocaml-eoe-indicator "\"org-babel-ocaml-eoe\";;")
(defvar org-babel-ocaml-eoe-output "org-babel-ocaml-eoe")
(defun org-babel-expand-body:ocaml (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (nth 1 (or processed-params (org-babel-process-params params)))))
(concat
(mapconcat
(lambda (pair) (format "let %s = %s;;" (car pair)
(org-babel-ocaml-elisp-to-ocaml (cdr pair))))
vars "\n") "\n" body "\n")))
(defun org-babel-execute:ocaml (body params)
"Execute a block of Ocaml code with Babel."
(let* ((processed-params (org-babel-process-params params))
(vars (nth 1 processed-params))
(full-body (org-babel-expand-body:ocaml body params processed-params))
(let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
(full-body (org-babel-expand-body:generic
body params
(org-babel-variable-assignments:ocaml params)))
(session (org-babel-prep-session:ocaml
(cdr (assoc :session params)) params))
(raw (org-babel-comint-with-output
@ -84,9 +76,9 @@
(org-babel-reassemble-table
(org-babel-ocaml-parse-output (org-babel-trim clean))
(org-babel-pick-name
(nth 4 processed-params) (cdr (assoc :colnames params)))
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
(nth 5 processed-params) (cdr (assoc :rownames params))))))
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
(defvar tuareg-interactive-buffer-name)
(defun org-babel-prep-session:ocaml (session params)
@ -100,6 +92,13 @@
(save-window-excursion (tuareg-run-caml)
(get-buffer tuareg-interactive-buffer-name))))
(defun org-babel-variable-assignments:ocaml (params)
"Return list of ocaml statements assigning the block's variables"
(mapcar
(lambda (pair) (format "let %s = %s;;" (car pair)
(org-babel-ocaml-elisp-to-ocaml (cdr pair))))
(mapcar #'cdr (org-babel-get-header params :var))))
(defun org-babel-ocaml-elisp-to-ocaml (val)
"Return a string of ocaml code which evaluates to VAL."
(if (listp val)

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

@ -5,7 +5,7 @@
;; Author: Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
@ -47,20 +47,6 @@
(defvar org-babel-octave-shell-command "octave -q"
"Shell command to run octave as an external process.")
(defun org-babel-expand-body:matlab (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body."
(org-babel-expand-body:octave body params processed-params))
(defun org-babel-expand-body:octave (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (nth 1 (or processed-params (org-babel-process-params params)))))
(concat
(mapconcat
(lambda (pair)
(format "%s=%s"
(car pair)
(org-babel-octave-var-to-octave (cdr pair))))
vars "\n") "\n" body "\n")))
(defvar org-babel-matlab-with-emacs-link nil
"If non-nil use matlab-shell-run-region for session evaluation.
This will use EmacsLink if (matlab-with-emacs-link) evaluates
@ -76,7 +62,7 @@ delete('%s')
(defvar org-babel-octave-wrapper-method
"%s
if ischar(ans), fid = fopen('%s', 'w'); fprintf(fid, '%%s\\n', ans); fclose(fid);
else, save -ascii %s ans
else, dlmwrite('%s', ans, '\\t')
end")
(defvar org-babel-octave-eoe-indicator "\'org_babel_eoe\'")
@ -85,53 +71,60 @@ end")
(defun org-babel-execute:matlab (body params)
"Execute a block of matlab code with Babel."
(require 'matlab)
(org-babel-execute:octave body params 'matlab))
(defun org-babel-execute:octave (body params &optional matlabp)
"Execute a block of octave code with Babel."
(let* ((processed-params (org-babel-process-params params))
(session
(let* ((session
(funcall (intern (format "org-babel-%s-initiate-session"
(if matlabp "matlab" "octave")))
(nth 0 processed-params) params))
(vars (nth 1 processed-params))
(result-params (nth 2 processed-params))
(result-type (nth 3 processed-params))
(cdr (assoc :session params)) params))
(vars (mapcar #'cdr (org-babel-get-header params :var)))
(result-params (cdr (assoc :result-params params)))
(result-type (cdr (assoc :result-type params)))
(out-file (cdr (assoc :file params)))
(augmented-body
(org-babel-expand-body:octave body params processed-params))
(full-body
(org-babel-expand-body:generic
body params (org-babel-variable-assignments:octave params)))
(result (org-babel-octave-evaluate
session augmented-body result-type matlabp)))
session full-body result-type matlabp)))
(or out-file
(org-babel-reassemble-table
result
(org-babel-pick-name
(nth 4 processed-params) (cdr (assoc :colnames params)))
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
(nth 5 processed-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."
(require 'matlab)
(org-babel-prep-session:octave session params 'matlab))
(defun org-babel-variable-assignments:octave (params)
"Return list of octave statements assigning the block's variables"
(mapcar
(lambda (pair)
(format "%s=%s"
(car pair)
(org-babel-octave-var-to-octave (cdr pair))))
(mapcar #'cdr (org-babel-get-header params :var))))
(defalias 'org-babel-variable-assignments:matlab
'org-babel-variable-assignments:octave)
(defun org-babel-octave-var-to-octave (var)
"Convert an emacs-lisp value into an octave variable.
Converts an emacs-lisp variable into a string of octave code
specifying a variable of the same value."
(if (listp var)
(concat "[" (mapconcat #'org-babel-octave-var-to-octave var ", ") "]")
(format "%S" var)))
(concat "[" (mapconcat #'org-babel-octave-var-to-octave var
(if (listp (car var)) "; " ",")) "]")
(format "%s" (or var "nil"))))
(defun org-babel-prep-session:octave (session params &optional matlabp)
"Prepare SESSION according to the header arguments specified in PARAMS."
(let* ((session (org-babel-octave-initiate-session session params matlabp))
(vars (org-babel-ref-variables params))
(var-lines (mapcar
(lambda (pair)
(format "%s=%s"
(car pair)
(org-babel-octave-var-to-octave (cdr pair))))
vars)))
(var-lines (org-babel-variable-assignments:octave params)))
(org-babel-comint-in-buffer session
(mapc (lambda (var)
(end-of-line 1) (insert var) (comint-send-input nil t)
@ -142,13 +135,13 @@ specifying a variable of the same value."
"Create a matlab inferior process buffer.
If there is not a current inferior-process-buffer in SESSION then
create. Return the initialized session."
(require 'matlab)
(org-babel-octave-initiate-session session params 'matlab))
(defun org-babel-octave-initiate-session (&optional session params matlabp)
"Create an octave inferior process buffer.
If there is not a current inferior-process-buffer in SESSION then
create. Return the initialized session."
(require 'octave-inf)
(if matlabp (require 'matlab) (require 'octave-inf))
(unless (string= session "none")
(let ((session (or session
(if matlabp "*Inferior Matlab*" "*Inferior Octave*"))))
@ -161,7 +154,7 @@ create. Return the initialized session."
(current-buffer))))))
(defun org-babel-octave-evaluate
(session body result-type lang &optional matlabp)
(session body result-type &optional matlabp)
"Pass BODY to the octave process in SESSION.
If RESULT-TYPE equals 'output then return the outputs of the
statements in BODY, if RESULT-TYPE equals 'value then return the
@ -177,17 +170,19 @@ value of the last statement in BODY, as elisp."
org-babel-octave-shell-command)))
(case result-type
(output (org-babel-eval cmd body))
(value (let ((tmp-file (make-temp-file "org-babel-results-")))
(value (let ((tmp-file (org-babel-temp-file "octave-")))
(org-babel-eval
cmd
(format org-babel-octave-wrapper-method body tmp-file tmp-file))
(org-babel-eval-read-file tmp-file))))))
(format org-babel-octave-wrapper-method body
(org-babel-process-file-name tmp-file 'noquote)
(org-babel-process-file-name tmp-file 'noquote)))
(org-babel-octave-import-elisp-from-file tmp-file))))))
(defun org-babel-octave-evaluate-session
(session body result-type &optional matlabp)
"Evaluate BODY in SESSION."
(let* ((tmp-file (make-temp-file "org-babel-results-"))
(wait-file (make-temp-file "org-babel-matlab-emacs-link-wait-signal-"))
(let* ((tmp-file (org-babel-temp-file (if matlabp "matlab-" "octave-")))
(wait-file (org-babel-temp-file "matlab-emacs-link-wait-signal-"))
(full-body
(case result-type
(output
@ -198,11 +193,15 @@ value of the last statement in BODY, as elisp."
(if (and matlabp org-babel-matlab-with-emacs-link)
(concat
(format org-babel-matlab-emacs-link-wrapper-method
body tmp-file tmp-file wait-file) "\n")
body
(org-babel-process-file-name tmp-file 'noquote)
(org-babel-process-file-name tmp-file 'noquote) wait-file) "\n")
(mapconcat
#'org-babel-chomp
(list (format org-babel-octave-wrapper-method
body tmp-file tmp-file)
body
(org-babel-process-file-name tmp-file 'noquote)
(org-babel-process-file-name tmp-file 'noquote))
org-babel-octave-eoe-indicator) "\n")))))
(raw (if (and matlabp org-babel-matlab-with-emacs-link)
(save-window-excursion
@ -225,8 +224,7 @@ value of the last statement in BODY, as elisp."
(insert full-body) (comint-send-input nil t)))) results)
(case result-type
(value
(org-babel-octave-import-elisp-from-file
(org-babel-maybe-remote-file tmp-file)))
(org-babel-octave-import-elisp-from-file tmp-file))
(output
(progn
(setq results
@ -244,14 +242,14 @@ value of the last statement in BODY, as elisp."
"Import data from FILE-NAME.
This removes initial blank and comment lines and then calls
`org-babel-import-elisp-from-file'."
(let ((temp-file (make-temp-file "org-babel-results-")) beg end)
(let ((temp-file (org-babel-temp-file "octave-matlab-")) beg end)
(with-temp-file temp-file
(insert-file-contents file-name)
(re-search-forward "^[ \t]*[^# \t]" nil t)
(if (< (setq beg (point-min))
(setq end (point-at-bol)))
(delete-region beg end)))
(org-babel-import-elisp-from-file temp-file)))
(org-babel-import-elisp-from-file temp-file '(16))))
(defun org-babel-octave-read-string (string)
"Strip \\\"s from around octave string"

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

@ -0,0 +1,62 @@
;;; ob-org.el --- org-babel functions for org code block evaluation
;; Copyright (C) 2010 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This is the simplest of code blocks, where upon evaluation the
;; contents of the code block are returned in a raw result.
;;; Code:
(require 'ob)
(declare-function org-export-string "org-exp" (string fmt &optional dir))
(defvar org-babel-default-header-args:org
'((:results . "raw silent") (:exports . "results"))
"Default arguments for evaluating a org source block.")
(defvar org-babel-org-default-header
"#+TITLE: default empty header\n"
"Default header inserted during export of org blocks.")
(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)))
(cond
((member "latex" result-params) (org-export-string body "latex"))
((member "html" result-params) (org-export-string body "html"))
((member "ascii" result-params) (org-export-string body "ascii"))
(t body))))
(defun org-babel-prep-session:org (session params)
"Return an error because org does not support sessions."
(error "Org does not support sessions"))
(provide 'ob-org)
;; arch-tag: 130af5fe-cc56-46bd-9508-fa0ebd94cb1f
;;; ob-org.el ends here

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

@ -5,7 +5,7 @@
;; Author: Dan Davison, Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
@ -38,39 +38,35 @@
(defvar org-babel-perl-command "perl"
"Name of command to use for executing perl code.")
(defun org-babel-expand-body:perl (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (nth 1 (or processed-params (org-babel-process-params params)))))
(concat
(mapconcat ;; define any variables
(lambda (pair)
(format "$%s=%s;"
(car pair)
(org-babel-perl-var-to-perl (cdr pair))))
vars "\n") "\n" (org-babel-trim body) "\n")))
(defun org-babel-execute:perl (body params)
"Execute a block of Perl code with Babel.
This function is called by `org-babel-execute-src-block'."
(let* ((processed-params (org-babel-process-params params))
(session (nth 0 processed-params))
(vars (nth 1 processed-params))
(result-params (nth 2 processed-params))
(result-type (nth 3 processed-params))
(full-body (org-babel-expand-body:perl
body params processed-params))
(let* ((session (cdr (assoc :session params)))
(result-params (cdr (assoc :result-params params)))
(result-type (cdr (assoc :result-type params)))
(full-body (org-babel-expand-body:generic
body params (org-babel-variable-assignments:perl params)))
(session (org-babel-perl-initiate-session session)))
(org-babel-reassemble-table
(org-babel-perl-evaluate session full-body result-type)
(org-babel-pick-name
(nth 4 processed-params) (cdr (assoc :colnames params)))
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
(nth 5 processed-params) (cdr (assoc :rownames params))))))
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
(defun org-babel-prep-session:perl (session params)
"Prepare SESSION according to the header arguments in PARAMS."
(error "Sessions are not supported for Perl."))
(defun org-babel-variable-assignments:perl (params)
"Return list of perl statements assigning the block's variables"
(mapcar
(lambda (pair)
(format "$%s=%s;"
(car pair)
(org-babel-perl-var-to-perl (cdr pair))))
(mapcar #'cdr (org-babel-get-header params :var))))
;; helper functions
(defun org-babel-perl-var-to-perl (var)
@ -107,10 +103,11 @@ return the value of the last statement in BODY, as elisp."
(when session (error "Sessions are not supported for Perl."))
(case result-type
(output (org-babel-eval org-babel-perl-command body))
(value (let ((tmp-file (make-temp-file "org-babel-perl-results-")))
(value (let ((tmp-file (org-babel-temp-file "perl-")))
(org-babel-eval
org-babel-perl-command
(format org-babel-perl-wrapper-method body tmp-file))
(format org-babel-perl-wrapper-method body
(org-babel-process-file-name tmp-file 'noquote)))
(org-babel-eval-read-file tmp-file)))))
(provide 'ob-perl)

83
lisp/org/ob-plantuml.el Normal file
View file

@ -0,0 +1,83 @@
;;; ob-plantuml.el --- org-babel functions for plantuml evaluation
;; Copyright (C) 2010 Free Software Foundation, Inc.
;; Author: Zhang Weize
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.3
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Org-Babel support for evaluating plantuml script.
;;
;; Inspired by Ian Yang's org-export-blocks-format-plantuml
;; http://www.emacswiki.org/emacs/org-export-blocks-format-plantuml.el
;;; Requirements:
;; plantuml | http://plantuml.sourceforge.net/
;; plantuml.jar | `org-plantuml-jar-path' should point to the jar file
;;; Code:
(require 'ob)
(require 'ob-eval)
(defvar org-babel-default-header-args:plantuml
'((:results . "file") (:exports . "results"))
"Default arguments for evaluating a plantuml source block.")
(defcustom org-plantuml-jar-path nil
"Path to the plantuml.jar file."
:group 'org-babel
:type 'string)
(defun org-babel-execute:plantuml (body params)
"Execute a block of plantuml code with org-babel.
This function is called by `org-babel-execute-src-block'."
(let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
(out-file (or (cdr (assoc :file params))
(error "plantuml requires a \":file\" header argument")))
(cmdline (cdr (assoc :cmdline params)))
(in-file (org-babel-temp-file "plantuml-"))
(cmd (if (not org-plantuml-jar-path)
(error "`org-plantuml-jar-path' is not set")
(concat "java -jar "
(shell-quote-argument
(expand-file-name org-plantuml-jar-path))
(if (string= (file-name-extension out-file) "svg")
" -tsvg" "")
" -p " cmdline " < "
(org-babel-process-file-name in-file)
" > "
(org-babel-process-file-name out-file)))))
(unless (file-exists-p org-plantuml-jar-path)
(error "Could not find plantuml.jar at %s" org-plantuml-jar-path))
(with-temp-file in-file (insert (concat "@startuml\n" body "\n@enduml")))
(message "%s" cmd) (org-babel-eval cmd "")
out-file))
(defun org-babel-prep-session:plantuml (session params)
"Return an error because plantuml does not support sessions."
(error "Plantuml does not support sessions"))
(provide 'ob-plantuml)
;; arch-tag: 451f50c5-e779-407e-ad64-70e0e8f161d1
;;; ob-plantuml.el ends here

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

@ -5,7 +5,7 @@
;; Author: Eric Schulte, Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
@ -47,46 +47,34 @@
(defvar org-babel-python-mode (if (featurep 'xemacs) 'python-mode 'python)
"Preferred python mode for use in running python interactively.")
(defun org-babel-expand-body:python (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body."
(concat
(mapconcat ;; define any variables
(lambda (pair)
(format "%s=%s"
(car pair)
(org-babel-python-var-to-python (cdr pair))))
(nth 1 (or processed-params (org-babel-process-params params))) "\n")
"\n" (org-babel-trim body) "\n"))
(defvar org-src-preserve-indentation)
(defun org-babel-execute:python (body params)
"Execute a block of Python code with Babel.
This function is called by `org-babel-execute-src-block'."
(let* ((processed-params (org-babel-process-params params))
(session (org-babel-python-initiate-session (first processed-params)))
(result-params (nth 2 processed-params))
(result-type (nth 3 processed-params))
(full-body (org-babel-expand-body:python
body params processed-params))
(let* ((session (org-babel-python-initiate-session
(cdr (assoc :session params))))
(result-params (cdr (assoc :result-params params)))
(result-type (cdr (assoc :result-type params)))
(full-body
(org-babel-expand-body:generic
body params (org-babel-variable-assignments:python params)))
(result (org-babel-python-evaluate
session full-body result-type result-params)))
(or (cdr (assoc :file params))
(org-babel-reassemble-table
result
(org-babel-pick-name (nth 4 processed-params)
(org-babel-pick-name (cdr (assoc :colname-names params))
(cdr (assoc :colnames params)))
(org-babel-pick-name (nth 5 processed-params)
(org-babel-pick-name (cdr (assoc :rowname-names params))
(cdr (assoc :rownames params)))))))
(defun org-babel-prep-session:python (session params)
"Prepare SESSION according to the header arguments in PARAMS."
"Prepare SESSION according to the header arguments in PARAMS.
VARS contains resolved variable references"
(let* ((session (org-babel-python-initiate-session session))
(vars (org-babel-ref-variables params))
(var-lines (mapcar ;; define any variables
(lambda (pair)
(format "%s=%s"
(car pair)
(org-babel-python-var-to-python (cdr pair))))
vars)))
(var-lines
(org-babel-variable-assignments:python params)))
(org-babel-comint-in-buffer session
(mapc (lambda (var)
(end-of-line 1) (insert var) (comint-send-input)
@ -104,6 +92,15 @@ This function is called by `org-babel-execute-src-block'."
;; helper functions
(defun org-babel-variable-assignments:python (params)
"Return list of python statements assigning the block's variables"
(mapcar
(lambda (pair)
(format "%s=%s"
(car pair)
(org-babel-python-var-to-python (cdr pair))))
(mapcar #'cdr (org-babel-get-header params :var))))
(defun org-babel-python-var-to-python (var)
"Convert an elisp value to a python variable.
Convert an elisp value, VAR, into a string of python source code
@ -125,8 +122,7 @@ Emacs-lisp table, otherwise return the results as a string."
(mapcar (lambda (el) (if (equal el 'None) 'hline el)) res)
res))
(org-babel-read
(if (or (string-match "^\\[.+\\]$" results)
(string-match "^(.+)$" results))
(if (and (stringp results) (string-match "^[([].+[])]$" results))
(org-babel-read
(concat "'"
(replace-regexp-in-string
@ -151,10 +147,10 @@ then create. Return the initialized session."
(let* ((session (if session (intern session) :default))
(python-buffer (org-babel-python-session-buffer session)))
(cond
((and (equal 'python org-babel-python-mode)
((and (eq 'python org-babel-python-mode)
(fboundp 'run-python)) ; python.el
(run-python))
((and (equal 'python-mode org-babel-python-mode)
((and (eq 'python-mode org-babel-python-mode)
(fboundp 'py-shell)) ; python-mode.el
;; `py-shell' creates a buffer whose name is the value of
;; `py-which-bufname' with '*'s at the beginning and end
@ -195,73 +191,89 @@ def main():
open('%s', 'w').write( pprint.pformat(main()) )")
(defun org-babel-python-evaluate
(buffer body &optional result-type result-params)
"Pass BODY to the Python process in BUFFER.
If RESULT-TYPE equals 'output then return a list of the outputs
of the statements in BODY, if RESULT-TYPE equals 'value then
return the value of the last statement in BODY, as elisp."
(if (not buffer)
;; external process evaluation
(case result-type
(output (org-babel-eval org-babel-python-command body))
(value (let ((tmp-file (make-temp-file "org-babel-python-results-")))
(org-babel-eval org-babel-python-command
(format
(if (member "pp" result-params)
org-babel-python-pp-wrapper-method
org-babel-python-wrapper-method)
(mapconcat
(lambda (line) (format "\t%s" line))
(split-string
(org-remove-indentation
(org-babel-trim body))
"[\r\n]") "\n")
tmp-file))
((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)))))
;; comint session evaluation
(flet ((dump-last-value (tmp-file pp)
(mapc
(lambda (statement) (insert statement) (comint-send-input))
(if pp
(list
"import pp"
(format "open('%s', 'w').write(pprint.pformat(_))" tmp-file))
(list (format "open('%s', 'w').write(str(_))" tmp-file)))))
(input-body (body)
(mapc (lambda (statement) (insert statement) (comint-send-input))
(split-string (org-babel-trim body) "[\r\n]+"))
(comint-send-input) (comint-send-input)))
(case result-type
(output
(mapconcat
#'org-babel-trim
(butlast
(org-babel-comint-with-output
(buffer org-babel-python-eoe-indicator t body)
(let ((comint-process-echoes nil))
(input-body body)
(insert org-babel-python-eoe-indicator)
(comint-send-input))) 2) "\n"))
(value
((lambda (results)
(if (or (member "code" result-params) (member "pp" result-params))
results
(org-babel-python-table-or-string results)))
(let ((tmp-file (make-temp-file "org-babel-python-results-")))
(org-babel-comint-with-output
(buffer org-babel-python-eoe-indicator t body)
(let ((comint-process-echoes nil))
(input-body body)
(dump-last-value tmp-file (member "pp" result-params))
(comint-send-input) (comint-send-input)
(insert org-babel-python-eoe-indicator)
(comint-send-input)))
(org-babel-eval-read-file tmp-file))))))))
(session body &optional result-type result-params)
"Evaluate BODY as python code."
(if session
(org-babel-python-evaluate-session
session body result-type result-params)
(org-babel-python-evaluate-external-process
body result-type result-params)))
(defun org-babel-python-evaluate-external-process
(body &optional result-type result-params)
"Evaluate BODY in external python process.
If RESULT-TYPE equals 'output then return standard output as a
string. If RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp."
(case result-type
(output (org-babel-eval org-babel-python-command body))
(value (let ((tmp-file (org-babel-temp-file "python-")))
(org-babel-eval org-babel-python-command
(format
(if (member "pp" result-params)
org-babel-python-pp-wrapper-method
org-babel-python-wrapper-method)
(mapconcat
(lambda (line) (format "\t%s" line))
(split-string
(org-remove-indentation
(org-babel-trim body))
"[\r\n]") "\n")
(org-babel-process-file-name tmp-file 'noquote)))
((lambda (raw)
(if (or (member "code" result-params)
(member "pp" result-params))
raw
(org-babel-python-table-or-string raw)))
(org-babel-eval-read-file tmp-file))))))
(defun org-babel-python-evaluate-session
(session body &optional result-type result-params)
"Pass BODY to the Python process in SESSION.
If RESULT-TYPE equals 'output then return standard output as a
string. If RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp."
(flet ((dump-last-value
(tmp-file pp)
(mapc
(lambda (statement) (insert statement) (comint-send-input))
(if pp
(list
"import pp"
(format "open('%s', 'w').write(pprint.pformat(_))"
(org-babel-process-file-name tmp-file 'noquote)))
(list (format "open('%s', 'w').write(str(_))"
(org-babel-process-file-name tmp-file 'noquote))))))
(input-body (body)
(mapc (lambda (statement) (insert statement) (comint-send-input))
(split-string (org-babel-trim body) "[\r\n]+"))
(comint-send-input) (comint-send-input)))
(case result-type
(output
(mapconcat
#'org-babel-trim
(butlast
(org-babel-comint-with-output
(session org-babel-python-eoe-indicator t body)
(let ((comint-process-echoes nil))
(input-body body)
(insert org-babel-python-eoe-indicator)
(comint-send-input))) 2) "\n"))
(value
((lambda (results)
(if (or (member "code" result-params) (member "pp" result-params))
results
(org-babel-python-table-or-string results)))
(let ((tmp-file (org-babel-temp-file "python-")))
(org-babel-comint-with-output
(session org-babel-python-eoe-indicator t body)
(let ((comint-process-echoes nil))
(input-body body)
(dump-last-value tmp-file (member "pp" result-params))
(comint-send-input) (comint-send-input)
(insert org-babel-python-eoe-indicator)
(comint-send-input)))
(org-babel-eval-read-file tmp-file)))))))
(defun org-babel-python-read-string (string)
"Strip 's from around python string"

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

@ -5,7 +5,7 @@
;; Author: Eric Schulte, Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
@ -57,36 +57,26 @@
(declare-function org-at-table-p "org" (&optional table-type))
(declare-function org-count "org" (CL-ITEM CL-SEQ))
(defun org-babel-ref-variables (params)
"Convert PARAMS to variable names and values.
Takes a parameter alist, and return an alist of variable names,
and the emacs-lisp representation of the related value."
(let ((assignments
(delq nil (mapcar (lambda (pair) (if (eq (car pair) :var) (cdr pair))) params)))
(others
(delq nil (mapcar (lambda (pair) (unless (eq :var (car pair)) pair)) params))))
(mapcar (lambda (assignment) (org-babel-ref-parse assignment)) assignments)))
(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]*")
(defun org-babel-ref-parse (assignment &optional params)
(defun org-babel-ref-parse (assignment)
"Parse a variable ASSIGNMENT in a header argument.
If the right hand side of the assignment has a literal value
return that value, otherwise interpret as a reference to an
external resource and find it's value using
`org-babel-ref-resolve-reference'. Return a list with two
elements. The first element of the list will be the name of the
variable, and the second will be an emacs-lisp representation of
the value of the variable."
(if (string-match org-babel-ref-split-regexp assignment)
(let ((var (match-string 1 assignment))
(ref (match-string 2 assignment)))
(cons (intern var)
((lambda (val)
(if (equal :ob-must-be-reference val)
(org-babel-ref-resolve-reference ref params)
val)) (org-babel-ref-literal ref))))))
`org-babel-ref-resolve'. Return a list with two elements. The
first element of the list will be the name of the variable, and
the second will be an emacs-lisp representation of the value of
the variable."
(when (string-match org-babel-ref-split-regexp assignment)
(let ((var (match-string 1 assignment))
(ref (match-string 2 assignment)))
(cons (intern var)
((lambda (val)
(if (equal :ob-must-be-reference val)
(org-babel-ref-resolve ref) val))
(org-babel-ref-literal ref))))))
(defun org-babel-ref-literal (ref)
"Return the value of REF if it is a literal value.
@ -103,7 +93,7 @@ return nil."
out)))
(defvar org-babel-library-of-babel)
(defun org-babel-ref-resolve-reference (ref &optional params)
(defun org-babel-ref-resolve (ref)
"Resolve the reference REF and return its value."
(save-excursion
(let ((case-fold-search t)
@ -119,12 +109,10 @@ return nil."
(when (string-match "^\\(.+?\\)\(\\(.*\\)\)$" ref)
(setq new-refere (match-string 1 ref))
(setq new-referent (match-string 2 ref))
;; (message "new-refere=%S, new-referent=%S" new-refere new-referent) ;; debugging
(when (> (length new-refere) 0)
(if (> (length new-referent) 0)
(setq args (mapcar (lambda (ref) (cons :var ref))
(org-babel-ref-split-args new-referent))))
;; (message "args=%S" args) ;; debugging
(setq ref new-refere)))
(when (string-match "^\\(.+\\):\\(.+\\)$" ref)
(setq split-file (match-string 1 ref))
@ -133,7 +121,8 @@ return nil."
(save-restriction
(widen)
(goto-char (point-min))
(if (let ((result_regexp (concat "^[ \t]*#\\+\\(TBLNAME\\|RESNAME\\|RESULTS\\):[ \t]*"
(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]*$")))
@ -144,7 +133,8 @@ return nil."
(re-search-forward regexp nil t)
(re-search-backward regexp nil t)
;; check the Library of Babel
(setq lob-info (cdr (assoc (intern ref) org-babel-library-of-babel)))))
(setq lob-info (cdr (assoc (intern ref)
org-babel-library-of-babel)))))
(unless lob-info (goto-char (match-beginning 0)))
;; ;; TODO: allow searching for names in other buffers
;; (setq id-loc (org-id-find ref 'marker)
@ -159,14 +149,14 @@ return nil."
(beginning-of-line)
(if (or (= (point) (point-min)) (= (point) (point-max)))
(error "reference not found"))))
(setq params (org-babel-merge-params params args '((:results . "silent"))))
(setq result
(case type
('results-line (org-babel-read-result))
('table (org-babel-read-table))
('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))))
(let ((params (append args '((:results . "silent")))))
(setq result
(case type
('results-line (org-babel-read-result))
('table (org-babel-read-table))
('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)))))
(if (symbolp result)
(format "%S" result)
(if (and index (listp result))
@ -199,7 +189,7 @@ to \"0:-1\"."
(if (or (= 0 (length portion)) (string-match ind-re portion))
(mapcar
(lambda (n) (nth n lis))
(apply 'number-sequence
(apply 'org-number-sequence
(if (and (> (length portion) 0) (match-string 2 portion))
(list
(wrap (string-to-number (match-string 2 portion)))

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

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
@ -52,48 +52,30 @@
(defvar org-babel-ruby-command "ruby"
"Name of command to use for executing ruby code.")
(defun org-babel-expand-body:ruby (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body."
(require 'inf-ruby)
(let ((vars (nth 1 (or processed-params (org-babel-process-params params)))))
(concat
(mapconcat ;; define any variables
(lambda (pair)
(format "%s=%s"
(car pair)
(org-babel-ruby-var-to-ruby (cdr pair))))
vars "\n") "\n" body "\n")))
(defun org-babel-execute:ruby (body params)
"Execute a block of Ruby code with Babel.
This function is called by `org-babel-execute-src-block'."
(let* ((processed-params (org-babel-process-params params))
(session (org-babel-ruby-initiate-session (first processed-params)))
(result-params (nth 2 processed-params))
(result-type (nth 3 processed-params))
(full-body (org-babel-expand-body:ruby
body params processed-params))
(let* ((session (org-babel-ruby-initiate-session
(cdr (assoc :session params))))
(result-params (cdr (assoc :result-params params)))
(result-type (cdr (assoc :result-type params)))
(full-body (org-babel-expand-body:generic
body params (org-babel-variable-assignments:ruby params)))
(result (org-babel-ruby-evaluate
session full-body result-type result-params)))
(or (cdr (assoc :file params))
(org-babel-reassemble-table
result
(org-babel-pick-name (nth 4 processed-params)
(org-babel-pick-name (cdr (assoc :colname-names params))
(cdr (assoc :colnames params)))
(org-babel-pick-name (nth 5 processed-params)
(org-babel-pick-name (cdr (assoc :rowname-names params))
(cdr (assoc :rownames params)))))))
(defun org-babel-prep-session:ruby (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
;; (message "params=%S" params) ;; debugging
(let* ((session (org-babel-ruby-initiate-session session))
(vars (org-babel-ref-variables params))
(var-lines (mapcar ;; define any variables
(lambda (pair)
(format "%s=%s"
(car pair)
(org-babel-ruby-var-to-ruby (cdr pair))))
vars)))
(var-lines (org-babel-variable-assignments:ruby params)))
(org-babel-comint-in-buffer session
(sit-for .5) (goto-char (point-max))
(mapc (lambda (var)
@ -113,6 +95,15 @@ This function is called by `org-babel-execute-src-block'."
;; helper functions
(defun org-babel-variable-assignments:ruby (params)
"Return list of ruby statements assigning the block's variables"
(mapcar
(lambda (pair)
(format "%s=%s"
(car pair)
(org-babel-ruby-var-to-ruby (cdr pair))))
(mapcar #'cdr (org-babel-get-header params :var))))
(defun org-babel-ruby-var-to-ruby (var)
"Convert VAR into a ruby variable.
Convert an elisp value into a string of ruby source code
@ -186,12 +177,13 @@ return the value of the last statement in BODY, as elisp."
;; external process evaluation
(case result-type
(output (org-babel-eval org-babel-ruby-command body))
(value (let ((tmp-file (make-temp-file "org-babel-ruby-results-")))
(org-babel-eval org-babel-ruby-command
(format (if (member "pp" result-params)
org-babel-ruby-pp-wrapper-method
org-babel-ruby-wrapper-method)
body tmp-file))
(value (let ((tmp-file (org-babel-temp-file "ruby-")))
(org-babel-eval
org-babel-ruby-command
(format (if (member "pp" result-params)
org-babel-ruby-pp-wrapper-method
org-babel-ruby-wrapper-method)
body (org-babel-process-file-name tmp-file 'noquote)))
((lambda (raw)
(if (or (member "code" result-params)
(member "pp" result-params))
@ -221,7 +213,7 @@ return the value of the last statement in BODY, as elisp."
(if (or (member "code" result-params) (member "pp" result-params))
results
(org-babel-ruby-table-or-string results)))
(let* ((tmp-file (make-temp-file "org-babel-ruby-results-"))
(let* ((tmp-file (org-babel-temp-file "ruby-"))
(ppp (or (member "code" result-params)
(member "pp" result-params))))
(org-babel-comint-with-output
@ -233,10 +225,12 @@ return the value of the last statement in BODY, as elisp."
(append
(list body)
(if (not ppp)
(list (format org-babel-ruby-f-write tmp-file))
(list (format org-babel-ruby-f-write
(org-babel-process-file-name tmp-file 'noquote)))
(list
"results=_" "require 'pp'" "orig_out = $stdout"
(format org-babel-ruby-pp-f-write tmp-file)))
(format org-babel-ruby-pp-f-write
(org-babel-process-file-name tmp-file 'noquote))))
(list org-babel-ruby-eoe-indicator)))
(comint-send-input nil t))
(org-babel-eval-read-file tmp-file)))))))

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

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
@ -43,20 +43,19 @@
(defvar org-babel-default-header-args:sass '())
(defun org-babel-expand-body:sass (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body." body)
(defun org-babel-execute:sass (body params)
"Execute a block of Sass code with Babel.
This function is called by `org-babel-execute-src-block'."
(let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
(file (cdr (assoc :file params)))
(out-file (or file (make-temp-file "org-babel-sass-out")))
(out-file (or file (org-babel-temp-file "sass-out-")))
(cmdline (cdr (assoc :cmdline params)))
(in-file (make-temp-file "org-babel-sass-in"))
(cmd (concat "sass " (or cmdline "") in-file " " out-file)))
(in-file (org-babel-temp-file "sass-in-"))
(cmd (concat "sass " (or cmdline "")
" " (org-babel-process-file-name in-file)
" " (org-babel-process-file-name out-file))))
(with-temp-file in-file
(insert (org-babel-expand-body:sass body params))) (shell-command cmd)
(insert (org-babel-expand-body:generic body params))) (shell-command cmd)
(or file (with-temp-buffer (insert-file-contents out-file) (buffer-string)))))
(defun org-babel-prep-session:sass (session params)

139
lisp/org/ob-scheme.el Normal file
View file

@ -0,0 +1,139 @@
;;; ob-scheme.el --- org-babel functions for Scheme
;; Copyright (C) 2010 Free Software Foundation
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, scheme
;; Homepage: http://orgmode.org
;; Version: 7.3
;;; 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:
;; 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.
;;; Requirements:
;; - a working scheme implementation
;; (e.g. guile http://www.gnu.org/software/guile/guile.html)
;;
;; - for session based evaluation cmuscheme.el is required which is
;; included in Emacs
;;; Code:
(require 'ob)
(require 'ob-ref)
(require 'ob-comint)
(require 'ob-eval)
(eval-when-compile (require 'cl))
(declare-function run-scheme "ext:cmuscheme" (cmd))
(defvar org-babel-default-header-args:scheme '()
"Default header arguments for scheme code blocks.")
(defvar org-babel-scheme-eoe "org-babel-scheme-eoe"
"String to indicate that evaluation has completed.")
(defcustom org-babel-scheme-cmd "guile"
"Name of command used to evaluate scheme blocks."
:group 'org-babel
:type 'string)
(defun org-babel-expand-body:scheme (body params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
(if (> (length vars) 0)
(concat "(let ("
(mapconcat
(lambda (var) (format "%S" (print `(,(car var) ',(cdr var)))))
vars "\n ")
")\n" body ")")
body)))
(defvar scheme-program-name)
(defun org-babel-execute:scheme (body params)
"Execute a block of Scheme code with org-babel.
This function is called by `org-babel-execute-src-block'"
(let* ((result-type (cdr (assoc :result-type params)))
(org-babel-scheme-cmd (or (cdr (assoc :scheme params))
org-babel-scheme-cmd))
(full-body (org-babel-expand-body:scheme body params)))
(read
(if (not (string= (cdr (assoc :session params)) "none"))
;; session evaluation
(let ((session (org-babel-prep-session:scheme
(cdr (assoc :session params)) params)))
(org-babel-comint-with-output
(session (format "%S" org-babel-scheme-eoe) t body)
(mapc
(lambda (line)
(insert (org-babel-chomp line)) (comint-send-input nil t))
(list body (format "%S" org-babel-scheme-eoe)))))
;; external evaluation
(let ((script-file (org-babel-temp-file "scheme-script-")))
(with-temp-file script-file
(insert
;; return the value or the output
(if (string= result-type "value")
(format "(display %s)" full-body)
full-body)))
(org-babel-eval
(format "%s %s" org-babel-scheme-cmd
(org-babel-process-file-name script-file)) ""))))))
(defun org-babel-prep-session:scheme (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(let* ((session (org-babel-scheme-initiate-session session))
(vars (mapcar #'cdr (org-babel-get-header params :var)))
(var-lines
(mapcar
(lambda (var) (format "%S" (print `(define ,(car var) ',(cdr var)))))
vars)))
(when session
(org-babel-comint-in-buffer session
(sit-for .5) (goto-char (point-max))
(mapc (lambda (var)
(insert var) (comint-send-input nil t)
(org-babel-comint-wait-for-output session)
(sit-for .1) (goto-char (point-max))) var-lines)))
session))
(defun org-babel-scheme-initiate-session (&optional session)
"If there is not a current inferior-process-buffer in SESSION
then create. Return the initialized session."
(require 'cmuscheme)
(unless (string= session "none")
(let ((session-buffer (save-window-excursion
(run-scheme org-babel-scheme-cmd)
(rename-buffer session)
(current-buffer))))
(if (org-babel-comint-buffer-livep session-buffer)
(progn (sit-for .25) session-buffer)
(sit-for .5)
(org-babel-scheme-initiate-session session)))))
(provide 'ob-scheme)
;; arch-tag: 6b2fe76f-4b25-4e87-ad1c-225b2f282a71
;;; ob-scheme.el ends here

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

@ -5,7 +5,7 @@
;; Author: Benjamin Andresen
;; Keywords: literate programming, interactive shell
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
@ -45,28 +45,21 @@ In case you want to use a different screen than one selected by your $PATH")
'((:results . "silent") (:session . "default") (:cmd . "sh") (:terminal . "xterm"))
"Default arguments to use when running screen source blocks.")
(defun org-babel-expand-body:screen (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body." body)
(defun org-babel-execute:screen (body params)
"Send a block of code via screen to a terminal using Babel.
\"default\" session is be used when none is specified."
\"default\" session is used when none is specified."
(message "Sending source code block to interactive terminal session...")
(save-window-excursion
(let* ((processed-params (org-babel-process-params params))
(session (nth 0 processed-params))
(let* ((session (cdr (assoc :session params)))
(socket (org-babel-screen-session-socketname session)))
(unless socket (org-babel-prep-session:screen session params))
(org-babel-screen-session-execute-string
session (org-babel-expand-body:screen body params)))))
session (org-babel-expand-body:generic body params)))))
(defun org-babel-prep-session:screen (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(let* ((processed-params (org-babel-process-params params))
(session (nth 0 processed-params))
(vars (nth 1 processed-params))
(let* ((session (cdr (assoc :session params)))
(socket (org-babel-screen-session-socketname session))
(vars (org-babel-ref-variables params))
(cmd (cdr (assoc :cmd params)))
(terminal (cdr (assoc :terminal params)))
(process-name (concat "org-babel: terminal (" session ")")))

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

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
@ -33,7 +33,10 @@
(require 'shell)
(eval-when-compile (require 'cl))
(declare-function org-babel-ref-variables "ob-ref" (params))
(declare-function org-babel-comint-in-buffer "ob-comint" (buffer &rest body))
(declare-function org-babel-comint-wait-for-output "ob-comint" (buffer))
(declare-function org-babel-comint-buffer-livep "ob-comint" (buffer))
(declare-function org-babel-comint-with-output "ob-comint" (meta &rest body))
(declare-function orgtbl-to-generic "org-table" (table params))
(defvar org-babel-default-header-args:sh '())
@ -42,44 +45,25 @@
"Command used to invoke a shell.
This will be passed to `shell-command-on-region'")
(defun org-babel-expand-body:sh (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (nth 1 (or processed-params (org-babel-process-params params))))
(sep (cdr (assoc :separator params))))
(concat
(mapconcat ;; define any variables
(lambda (pair)
(format "%s=%s"
(car pair)
(org-babel-sh-var-to-sh (cdr pair) sep)))
vars "\n") "\n" body "\n\n")))
(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* ((processed-params (org-babel-process-params params))
(session (org-babel-sh-initiate-session (nth 0 processed-params)))
(result-params (nth 2 processed-params))
(full-body (org-babel-expand-body:sh
body params processed-params)))
(let* ((session (org-babel-sh-initiate-session
(cdr (assoc :session params))))
(result-params (cdr (assoc :result-params 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-pick-name
(nth 4 processed-params) (cdr (assoc :colnames params)))
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
(nth 5 processed-params) (cdr (assoc :rownames params))))))
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
(defun org-babel-prep-session:sh (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(let* ((session (org-babel-sh-initiate-session session))
(vars (org-babel-ref-variables params))
(sep (cdr (assoc :separator params)))
(var-lines (mapcar ;; define any variables
(lambda (pair)
(format "%s=%s"
(car pair)
(org-babel-sh-var-to-sh (cdr pair) sep)))
vars)))
(var-lines (org-babel-variable-assignments:sh params)))
(org-babel-comint-in-buffer session
(mapc (lambda (var)
(insert var) (comint-send-input nil t)
@ -97,6 +81,16 @@ This function is called by `org-babel-execute-src-block'."
;; helper functions
(defun org-babel-variable-assignments:sh (params)
"Return list of shell statements assigning the block's variables"
(let ((sep (cdr (assoc :separator params))))
(mapcar
(lambda (pair)
(format "%s=%s"
(car pair)
(org-babel-sh-var-to-sh (cdr pair) sep)))
(mapcar #'cdr (org-babel-get-header params :var)))))
(defun org-babel-sh-var-to-sh (var &optional sep)
"Convert an elisp value to a shell variable.
Convert an elisp var into a string of shell commands specifying a
@ -108,7 +102,8 @@ var of the same value."
(org-babel-sh-var-to-sh el sep))))
(format "$(cat <<BABEL_TABLE\n%s\nBABEL_TABLE\n)"
(orgtbl-to-generic
(deep-string var) (list :sep (or sep "\t")))))
(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)
@ -148,29 +143,29 @@ If RESULT-TYPE equals 'output then return a list of the outputs
of the statements in BODY, if RESULT-TYPE equals 'value then
return the value of the last statement in BODY."
((lambda (results)
(if (or (member "scalar" result-params)
(member "output" result-params))
results
(let ((tmp-file (make-temp-file "org-babel-sh")))
(with-temp-file tmp-file (insert results))
(org-babel-import-elisp-from-file tmp-file))))
(when results
(if (or (member "scalar" 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))
(let ((tmp-file (make-temp-file "org-babel-sh")))
(mapconcat
#'org-babel-sh-strip-weird-long-prompt
(mapcar
#'org-babel-trim
(butlast
(org-babel-comint-with-output
(session org-babel-sh-eoe-output t body)
(mapc
(lambda (line)
(insert line) (comint-send-input nil t) (sleep-for 0.25))
(append
(split-string (org-babel-trim body) "\n")
(list org-babel-sh-eoe-indicator))))
2)) "\n")))))
(mapconcat
#'org-babel-sh-strip-weird-long-prompt
(mapcar
#'org-babel-trim
(butlast
(org-babel-comint-with-output
(session org-babel-sh-eoe-output t body)
(mapc
(lambda (line)
(insert line) (comint-send-input nil t) (sleep-for 0.25))
(append
(split-string (org-babel-trim body) "\n")
(list org-babel-sh-eoe-indicator))))
2)) "\n"))))
(defun org-babel-sh-strip-weird-long-prompt (string)
"Remove prompt cruft from a string of shell output."

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

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
@ -50,33 +50,37 @@
(defvar org-babel-default-header-args:sql '())
(defun org-babel-expand-body:sql (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body." body)
(defun org-babel-execute:sql (body params)
"Execute a block of Sql code with Babel.
This function is called by `org-babel-execute-src-block'."
(let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
(processed-params (org-babel-process-params params))
(let* ((result-params (cdr (assoc :result-params params)))
(cmdline (cdr (assoc :cmdline params)))
(engine (cdr (assoc :engine params)))
(in-file (make-temp-file "org-babel-sql-in"))
(in-file (org-babel-temp-file "sql-in-"))
(out-file (or (cdr (assoc :out-file params))
(make-temp-file "org-babel-sql-out")))
(org-babel-temp-file "sql-out-")))
(command (case (intern engine)
('mysql (format "mysql %s -e \"source %s\" > %s"
(or cmdline "") in-file out-file))
(or cmdline "")
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)))
('postgresql (format "psql -A -P footer=off -F \"\t\" -f %s -o %s %s"
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)
(or cmdline "")))
(t (error "no support for the %s sql engine" engine)))))
(with-temp-file in-file
(insert (org-babel-expand-body:sql body params)))
(insert (org-babel-expand-body:generic body params)))
(message command)
(shell-command command)
(with-temp-buffer
(org-table-import out-file nil)
(org-babel-reassemble-table
(org-table-to-lisp)
(org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params)))
(org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames 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)))))))
(defun org-babel-prep-session:sql (session params)

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

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
@ -41,9 +41,10 @@
'(db header echo bail csv column html line list separator nullvalue)
"Sqlite specific header args.")
(defun org-babel-expand-body:sqlite (body params &optional processed-params)
(defun org-babel-expand-body:sqlite (body params)
"Expand BODY according to the values of PARAMS."
(org-babel-sqlite-expand-vars
body (or (nth 1 processed-params) (org-babel-ref-variables params))))
body (mapcar #'cdr (org-babel-get-header params :var))))
(defvar org-babel-sqlite3-command "sqlite3")
@ -51,7 +52,7 @@
"Execute a block of Sqlite code with Babel.
This function is called by `org-babel-execute-src-block'."
(let ((result-params (split-string (or (cdr (assoc :results params)) "")))
(vars (org-babel-ref-variables params))
(vars (org-babel-get-header params :var))
(db (cdr (assoc :db params)))
(separator (cdr (assoc :separator params)))
(nullvalue (cdr (assoc :nullvalue params)))
@ -70,10 +71,9 @@ This function is called by `org-babel-execute-src-block'."
(list
(cons "body" ((lambda (sql-file)
(with-temp-file sql-file
(insert (org-babel-expand-body:sqlite
body nil (list nil vars))))
(insert (org-babel-expand-body:sqlite body params)))
sql-file)
(make-temp-file "ob-sqlite-sql")))
(org-babel-temp-file "sqlite-sql-")))
(cons "cmd" org-babel-sqlite3-command)
(cons "header" (if headers-p "-header" "-noheader"))
(cons "separator"
@ -117,8 +117,8 @@ This function is called by `org-babel-execute-src-block'."
el
(format "%S" el)))))))
data-file)
(make-temp-file "ob-sqlite-data"))
(format "%S" val)))
(org-babel-temp-file "sqlite-data-"))
(if (stringp val) val (format "%S" val))))
(cdr pair))
body)))
vars)

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

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
@ -79,13 +79,24 @@ references to source-code blocks, to force interpretation of a
cell's value as a string, prefix the identifier with two \"$\"s
rather than a single \"$\" (i.e. \"$$2\" instead of \"$2\" in the
example above."
(let ((variables (mapcar
(lambda (var)
(if (and (= 3 (length var)) (eq (nth 1 var) '$))
(list (car var) (format "\"%s\"" (last var)))
var))
variables)))
(unless (stringp source-block) (setq source-block (symbol-name source-block)))
(let* (quote
(variables
(mapcar
(lambda (var)
;; ensure that all cells prefixed with $'s are strings
(cons (car var)
(delq nil (mapcar
(lambda (el)
(if (eq '$ el)
(setq quote t)
(prog1 (if quote
(format "\"%s\"" el)
(org-babel-clean-text-properties el))
(setq quote nil))))
(cdr var)))))
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
(if (and source-block (> (length source-block) 0))
(let ((params
@ -93,13 +104,18 @@ example above."
(concat ":var results="
,source-block
"("
(mapconcat (lambda (var-spec)
(format "%S=%s" (nth 0 var-spec) (nth 1 var-spec)))
',variables ", ")
(mapconcat
(lambda (var-spec)
(if (> (length (cdr var-spec)) 1)
(format "%S='%S"
(car var-spec)
(mapcar #'read (cdr var-spec)))
(format "%S=%s"
(car var-spec) (cadr var-spec))))
',variables ", ")
")")))))
(org-babel-execute-src-block
nil (list "emacs-lisp" "results"
(org-babel-merge-params '((:results . "silent")) params))))
nil (list "emacs-lisp" "results" params) '((:results . "silent"))))
""))))
(provide 'ob-table)

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

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
@ -34,7 +34,11 @@
(declare-function org-link-escape "org" (text &optional table))
(declare-function org-heading-components "org" ())
(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))
;;;###autoload
(defcustom org-babel-tangle-lang-exts
'(("emacs-lisp" . "el"))
"Alist mapping languages to their file extensions.
@ -53,18 +57,66 @@ then the name of the language is used."
:group 'org-babel
:type 'hook)
(defcustom org-babel-pre-tangle-hook '(save-buffer)
"Hook run at the beginning of `org-babel-tangle'."
:group 'org-babel
:type 'hook)
(defcustom org-babel-tangle-pad-newline t
"Switch indicating whether to pad tangled code with newlines."
:group 'org-babel
:type 'boolean)
(defcustom org-babel-tangle-comment-format-beg "[[%link][%source-name]]"
"Format of inserted comments in tangled code files.
The following format strings can be used to insert special
information into the output using `org-fill-template'.
%start-line --- the line number at the start of the code block
%file --------- the file from which the code block was tangled
%link --------- Org-mode style link to the code block
%source-name -- name of the code block
Whether or not comments are inserted during tangling is
controlled by the :comments header argument."
:group 'org-babel
:type 'string)
(defcustom org-babel-tangle-comment-format-end "%source-name ends here"
"Format of inserted comments in tangled code files.
The following format strings can be used to insert special
information into the output using `org-fill-template'.
%start-line --- the line number at the start of the code block
%file --------- the file from which the code block was tangled
%link --------- Org-mode style link to the code block
%source-name -- name of the code block
Whether or not comments are inserted during tangling is
controlled by the :comments header argument."
:group 'org-babel
:type 'string)
(defun org-babel-find-file-noselect-refresh (file)
"Find file ensuring that the latest changes on disk are
represented in the file."
(find-file-noselect file)
(with-current-buffer (get-file-buffer file)
(revert-buffer t t t)))
(defmacro org-babel-with-temp-filebuffer (file &rest body)
"Open FILE into a temporary buffer execute BODY there like
`progn', then kill the FILE buffer returning the result of
evaluating BODY."
(declare (indent 1))
(let ((temp-result (make-symbol "temp-result"))
(temp-file (make-symbol "temp-file")))
`(let (,temp-result ,temp-file)
(find-file ,file)
(setf ,temp-file (current-buffer))
(setf ,temp-result (progn ,@body))
(kill-buffer ,temp-file)
(temp-file (make-symbol "temp-file"))
(visited-p (make-symbol "visited-p")))
`(let (,temp-result ,temp-file
(,visited-p (get-file-buffer ,file)))
(org-babel-find-file-noselect-refresh ,file)
(setf ,temp-file (get-file-buffer ,file))
(with-current-buffer ,temp-file
(setf ,temp-result (progn ,@body)))
(unless ,visited-p (kill-buffer ,temp-file))
,temp-result)))
;;;###autoload
@ -117,7 +169,7 @@ 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)
(save-buffer)
(run-hooks 'org-babel-pre-tangle-hook)
(save-excursion
(let ((block-counter 0)
(org-babel-default-header-args
@ -142,7 +194,7 @@ exported source code blocks by language."
(mapc
(lambda (spec)
(flet ((get-spec (name)
(cdr (assoc name (nth 2 spec)))))
(cdr (assoc name (nth 4 spec)))))
(let* ((tangle (get-spec :tangle))
(she-bang ((lambda (sheb) (when (> (length sheb) 0) sheb))
(get-spec :shebang)))
@ -177,14 +229,15 @@ exported source code blocks by language."
(insert content)
(write-region nil nil file-name))))
;; if files contain she-bangs, then make the executable
(when she-bang (set-file-modes file-name ?\755))
(when she-bang (set-file-modes file-name #o755))
;; update counter
(setq block-counter (+ 1 block-counter))
(add-to-list 'path-collector file-name)))))
specs)))
(org-babel-tangle-collect-blocks lang))
(message "tangled %d code block%s" block-counter
(if (= block-counter 1) "" "s"))
(message "tangled %d code block%s from %s" block-counter
(if (= block-counter 1) "" "s")
(file-name-nondirectory (buffer-file-name (current-buffer))))
;; run `org-babel-post-tangle-hook' in all tangled files
(when org-babel-post-tangle-hook
(mapc
@ -209,7 +262,7 @@ references."
(save-excursion (end-of-line 1) (forward-char 1) (point)))))
(defvar org-stored-links)
(defun org-babel-tangle-collect-blocks (&optional lang)
(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
the form used by `org-babel-spec-to-string' grouped by language.
@ -224,44 +277,69 @@ code blocks by language."
(setq current-heading new-heading))
(setq block-counter (+ 1 block-counter))))
(replace-regexp-in-string "[ \t]" "-"
(nth 4 (org-heading-components))))
(let* ((link (progn (call-interactively 'org-store-link)
(org-babel-clean-text-properties
(car (pop org-stored-links)))))
(info (org-babel-get-src-block-info))
(source-name (intern (or (nth 4 info)
(format "%s:%d"
current-heading block-counter))))
(src-lang (nth 0 info))
(expand-cmd (intern (concat "org-babel-expand-body:" src-lang)))
(params (nth 2 info))
by-lang)
(unless (string= (cdr (assoc :tangle params)) "no") ;; skip
(unless (and lang (not (string= lang src-lang))) ;; limit by language
;; add the spec for this block to blocks under it's language
(setq by-lang (cdr (assoc src-lang blocks)))
(setq blocks (delq (assoc src-lang blocks) blocks))
(setq blocks
(cons
(cons src-lang
(cons (list link source-name params
((lambda (body)
(if (assoc :no-expand params)
body
(funcall
(if (fboundp expand-cmd)
expand-cmd
'org-babel-expand-body:generic)
body
params)))
(if (and (cdr (assoc :noweb params))
(string=
"yes"
(cdr (assoc :noweb params))))
(org-babel-expand-noweb-references
info)
(nth 1 info))))
by-lang)) blocks))))))
(condition-case nil
(nth 4 (org-heading-components))
(error (buffer-file-name)))))
(let* ((start-line (save-restriction (widen)
(+ 1 (line-number-at-pos (point)))))
(file (buffer-file-name))
(info (org-babel-get-src-block-info 'light))
(src-lang (nth 0 info)))
(unless (string= (cdr (assoc :tangle (nth 2 info))) "no")
(unless (and language (not (string= language src-lang)))
(let* ((info (org-babel-get-src-block-info))
(params (nth 2 info))
(link (progn (call-interactively 'org-store-link)
(org-babel-clean-text-properties
(car (pop org-stored-links)))))
(source-name
(intern (or (nth 4 info)
(format "%s:%d"
current-heading block-counter))))
(expand-cmd
(intern (concat "org-babel-expand-body:" src-lang)))
(assignments-cmd
(intern (concat "org-babel-variable-assignments:" src-lang)))
(body
((lambda (body)
(if (assoc :no-expand params)
body
(if (fboundp expand-cmd)
(funcall expand-cmd body params)
(org-babel-expand-body:generic
body params
(and (fboundp assignments-cmd)
(funcall assignments-cmd params))))))
(if (and (cdr (assoc :noweb params))
(let ((nowebs (split-string
(cdr (assoc :noweb params)))))
(or (member "yes" nowebs)
(member "tangle" nowebs))))
(org-babel-expand-noweb-references info)
(nth 1 info))))
(comment
(when (or (string= "both" (cdr (assoc :comments params)))
(string= "org" (cdr (assoc :comments params))))
;; from the previous heading or code-block end
(buffer-substring
(max (condition-case nil
(save-excursion
(org-back-to-heading t) (point))
(error 0))
(save-excursion
(re-search-backward
org-babel-src-block-regexp nil t)
(match-end 0)))
(point))))
by-lang)
;; add the spec for this block to blocks under it's language
(setq by-lang (cdr (assoc src-lang blocks)))
(setq blocks (delq (assoc src-lang blocks) blocks))
(setq blocks (cons
(cons src-lang
(cons (list start-line file link
source-name params body comment)
by-lang)) blocks)))))))
;; ensure blocks in the correct order
(setq blocks
(mapcar
@ -276,22 +354,97 @@ source code file. This function uses `comment-region' which
assumes that the appropriate major-mode is set. SPEC has the
form
(link source-name params body)"
(let ((link (nth 0 spec))
(source-name (nth 1 spec))
(body (nth 3 spec))
(commentable (string= (cdr (assoc :comments (nth 2 spec))) "yes")))
(start-line file link source-name params body comment)"
(let* ((start-line (nth 0 spec))
(file (nth 1 spec))
(link (org-link-escape (nth 2 spec)))
(source-name (nth 3 spec))
(body (nth 5 spec))
(comment (nth 6 spec))
(comments (cdr (assoc :comments (nth 4 spec))))
(link-p (or (string= comments "both") (string= comments "link")
(string= comments "yes")))
(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))))
(flet ((insert-comment (text)
(when commentable
(insert "\n")
(comment-region (point)
(progn (insert text) (point)))
(end-of-line nil)
(insert "\n"))))
(insert-comment (format "[[%s][%s]]" (org-link-escape link) source-name))
(insert (format "\n%s\n" (replace-regexp-in-string
"^," "" (org-babel-chomp body))))
(insert-comment (format "%s ends here" source-name)))))
(let ((text (org-babel-trim text)))
(when (and comments (not (string= comments "no"))
(> (length text) 0))
(when org-babel-tangle-pad-newline (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"))
(insert
(format
"%s\n"
(replace-regexp-in-string
"^," ""
(org-babel-trim body (if org-src-preserve-indentation "[\f\n\r\v]")))))
(when link-p
(insert-comment
(org-fill-template org-babel-tangle-comment-format-end link-data))))))
;; detangling 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.
This requires that code blocks were tangled with link comments
which enable the original code blocks to be found."
(interactive)
(save-excursion
(when source-code-file (find-file source-code-file))
(goto-char (point-min))
(let ((counter 0) new-body end)
(while (re-search-forward org-bracket-link-analytic-regexp nil t)
(when (re-search-forward
(concat " " (regexp-quote (match-string 5)) " ends here"))
(setq end (match-end 0))
(forward-line -1)
(save-excursion
(when (setq new-body (org-babel-tangle-jump-to-org))
(org-babel-update-block-body new-body)))
(setq counter (+ 1 counter)))
(goto-char end))
(prog1 counter (message "detangled %d code blocks" counter)))))
(defun org-babel-tangle-jump-to-org ()
"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)
(save-window-excursion
(save-excursion
(unless (and (re-search-backward org-bracket-link-analytic-regexp nil t)
(setq start (point-at-eol))
(setq link (match-string 0))
(setq path (match-string 3))
(setq block-name (match-string 5))
(re-search-forward
(concat " " (regexp-quote block-name) " ends here") nil t)
(setq end (point-at-bol))
(< start mid) (< mid end))
(error "not in tangled code"))
(setq body (org-babel-trim (buffer-substring start end))))
(when (string-match "::" path)
(setq path (substring path 0 (match-beginning 0))))
(find-file path) (setq target-buffer (current-buffer))
(goto-char start) (org-open-link-from-string link)
(if (string-match "[^ \t\n\r]:\\([[:digit:]]+\\)" block-name)
(org-babel-next-src-block
(string-to-number (match-string 1 block-name)))
(org-babel-goto-named-src-block block-name))
(setq target-char (point)))
(pop-to-buffer target-buffer)
(prog1 body (goto-char target-char))))
(provide 'ob-tangle)

989
lisp/org/ob.el
View file

File diff suppressed because it is too large Load diff

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

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;
@ -62,6 +62,7 @@
(declare-function org-habit-parse-todo "org-habit" (&optional pom))
(declare-function org-habit-get-priority "org-habit" (habit &optional moment))
(defvar calendar-mode-map)
(defvar org-clock-current-task) ; defined in org-clock.el
(defvar org-mobile-force-id-on-agenda-items) ; defined in org-mobile.el
(defvar org-habit-show-habits)
(defvar org-habit-show-habits-only-for-today)
@ -749,6 +750,22 @@ N days, just insert a special line indicating the size of the gap."
:tag "Org Agenda Startup"
:group 'org-agenda)
(defcustom org-agenda-menu-show-matcher t
"Non-nil menas show the match string in the agenda dispatcher menu.
When nil, the matcher string is not shown, but is put into the help-echo
property so than moving the mouse over the command shows it.
Setting it to nil is good if matcher strings are very long and/or if
you wnat to use two-column display (see `org-agenda-menu-two-column')."
:group 'org-agenda
:type 'boolean)
(defcustom org-agenda-menu-two-column nil
"Non-nil means, use two columns to show custom commands in the dispatcher.
If you use this, you probably want to set `org-agenda-menu-show-matcher'
to nil."
:group 'org-agenda
:type 'boolean)
(defcustom org-finalize-agenda-hook nil
"Hook run just before displaying an agenda buffer."
:group 'org-agenda-startup
@ -1359,7 +1376,7 @@ When non-nil, this must be the number of minutes, e.g. 60 for one hour."
"Regular expression used to filter away specific tags in agenda views.
This means that these tags will be present, but not be shown in the agenda
line. Secondary filtering will still work on the hidden tags.
The value nil means don't hide any tags."
Nil means don't hide any tags."
:group 'org-agenda-line-format
:type '(choice
(const :tag "Hide none" nil)
@ -1471,6 +1488,18 @@ the lower-case version of all tags."
(require 'cl))
(require 'org)
(defmacro org-agenda-with-point-at-orig-entry (string &rest body)
"Execute BODY with point at location given by `org-hd-marker' property.
If STRING is non-nil, the text property will be fetched from position 0
in that string. If STRING is nil, it will be fetched from the beginning
of the current line."
`(let ((marker (get-text-property (if string 0 (point-at-bol))
'org-hd-marker string)))
(with-current-buffer (marker-buffer marker)
(save-excursion
(goto-char marker)
,@body))))
(defun org-add-agenda-custom-command (entry)
"Replace or add a command in `org-agenda-custom-commands'.
This is mostly for hacking and trying a new command - once the command
@ -1651,7 +1680,7 @@ The following commands are available:
(org-defkey org-agenda-mode-map "\C-c\C-x\C-x" 'org-agenda-clock-cancel)
(org-defkey org-agenda-mode-map "X" 'org-agenda-clock-cancel)
(org-defkey org-agenda-mode-map "\C-c\C-x\C-j" 'org-clock-goto)
(org-defkey org-agenda-mode-map "J" 'org-clock-goto)
(org-defkey org-agenda-mode-map "J" 'org-agenda-clock-goto)
(org-defkey org-agenda-mode-map "+" 'org-agenda-priority-up)
(org-defkey org-agenda-mode-map "-" 'org-agenda-priority-down)
(org-defkey org-agenda-mode-map [(shift up)] 'org-agenda-priority-up)
@ -2073,7 +2102,8 @@ Pressing `<' twice means to restrict to the current subtree or region
(custom org-agenda-custom-commands)
(selstring "")
restriction second-time
c entry key type match prefixes rmheader header-end custom1 desc)
c entry key type match prefixes rmheader header-end custom1 desc
line lines left right n n1)
(save-window-excursion
(delete-other-windows)
(org-switch-to-buffer-other-window " *Agenda Commands*")
@ -2111,56 +2141,91 @@ s Search for keywords C Configure custom agenda commands
(move-marker header-end (match-end 0)))
(goto-char header-end)
(delete-region (point) (point-max))
;; Produce all the lines that describe custom commands and prefixes
(setq lines nil)
(while (setq entry (pop custom1))
(setq key (car entry) desc (nth 1 entry)
type (nth 2 entry)
match (nth 3 entry))
(if (> (length key) 1)
(add-to-list 'prefixes (string-to-char key))
(insert
(format
"\n%-4s%-14s: %s"
(org-add-props (copy-sequence key)
'(face bold))
(cond
((string-match "\\S-" desc) desc)
((eq type 'agenda) "Agenda for current week or day")
((eq type 'alltodo) "List of all TODO entries")
((eq type 'search) "Word search")
((eq type 'stuck) "List of stuck projects")
((eq type 'todo) "TODO keyword")
((eq type 'tags) "Tags query")
((eq type 'tags-todo) "Tags (TODO)")
((eq type 'tags-tree) "Tags tree")
((eq type 'todo-tree) "TODO kwd tree")
((eq type 'occur-tree) "Occur tree")
((functionp type) (if (symbolp type)
(symbol-name type)
"Lambda expression"))
(t "???"))
(cond
((stringp match)
(setq match (copy-sequence match))
(org-add-props match nil 'face 'org-warning))
(match
(format "set of %d commands" (length match)))
(t ""))))))
(setq line
(format
"%-4s%-14s"
(org-add-props (copy-sequence key)
'(face bold))
(cond
((string-match "\\S-" desc) desc)
((eq type 'agenda) "Agenda for current week or day")
((eq type 'alltodo) "List of all TODO entries")
((eq type 'search) "Word search")
((eq type 'stuck) "List of stuck projects")
((eq type 'todo) "TODO keyword")
((eq type 'tags) "Tags query")
((eq type 'tags-todo) "Tags (TODO)")
((eq type 'tags-tree) "Tags tree")
((eq type 'todo-tree) "TODO kwd tree")
((eq type 'occur-tree) "Occur tree")
((functionp type) (if (symbolp type)
(symbol-name type)
"Lambda expression"))
(t "???"))))
(if org-agenda-menu-show-matcher
(setq line
(concat line ": "
(cond
((stringp match)
(setq match (copy-sequence match))
(org-add-props match nil 'face 'org-warning))
(match
(format "set of %d commands" (length match)))
(t ""))))
(if (org-string-nw-p match)
(add-text-properties
0 (length line) (list 'help-echo
(concat "Matcher: "match)) line)))
(push line lines)))
(setq lines (nreverse lines))
(when prefixes
(mapc (lambda (x)
(insert
(format "\n%s %s"
(push
(format "%s %s"
(org-add-props (char-to-string x)
nil 'face 'bold)
(or (cdr (assoc (concat selstring (char-to-string x))
nil 'face 'bold)
(or (cdr (assoc (concat selstring
(char-to-string x))
prefix-descriptions))
"Prefix key"))))
"Prefix key"))
lines))
prefixes))
;; Check if we should display in two columns
(if org-agenda-menu-two-column
(progn
(setq n (length lines)
n1 (+ (/ n 2) (mod n 2))
right (nthcdr n1 lines)
left (copy-sequence lines))
(setcdr (nthcdr (1- n1) left) nil))
(setq left lines right nil))
(while left
(insert "\n" (pop left))
(when right
(if (< (current-column) 40)
(move-to-column 40 t)
(insert " "))
(insert (pop right))))
;; Make the window the right size
(goto-char (point-min))
(if second-time
(if (not (pos-visible-in-window-p (point-max)))
(org-fit-window-to-buffer))
(setq second-time t)
(org-fit-window-to-buffer))
;; Ask for selection
(message "Press key for agenda command%s:"
(if (or restrict-ok org-agenda-overriding-restriction)
(if org-agenda-overriding-restriction
@ -2450,16 +2515,15 @@ higher priority settings."
(interactive "FWrite agenda to file: \nP")
(if (not (file-writable-p file))
(error "Cannot write agenda to file %s" file))
(cond
((string-match "\\.html?\\'" file) (require 'htmlize))
((string-match "\\.ps\\'" file) (require 'ps-print)))
(org-let (if nosettings nil org-agenda-exporter-settings)
`(save-excursion
'(save-excursion
(save-window-excursion
(org-agenda-mark-filtered-text)
(let ((bs (copy-sequence (buffer-string))) beg)
(org-agenda-unmark-filtered-text)
(with-temp-buffer
(rename-buffer "Agenda View" t)
(set-buffer-modified-p nil)
(insert bs)
(org-agenda-remove-marked-text 'org-filtered)
(while (setq beg (text-property-any (point-min) (point-max)
@ -2472,6 +2536,7 @@ higher priority settings."
((org-bound-and-true-p org-mobile-creating-agendas)
(org-mobile-write-agenda-for-mobile file))
((string-match "\\.html?\\'" file)
(require 'htmlize)
(set-buffer (htmlize-buffer (current-buffer)))
(when (and org-agenda-export-html-style
@ -2486,18 +2551,17 @@ higher priority settings."
(message "HTML written to %s" file))
((string-match "\\.ps\\'" file)
(require 'ps-print)
,(flet ((ps-get-buffer-name () "Agenda View"))
(ps-print-buffer-with-faces file))
(ps-print-buffer-with-faces file)
(message "Postscript written to %s" file))
((string-match "\\.pdf\\'" file)
(require 'ps-print)
,(flet ((ps-get-buffer-name () "Agenda View"))
(ps-print-buffer-with-faces
(concat (file-name-sans-extension file) ".ps")))
(ps-print-buffer-with-faces
(concat (file-name-sans-extension file) ".ps"))
(call-process "ps2pdf" nil nil nil
(expand-file-name
(concat (file-name-sans-extension file) ".ps"))
(expand-file-name file))
(delete-file (concat (file-name-sans-extension file) ".ps"))
(message "PDF written to %s" file))
((string-match "\\.ics\\'" file)
(require 'org-icalendar)
@ -2563,7 +2627,9 @@ Drawers will be excluded, also the line with scheduling/deadline info."
(setq txt (org-agenda-get-some-entry-text
m org-agenda-add-entry-text-maxlines " > "))
(end-of-line 1)
(if (string-match "\\S-" txt) (insert "\n" txt)))))))
(if (string-match "\\S-" txt)
(insert "\n" txt)
(or (eobp) (forward-char 1))))))))
(defun org-agenda-get-some-entry-text (marker n-lines &optional indent
&rest keep)
@ -2717,7 +2783,10 @@ removed from the entry content. Currently only `planning' is allowed here."
This must be a list of strings, each string must be a single tag preceded
by \"+\" or \"-\".
This variable should not be set directly, but agenda custom commands can
bind it in the options section.")
bind it in the options section. The preset filter is a global property of
the entire agenda view. In a block agenda, it will not work reliably to
define a filter for one of the individual blocks. You need to set it in
the global options and expect it to be applied to the entire view.")
(defun org-prepare-agenda (&optional name)
(setq org-todo-keywords-for-agenda nil)
@ -2760,7 +2829,11 @@ bind it in the options section.")
(switch-to-buffer-other-frame abuf))
((equal org-agenda-window-setup 'reorganize-frame)
(delete-other-windows)
(org-switch-to-buffer-other-window abuf))))
(org-switch-to-buffer-other-window abuf)))
;; additional test in case agenda is invoked from within agenda
;; buffer via elisp link
(unless (equal (current-buffer) abuf)
(switch-to-buffer abuf)))
(setq buffer-read-only nil)
(let ((inhibit-read-only t)) (erase-buffer))
(org-agenda-mode)
@ -3009,7 +3082,8 @@ dates."
(let* ((dopast t)
(dotodo include-all)
(doclosed org-agenda-show-log)
(entry buffer-file-name)
(entry (buffer-file-name (or (buffer-base-buffer (current-buffer))
(current-buffer))))
(date (calendar-current-date))
(beg (if (org-region-active-p) (region-beginning) (point-min)))
(end (if (org-region-active-p) (region-end) (point-max)))
@ -3031,8 +3105,7 @@ dates."
(setq day-numbers (delq nil (mapcar (lambda(x)
(if (>= x today) x nil))
day-numbers))))
(org-prepare-agenda (concat "Timeline "
(file-name-nondirectory buffer-file-name)))
(org-prepare-agenda (concat "Timeline " (file-name-nondirectory entry)))
(if doclosed (push :closed args))
(push :timestamp args)
(push :deadline args)
@ -3483,6 +3556,20 @@ in `org-agenda-text-search-extra-files'."
(member (string-to-char words) '(?- ?+ ?\{)))
(setq boolean t))
(setq words (org-split-string words))
(let (www w)
(while (setq w (pop words))
(while (and (string-match "\\\\\\'" w) words)
(setq w (concat (substring w 0 -1) " " (pop words))))
(push w www))
(setq words (nreverse www) www nil)
(while (setq w (pop words))
(when (and (string-match "\\`[-+]?{" w)
(not (string-match "}\\'" w)))
(while (and words (not (string-match "}\\'" (car words))))
(setq w (concat w " " (pop words))))
(setq w (concat w " " (pop words))))
(push w www))
(setq words (nreverse www)))
(setq org-agenda-last-search-view-search-was-boolean boolean)
(when boolean
(let (wds w)
@ -3933,8 +4020,7 @@ The remainder is either a list of TODO keywords, or a state symbol
"Create agenda view for projects that are stuck.
Stuck projects are project that have no next actions. For the definitions
of what a project is and how to check if it stuck, customize the variable
`org-stuck-projects'.
MATCH is being ignored."
`org-stuck-projects'."
(interactive)
(let* ((org-agenda-skip-function
'org-agenda-skip-entry-when-regexp-matches-in-subtree)
@ -3956,11 +4042,11 @@ MATCH is being ignored."
"\\)\\>"))
(tags (nth 2 org-stuck-projects))
(tags-re (if (member "*" tags)
(org-re "^\\*+ .*:[[:alnum:]_@]+:[ \t]*$")
(org-re "^\\*+ .*:[[:alnum:]_@#%]+:[ \t]*$")
(if tags
(concat "^\\*+ .*:\\("
(mapconcat 'identity tags "\\|")
(org-re "\\):[[:alnum:]_@:]*[ \t]*$")))))
(org-re "\\):[[:alnum:]_@#%:]*[ \t]*$")))))
(gen-re (nth 3 org-stuck-projects))
(re-list
(delq nil
@ -4413,17 +4499,20 @@ the documentation of `org-diary'."
category (org-get-category beg)
todo-state (org-get-todo-state))
(if (string-match "\\S-" result)
(setq txt result)
(setq txt "SEXP entry returned empty string"))
(dolist (r (if (stringp result)
(list result)
result)) ;; we expect a list here
(if (string-match "\\S-" r)
(setq txt r)
(setq txt "SEXP entry returned empty string"))
(setq txt (org-format-agenda-item
"" txt category tags 'time))
(org-add-props txt props 'org-marker marker)
(org-add-props txt nil
'org-category category 'date date 'todo-state todo-state
'type "sexp")
(push txt ee))))
(setq txt (org-format-agenda-item
"" txt category tags 'time))
(org-add-props txt props 'org-marker marker)
(org-add-props txt nil
'org-category category 'date date 'todo-state todo-state
'type "sexp")
(push txt ee)))))
(nreverse ee)))
(defun org-diary-class (m1 d1 y1 m2 d2 y2 dayname &rest skip-weeks)
@ -4919,7 +5008,7 @@ Any match of REMOVE-RE will be removed from TXT."
(setq h (/ m 60) m (- m (* h 60)))
(setq s2 (format "%02d:%02d" h m))))
(when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$")
(when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")
txt)
;; Tags are in the string
(if (or (eq org-agenda-remove-tags t)
@ -4993,7 +5082,7 @@ Any match of REMOVE-RE will be removed from TXT."
The modified list may contain inherited tags, and tags matched by
`org-agenda-hide-tags-regexp' will be removed."
(when (or add-inherited hide-re)
(if (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$") txt)
(if (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") txt)
(setq txt (substring txt 0 (match-beginning 0))))
(setq tags
(delq nil
@ -5049,13 +5138,13 @@ The modified list may contain inherited tags, and tags matched by
(throw 'exit list))
(while (setq time (pop gridtimes))
(unless (and remove (member time have))
(setq time (int-to-string time))
(setq time (replace-regexp-in-string " " "0" (format "%04s" time)))
(push (org-format-agenda-item
nil string "" nil
(concat (substring time 0 -2) ":" (substring time -2)))
new)
(put-text-property
1 (length (car new)) 'face 'org-time-grid (car new))))
2 (length (car new)) 'face 'org-time-grid (car new))))
(if (member 'time-up org-agenda-sorting-strategy-selected)
(append new list)
(append list new)))))
@ -5142,11 +5231,33 @@ HH:MM."
(int-to-string t0))))
(if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0)))))
(defvar org-agenda-before-sorting-filter-function nil
"Function to be applied to agenda items prior to sorting.
Prior to sorting also means just before they are inserted into the agenda.
To aid sorting, you may revisit the original entries and add more text
properties which will later be used by the sorting functions.
The function should take a string argument, an agenda line.
It has access to the text properties in that line, which contain among
other things, the property `org-hd-marker' that points to the entry
where the line comes from. Note that not all lines going into the agenda
have this property, only most.
The function should return the modified string. It is probably best
to ONLY change text properties.
You can also use this function as a filter, by returning nil for lines
you don't want to have in the agenda at all. For this application, you
could bind the variable in the options section of a custom command.")
(defun org-finalize-agenda-entries (list &optional nosort)
"Sort and concatenate the agenda items."
(setq list (mapcar 'org-agenda-highlight-todo list))
(if nosort
list
(when org-agenda-before-sorting-filter-function
(setq list (delq nil (mapcar org-agenda-before-sorting-filter-function list))))
(mapconcat 'identity (sort list 'org-entries-lessp) "\n")))
(defun org-agenda-highlight-todo (x)
@ -5312,8 +5423,9 @@ HH:MM."
(alpha-up (and (org-em 'alpha-up 'alpha-down ss)
(org-cmp-alpha a b)))
(alpha-down (if alpha-up (- alpha-up) nil))
(need-user-cmp (org-em 'user-defined-up 'user-defined-down ss))
user-defined-up user-defined-down)
(if (and org-agenda-cmp-user-defined
(if (and need-user-cmp org-agenda-cmp-user-defined
(functionp org-agenda-cmp-user-defined))
(setq user-defined-up
(funcall org-agenda-cmp-user-defined a b)
@ -5635,7 +5747,9 @@ If the line does not have an effort defined, return nil."
(if (not (eval org-agenda-filter-form))
(org-agenda-filter-by-tag-hide-line))
(beginning-of-line 2))
(beginning-of-line 2))))))
(beginning-of-line 2))))
(if (get-char-property (point) 'invisible)
(org-agenda-previous-line))))
(defun org-agenda-filter-by-tag-hide-line ()
(let (ov)
@ -5712,7 +5826,9 @@ Negative selection means regexp must not match for selection of an entry."
(defun org-agenda-goto-date (date)
"Jump to DATE in agenda."
(interactive (list (org-read-date)))
(interactive (list (let ((org-read-date-prefer-future
(eval org-agenda-jump-prefer-future)))
(org-read-date))))
(org-agenda-list nil date))
(defun org-agenda-goto-today ()
@ -6636,7 +6752,7 @@ If FORCE-TAGS is non nil, the car of it returns the new tags."
(let ((inhibit-read-only t) l c)
(save-excursion
(goto-char (if line (point-at-bol) (point-min)))
(while (re-search-forward (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$")
(while (re-search-forward (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")
(if line (point-at-eol) nil) t)
(add-text-properties
(match-beginning 2) (match-end 2)
@ -7059,9 +7175,9 @@ The cursor may be at a date in the calendar, or in the Org agenda."
(setq newhead (org-get-heading)))
(org-agenda-change-all-lines newhead hdmarker)))))
(defun org-agenda-clock-out (&optional arg)
(defun org-agenda-clock-out ()
"Stop the currently running clock."
(interactive "P")
(interactive)
(unless (marker-buffer org-clock-marker)
(error "No running clock"))
(let ((marker (make-marker)) newhead)
@ -7086,6 +7202,23 @@ The cursor may be at a date in the calendar, or in the Org agenda."
(org-with-remote-undo (marker-buffer org-clock-marker)
(org-clock-cancel)))
(defun org-agenda-clock-goto ()
"Jump to the currently clocked in task within the agenda.
If the currently clocked in task is not listed in the agenda
buffer, display it in another window."
(interactive)
(let (pos)
(mapc (lambda (o)
(if (eq (overlay-get o 'type) 'org-agenda-clocking)
(setq pos (overlay-start o))))
(overlays-in (point-min) (point-max)))
(cond (pos (goto-char pos))
;; If the currently clocked entry is not in the agenda
;; buffer, we visit it in another window:
(org-clock-current-task
(org-switch-to-buffer-other-window (org-clock-goto)))
(t (message "No running clock, use `C-c C-x C-j' to jump to the most recent one")))))
(defun org-agenda-diary-entry-in-org-file ()
"Make a diary entry in the file `org-agenda-diary-file'."
(let (d1 d2 char (text "") dp1 dp2)
@ -7171,7 +7304,8 @@ the resulting entry will not be shown. When TEXT is empty, switch to
(let ((calendar-date-display-form
(if (if (boundp 'calendar-date-style)
(eq calendar-date-style 'european)
(org-bound-and-true-p european-calendar-style)) ; Emacs 22
(with-no-warnings ;; european-calendar-style is obsolete as of version 23.1
(org-bound-and-true-p european-calendar-style))) ; Emacs 22
'(day " " month " " year)
'(month " " day " " year))))

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

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;
@ -115,7 +115,7 @@ information."
((or (re-search-backward re nil t)
(re-search-forward re nil t))
(match-string 1))
(t org-archive-location (match-string 1)))))))
(t org-archive-location))))))
(defun org-add-archive-files (files)
"Splice the archive files into the list of files.
@ -268,7 +268,7 @@ this heading."
(progn
(if (re-search-forward
(concat "^" (regexp-quote heading)
(org-re "[ \t]*\\(:[[:alnum:]_@:]+:\\)?[ \t]*\\($\\|\r\\)"))
(org-re "[ \t]*\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\($\\|\r\\)"))
nil t)
(goto-char (match-end 0))
;; Heading not found, just insert it at the end

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

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;
@ -311,7 +311,7 @@ publishing directory."
:add-text (plist-get opt-plist :text))
"\n"))
thetoc have-headings first-heading-pos
table-open table-buffer link-buffer link desc desc0 rpl wrap)
table-open table-buffer link-buffer link type path desc desc0 rpl wrap fnc)
(let ((inhibit-read-only t))
(org-unmodified
(remove-text-properties (point-min) (point-max)
@ -347,7 +347,7 @@ publishing directory."
(if (and (or author email)
org-export-author-info)
(insert(concat (nth 1 lang-words) ": " (or author "")
(insert (concat (nth 1 lang-words) ": " (or author "")
(if (and org-export-email-info
email (string-match "\\S-" email))
(concat " <" email ">") "")
@ -400,7 +400,7 @@ publishing directory."
(if (and (memq org-export-with-tags '(not-in-toc nil))
(string-match
(org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$")
(org-re "[ \t]+:[[:alnum:]_@#%:]+:[ \t]*$")
txt))
(setq txt (replace-match "" t t txt)))
(if (string-match quote-re0 txt)
@ -431,10 +431,12 @@ publishing directory."
;; Remove the quoted HTML tags.
(setq line (org-html-expand-for-ascii line))
;; Replace links with the description when possible
(while (string-match org-bracket-link-regexp line)
(setq link (match-string 1 line)
desc0 (match-string 3 line)
desc (or desc0 (match-string 1 line)))
(while (string-match org-bracket-link-analytic-regexp++ line)
(setq path (match-string 3 line)
link (concat (match-string 1 line) path)
type (match-string 2 line)
desc0 (match-string 5 line)
desc (or desc0 link))
(if (and (> (length link) 8)
(equal (substring link 0 8) "coderef:"))
(setq line (replace-match
@ -443,15 +445,18 @@ publishing directory."
(substring link 8)
org-export-code-refs)))
t t line))
(setq rpl (concat "["
(or (match-string 3 line) (match-string 1 line))
"]"))
(when (and desc0 (not (equal desc0 link)))
(if org-export-ascii-links-to-notes
(push (cons desc0 link) link-buffer)
(setq rpl (concat rpl " (" link ")")
wrap (+ (length line) (- (length (match-string 0 line)))
(length desc)))))
(setq rpl (concat "[" desc "]"))
(if (functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
(setq rpl (or (save-match-data
(funcall fnc (org-link-unescape path)
desc0 'ascii))
rpl))
(when (and desc0 (not (equal desc0 link)))
(if org-export-ascii-links-to-notes
(push (cons desc0 link) link-buffer)
(setq rpl (concat rpl " (" link ")")
wrap (+ (length line) (- (length (match-string 0 line)))
(length desc))))))
(setq line (replace-match rpl t t line))))
(when custom-times
(setq line (org-translate-time line)))
@ -482,7 +487,8 @@ publishing directory."
(org-format-table-ascii table-buffer)
"\n") "\n")))
(t
(if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)" line)
(if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)"
line)
(setq line (replace-match "\\1\\3:" t nil line)))
(setq line (org-fix-indentation line org-ascii-current-indentation))
;; Remove forced line breaks
@ -571,9 +577,12 @@ publishing directory."
(replace-match "\\1\\2")))
;; Remove list start counters
(goto-char (point-min))
(while (re-search-forward "\\[@start:[0-9]+\\] ?" nil t)
(org-if-unprotected
(replace-match ""))))
(while (org-search-forward-unenclosed
"\\[@\\(?:start:\\)?[0-9]+\\][ \t]*" nil t)
(replace-match ""))
(remove-text-properties
(point-min) (point-max)
'(face nil font-lock-fontified nil font-lock-multiline nil line-prefix nil wrap-prefix nil)))
(defun org-html-expand-for-ascii (line)
"Handle quoted HTML for ASCII export."
@ -586,7 +595,7 @@ publishing directory."
(defun org-ascii-replace-entities ()
"Replace entities with the ASCII representation."
(let (e)
(while (re-search-forward "\\\\\\([a-zA-Z]+[0-9]*\\)" nil t)
(while (re-search-forward "\\\\\\([a-zA-Z]+[0-9]*\\)\\({}\\)?" nil t)
(org-if-unprotected-at (match-beginning 1)
(setq e (org-entity-get-representation (match-string 1)
org-export-ascii-entities))
@ -645,7 +654,7 @@ publishing directory."
(insert "\n"))
(setq char (nth (- umax level) (reverse org-export-ascii-underline)))
(unless org-export-with-tags
(if (string-match (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title)
(if (string-match (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title)
(setq title (replace-match "" t t title))))
(if org-export-with-section-numbers
(setq title (concat (org-section-number level) " " title)))

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

@ -4,7 +4,7 @@
;; Author: John Wiegley <johnw@newartisans.com>
;; Keywords: org data task
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
;;

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

@ -7,7 +7,7 @@
;; Thomas Baumann <thomas dot baumann at ch dot tum dot de>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;
@ -322,8 +322,8 @@ This is used by Org to re-create the anniversary hash table."
(when rec
(let* ((class (or (nth 2 rec)
org-bbdb-default-anniversary-format))
(form (or (cdr (assoc class
org-bbdb-anniversary-format-alist))
(form (or (cdr (assoc-string
class org-bbdb-anniversary-format-alist t))
class)) ; (as format string)
(name (nth 1 rec))
(years (- y (car rec)))
@ -338,8 +338,7 @@ This is used by Org to re-create the anniversary hash table."
(setq text (append text (list tmp)))
(setq text (list tmp)))))
))
(when text
(mapconcat 'identity text "; "))))
text))
(defun org-bbdb-complete-link ()
"Read a bbdb link with name completion."

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

@ -2,7 +2,7 @@
;;
;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;;
;; Version: 7.01
;; Version: 7.3
;; Author: Carsten Dominik <carsten.dominik AT gmail DOT com>
;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com>
;; Keywords: org, wp, tex
@ -373,7 +373,7 @@ The need to be after the begin statement of the environment."
(let (dovl)
(goto-char (point-min))
(while (re-search-forward
"^[ \t]*\\\\begin{\\(itemize\\|enumerate\\|desctiption\\)}[ \t\n]*\\\\item\\>\\( ?\\(<[^<>\n]*>\\|\\[[^][\n*]\\]\\)\\)?[ \t]*\\S-" nil t)
"^[ \t]*\\\\begin{\\(itemize\\|enumerate\\|description\\)}[ \t\n]*\\\\item\\>\\( ?\\(<[^<>\n]*>\\|\\[[^][\n*]\\]\\)\\)?[ \t]*\\S-" nil t)
(if (setq dovl (cdr (assoc "BEAMER_dovl"
(get-text-property (match-end 0)
'org-props))))
@ -382,7 +382,7 @@ The need to be after the begin statement of the environment."
(insert dovl)))))))
(defun org-beamer-amend-header ()
"Add `org-beamer-header-extra' to the LaTeX herder.
"Add `org-beamer-header-extra' to the LaTeX header.
If the file contains the string BEAMER-HEADER-EXTRA-HERE on a line
by itself, it will be replaced with `org-beamer-header-extra'. If not,
the value will be inserted right after the documentclass statement."

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

@ -5,7 +5,7 @@
;; Author: Bastien Guerry <bzg at altern dot org>
;; Carsten Dominik <carsten dot dominik at gmail dot com>
;; Keywords: org, wp, remember
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;

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

@ -5,7 +5,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;
@ -76,6 +76,7 @@
:tag "Org Capture"
:group 'org)
;;;###autoload
(defcustom org-capture-templates nil
"Templates for the creation of new entries.
@ -185,6 +186,10 @@ properties are:
which means 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.
@ -220,20 +225,23 @@ Furthermore, the following %-escapes will be replaced with content:
Apart from these general escapes, you can access information specific to the
link type that is created. For example, calling `org-capture' in emails
or gnus will record the author and the subject of the message, which you
can access with \"%:author\" and \"%:subject\", respectively. Here is a
can access with \"%:from\" and \"%:subject\", respectively. Here is a
complete list of what is recorded for each link type.
Link type | Available information
-------------------+------------------------------------------------------
bbdb | %:type %:name %:company
vm, wl, mh, rmail | %:type %:subject %:message-id
| %:from %:fromname %:fromaddress
| %:to %:toname %:toaddress
| %:fromto (either \"to NAME\" or \"from NAME\")
gnus | %:group, for messages also all email fields
w3, w3m | %:type %:url
info | %:type %:file %:node
calendar | %:type %:date"
Link type | Available information
------------------------+------------------------------------------------------
bbdb | %:type %:name %:company
vm, wl, mh, mew, rmail | %:type %:subject %:message-id
| %:from %:fromname %:fromaddress
| %:to %:toname %:toaddress
| %:fromto (either \"to NAME\" or \"from NAME\")
| %:date
| %:date-timestamp (as active timestamp)
| %:date-timestamp-inactive (as inactive timestamp)
gnus | %:group, for messages also all email fields
w3, w3m | %:type %:url
info | %:type %:file %:node
calendar | %:type %:date"
:group 'org-capture
:type
'(repeat
@ -289,7 +297,7 @@ calendar | %:type %:date"
(file :tag "Template file"))
(list :tag "Function"
(const :format "" function)
(file :tag "Template function")))
(function :tag "Template function")))
(plist :inline t
;; Give the most common options as checkboxes
:options (((const :format "%v " :prepend) (const t))
@ -297,7 +305,8 @@ calendar | %:type %:date"
((const :format "%v " :empty-lines) (const 1))
((const :format "%v " :clock-in) (const t))
((const :format "%v " :clock-resume) (const t))
((const :format "%v " :unnarrowed) (const t))))))))
((const :format "%v " :unnarrowed) (const t))
((const :format "%v " :kill-buffer) (const t))))))))
(defcustom org-capture-before-finalize-hook nil
"Hook that is run right before a remember process is finalized.
@ -382,6 +391,11 @@ bypassed."
(initial (and (org-region-active-p)
(buffer-substring (point) (mark))))
(entry (org-capture-select-template keys)))
(when (stringp initial)
(remove-text-properties 0 (length initial) '(read-only t) initial))
(when (stringp annotation)
(remove-text-properties 0 (length annotation)
'(read-only t) annotation))
(cond
((equal entry "C")
(customize-variable 'org-capture-templates))
@ -467,8 +481,9 @@ bypassed."
(markerp (org-capture-get :interrupted-clock 'local))
(buffer-live-p (marker-buffer
(org-capture-get :interrupted-clock 'local))))
(org-with-point-at (org-capture-get :interrupted-clock 'local)
(org-clock-in))
(let ((clock-in-task (org-capture-get :interrupted-clock 'local)))
(org-with-point-at clock-in-task
(org-clock-in)))
(message "Interrupted clock has been resumed")))
(let ((beg (point-min))
@ -519,14 +534,25 @@ bypassed."
;; Kill the indirect buffer
(save-buffer)
(let ((return-wconf (org-capture-get :return-to-wconf 'local)))
(let ((return-wconf (org-capture-get :return-to-wconf 'local))
(new-buffer (org-capture-get :new-buffer 'local))
(kill-buffer (org-capture-get :kill-buffer 'local))
(base-buffer (buffer-base-buffer (current-buffer))))
;; Kill the indiret buffer
(kill-buffer (current-buffer))
;; Kill the target buffer if that is desired
(when (and base-buffer new-buffer kill-buffer)
(with-current-buffer base-buffer (save-buffer))
(kill-buffer base-buffer))
;; Restore the window configuration before capture
(set-window-configuration return-wconf))
(when abort-note
(cond
((equal abort-note 'clean)
(message "Capture process aborted and target file cleaned up"))
(message "Capture process aborted and target buffer cleaned up"))
((equal abort-note 'dirty)
(error "Capture process aborted, but target buffer could not be cleaned up correctly"))))))
@ -588,6 +614,8 @@ already gone."
(set-buffer (org-capture-target-buffer (nth 1 target)))
(let ((hd (nth 2 target)))
(goto-char (point-min))
(unless (org-mode-p)
(error "Target buffer for file+headline should be in Org mode"))
(if (re-search-forward
(format org-complex-heading-regexp-format (regexp-quote hd))
nil t)
@ -651,8 +679,12 @@ already gone."
(defun org-capture-target-buffer (file)
"Get a buffer for FILE."
(setq file (or (org-string-nw-p file)
org-default-notes-file
(error "No notes file specified, and no default available")))
(or (org-find-base-buffer-visiting file)
(find-file-noselect (expand-file-name file org-directory))))
(progn (org-capture-put :new-buffer t)
(find-file-noselect (expand-file-name file org-directory)))))
(defun org-capture-steal-local-variables (buffer)
"Install Org-mode local variables."
@ -666,6 +698,7 @@ already gone."
(delete-other-windows)
(org-switch-to-buffer-other-window
(org-capture-get-indirect-buffer (org-capture-get :buffer) "CAPTURE"))
(widen)
(show-all)
(goto-char (org-capture-get :pos))
(org-set-local 'org-capture-target-marker
@ -676,7 +709,8 @@ already gone."
((nil entry) (org-capture-place-entry))
(table-line (org-capture-place-table-line))
(plain (org-capture-place-plain-text))
(item (org-capture-place-item))))
(item (org-capture-place-item))
(checkitem (org-capture-place-item))))
(org-capture-mode 1)
(org-set-local 'org-capture-current-plist org-capture-plist))
@ -695,7 +729,8 @@ already gone."
(setq level 1)
(if reversed
(progn (goto-char (point-min))
(outline-next-heading))
(or (org-at-heading-p)
(outline-next-heading)))
(goto-char (point-max))
(or (bolp) (insert "\n"))))
(t
@ -718,6 +753,7 @@ already gone."
(setq end (point))
(org-capture-mark-kill-region beg (1- end))
(org-capture-narrow beg (1- end))
(goto-char beg)
(if (re-search-forward "%\\?" end t) (replace-match ""))))
(defun org-capture-place-item ()
@ -738,14 +774,14 @@ already gone."
(if (org-capture-get :prepend)
(progn
(goto-char beg)
(if (re-search-forward (concat "^" (org-item-re)) nil t)
(if (org-search-forward-unenclosed 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 (re-search-backward (concat "^" (org-item-re)) nil t)
(if (org-search-backward-unenclosed org-item-beginning-re beg t)
(progn
(setq ind (org-get-indentation))
(org-end-of-item))
@ -929,7 +965,7 @@ Point will be after the empty lines, so insertion can directly be done."
(let ((pos (point)))
(org-back-over-empty-lines)
(delete-region (point) pos)
(newline n)))
(if (> n 0) (newline n))))
(defun org-capture-empty-lines-after (&optional n)
"Arrange for the correct number of empty lines after the inserted string.
@ -938,7 +974,7 @@ Point will remain at the first line after the inserted text."
(org-back-over-empty-lines)
(while (looking-at "[ \t]*\n") (replace-match ""))
(let ((pos (point)))
(newline n)
(if (> n 0) (newline n))
(goto-char pos)))
(defvar org-clock-marker) ; Defined in org.el
@ -967,7 +1003,7 @@ Point will remain at the first line after the inserted text."
(insert template)
(org-capture-empty-lines-after)
(goto-char beg)
(org-maybe-renumber-ordered-list)
(org-list-repair)
(org-end-of-item)
(setq end (point)))
(t (insert template)))
@ -1023,17 +1059,19 @@ Use PREFIX as a prefix for the name of the indirect buffer."
(defun org-capture-select-template (&optional keys)
"Select a capture template.
Lisp programs can force the template by setting KEYS to a string."
(when org-capture-templates
(if keys
(or (assoc keys org-capture-templates)
(error "No capture template referred to by \"%s\" keys" keys))
(if (= 1 (length org-capture-templates))
(car org-capture-templates)
(org-mks org-capture-templates
"Select a capture template\n========================="
"Template key: "
'(("C" "Customize org-capture-templates")
("q" "Abort")))))))
(if org-capture-templates
(if keys
(or (assoc keys org-capture-templates)
(error "No capture template referred to by \"%s\" keys" keys))
(if (= 1 (length org-capture-templates))
(car org-capture-templates)
(org-mks org-capture-templates
"Select a capture template\n========================="
"Template key: "
'(("C" "Customize org-capture-templates")
("q" "Abort")))))
;; Use an arbitrary default template
'("t" "Task" entry (file+headline "" "Tasks") "* TODO %?\n %u\n %a")))
(defun org-capture-fill-template (&optional template initial annotation)
"Fill a template and return the filled template as a string.
@ -1098,6 +1136,7 @@ The template may still contain \"%?\" for cursor positioning."
(plist-put org-store-link-plist :annotation v-a)
org-store-link-plist
(plist-put org-store-link-plist :initial v-i))
(setq initial v-i)
(unless template (setq template "") (message "No template") (ding)
(sit-for 1))
@ -1138,6 +1177,7 @@ The template may still contain \"%?\" for cursor positioning."
(insert result)))))
;; Simple %-escapes
(goto-char (point-min))
(while (re-search-forward "%\\([tTuUaiAcxkKI]\\)" nil t)
(unless (org-capture-escaped-%)
(when (and initial (equal (match-string 0) "%i"))
@ -1181,6 +1221,7 @@ The template may still contain \"%?\" for cursor positioning."
"org-capture-template-prompt-history::"
(or prompt "")))
completions (mapcar 'list completions)))
(unless (boundp histvar) (set histvar nil))
(cond
((member char '("G" "g"))
(let* ((org-last-tags-completion-table
@ -1195,12 +1236,13 @@ The template may still contain \"%?\" for cursor positioning."
'org-tags-history)))
(setq ins (mapconcat 'identity
(org-split-string
ins (org-re "[^[:alnum:]_@]+"))
ins (org-re "[^[:alnum:]_@#%]+"))
":"))
(when (string-match "\\S-" ins)
(or (equal (char-before) ?:) (insert ":"))
(insert ins)
(or (equal (char-after) ?:) (insert ":")))))
(or (equal (char-after) ?:) (insert ":"))
(and (org-on-heading-p) (org-set-tags nil 'align)))))
((equal char "C")
(cond ((= (length clipboards) 1) (insert (car clipboards)))
((> (length clipboards) 1)

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

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;
@ -35,6 +35,7 @@
(require 'cl))
(declare-function calendar-absolute-from-iso "cal-iso" (&optional date))
(declare-function notifications-notify "notifications" (&rest params))
(defvar org-time-stamp-formats)
(defgroup org-clock nil
@ -557,6 +558,14 @@ use libnotify if available, or fall back on a message."
((stringp org-show-notification-handler)
(start-process "emacs-timer-notification" nil
org-show-notification-handler notification))
((featurep 'notifications)
(require 'notifications)
(notifications-notify
:title "Org-mode message"
:body notification
;; FIXME how to link to the Org icon?
;; :app-icon "~/.emacs.d/icons/mail.png"
:urgency 'low))
((org-program-exists "notify-send")
(start-process "emacs-timer-notification" nil
"notify-send" notification))
@ -950,7 +959,7 @@ the clocking selection, associated with the letter `d'."
;; We are interrupting the clocking of a different task.
;; Save a marker to this task, so that we can go back.
;; First check if we are trying to clock into the same task!
(if (save-excursion
(when (save-excursion
(unless selected-task
(org-back-to-heading t))
(and (equal (marker-buffer org-clock-hd-marker)
@ -961,13 +970,13 @@ the clocking selection, associated with the letter `d'."
(if selected-task
(marker-position selected-task)
(point)))))
(message "Clock continues in \"%s\"" org-clock-heading)
(progn
(move-marker org-clock-interrupted-task
(marker-position org-clock-marker)
(org-clocking-buffer))
(let ((org-clock-clocking-in t))
(org-clock-out t)))))
(message "Clock continues in \"%s\"" org-clock-heading)
(throw 'abort nil))
(move-marker org-clock-interrupted-task
(marker-position org-clock-marker)
(marker-buffer org-clock-marker))
(let ((org-clock-clocking-in t))
(org-clock-out t)))
(when (equal select '(16))
;; Mark as default clocking task
@ -1098,6 +1107,7 @@ the clocking selection, associated with the letter `d'."
(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))
@ -1830,6 +1840,7 @@ the currently selected interval size."
(org-prepare-agenda-buffers files)
(while (setq file (pop files))
(with-current-buffer (find-buffer-visiting file)
(setq org-clock-file-total-minutes 0)
(setq tbl1 (org-dblock-write:clocktable p1))
(when tbl1
(push (org-clocktable-add-file
@ -1862,7 +1873,7 @@ the currently selected interval size."
(when (setq time (get-text-property p :org-clock-minutes))
(save-excursion
(beginning-of-line 1)
(when (and (looking-at (org-re "\\(\\*+\\)[ \t]+\\(.*?\\)\\([ \t]+:[[:alnum:]_@:]+:\\)?[ \t]*$"))
(when (and (looking-at (org-re "\\(\\*+\\)[ \t]+\\(.*?\\)\\([ \t]+:[[:alnum:]_@#%:]+:\\)?[ \t]*$"))
(setq level (org-reduced-level
(- (match-end 1) (match-beginning 1))))
(<= level maxlevel))
@ -1970,10 +1981,22 @@ the currently selected interval size."
(when block
(setq cc (org-clock-special-range block nil t)
ts (car cc) te (nth 1 cc) range-text (nth 2 cc)))
(if ts (setq ts (org-float-time
(apply 'encode-time (org-parse-time-string ts)))))
(if te (setq te (org-float-time
(apply 'encode-time (org-parse-time-string te)))))
(cond
((numberp ts)
;; If ts is a number, it's an absolute day number from org-agenda.
(destructuring-bind (month day year) (calendar-gregorian-from-absolute ts)
(setq ts (org-float-time (encode-time 0 0 0 day month year)))))
(ts
(setq ts (org-float-time
(apply 'encode-time (org-parse-time-string ts))))))
(cond
((numberp te)
;; Likewise for te.
(destructuring-bind (month day year) (calendar-gregorian-from-absolute te)
(setq te (org-float-time (encode-time 0 0 0 day month year)))))
(te
(setq te (org-float-time
(apply 'encode-time (org-parse-time-string te))))))
(setq p1 (plist-put p1 :header ""))
(setq p1 (plist-put p1 :step nil))
(setq p1 (plist-put p1 :block nil))

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

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;
@ -228,7 +228,9 @@ This is the compiled version of the format.")
(overlay-put ov 'org-columns-value (cdr ass))
(overlay-put ov 'org-columns-value-modified modval)
(overlay-put ov 'org-columns-pom pom)
(overlay-put ov 'org-columns-format f))
(overlay-put ov 'org-columns-format f)
(overlay-put ov 'line-prefix "")
(overlay-put ov 'wrap-prefix ""))
(if (or (not (char-after beg))
(equal (char-after beg) ?\n))
(let ((inhibit-read-only t))
@ -241,6 +243,8 @@ This is the compiled version of the format.")
(overlay-put ov 'invisible t)
(overlay-put ov 'keymap org-columns-map)
(overlay-put ov 'intangible t)
(overlay-put ov 'line-prefix "")
(overlay-put ov 'wrap-prefix "")
(push ov org-columns-overlays)
(setq ov (make-overlay (1- (point-at-eol)) (1+ (point-at-eol))))
(overlay-put ov 'keymap org-columns-map)
@ -464,7 +468,7 @@ Where possible, use the standard interface for changing this line."
(call-interactively 'org-schedule))))
((equal key "BEAMER_env")
(setq eval '(org-with-point-at pom
(call-interactively 'org-beamer-set-environment-tag))))
(call-interactively 'org-beamer-select-environment))))
(t
(setq allowed (org-property-get-allowed-values pom key 'table))
(if allowed
@ -515,7 +519,7 @@ Where possible, use the standard interface for changing this line."
(txt (match-string 3))
(post "")
txt2)
(if (string-match (org-re "[ \t]+:[[:alnum:]:_@]+:[ \t]*$") txt)
(if (string-match (org-re "[ \t]+:[[:alnum:]:_@#%]+:[ \t]*$") txt)
(setq post (match-string 0 txt)
txt (substring txt 0 (match-beginning 0))))
(setq txt2 (read-string "Edit: " txt))
@ -746,7 +750,8 @@ around it."
("@max" max_age max (lambda (x) (- org-columns-time x)))
("@mean" mean_age
(lambda (&rest x) (/ (apply '+ x) (float (length x))))
(lambda (x) (- org-columns-time x))))
(lambda (x) (- org-columns-time x)))
("est+" estimate org-estimate-combine))
"Operator <-> format,function,calc map.
Used to compile/uncompile columns format and completing read in
interactive function `org-columns-new'.
@ -1031,6 +1036,7 @@ Don't set this, this is meant for dynamic scoping.")
(defun org-columns-number-to-string (n fmt &optional printf)
"Convert a computed column number to a string value, according to FMT."
(cond
((memq fmt '(estimate)) (org-estimate-print n printf))
((not (numberp n)) "")
((memq fmt '(add_times max_times min_times mean_times))
(let* ((h (floor n)) (m (floor (+ 0.5 (* 60 (- n h))))))
@ -1054,28 +1060,30 @@ Don't set this, this is meant for dynamic scoping.")
(format "[%d/%d]" n m)
(format "[%d%%]"(floor (+ 0.5 (* 100. (/ (* 1.0 n) m)))))))
(defun org-columns-string-to-number (s fmt)
"Convert a column value to a number that can be used for column computing."
(if s
(cond
((memq fmt '(min_age max_age mean_age))
(cond ((string= s "") org-columns-time)
((string-match
"\\([0-9]+\\)d \\([0-9]+\\)h \\([0-9]+\\)m \\([0-9]+\\)s"
s)
(+ (* 60 (+ (* 60 (+ (* 24 (string-to-number (match-string 1 s)))
(string-to-number (match-string 2 s))))
(string-to-number (match-string 3 s))))
(string-to-number (match-string 4 s))))
(t (time-to-number-of-days (apply 'encode-time
(org-parse-time-string s t))))))
(cond ((string= s "") org-columns-time)
((string-match
"\\([0-9]+\\)d \\([0-9]+\\)h \\([0-9]+\\)m \\([0-9]+\\)s"
s)
(+ (* 60 (+ (* 60 (+ (* 24 (string-to-number (match-string 1 s)))
(string-to-number (match-string 2 s))))
(string-to-number (match-string 3 s))))
(string-to-number (match-string 4 s))))
(t (time-to-number-of-days (apply 'encode-time
(org-parse-time-string s t))))))
((string-match ":" s)
(let ((l (nreverse (org-split-string s ":"))) (sum 0.0))
(while l
(setq sum (+ (string-to-number (pop l)) (/ sum 60))))
sum))
(let ((l (nreverse (org-split-string s ":"))) (sum 0.0))
(while l
(setq sum (+ (string-to-number (pop l)) (/ sum 60))))
sum))
((memq fmt '(checkbox checkbox-n-of-m checkbox-percent))
(if (equal s "[X]") 1. 0.000001))
(if (equal s "[X]") 1. 0.000001))
((memq fmt '(estimate)) (org-string-to-estimate s))
(t (string-to-number s)))))
(defun org-columns-uncompile-format (cfmt)
@ -1491,6 +1499,41 @@ This will add overlays to the date lines, to show the summary for each day."
(format "%dd %02dh %02dm %02ds" days hours minutes seconds))
""))
(defun org-estimate-mean-and-var (v)
"Return the mean and variance of an estimate."
(let* ((low (float (car v)))
(high (float (cadr v)))
(mean (/ (+ low high) 2.0))
(var (/ (+ (expt (- mean low) 2.0) (expt (- high mean) 2.0)) 2.0)))
(list mean var)))
(defun org-estimate-combine (&rest el)
"Combine a list of estimates, using mean and variance.
The mean and variance of the result will be the sum of the means
and variances (respectively) of the individual estimates."
(let ((mean 0)
(var 0))
(mapc (lambda (e)
(let ((stats (org-estimate-mean-and-var e)))
(setq mean (+ mean (car stats)))
(setq var (+ var (cadr stats)))))
el)
(let ((stdev (sqrt var)))
(list (- mean stdev) (+ mean stdev)))))
(defun org-estimate-print (e &optional fmt)
"Prepare a string representation of an estimate.
This formats these numbers as two numbers with a \"-\" between them."
(if (null fmt) (set 'fmt "%.0f"))
(format "%s" (mapconcat (lambda (n) (format fmt n)) e "-")))
(defun org-string-to-estimate (s)
"Convert a string to an estimate.
The string should be two numbers joined with a \"-\"."
(if (string-match "\\(.*\\)-\\(.*\\)" s)
(list (string-to-number (match-string 1 s))
(string-to-number(match-string 2 s)))
(list (string-to-number s) (string-to-number s))))
(provide 'org-colview)

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

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;
@ -162,6 +162,15 @@ If DELETE is non-nil, delete all those overlays."
(let ((x (org-get-x-clipboard-compat value)))
(if x (org-no-properties x)))))
(defsubst org-decompose-region (beg end)
"Decompose from BEG to END."
(if (featurep 'xemacs)
(let ((modified-p (buffer-modified-p))
(buffer-read-only nil))
(remove-text-properties beg end '(composition nil))
(set-buffer-modified-p modified-p))
(decompose-region beg end)))
;; Miscellaneous functions
(defun org-add-hook (hook function &optional append local)
@ -197,6 +206,26 @@ ignored in this case."
(shrink-window-if-larger-than-buffer window)))
(or window (selected-window)))
(defun org-number-sequence (from &optional to inc)
"Call `number-sequence or emulate it."
(if (fboundp 'number-sequence)
(number-sequence from to inc)
(if (or (not to) (= from to))
(list from)
(or inc (setq inc 1))
(when (zerop inc) (error "The increment can not be zero"))
(let (seq (n 0) (next from))
(if (> inc 0)
(while (<= next to)
(setq seq (cons next seq)
n (1+ n)
next (+ from (* n inc))))
(while (>= next to)
(setq seq (cons next seq)
n (1+ n)
next (+ from (* n inc)))))
(nreverse seq)))))
;; Region compatibility
(defvar org-ignore-region nil
@ -353,7 +382,7 @@ TIME defaults to the current time."
(if (fboundp 'looking-at-p)
(apply 'looking-at-p args)
(save-match-data
(apply 'looking-at-p args))))
(apply 'looking-at args))))
; XEmacs does not have `looking-back'.
(if (fboundp 'looking-back)

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

@ -4,7 +4,7 @@
;; Emacs Lisp Archive Entry
;; Filename: org-crypt.el
;; Version: 7.01
;; Version: 7.3
;; Keywords: org-mode
;; Author: John Wiegley <johnw@gnu.org>
;; Maintainer: Peter Jones <pjones@pmade.com>

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

@ -3,10 +3,10 @@
;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Paul Sexton <eeeickythump@gmail.com>
;; Version: 7.01
;; Version: 7.3
;; Keywords: org, wp
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;

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

@ -5,7 +5,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;

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

@ -4,7 +4,7 @@
;;
;; Emacs Lisp Archive Entry
;; Filename: org-docbook.el
;; Version: 7.01
;; Version: 7.3
;; Author: Baoqiu Cui <cbaoqiu AT yahoo DOT com>
;; Maintainer: Baoqiu Cui <cbaoqiu AT yahoo DOT com>
;; Keywords: org, wp, docbook
@ -552,9 +552,9 @@ publishing directory."
(nth 2 (assoc "=" org-export-docbook-emphasis-alist)))
table-open type
table-buffer table-orig-buffer
ind item-type starter didclose
ind item-type starter
rpl path attr caption label desc descp desc1 desc2 link
fnc item-tag initial-number
fnc item-tag item-number
footref-seen footnote-list
id-file
)
@ -671,7 +671,21 @@ publishing directory."
(org-export-docbook-open-para))
(throw 'nextline nil))
(org-export-docbook-close-lists-maybe line)
;; 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)
@ -963,18 +977,6 @@ publishing directory."
txt (match-string 2 line))
(if (string-match quote-re0 txt)
(setq txt (replace-match "" t t txt)))
(when in-local-list
;; Close any local lists before inserting a new header 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))
(setq local-list-indent nil
in-local-list nil))
(org-export-docbook-level-start level txt)
;; QUOTES
(when (string-match quote-re line)
@ -1003,7 +1005,9 @@ publishing directory."
table-orig-buffer (nreverse table-orig-buffer))
(org-export-docbook-close-para-maybe)
(insert (org-export-docbook-finalize-table
(org-format-table-html table-buffer table-orig-buffer)))))
(org-format-table-html table-buffer table-orig-buffer
'no-css)))))
(t
;; Normal lines
(when (string-match
@ -1020,34 +1024,14 @@ publishing directory."
(substring (match-string 2 line) 0 -1))
line (substring line (match-beginning 5))
item-tag nil
initial-number nil)
(if (string-match "\\`\\[@start:\\([0-9]+\\)\\][ \t]?" line)
(setq initial-number (match-string 1 line)
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))))
(when (and (not (equal item-type "d"))
(not (string-match "[^ \t]" line)))
;; Empty line. Pretend indentation is large.
(setq ind (if org-empty-line-terminates-plain-lists
0
(1+ (or (car local-list-indent) 1)))))
(setq didclose nil)
(while (and in-local-list
(or (and (= ind (car local-list-indent))
(not starter))
(< ind (car local-list-indent))))
(setq didclose t)
(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))
(cond
((and starter
(or (not in-local-list)
@ -1056,7 +1040,7 @@ publishing directory."
(org-export-docbook-close-para-maybe)
(insert (cond
((equal item-type "u") "<itemizedlist>\n<listitem>\n")
((equal item-type "o")
((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
@ -1064,10 +1048,8 @@ publishing directory."
;; ``startingnumber'' attribute of element
;; <orderedlist>, but the former works on both
;; DocBook 5.0 and prior versions.
(if initial-number
(format "<orderedlist>\n<listitem override=\"%s\">\n"
initial-number)
"<orderedlist>\n<listitem>\n"))
(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
@ -1076,11 +1058,27 @@ publishing directory."
(push item-type local-list-type)
(push ind local-list-indent)
(setq in-local-list t))
(starter
;; 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
@ -1089,9 +1087,6 @@ publishing directory."
"???"))))))
;; For DocBook, we need to open a para right after tag
;; <listitem>.
(org-export-docbook-open-para))
(didclose
;; We did close a list, normal text follows: need <para>
(org-export-docbook-open-para)))
;; Checkboxes.
(if (string-match "^[ \t]*\\(\\[[X -]\\]\\)" line)
@ -1134,18 +1129,7 @@ publishing directory."
(when inquote
(insert "]]></programlisting>\n")
(org-export-docbook-open-para))
(when in-local-list
;; Close any local lists before inserting a new header 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))
(setq local-list-indent nil
in-local-list nil))
;; Close all open sections.
(org-export-docbook-level-start 1 nil)
@ -1212,24 +1196,6 @@ publishing directory."
(defvar in-local-list)
(defvar local-list-indent)
(defvar local-list-type)
(defun org-export-docbook-close-lists-maybe (line)
(let ((ind (or (get-text-property 0 'original-indentation line)))
; (and (string-match "\\S-" line)
; (org-get-indentation line))))
didclose)
(when ind
(while (and in-local-list
(<= ind (car local-list-indent)))
(setq didclose t)
(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))
(and didclose (org-export-docbook-open-para)))))
(defun org-export-docbook-level-start (level title)
"Insert a new level in DocBook export.
@ -1249,7 +1215,7 @@ When TITLE is nil, just close all open levels."
;; all levels, so the rest is done only if title is given.
;;
;; Format tags: put them into a superscript like format.
(when (string-match (org-re "\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title)
(when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title)
(setq title
(replace-match
(if org-export-with-tags
@ -1273,7 +1239,7 @@ When TITLE is nil, just close all open levels."
Applies all active conversions. If there are links in the
string, don't modify these."
(let* ((re (concat org-bracket-link-regexp "\\|"
(org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$")))
(org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")))
m s l res)
(while (setq m (string-match re string))
(setq s (substring string 0 m)

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

@ -5,7 +5,7 @@
;; Author: Jan Böcker <jan.boecker at jboecker dot de>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;
@ -45,7 +45,10 @@
(require 'org)
(eval-when-compile (require 'doc-view)) ; doc-view-current-page macro
(declare-function doc-view-goto-page "ext:doc-view" (page))
(declare-function image-mode-window-get "ext:image-mode"
(prop &optional winprops))
(autoload 'doc-view-goto-page "doc-view")
@ -66,7 +69,7 @@
(when (eq major-mode 'doc-view-mode)
;; This buffer is in doc-view-mode
(let* ((path buffer-file-name)
(page (doc-view-current-page))
(page (image-mode-window-get 'page))
(link (concat "docview:" path "::" (number-to-string page)))
(description ""))
(org-store-link-props

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

@ -6,7 +6,7 @@
;; Ulf Stegemann <ulf at zeitform dot de>
;; Keywords: outlines, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;

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

@ -4,7 +4,7 @@
;; Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
;;
@ -201,7 +201,8 @@ which defaults to the value of `org-export-blocks-witheld'."
(interblock start (point-max))
(run-hooks 'org-export-blocks-postblock-hook)))))
(add-hook 'org-export-preprocess-hook 'org-export-blocks-preprocess)
(add-hook 'org-export-preprocess-after-include-files-hook
'org-export-blocks-preprocess)
;;================================================================================
;; type specific functions

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

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;
@ -181,7 +181,7 @@ This option can also be set with the +OPTIONS line, e.g. \"-:nil\"."
("no" "Forfatter" "Dato" "Innhold" "Fotnoter")
("nb" "Forfatter" "Dato" "Innhold" "Fotnoter") ;; nb = Norsk (bokm.l)
("nn" "Forfattar" "Dato" "Innhald" "Fotnotar") ;; nn = Norsk (nynorsk)
("pl" "Autor" "Data" "Spis tre&sacute;ci" "Przypis")
("pl" "Autor" "Data" "Spis tre&#x015b;ci" "Przypis")
("sv" "F&ouml;rfattare" "Datum" "Inneh&aring;ll" "Fotnoter"))
"Terms used in export text, translated to different languages.
Use the variable `org-export-default-language' to set the language,
@ -417,6 +417,10 @@ This is run just before backend-specific blocks get selected.")
This is run after blockquote/quote/verse/center have been marked
with cookies.")
(defvar org-export-preprocess-after-radio-targets-hook nil
"Hook for preprocessing an export buffer.
This is run after radio target processing.")
(defvar org-export-preprocess-before-normalizing-links-hook nil
"Hook for preprocessing an export buffer.
This hook is run before links are normalized.")
@ -467,20 +471,34 @@ This option can also be set with the +OPTIONS line, e.g. \"TeX:nil\"."
:group 'org-export-latex
:type 'boolean)
(defcustom org-export-with-LaTeX-fragments nil
"Non-nil means convert LaTeX fragments to images when exporting to HTML.
When set, the exporter will find LaTeX environments if the \\begin line is
the first non-white thing on a line. It will also find the math delimiters
like $a=b$ and \\( a=b \\) for inline math, $$a=b$$ and \\[ a=b \\] for
display math.
(defcustom org-export-with-LaTeX-fragments t
"Non-nil means process LaTeX math fragments for HTML display.
When set, the exporter will find and process LaTeX environments if the
\\begin line is the first non-white thing on a line. It will also find
and process the math delimiters like $a=b$ and \\( a=b \\) for inline math,
$$a=b$$ and \\[ a=b \\] for display math.
This option can also be set with the +OPTIONS line, e.g. \"LaTeX:t\".
This option can also be set with the +OPTIONS line, e.g. \"LaTeX:mathjax\".
Allowed values are:
nil Don't do anything.
verbatim Keep eveything in verbatim
dvipng Process the LaTeX fragments to images.
This will also include processing of non-math environments.
t Do MathJax preprocessing if there is at least on math snippet,
and arrange for MathJax.js to be loaded.
The default is nil, because this option needs the `dvipng' program which
is not available on all systems."
:group 'org-export-translation
:group 'org-export-latex
:type 'boolean)
:type '(choice
(const :tag "Do not process math in any way" nil)
(const :tag "Obsolete, use dvipng setting" t)
(const :tag "Use dvipng to make images" dvipng)
(const :tag "Use MathJax to display math" mathjax)
(const :tag "Leave math verbatim" verbatim)))
(defcustom org-export-with-fixed-width t
"Non-nil means lines starting with \":\" will be in fixed width font.
@ -671,12 +689,14 @@ modified) list.")
(let ((re (org-make-options-regexp
(append
'("TITLE" "AUTHOR" "DATE" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"
"MATHJAX"
"LINK_UP" "LINK_HOME" "SETUPFILE" "STYLE"
"LATEX_HEADER" "LATEX_CLASS"
"EXPORT_SELECT_TAGS" "EXPORT_EXCLUDE_TAGS"
"KEYWORDS" "DESCRIPTION" "MACRO" "BIND" "XSLT")
(mapcar 'car org-export-inbuffer-options-extra))))
p key val text options a pr style
(case-fold-search t)
p key val text options mathjax a pr style
latex-header latex-class macros letbind
ext-setup-or-nil setup-contents (start 0))
(while (or (and ext-setup-or-nil
@ -708,6 +728,8 @@ modified) list.")
(setq text (if text (concat text "\n" val) val)))
((string-equal key "OPTIONS")
(setq options (concat val " " options)))
((string-equal key "MATHJAX")
(setq mathjax (concat val " " mathjax)))
((string-equal key "BIND")
(push (read (concat "(" val ")")) letbind))
((string-equal key "XSLT")
@ -744,9 +766,12 @@ modified) list.")
(setq p (plist-put p :latex-class latex-class)))
(when options
(setq p (org-export-add-options-to-plist p options)))
(when mathjax
(setq p (plist-put p :mathjax mathjax)))
;; Add macro definitions
(setq p (plist-put p :macro-date "(eval (format-time-string \"$1\"))"))
(setq p (plist-put p :macro-time "(eval (format-time-string \"$1\"))"))
(setq p (plist-put p :macro-property "(eval (org-entry-get nil \"$1\" 'selective))"))
(setq p (plist-put
p :macro-modification-time
(and (buffer-file-name)
@ -1052,6 +1077,9 @@ on this string to produce the exported version."
(plist-get parameters :exclude-tags))
(run-hooks 'org-export-preprocess-after-tree-selection-hook)
;; Mark end of lists
(org-export-mark-list-ending backend)
;; Handle source code snippets
(org-export-replace-src-segments-and-examples backend)
@ -1120,6 +1148,7 @@ on this string to produce the exported version."
;; Find matches for radio targets and turn them into internal links
(org-export-mark-radio-links)
(run-hooks 'org-export-preprocess-after-radio-targets-hook)
;; Find all links that contain a newline and put them into a single line
(org-export-concatenate-multiline-links)
@ -1138,7 +1167,8 @@ on this string to produce the exported version."
(when (plist-get parameters :emph-multiline)
(org-export-concatenate-multiline-emphasis))
;; Remove special table lines
;; Remove special table lines, and store alignment information
(org-store-forced-table-alignment)
(when org-export-table-remove-special-lines
(org-export-remove-special-table-lines))
@ -1185,6 +1215,10 @@ on this string to produce the exported version."
p (or (next-single-property-change p :org-license-to-kill)
(point-max))))))
(defvar org-export-define-heading-targets-headline-hook nil
"Hook that is run when a headline was matched during target search.
This is part of the preprocessing for export.")
(defun org-export-define-heading-targets (target-alist)
"Find all headings and define the targets for them.
The new targets are added to TARGET-ALIST, which is also returned.
@ -1228,7 +1262,8 @@ Also find all ID and CUSTOM_ID properties and store them."
(push (cons target target) target-alist)
(add-text-properties
(point-at-bol) (point-at-eol)
(list 'target target))))))
(list 'target target))
(run-hooks 'org-export-define-heading-targets-headline-hook)))))
target-alist)
(defun org-export-handle-invisible-targets (target-alist)
@ -1289,18 +1324,19 @@ the current file."
(string-match "^\\." link))
nil)
(t
(save-excursion
(setq found (condition-case nil (org-link-search link)
(error nil)))
(when (and found
(or (org-on-heading-p)
(not (eq found 'dedicated))))
(or (get-text-property (point) 'target)
(get-text-property
(max (point-min)
(1- (or (previous-single-property-change
(point) 'target) 0)))
'target))))))))
(let ((org-link-search-inhibit-query t))
(save-excursion
(setq found (condition-case nil (org-link-search link)
(error nil)))
(when (and found
(or (org-on-heading-p)
(not (eq found 'dedicated))))
(or (get-text-property (point) 'target)
(get-text-property
(max (point-min)
(1- (or (previous-single-property-change
(point) 'target) 0)))
'target)))))))))
(when target
(set-match-data md)
(goto-char (match-beginning 1))
@ -1316,7 +1352,7 @@ the current file."
(goto-char (point-min))
(let (class)
(while (re-search-forward
"^[ \t]*:HTML_CONTAINER_CLASS:[ \t]+\\(\\S-+\\)" nil t)
"^[ \t]*:HTML_CONTAINER_CLASS:[ \t]+\\(.+\\)$" nil t)
(setq class (match-string 1))
(save-excursion
(org-back-to-heading t)
@ -1446,7 +1482,7 @@ from the buffer."
(goto-char (point-min))
(while (re-search-forward re-archive nil t)
(if (not (org-on-heading-p t))
(org-end-of-subtree t)
(goto-char (point-at-eol))
(beginning-of-line 1)
(setq a (if export-archived-trees
(1+ (point-at-eol)) (point))
@ -1595,6 +1631,31 @@ These special cookies will later be interpreted by the backend."
(delete-region beg end)
(insert (org-add-props content nil 'original-indentation ind))))))
(defun org-export-mark-list-ending (backend)
"Mark list endings with special cookies.
These special cookies will later be interpreted by the backend.
`org-list-end-re' is replaced by a blank line in the process."
(let ((process-buffer
(lambda (end-list-marker)
(goto-char (point-min))
(while (org-search-forward-unenclosed org-item-beginning-re nil t)
(goto-char (org-list-bottom-point))
(when (and (not (eq org-list-ending-method 'indent))
(looking-at (org-list-end-re)))
(replace-match "\n"))
(insert end-list-marker)))))
;; We need to divide backends into 3 categories.
(cond
;; 1. Backends using `org-list-parse-list' do not need markers.
((memq backend '(latex))
nil)
;; 2. Line-processing backends need to be told where lists end.
((memq backend '(html docbook))
(funcall process-buffer "ORG-LIST-END\n"))
;; 3. Others backends do not need to know this: clean list enders.
(t
(funcall process-buffer "")))))
(defun org-export-attach-captions-and-attributes (backend target-alist)
"Move #+CAPTION, #+ATTR_BACKEND, and #+LABEL text into text properties.
If the next thing following is a table, add the text properties to the first
@ -1691,7 +1752,7 @@ When it is nil, all comments will be removed."
(while (or (looking-at re)
(re-search-forward re nil t))
(setq pos (match-beginning 0))
(if (get-text-property (point) 'org-protected)
(if (get-text-property (match-beginning 1) 'org-protected)
(goto-char (1+ pos))
(goto-char (1+ pos))
(replace-match "")
@ -1712,8 +1773,30 @@ When it is nil, all comments will be removed."
(org-if-unprotected
(replace-match "\\1[[\\2]]")))))))
(defun org-store-forced-table-alignment ()
"Find table lines which force alignment, store the results in properties."
(let (line cnt aligns)
(goto-char (point-min))
(while (re-search-forward "|[ \t]*<[lrc][0-9]*>[ \t]*|" nil t)
;; OK, this looks like a table line with an alignment cookie
(org-if-unprotected
(setq line (buffer-substring (point-at-bol) (point-at-eol)))
(when (and (org-at-table-p)
(org-table-cookie-line-p line))
(setq cnt 0 aligns nil)
(mapc
(lambda (x)
(setq cnt (1+ cnt))
(if (string-match "\\`<\\([lrc]\\)" x)
(push (cons cnt (downcase (match-string 1 x))) aligns)))
(org-split-string line "[ \t]*|[ \t]*"))
(add-text-properties (org-table-begin) (org-table-end)
(list 'org-forced-aligns aligns))))
(goto-char (point-at-eol)))))
(defun org-export-remove-special-table-lines ()
"Remove tables lines that are used for internal purposes."
"Remove tables lines that are used for internal purposes.
Also, store forcedalignment information found in such lines."
(goto-char (point-min))
(while (re-search-forward "^[ \t]*|" nil t)
(org-if-unprotected-at (1- (point))
@ -1726,7 +1809,7 @@ When it is nil, all comments will be removed."
(lambda (f)
(or (= (length f) 0)
(string-match
"\\`<\\([0-9]\\|[rl]\\|[rl][0-9]+\\)>\\'" f)))
"\\`<\\([0-9]\\|[lrc]\\|[lrc][0-9]+\\)>\\'" f)))
(org-split-string ;; FIXME, can't we do without splitting???
(buffer-substring (point-at-bol) (point-at-eol))
"[ \t]*|[ \t]*")))))
@ -1747,16 +1830,19 @@ When it is nil, all comments will be removed."
nodesc)
(goto-char (point-min))
(while (re-search-forward re-plain-link nil t)
(goto-char (1- (match-end 0)))
(org-if-unprotected-at (1+ (match-beginning 0))
(let* ((s (concat (match-string 1)
"[[" (match-string 2) ":" (match-string 3)
"][" (match-string 2) ":" (org-export-protect-sub-super
(match-string 3))
"]]")))
;; added 'org-link face to links
(put-text-property 0 (length s) 'face 'org-link s)
(replace-match s t t))))
(unless (org-string-match-p
"\\[\\[\\S+:\\S-*?\\<"
(buffer-substring (point-at-bol) (match-beginning 0)))
(goto-char (1- (match-end 0)))
(org-if-unprotected-at (1+ (match-beginning 0))
(let* ((s (concat (match-string 1)
"[[" (match-string 2) ":" (match-string 3)
"][" (match-string 2) ":" (org-export-protect-sub-super
(match-string 3))
"]]")))
;; added 'org-link face to links
(put-text-property 0 (length s) 'face 'org-link s)
(replace-match s t t)))))
(goto-char (point-min))
(while (re-search-forward re-angle-link nil t)
(goto-char (1- (match-end 0)))
@ -1807,7 +1893,9 @@ can work correctly."
(if (and (not (= (char-after (match-beginning 3))
(char-after (match-beginning 4))))
(save-excursion (goto-char (match-beginning 0))
(save-match-data (not (org-at-table-p)))))
(save-match-data
(and (not (org-at-table-p))
(not (org-at-heading-p))))))
(org-if-unprotected
(subst-char-in-region (match-beginning 0) (match-end 0)
?\n ?\ t)
@ -1976,16 +2064,15 @@ TYPE must be a string, any of:
(intern (concat ":" key)))))
(save-match-data
(when args
(setq args (org-split-string args ",[ \t\n]*") args2 nil)
(setq args (mapcar 'org-trim args))
(setq args (org-split-string args ",") args2 nil)
(while args
(while (string-match "\\\\\\'" (car args))
;; repair bad splits
(setcar (cdr args) (concat (substring (car args) 0 -1)
";" (nth 1 args)))
"," (nth 1 args)))
(pop args))
(push (pop args) args2))
(setq args (nreverse args2))
(setq args (mapcar 'org-trim (nreverse args2)))
(setq s 0)
(while (string-match "\\$\\([0-9]+\\)" val s)
(setq s (1+ (match-beginning 0))
@ -2146,6 +2233,9 @@ in the list) and remove property and value from the list in LISTVAR."
(defvar org-export-latex-verbatim-wrap) ;; defined in org-latex.el
(defvar org-export-latex-listings) ;; defined in org-latex.el
(defvar org-export-latex-listings-langs) ;; defined in org-latex.el
(defvar org-export-latex-listings-w-names) ;; defined in org-latex.el
(defvar org-export-latex-minted-langs) ;; defined in org-latex.el
(defvar org-export-latex-minted-with-line-numbers) ;; defined in org-latex.el
(defun org-export-format-source-code-or-example
(backend lang code &optional opts indent caption)
@ -2275,32 +2365,56 @@ INDENT was the original indentation of the block."
(setq rtn (org-export-number-lines rtn 'latex 0 0 num cont rpllbl fmt))
(concat "#+BEGIN_LaTeX\n"
(org-add-props
(if org-export-latex-listings
(concat
(if lang
(let*
((lang-sym (intern lang))
(lstlang
(or (cadr
(assq
lang-sym
org-export-latex-listings-langs))
lang)))
(format "\\lstset{language=%s}\n" lstlang))
"\n")
(when caption
(format "\n%s $\\equiv$ \n" caption))
"\\begin{lstlisting}\n"
rtn "\\end{lstlisting}\n")
(concat (car org-export-latex-verbatim-wrap)
rtn (cdr org-export-latex-verbatim-wrap)))
'(org-protected t org-example t))
"#+END_LaTeX\n"))
((eq backend 'ascii)
;; This is not HTML or LaTeX, so just make it an example.
(setq rtn (org-export-number-lines rtn 'ascii 0 0 num cont rpllbl fmt))
(concat caption "\n"
"#+BEGIN_ASCII\n"
(cond
((and org-export-latex-listings
(not (eq org-export-latex-listings 'minted)))
(concat
(if lang
(let*
((lang-sym (intern lang))
(lstlang
(or (cadr
(assq
lang-sym
org-export-latex-listings-langs))
lang)))
(format "\\lstset{language=%s}\n" lstlang))
"\n")
(when (and caption
org-export-latex-listings-w-names)
(format "\n%s $\\equiv$ \n"
(replace-regexp-in-string
"_" "\\\\_" caption)))
"\\begin{lstlisting}\n"
rtn "\\end{lstlisting}\n"))
((eq org-export-latex-listings 'minted)
(if lang
(let*
((lang-sym (intern lang))
(minted-lang
(or (cadr
(assq
lang-sym
org-export-latex-minted-langs))
(downcase lang))))
(concat
(when (and caption
org-export-latex-listings-w-names)
(format "\n%s $\\equiv$ \n"
(replace-regexp-in-string
"_" "\\\\_" caption)))
(format
"\\begin{minted}[mathescape,%s\nnumbersep=5pt,\nframe=lines,\nframesep=2mm]{%s}\n" (if org-export-latex-minted-with-line-numbers "\nlinenos," "") minted-lang)
rtn "\\end{minted}\n"))))
(t (concat (car org-export-latex-verbatim-wrap)
rtn (cdr org-export-latex-verbatim-wrap))))
'(org-protected t org-example t))
"#+END_LaTeX\n"))
((eq backend 'ascii)
;; This is not HTML or LaTeX, so just make it an example.
(setq rtn (org-export-number-lines rtn 'ascii 0 0 num cont rpllbl fmt))
(concat caption "\n"
"#+BEGIN_ASCII\n"
(org-add-props
(concat
(mapconcat
@ -2498,6 +2612,28 @@ command."
(defvar org-export-htmlized-org-css-url) ;; defined in org-html.el
(defun org-export-string (string fmt &optional dir)
"Export STRING to FMT using existing export facilities.
During export STRING is saved to a temporary file whose location
could vary. Optional argument DIR can be used to force the
directory in which the temporary file is created during export
which can be useful for resolving relative paths. Dir defaults
to the value of `temporary-file-directory'."
(let ((temporary-file-directory (or dir temporary-file-directory))
(tmp-file (make-temp-file "org-")))
(unwind-protect
(with-temp-buffer
(insert string)
(write-file tmp-file)
(org-load-modules-maybe)
(unless org-local-vars
(setq org-local-vars (org-get-local-variables)))
(eval ;; convert to fmt -- mimicing `org-run-like-in-org-mode'
(list 'let org-local-vars
(list (intern (concat "org-export-as-" fmt))
nil nil nil ''string t))))
(delete-file tmp-file))))
;;;###autoload
(defun org-export-as-org (arg &optional hidden ext-plist
to-buffer body-only pub-dir)
@ -2760,7 +2896,7 @@ If yes remove the column and the special lines."
(defun org-export-cleanup-toc-line (s)
"Remove tags and timestamps from lines going into the toc."
(when (memq org-export-with-tags '(not-in-toc nil))
(if (string-match (org-re " +:[[:alnum:]_@:]+: *$") s)
(if (string-match (org-re " +:[[:alnum:]_@#%:]+: *$") s)
(setq s (replace-match "" t t s))))
(when org-export-remove-timestamps-from-toc
(while (string-match org-maybe-keyword-time-regexp s)

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

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;

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

@ -5,7 +5,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;
@ -99,11 +99,11 @@
(declare-function xml-get-children "xml" (node child-name))
(declare-function xml-get-attribute "xml" (node attribute))
(declare-function xml-get-attribute-or-nil "xml" (node attribute))
(defvar xml-entity-alist)
(declare-function xml-substitute-special "xml" (string))
(defgroup org-feed nil
"Options concerning RSS feeds as inputs for Org files."
:tag "Org ID"
:tag "Org Feed"
:group 'org)
(defcustom org-feed-alist nil
@ -269,17 +269,6 @@ have been saved."
(defvar org-feed-buffer "*Org feed*"
"The buffer used to retrieve a feed.")
(defun org-feed-unescape (s)
"Unescape protected entities in S."
(require 'xml)
(let ((re (concat "&\\("
(mapconcat 'car xml-entity-alist "\\|")
"\\);")))
(while (string-match re s)
(setq s (replace-match
(cdr (assoc (match-string 1 s) xml-entity-alist)) nil nil s)))
s))
;;;###autoload
(defun org-feed-update-all ()
"Get inbox items from all feeds in `org-feed-alist'."
@ -553,7 +542,8 @@ If that property is already present, nothing changes."
(setq tmp (org-feed-make-indented-block
tmp (org-get-indentation))))))
(replace-match tmp t t))))
(buffer-string)))))
(decode-coding-string
(buffer-string) (detect-coding-region (point-min) (point-max) t))))))
(defun org-feed-make-indented-block (s n)
"Add indentation of N spaces to a multiline string S."
@ -613,6 +603,7 @@ containing the properties `:guid' and `:item-full-text'."
(defun org-feed-parse-rss-entry (entry)
"Parse the `:item-full-text' field for xml tags and create new properties."
(require 'xml)
(with-temp-buffer
(insert (plist-get entry :item-full-text))
(goto-char (point-min))
@ -620,7 +611,7 @@ containing the properties `:guid' and `:item-full-text'."
nil t)
(setq entry (plist-put entry
(intern (concat ":" (match-string 1)))
(org-feed-unescape (match-string 2)))))
(xml-substitute-special (match-string 2)))))
(goto-char (point-min))
(unless (re-search-forward "isPermaLink[ \t]*=[ \t]*\"false\"" nil t)
(setq entry (plist-put entry :guid-permalink t))))
@ -654,7 +645,7 @@ formatted as a string, not the original XML data."
'href)))
;; Add <title/> as :title.
(setq entry (plist-put entry :title
(org-feed-unescape
(xml-substitute-special
(car (xml-node-children
(car (xml-get-children xml 'title)))))))
(let* ((content (car (xml-get-children xml 'content)))
@ -664,12 +655,12 @@ formatted as a string, not the original XML data."
((string= type "text")
;; We like plain text.
(setq entry (plist-put entry :description
(org-feed-unescape
(xml-substitute-special
(car (xml-node-children content))))))
((string= type "html")
;; TODO: convert HTML to Org markup.
(setq entry (plist-put entry :description
(org-feed-unescape
(xml-substitute-special
(car (xml-node-children content))))))
((string= type "xhtml")
;; TODO: convert XHTML to Org markup.

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

@ -5,7 +5,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;
@ -49,6 +49,7 @@
(declare-function org-in-verbatim-emphasis "org" ())
(declare-function org-inside-latex-macro-p "org" ())
(defvar org-odd-levels-only) ;; 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
@ -188,7 +189,7 @@ with start and label of the footnote if there is a definition at point."
(message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'."))))
(defun org-footnote-goto-previous-reference (label)
"Find the next previous of the footnote with label LABEL."
"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))
@ -302,15 +303,19 @@ or new, let the user edit the definition of the footnote."
(t
(setq re (concat "^" org-footnote-tag-for-non-org-mode-files "[ \t]*$"))
(unless (re-search-forward re nil t)
(goto-char (point-max))
(skip-chars-backward " \t\r\n")
(insert "\n\n")
(delete-region (point) (point-max))
(insert org-footnote-tag-for-non-org-mode-files "\n"))
(goto-char (point-max))
(skip-chars-backward " \t\r\n")))
(insert "\n\n")
(insert "[" label "] ")
(let ((max (if (and (eq major-mode 'message-mode)
(re-search-forward message-signature-separator nil t))
(progn (beginning-of-line) (point))
(goto-char (point-max)))))
(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)))
(message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'.")))
;;;###autoload
@ -506,7 +511,8 @@ ENTRY is (fn-label num-mark definition)."
(beginning-of-line 0))
(if (looking-at "[ \t]*#\\+TBLFM:") (beginning-of-line 2))
(end-of-line 1)
(skip-chars-backward "\n\r\t "))
(skip-chars-backward "\n\r\t ")
(forward-line))
(defun org-footnote-delete (&optional label)
"Delete the footnote at point.

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

@ -5,7 +5,7 @@
;; Author: Lennart Borgman (lennart O borgman A gmail O com)
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 6.35i
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;
@ -81,31 +81,35 @@
(require 'xml)
(require 'org)
(require 'rx)
;(require 'rx)
(require 'org-exp)
(eval-when-compile (require 'cl))
(defgroup org-freemind nil
"Customization group for org-freemind export/import."
:group 'org)
;; Fix-me: I am not sure these are useful:
;;
;; (defcustom org-freemind-main-fgcolor "black"
;; "Color of main node's text."
;; :type 'color
;; :group 'freemind)
;; :group 'org-freemind)
;; (defcustom org-freemind-main-color "black"
;; "Background color of main node."
;; :type 'color
;; :group 'freemind)
;; :group 'org-freemind)
;; (defcustom org-freemind-child-fgcolor "black"
;; "Color of child nodes' text."
;; :type 'color
;; :group 'freemind)
;; :group 'org-freemind)
;; (defcustom org-freemind-child-color "black"
;; "Background color of child nodes."
;; :type 'color
;; :group 'freemind)
;; :group 'org-freemind)
(defvar org-freemind-node-style nil "Internal use.")
@ -152,11 +156,25 @@ NOT READY YET."
(string :tag "Font name" :value "SansSerif"))
(list :format "%v" (const :format "" font-size)
(integer :tag "Font size" :value 12)))))))
:group 'freemind)
:group 'org-freemind)
;;;###autoload
(defun org-export-as-freemind (arg &optional hidden ext-plist
(defun org-export-as-freemind (&optional hidden ext-plist
to-buffer body-only pub-dir)
"Export the current buffer as a Freemind file.
If there is an active region, export only the region. HIDDEN is
obsolete and does nothing. EXT-PLIST is a property list with
external parameters overriding org-mode's default settings, but
still inferior to file-local settings. When TO-BUFFER is
non-nil, create a buffer with that name and export to that
buffer. If TO-BUFFER is the symbol `string', don't leave any
buffer behind but just return the resulting HTML as a string.
When BODY-ONLY is set, don't produce the file header and footer,
simply return the content of the document (all top level
sections). When PUB-DIR is set, use this as the publishing
directory.
See `org-freemind-from-org-mode' for more information."
(interactive "P")
(let* ((opt-plist (org-combine-plists (org-default-export-plist)
ext-plist
@ -203,7 +221,20 @@ NOT READY YET."
(let ((name (read-file-name "FreeMind file: "
nil nil nil
(if (buffer-file-name)
(file-name-nondirectory (buffer-file-name))
(let* ((name-ext (file-name-nondirectory (buffer-file-name)))
(name (file-name-sans-extension name-ext))
(ext (file-name-extension name-ext)))
(cond
((string= "mm" ext)
name-ext)
((string= "org" ext)
(let ((name-mm (concat name ".mm")))
(if (file-exists-p name-mm)
name-mm
(message "Not exported to Freemind format yet")
"")))
(t
"")))
"")
;; Fix-me: Is this an Emacs bug?
;; This predicate function is never
@ -227,7 +258,7 @@ The characters \"&<> will be escaped."
(dolist (cc chars)
(setq fm-str
(concat fm-str
(if (< cc 256)
(if (< cc 160)
(cond
((= cc ?\") "&quot;")
((= cc ?\&) "&amp;")
@ -265,52 +296,84 @@ will also unescape &#nn;."
)))
org-str))))
;; (org-freemind-test-escape)
(defun org-freemind-test-escape ()
(let* ((str1 "a quote: \", an amp: &, lt: <; over 256: öåäÖÅÄ")
(str2 (org-freemind-escape-str-from-org str1))
(str3 (org-freemind-unescape-str-to-org str2))
;; (let* ((str1 "a quote: \", an amp: &, lt: <; over 256: öåäÖÅÄ")
;; (str2 (org-freemind-escape-str-from-org str1))
;; (str3 (org-freemind-unescape-str-to-org str2)))
;; (unless (string= str1 str3)
;; (error "Error str3=%s" str3)))
(defun org-freemind-convert-links-helper (matched)
"Helper for `org-freemind-convert-links-from-org'.
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))
(is-img (and (image-type-from-file-name link)
(let ((url-type (substring link 0 col-pos)))
(member url-type '("file" "http" "https")))))
)
(unless (string= str1 str3)
(error "str3=%s" str3))
))
(if is-img
;; Fix-me: I can't find a way to get the border to "shrink
;; wrap" around the image using <div>.
;;
;; (concat "<div style=\"border: solid 1px #ddd; width:auto;\">"
;; "<img src=\"" link "\" alt=\"" text "\" />"
;; "<br />"
;; "<i>" text "</i>"
;; "</div>")
(concat "<table border=\"0\" style=\"border: solid 1px #ddd;\"><tr><td>"
"<img src=\"" link "\" alt=\"" text "\" />"
"<br />"
"<i>" text "</i>"
"</td></tr></table>")
(concat "<a href=\"" link "\">" text "</a>"))))
(defun org-freemind-convert-links-from-org (org-str)
"Convert org links in ORG-STR to freemind links and return the result."
(let ((fm-str (replace-regexp-in-string
(rx (not (any "[\""))
(submatch
"http"
(opt ?\s)
"://"
(1+
(any "-%.?@a-zA-Z0-9()_/:~=&#"))))
;;(rx (not (any "[\""))
;; (submatch
;; "http"
;; (opt ?\s)
;; "://"
;; (1+
;; (any "-%.?@a-zA-Z0-9()_/:~=&#"))))
"[^\"[]\\(http ?://[--:#%&()=?-Z_a-z~]+\\)"
"[[\\1][\\1]]"
org-str)))
(replace-regexp-in-string (rx "[["
(submatch (*? nonl))
"]["
(submatch (*? nonl))
"]]")
"<a href=\"\\1\">\\2</a>"
fm-str)))
org-str
nil ;; fixedcase
nil ;; literal
1 ;; subexp
)))
(replace-regexp-in-string
;;(rx "[["
;; (submatch (*? nonl))
;; "]["
;; (submatch (*? nonl))
;; "]]")
"\\[\\[\\(.*?\\)]\\[\\(.*?\\)]]"
;;"<a href=\"\\1\">\\2</a>"
'org-freemind-convert-links-helper
fm-str)))
;;(org-freemind-convert-links-to-org "<a href=\"http://www.somewhere/\">link-text</a>")
(defun org-freemind-convert-links-to-org (fm-str)
"Convert freemind links in FM-STR to org links and return the result."
(let ((org-str (replace-regexp-in-string
(rx "<a"
space
(0+
(0+ (not (any ">")))
space)
"href=\""
(submatch (0+ (not (any "\""))))
"\""
(0+ (not (any ">")))
">"
(submatch (0+ (not (any "<"))))
"</a>")
;;(rx "<a"
;; space
;; (0+
;; (0+ (not (any ">")))
;; space)
;; "href=\""
;; (submatch (0+ (not (any "\""))))
;; "\""
;; (0+ (not (any ">")))
;; ">"
;; (submatch (0+ (not (any "<"))))
;; "</a>")
"<a[[:space:]]\\(?:[^>]*[[:space:]]\\)*href=\"\\([^\"]*\\)\"[^>]*>\\([^<]*\\)</a>"
"[[\\1][\\2]]"
fm-str)))
org-str))
@ -319,29 +382,60 @@ will also unescape &#nn;."
;;(defun org-freemind-convert-drawers-from-org (text)
;; )
;; (org-freemind-test-links)
;; (defun org-freemind-test-links ()
;; (let* ((str1 "[[http://www.somewhere/][link-text]")
;; (str2 (org-freemind-convert-links-from-org str1))
;; (str3 (org-freemind-convert-links-to-org str2))
;; )
;; (str3 (org-freemind-convert-links-to-org str2)))
;; (unless (string= str1 str3)
;; (error "str3=%s" str3))
;; ))
;; (error "Error str3=%s" str3)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Org => FreeMind
(defvar org-freemind-bol-helper-base-indent nil)
(defun org-freemind-bol-helper (matched)
"Helper for `org-freemind-convert-text-p'.
MATCHED is the link just matched."
(let ((res "")
(bi org-freemind-bol-helper-base-indent))
(dolist (cc (append matched nil))
(if (= 32 cc)
;;(setq res (concat res "&nbsp;"))
;; We need to use the numerical version. Otherwise Freemind
;; ver 0.9.0 RC9 can not export to html/javascript.
(progn
(if (< 0 bi)
(setq bi (1- bi))
(setq res (concat res "&#160;"))))
(setq res (concat res (char-to-string cc)))))
res))
;; (setq x (replace-regexp-in-string "\n +" 'org-freemind-bol-nbsp-helper "\n "))
(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 text (org-freemind-escape-str-from-org text))
(setq text (replace-regexp-in-string (rx "\n" (0+ blank) "\n") "</p><p>\n" text))
;;(setq text (replace-regexp-in-string (rx bol (1+ blank) eol) "" text))
;;(setq text (replace-regexp-in-string (rx bol (1+ blank)) "<br />" text))
(setq text (replace-regexp-in-string "\\([[:space:]]\\)\\(/\\)\\([^/]+\\)\\(/\\)\\([[:space:]]\\)" "\\1<i>\\3</i>\\5" text))
(setq text (replace-regexp-in-string "\\([[:space:]]\\)\\(\*\\)\\([^*]+\\)\\(\*\\)\\([[:space:]]\\)" "\\1<b>\\3</b>\\5" text))
(setq text (concat "<p>" text))
(setq text (replace-regexp-in-string "\n[[:blank:]]*\n" "</p><p>" text))
(setq text (replace-regexp-in-string "\\(?:<p>\\|\n\\) +" 'org-freemind-bol-helper text))
(setq text (replace-regexp-in-string "\n" "<br />" text))
(concat "<p>"
(org-freemind-convert-links-from-org text)
"</p>\n"))
(setq text (concat text "</p>"))
(org-freemind-convert-links-from-org text))
(defcustom org-freemind-node-css-style
"p { margin-top: 3px; margin-bottom: 3px; }"
"CSS style for Freemind nodes."
;; Fix-me: I do not understand this. It worked to export from Freemind
;; with this setting now, but not before??? Was this perhaps a java
;; bug or is it a windows xp bug (some resource gets exhausted if you
;; use sticky keys which I do).
:group 'org-freemind)
(defun org-freemind-org-text-to-freemind-subnode/note (node-name start end drawers-regexp)
"Convert text part of org node to freemind subnode or note.
@ -390,11 +484,14 @@ DRAWERS-REGEXP are converted to freemind notes."
"<node style=\"bubble\" background_color=\"#eeee00\">\n"
"<richcontent TYPE=\"NODE\"><html>\n"
"<head>\n"
(if (= 0 (length org-freemind-node-css-style))
""
(concat
"<style type=\"text/css\">\n"
"<!--\n"
"p { margin-top: 0 }\n"
org-freemind-node-css-style
"-->\n"
"</style>\n"
"</style>\n"))
"</head>\n"
"<body>\n"))
(let ((begin-html-mark (regexp-quote "#+BEGIN_HTML"))
@ -427,21 +524,28 @@ DRAWERS-REGEXP are converted to freemind notes."
"</html>\n"
"</richcontent>\n"
;; Put a note that this is for the parent node
"<richcontent TYPE=\"NOTE\"><html>"
"<head>"
"</head>"
"<body>"
"<p>"
"-- This is more about \"" node-name "\" --"
"</p>"
"</body>"
"</html>"
"</richcontent>\n"
;; "<richcontent TYPE=\"NOTE\"><html>"
;; "<head>"
;; "</head>"
;; "<body>"
;; "<p>"
;; "-- This is more about \"" node-name "\" --"
;; "</p>"
;; "</body>"
;; "</html>"
;; "</richcontent>\n"
note-res
"</node>\n" ;; ok
)))
(list node-res note-res))))
(defun org-freemind-write-node (mm-buffer drawers-regexp num-left-nodes base-level current-level next-level this-m2 this-node-end this-children-visible next-node-start next-has-some-visible-child)
(defun org-freemind-write-node (mm-buffer drawers-regexp
num-left-nodes base-level
current-level next-level this-m2
this-node-end
this-children-visible
next-node-start
next-has-some-visible-child)
(let* (this-icons
this-bg-color
this-m2-escaped
@ -503,7 +607,7 @@ DRAWERS-REGEXP are converted to freemind notes."
(insert "<icon builtin=\"" icon "\"/>\n")))
)
(with-current-buffer mm-buffer
(when this-rich-note (insert this-rich-note))
;;(when this-rich-note (insert this-rich-note))
(when this-rich-node (insert this-rich-node))))
num-left-nodes)
@ -521,11 +625,13 @@ Otherwise give an error say the file exists."
(error "File %s already exists" file))
t))
(defvar org-freemind-node-pattern (rx bol
(submatch (1+ "*"))
(1+ space)
(submatch (*? nonl))
eol))
(defvar org-freemind-node-pattern
;;(rx bol
;; (submatch (1+ "*"))
;; (1+ space)
;; (submatch (*? nonl))
;; eol)
"^\\(\\*+\\)[[:space:]]+\\(.*?\\)$")
(defun org-freemind-look-for-visible-child (node-level)
(save-excursion
@ -573,27 +679,31 @@ Otherwise give an error say the file exists."
node-at-line-last)
(with-current-buffer mm-buffer
(erase-buffer)
(insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n")
(setq buffer-file-coding-system 'utf-8)
;; Fix-me: Currentl Freemind (ver 0.9.0 RC9) does not support this:
;;(insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n")
(insert "<map version=\"0.9.0\">\n")
(insert "<!-- To view this file, download free mind mapping software FreeMind from http://freemind.sourceforge.net -->\n"))
(save-excursion
;; Get special buffer vars:
(goto-char (point-min))
(while (re-search-forward (rx bol "#+DRAWERS:") nil t)
(message "Writing Freemind file...")
(while (re-search-forward "^#\\+DRAWERS:" nil t)
(let ((dr-txt (buffer-substring-no-properties (match-end 0) (line-end-position))))
(setq drawers (append drawers (split-string dr-txt) nil))))
(setq drawers-regexp
(concat (rx bol (0+ blank) ":")
(concat "^[[:blank:]]*:"
(regexp-opt drawers)
(rx ":" (0+ blank)
"\n"
(*? anything)
"\n"
(0+ blank)
":END:"
(0+ blank)
eol)
))
;;(rx ":" (0+ blank)
;; "\n"
;; (*? anything)
;; "\n"
;; (0+ blank)
;; ":END:"
;; (0+ blank)
;; eol)
":[[:blank:]]*\n\\(?:.\\|\n\\)*?\n[[:blank:]]*:END:[[:blank:]]*$"
))
(if node-at-line
;; Get number of top nodes and last line for this node
@ -795,7 +905,8 @@ Otherwise give an error say the file exists."
;;;###autoload
(defun org-freemind-from-org-mode-node (node-line mm-file)
"Convert node at line NODE-LINE to the FreeMind file MM-FILE."
"Convert node at line NODE-LINE to the FreeMind file MM-FILE.
See `org-freemind-from-org-mode' for more information."
(interactive
(progn
(unless (org-back-to-heading nil)
@ -808,20 +919,29 @@ Otherwise give an error say the file exists."
".mm"))
(mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file)))
(list line mm-file))))
(when (org-freemind-check-overwrite mm-file (called-interactively-p 'any))
(when (org-freemind-check-overwrite mm-file (org-called-interactively-p 'any))
(let ((org-buffer (current-buffer))
(mm-buffer (find-file-noselect mm-file)))
(org-freemind-write-mm-buffer org-buffer mm-buffer node-line)
(with-current-buffer mm-buffer
(basic-save-buffer)
(when (called-interactively-p 'any)
(when (org-called-interactively-p 'any)
(switch-to-buffer-other-window mm-buffer)
(when (y-or-n-p "Show in FreeMind? ")
(org-freemind-show buffer-file-name)))))))
;;;###autoload
(defun org-freemind-from-org-mode (org-file mm-file)
"Convert the `org-mode' file ORG-FILE to the FreeMind file MM-FILE."
"Convert the `org-mode' file ORG-FILE to the FreeMind file MM-FILE.
All the nodes will be opened or closed in Freemind just as you
have them in `org-mode'.
Note that exporting to Freemind also gives you an alternative way
to export from `org-mode' to html. You can create a dynamic html
version of the your org file, by first exporting to Freemind and
then exporting from Freemind to html. The 'As
XHTML (JavaScript)' version in Freemind works very well \(and you
can use a CSS stylesheet to style it)."
;; Fix-me: better doc, include recommendations etc.
(interactive
(let* ((org-file buffer-file-name)
@ -832,13 +952,13 @@ Otherwise give an error say the file exists."
".mm"))
(mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file)))
(list org-file mm-file)))
(when (org-freemind-check-overwrite mm-file (called-interactively-p 'any))
(when (org-freemind-check-overwrite mm-file (org-called-interactively-p 'any))
(let ((org-buffer (if org-file (find-file-noselect org-file) (current-buffer)))
(mm-buffer (find-file-noselect mm-file)))
(org-freemind-write-mm-buffer org-buffer mm-buffer nil)
(with-current-buffer mm-buffer
(basic-save-buffer)
(when (called-interactively-p 'any)
(when (org-called-interactively-p 'any)
(switch-to-buffer-other-window mm-buffer)
(when (y-or-n-p "Show in FreeMind? ")
(org-freemind-show buffer-file-name)))))))
@ -855,7 +975,7 @@ Otherwise give an error say the file exists."
"-sparse.mm"))
(mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file)))
(list (current-buffer) mm-file)))
(when (org-freemind-check-overwrite mm-file (called-interactively-p 'any))
(when (org-freemind-check-overwrite mm-file (org-called-interactively-p 'any))
(let (org-buffer
(mm-buffer (find-file-noselect mm-file)))
(save-window-excursion
@ -864,7 +984,7 @@ Otherwise give an error say the file exists."
(org-freemind-write-mm-buffer org-buffer mm-buffer nil)
(with-current-buffer mm-buffer
(basic-save-buffer)
(when (called-interactively-p 'any)
(when (org-called-interactively-p 'any)
(switch-to-buffer-other-window mm-buffer)
(when (y-or-n-p "Show in FreeMind? ")
(org-freemind-show buffer-file-name)))))))
@ -1019,7 +1139,7 @@ PATH should be a list of steps, where each step has the form
(save-match-data
(let* ((rc (org-freemind-get-richcontent-node node))
(txt (org-freemind-get-tree-text rc)))
;;(when txt (setq txt (replace-regexp-in-string (rx (1+ whitespace)) " " txt)))
;;(when txt (setq txt (replace-regexp-in-string "[[:space:]]+" " " txt)))
txt
)))
@ -1028,7 +1148,7 @@ PATH should be a list of steps, where each step has the form
(save-match-data
(let* ((rc (org-freemind-get-richcontent-note node))
(txt (when rc (org-freemind-get-tree-text rc))))
;;(when txt (setq txt (replace-regexp-in-string (rx (1+ whitespace)) " " txt)))
;;(when txt (setq txt (replace-regexp-in-string "[[:space:]]+" " " txt)))
txt
)))
@ -1044,6 +1164,7 @@ PATH should be a list of steps, where each step has the form
(let ((qname (car node))
(attributes (cadr node))
text
;; Fix-me: note is never inserted
(note (org-freemind-get-richcontent-note-text node))
(mark "-- This is more about ")
(icons (org-freemind-get-icon-names node))
@ -1074,6 +1195,8 @@ PATH should be a list of steps, where each step has the form
(case qname
('node
(insert (make-string (- level skip-levels) ?*) " " text "\n")
(when note
(insert ":COMMENT:\n" note "\n:END:\n"))
))))
(dolist (child children)
(unless (or (null child)
@ -1091,7 +1214,7 @@ PATH should be a list of steps, where each step has the form
(default-org-file (concat (file-name-nondirectory mm-file) ".org"))
(org-file (read-file-name "Output org-mode file: " nil nil nil default-org-file)))
(list mm-file org-file))))
(when (org-freemind-check-overwrite org-file (called-interactively-p 'any))
(when (org-freemind-check-overwrite org-file (org-called-interactively-p 'any))
(let ((mm-buffer (find-file-noselect mm-file))
(org-buffer (find-file-noselect org-file)))
(with-current-buffer mm-buffer
@ -1100,7 +1223,7 @@ PATH should be a list of steps, where each step has the form
(note (org-freemind-get-richcontent-note-text top-node))
(skip-levels
(if (and note
(string-match (rx bol "--org-mode: WHOLE FILE" eol) note))
(string-match "^--org-mode: WHOLE FILE$" note))
1
0)))
(with-current-buffer org-buffer

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

@ -7,7 +7,7 @@
;; Tassilo Horn <tassilo at member dot fsf dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;
@ -39,9 +39,9 @@
;; Declare external functions and variables
(declare-function message-fetch-field "message" (header &optional not-all))
(declare-function message-narrow-to-head-1 "message" nil)
(declare-function nnimap-group-overview-filename "nnimap" (group server))
;; The following line suppresses a compiler warning stemming from gnus-sum.el
(declare-function gnus-summary-last-subject "gnus-sum" nil)
;; Customization variables
(when (fboundp 'defvaralias)
@ -55,6 +55,17 @@ negates this setting for the duration of the command."
:group 'org-link-store
:type 'boolean)
(defcustom org-gnus-nnimap-query-article-no-from-file nil
"If non-nil, `org-gnus-follow-link' will try to translate
Message-Ids to article numbers by querying the .overview file.
Normally, this translation is done by querying the IMAP server,
which is usually very fast. Unfortunately, some (maybe badly
configured) IMAP servers don't support this operation quickly.
So if following a link to a Gnus article takes ages, try setting
this variable to `t'."
:group 'org-link-store
:type 'boolean)
;; Install the link type
(org-add-link-type "gnus" 'org-gnus-open)
@ -62,6 +73,22 @@ negates this setting for the duration of the command."
;; Implementation
(defun org-gnus-nnimap-cached-article-number (group server message-id)
"Return cached article number (uid) of message in GROUP on SERVER.
MESSAGE-ID is the message-id header field that identifies the
message. If the uid is not cached, return nil."
(with-temp-buffer
(let ((nov (nnimap-group-overview-filename group server)))
(when (file-exists-p nov)
(mm-insert-file-contents nov)
(set-buffer-modified-p nil)
(goto-char (point-min))
(catch 'found
(while (search-forward message-id nil t)
(let ((hdr (split-string (thing-at-point 'line) "\t")))
(if (string= (nth 4 hdr) message-id)
(throw 'found (nth 0 hdr))))))))))
(defun org-gnus-group-link (group)
"Create a link to the Gnus group GROUP.
If GROUP is a newsgroup and `org-gnus-prefer-web-links' is
@ -125,6 +152,11 @@ If `org-store-link' was called with a prefix arg the meaning of
(from (mail-header-from header))
(message-id (org-remove-angle-brackets (mail-header-id header)))
(date (mail-header-date header))
(date-ts (and date (format-time-string
(org-time-stamp-format t) (date-to-time date))))
(date-ts-ia (and date (format-time-string
(org-time-stamp-format t t)
(date-to-time date))))
(subject (copy-sequence (mail-header-subject header)))
(to (cdr (assq 'To (mail-header-extra header))))
newsgroups x-no-archive desc link)
@ -140,14 +172,27 @@ If `org-store-link' was called with a prefix arg the meaning of
(setq to (or to (gnus-fetch-original-field "To"))
newsgroups (gnus-fetch-original-field "Newsgroups")
x-no-archive (gnus-fetch-original-field "x-no-archive")))
(org-store-link-props :type "gnus" :from from :subject subject
(org-store-link-props :type "gnus" :from from :subject subject
:message-id message-id :group group :to to)
(when date
(org-add-link-props :date date :date-timestamp date-ts
:date-timestamp-inactive date-ts-ia))
(setq desc (org-email-link-description)
link (org-gnus-article-link
group newsgroups message-id x-no-archive))
(org-add-link-props :link link :description desc)
link))))
(defun org-gnus-open-nntp (path)
"Follow the nntp: link specified by PATH."
(let* ((spec (split-string path "/"))
(server (split-string (nth 2 spec) "@"))
(group (nth 3 spec))
(article (nth 4 spec)))
(org-gnus-follow-link
(format "nntp+%s:%s" (or (cdr server) (car server)) group)
article)))
(defun org-gnus-open (path)
"Follow the Gnus message or folder link specified by PATH."
(let (group article)
@ -173,7 +218,9 @@ If `org-store-link' was called with a prefix arg the meaning of
(cond ((and group article)
(gnus-activate-group group t)
(condition-case nil
(let ((backend (car (gnus-find-method-for-group group))))
(let* ((method (gnus-find-method-for-group group))
(backend (car method))
(server (cadr method)))
(cond
((eq backend 'nndoc)
(if (gnus-group-read-group t nil group)
@ -183,6 +230,12 @@ If `org-store-link' was called with a prefix arg the meaning of
(t
(let ((articles 1)
group-opened)
(when (and (eq backend 'nnimap)
org-gnus-nnimap-query-article-no-from-file)
(setq article
(or (org-gnus-nnimap-cached-article-number
(nth 1 (split-string group ":"))
server (concat "<" article ">")) article)))
(while (and (not group-opened)
;; stop on integer overflows
(> articles 0))

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

@ -5,7 +5,7 @@
;; Author: John Wiegley <johnw at gnu dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;
@ -149,15 +149,17 @@ This list represents a \"habit\" for the rest of this module."
(assert (org-is-habit-p (point)))
(let* ((scheduled (org-get-scheduled-time (point)))
(scheduled-repeat (org-get-repeat org-scheduled-string))
(sr-days (org-habit-duration-to-days scheduled-repeat))
(end (org-entry-end-position))
(habit-entry (org-no-properties (nth 5 (org-heading-components))))
closed-dates deadline dr-days)
(habit-entry (org-no-properties (nth 4 (org-heading-components))))
closed-dates deadline dr-days sr-days)
(if scheduled
(setq scheduled (time-to-days scheduled))
(error "Habit %s has no scheduled date" habit-entry))
(unless scheduled-repeat
(error "Habit %s has no scheduled repeat period" habit-entry))
(error
"Habit '%s' has no scheduled repeat period or has an incorrect one"
habit-entry))
(setq sr-days (org-habit-duration-to-days scheduled-repeat))
(unless (> sr-days 0)
(error "Habit %s scheduled repeat period is less than 1d" habit-entry))
(when (string-match "/\\([0-9]+[dwmy]\\)" scheduled-repeat)

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

File diff suppressed because it is too large Load diff

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

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;
@ -47,13 +47,24 @@ The file name should be absolute, the file will be overwritten without warning."
:group 'org-export-icalendar
:type 'file)
(defcustom org-icalendar-alarm-time 0
"Number of minutes for triggering an alarm for exported timed events.
A zero value (the default) turns off the definition of an alarm trigger
for timed events. If non-zero, alarms are created.
- a single alarm per entry is defined
- The alarm will go off N minutes before the event
- only a DISPLAY action is defined."
:group 'org-export-icalendar
:type 'integer)
(defcustom org-icalendar-combined-name "OrgMode"
"Calendar name for the combined iCalendar representing all agenda files."
:group 'org-export-icalendar
:type 'string)
(defcustom org-icalendar-combined-description nil
"Calendar description for the combined iCalendar representing all agenda files."
"Calendar description for the combined iCalendar (all agenda files)."
:group 'org-export-icalendar
:type 'string)
@ -183,6 +194,13 @@ 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."
:group 'org-export-icalendar
:type 'boolean)
;;; iCalendar export
;;;###autoload
@ -282,7 +300,7 @@ When COMBINE is non nil, add the category to each line."
"DTSTART"))
hd ts ts2 state status (inc t) pos b sexp rrule
scheduledp deadlinep todo prefix due start
tmp pri categories location summary desc uid
tmp pri categories location summary desc uid alarm
(sexp-buffer (get-buffer-create "*ical-tmp*")))
(org-refresh-category-properties)
(save-excursion
@ -300,7 +318,7 @@ When COMBINE is non nil, add the category to each line."
inc t
hd (condition-case nil
(org-icalendar-cleanup-string
(org-get-heading))
(org-get-heading t))
(error (throw :skip nil)))
summary (org-icalendar-cleanup-string
(org-entry-get nil "SUMMARY"))
@ -314,6 +332,7 @@ When COMBINE is non nil, add the category to each line."
(org-id-get-create)
(or (org-id-get) (org-id-new)))
categories (org-export-get-categories)
alarm ""
deadlinep nil scheduledp nil)
(if (looking-at re2)
(progn
@ -362,6 +381,17 @@ When COMBINE is non nil, add the category to each line."
";INTERVAL=" (match-string 1 ts)))
(setq rrule ""))
(setq summary (or summary hd))
;; create an alarm entry if the entry is timed. this is not very general in that:
;; (a) only one alarm per entry is defined,
;; (b) only minutes are allowed for the trigger period ahead of the start time, and
;; (c) only a DISPLAY action is defined.
;; [ESF]
(let ((t1 (ignore-errors (org-parse-time-string ts 'nodefault))))
(if (and (> org-icalendar-alarm-time 0)
(car t1) (nth 1 t1) (nth 2 t1))
(setq alarm (format "\nBEGIN:VALARM\nACTION:DISPLAY\nDESCRIPTION:%s\nTRIGGER:-P0D0H%dM0S\nEND:VALARM" summary org-icalendar-alarm-time))
(setq alarm ""))
)
(if (string-match org-bracket-link-regexp summary)
(setq summary
(replace-match (if (match-end 3)
@ -378,7 +408,7 @@ UID: %s
%s
%s%s
SUMMARY:%s%s%s
CATEGORIES:%s
CATEGORIES:%s%s
END:VEVENT\n"
(concat prefix uid)
(org-ical-ts-to-string ts "DTSTART")
@ -388,7 +418,8 @@ END:VEVENT\n"
(concat "\nDESCRIPTION: " desc) "")
(if (and location (string-match "\\S-" location))
(concat "\nLOCATION: " location) "")
categories)))))
categories
alarm)))))
(when (and org-icalendar-include-sexps
(condition-case nil (require 'icalendar) (error nil))
(fboundp 'icalendar-export-region))
@ -415,7 +446,7 @@ END:VEVENT\n"
(when org-icalendar-include-todo
(setq prefix "TODO-")
(goto-char (point-min))
(while (re-search-forward org-todo-line-regexp nil t)
(while (re-search-forward org-complex-heading-regexp nil t)
(catch :skip
(org-agenda-skip)
(when org-icalendar-verify-function
@ -447,7 +478,7 @@ END:VEVENT\n"
((eq org-icalendar-include-todo t)
;; include everything that is not done
(member state org-not-done-keywords))))
(setq hd (match-string 3)
(setq hd (match-string 4)
summary (org-icalendar-cleanup-string
(org-entry-get nil "SUMMARY"))
desc (org-icalendar-cleanup-string
@ -610,8 +641,13 @@ 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 ":%Y%m%dT%H%M%S" ";VALUE=DATE:%Y%m%d"))
(concat keyword (format-time-string fmt time)))))
(setq fmt (if have-time (if org-icalendar-use-UTC-date-time
":%Y%m%dT%H%M%SZ"
":%Y%m%dT%H%M%S")
";VALUE=DATE:%Y%m%d"))
(concat keyword (format-time-string fmt time
(and org-icalendar-use-UTC-date-time
have-time))))))
(provide 'org-icalendar)

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

@ -5,7 +5,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;
@ -596,6 +596,7 @@ optional argument MARKERP, return the position as a new marker."
;; Calling the following function is hard-coded into `org-store-link',
;; so we do have to add it to `org-store-link-functions'.
;;;###autoload
(defun org-id-store-link ()
"Store a link to the current entry, using its ID."
(interactive)

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

@ -4,7 +4,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;
@ -135,11 +135,11 @@ FIXME: How to update when broken?"
((org-bound-and-true-p org-inhibit-startup)
(setq org-indent-mode nil))
((and org-indent-mode (featurep 'xemacs))
(message "org-indent-mode does not work in XEmacs - refused to turn it on")
(message "org-indent-mode does not work in XEmacs - refusing to turn it on")
(setq org-indent-mode nil))
((and org-indent-mode
(not (org-version-check "23.1.50" "Org Indent mode" :predicate)))
(message "org-indent-mode is can crash Emacs 23.1 - refused to turn it on!")
(message "org-indent-mode can crash Emacs 23.1 - refusing to turn it on!")
(ding)
(sit-for 1)
(setq org-indent-mode nil))
@ -203,8 +203,9 @@ useful to make it ever so slightly different."
(defun org-indent-remove-properties (beg end)
"Remove indentations between BEG and END."
(org-unmodified
(remove-text-properties beg end '(line-prefix nil wrap-prefix nil))))
(let ((inhibit-modification-hooks t))
(with-silent-modifications
(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."
@ -219,8 +220,9 @@ useful to make it ever so slightly different."
"Add indentation properties between BEG and END.
Assumes that BEG is at the beginning of a line."
(when (or t org-indent-mode)
(let (ov b e n level exit nstars)
(org-unmodified
(let ((inhibit-modification-hooks t)
ov b e n level exit nstars)
(with-silent-modifications
(save-excursion
(goto-char beg)
(while (not exit)

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

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;

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

@ -5,7 +5,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
@ -90,7 +90,9 @@ or to a number smaller than this one. In fact, when `org-cycle-max-level' is
not set, it will be assumed to be one less than the value of smaller than
the value of this variable."
:group 'org-inlinetask
:type 'boolean)
:type '(choice
(const :tag "Off" nil)
(integer)))
(defcustom org-inlinetask-export t
"Non-nil means export inline tasks.
@ -104,7 +106,7 @@ When nil, they will not be exported."
(defvar org-complex-heading-regexp)
(defvar org-property-end-re)
(defcustom org-inlinetask-defaut-state nil
(defcustom org-inlinetask-default-state nil
"Non-nil means make inline tasks have a TODO keyword initially.
This should be the state `org-inlinetask-insert-task' should use by
default, or nil of no state should be assigned."
@ -115,20 +117,36 @@ default, or nil of no state should be assigned."
(defun org-inlinetask-insert-task (&optional no-state)
"Insert an inline task.
If prefix arg NO-STATE is set, ignore `org-inlinetask-defaut-state'."
If prefix arg NO-STATE is set, ignore `org-inlinetask-default-state'."
(interactive "P")
(or (bolp) (newline))
(let ((indent org-inlinetask-min-level))
(if org-odd-levels-only
(setq indent (- (* 2 indent) 1)))
(insert (make-string indent ?*)
(if (or no-state (not org-inlinetask-defaut-state))
(if (or no-state (not org-inlinetask-default-state))
" \n"
(concat " " org-inlinetask-defaut-state " \n"))
(concat " " org-inlinetask-default-state " \n"))
(make-string indent ?*) " END\n"))
(end-of-line -1))
(define-key org-mode-map "\C-c\C-xt" 'org-inlinetask-insert-task)
(defun org-inlinetask-in-task-p ()
"Return true if point is inside an inline task."
(save-excursion
(let* ((nstars (if org-odd-levels-only
(1- (* 2 (or org-inlinetask-min-level 200)))
(or org-inlinetask-min-level 200)))
(stars-re (concat "^\\(?:\\*\\{"
(format "%d" (- nstars 1))
",\\}\\)[ \t]+"))
(task-beg-re (concat stars-re "\\(?:.*\\)"))
(task-end-re (concat stars-re "\\(?:END\\|end\\)")))
(beginning-of-line)
(or (looking-at task-beg-re)
(and (re-search-forward "^\\*+[ \t]+" nil t)
(progn (beginning-of-line) (looking-at task-end-re)))))))
(defvar htmlp) ; dynamically scoped into the next function
(defvar latexp) ; dynamically scoped into the next function
(defun org-inlinetask-export-handler ()

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

@ -4,7 +4,7 @@
;;
;; Author: Philip Jackson <emacs@shellarchive.co.uk>
;; Keywords: erc, irc, link, org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;

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

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;

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

@ -4,7 +4,7 @@
;;
;; Emacs Lisp Archive Entry
;; Filename: org-latex.el
;; Version: 7.01
;; Version: 7.3
;; Author: Bastien Guerry <bzg AT altern DOT org>
;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com>
;; Keywords: org, wp, tex
@ -280,6 +280,11 @@ markup defined, the first one in the association list will be used."
(string :tag "Keyword")
(string :tag "Markup")))))
(defcustom org-export-latex-tag-markup "\\textbf{%s}"
"Markup for tags, as a printf format."
:group 'org-export-latex
:type 'string)
(defcustom org-export-latex-timestamp-markup "\\textit{%s}"
"A printf format string to be applied to time stamps."
:group 'org-export-latex
@ -371,12 +376,30 @@ for example using customize, or with something like
(require 'org-latex)
(add-to-list 'org-export-latex-packages-alist '(\"\" \"listings\"))
(add-to-list 'org-export-latex-packages-alist '(\"\" \"color\"))"
(add-to-list 'org-export-latex-packages-alist '(\"\" \"color\"))
Alternatively,
(setq org-export-latex-listings 'minted)
causes source code to be exported using the minted package as
opposed to listings. If you want to use minted, you need to add
the minted package to `org-export-latex-packages-alist', for
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
`org-latex-to-pdf-process' so that the -shell-escape option is
passed to pdflatex.
"
:group 'org-export-latex
:type 'boolean)
(defcustom org-export-latex-listings-langs
'((emacs-lisp "Lisp") (lisp "Lisp")
'((emacs-lisp "Lisp") (lisp "Lisp") (clojure "Lisp")
(c "C") (cc "C++")
(fortran "fortran")
(perl "Perl") (cperl "Perl") (python "Python") (ruby "Ruby")
@ -398,6 +421,44 @@ hurt if it is present."
(symbol :tag "Major mode ")
(string :tag "Listings language"))))
(defcustom org-export-latex-listings-w-names t
"Non-nil means export names of named code blocks.
Code blocks exported with the listings package (controlled by the
`org-export-latex-listings' variable) can be named in the style
of noweb."
:group 'org-export-latex
:type 'boolean)
(defcustom org-export-latex-minted-langs
'((emacs-lisp "common-lisp")
(cc "c++")
(cperl "perl")
(shell-script "bash")
(caml "ocaml"))
"Alist mapping languages to their minted language counterpart.
The key is a symbol, the major mode symbol without the \"-mode\".
The value is the string that should be inserted as the language parameter
for the minted package. If the mode name and the listings name are
the same, the language does not need an entry in this list - but it does not
hurt if it is present.
Note that minted uses all lower case for language identifiers,
and that the full list of language identifiers can be obtained
with:
pygmentize -L lexers
"
:group 'org-export-latex
:type '(repeat
(list
(symbol :tag "Major mode ")
(string :tag "Listings language"))))
(defcustom org-export-latex-minted-with-line-numbers nil
"Should source code line numbers be included when exporting
with the latex minted package?"
:group 'org-export-latex
:type 'boolean)
(defcustom org-export-latex-remove-from-headlines
'(:todo nil :priority nil :tags nil)
"A plist of keywords to remove from headlines. OBSOLETE.
@ -443,24 +504,53 @@ allowed. The default we use here encompasses both."
:group 'org-export)
(defcustom org-latex-to-pdf-process
'("pdflatex -interaction nonstopmode %s"
"pdflatex -interaction nonstopmode %s")
'("pdflatex -interaction nonstopmode -output-directory %o %f"
"pdflatex -interaction nonstopmode -output-directory %o %f"
"pdflatex -interaction nonstopmode -output-directory %o %f")
"Commands to process a LaTeX file to a PDF file.
This is a list of strings, each of them will be given to the shell
as a command. %s in the command will be replaced by the full file name, %b
by the file base name (i.e. without extension).
as a command. %f in the command will be replaced by the full file name, %b
by the file base name (i.e. without extension) and %o by the base directory
of the file.
The reason why this is a list is that it usually takes several runs of
pdflatex, maybe mixed with a call to bibtex. Org does not have a clever
`pdflatex', maybe mixed with a call to `bibtex'. Org does not have a clever
mechanism to detect which of these commands have to be run to get to a stable
result, and it also does not do any error checking.
By default, Org uses 3 runs of `pdflatex' to do the processing. If you
have texi2dvi on your system and if that does not cause the infamous
egrep/locale bug:
http://lists.gnu.org/archive/html/bug-texinfo/2010-03/msg00031.html
then `texi2dvi' is the superior choice. Org does offer it as one
of the customize options.
Alternatively, this may be a Lisp function that does the processing, so you
could use this to apply the machinery of AUCTeX or the Emacs LaTeX mode.
This function should accept the file name as its single argument."
:group 'org-export-pdf
:type '(choice (repeat :tag "Shell command sequence"
:type '(choice
(repeat :tag "Shell command sequence"
(string :tag "Shell command"))
(function)))
(const :tag "2 runs of pdflatex"
("pdflatex -interaction nonstopmode -output-directory %o %f"
"pdflatex -interaction nonstopmode -output-directory %o %f"))
(const :tag "3 runs of pdflatex"
("pdflatex -interaction nonstopmode -output-directory %o %f"
"pdflatex -interaction nonstopmode -output-directory %o %f"
"pdflatex -interaction nonstopmode -output-directory %o %f"))
(const :tag "pdflatex,bibtex,pdflatex,pdflatex"
("pdflatex -interaction nonstopmode -output-directory %o %f"
"bibtex %b"
"pdflatex -interaction nonstopmode -output-directory %o %f"
"pdflatex -interaction nonstopmode -output-directory %o %f"))
(const :tag "texi2dvi"
("texi2dvi -p -b -c -V %f"))
(const :tag "rubber"
("rubber -d --into %o %f"))
(function)))
(defcustom org-export-pdf-logfiles
'("aux" "idx" "log" "out" "toc" "nav" "snm" "vrb")
@ -832,9 +922,10 @@ when PUB-DIR is set, use this as the publishing directory."
(save-excursion
(goto-char (point-min))
(re-search-forward "\\\\bibliography{" nil t))))
cmd)
cmd output-dir errors)
(with-current-buffer outbuf (erase-buffer))
(message "Processing LaTeX file...")
(message (concat "Processing LaTeX file " file "..."))
(setq output-dir (file-name-directory file))
(if (and cmds (symbolp cmds))
(funcall cmds (shell-quote-argument file))
(while cmds
@ -844,23 +935,52 @@ when PUB-DIR is set, use this as the publishing directory."
(save-match-data
(shell-quote-argument base))
t t cmd)))
(while (string-match "%s" cmd)
(while (string-match "%f" cmd)
(setq cmd (replace-match
(save-match-data
(shell-quote-argument file))
t t cmd)))
(shell-command cmd outbuf outbuf)))
(message "Processing LaTeX file...done")
(while (string-match "%o" cmd)
(setq cmd (replace-match
(save-match-data
(shell-quote-argument output-dir))
t t cmd)))
(shell-command cmd outbuf)))
(message (concat "Processing LaTeX file " file "...done"))
(setq errors (org-export-latex-get-error outbuf))
(if (not (file-exists-p pdffile))
(error "PDF file was not produced")
(error (concat "PDF file " pdffile " was not produced"
(if errors (concat ":" errors "") "")))
(set-window-configuration wconfig)
(when org-export-pdf-remove-logfiles
(dolist (ext org-export-pdf-logfiles)
(setq file (concat base "." ext))
(and (file-exists-p file) (delete-file file))))
(message "Exporting to PDF...done")
(message (concat
"Exporting to PDF...done"
(if errors
(concat ", with some errors:" errors)
"")))
pdffile)))
(defun org-export-latex-get-error (buf)
"Collect the kinds of errors that remain in pdflatex processing."
(with-current-buffer buf
(save-excursion
(goto-char (point-max))
(when (re-search-backward "^[ \t]*This is pdf.*?TeX.*?Version" nil t)
;; OK, we are at the location of the final run
(let ((pos (point)) (errors "") (case-fold-search t))
(if (re-search-forward "Reference.*?undefined" nil t)
(setq errors (concat errors " [undefined reference]")))
(goto-char pos)
(if (re-search-forward "Citation.*?undefined" nil t)
(setq errors (concat errors " [undefined citation]")))
(goto-char pos)
(if (re-search-forward "Undefined control sequence" nil t)
(setq errors (concat errors " [undefined control sequence]")))
(and (org-string-nw-p errors) errors))))))
;;;###autoload
(defun org-export-as-pdf-and-open (arg)
"Export as LaTeX, then process through to PDF, and open."
@ -1158,7 +1278,7 @@ OPT-PLIST is the options plist for current buffer."
(plist-get opt-plist :latex-header-extra)))
;; append another special variable
(org-export-apply-macros-in-string org-export-latex-append-header)
;; define align if not yet defined
;; define alert if not yet defined
"\n\\providecommand{\\alert}[1]{\\textbf{#1}}"
;; insert the title
(format
@ -1227,9 +1347,13 @@ If END is non-nil, it is the end of the region."
'(:org-license-to-kill t))
(save-excursion
(goto-char pt)
(while (re-search-forward "^[ \t]*#+.*\n?" limit t)
(remove-text-properties (match-beginning 0) (match-end 0)
'(:org-license-to-kill t))))))))))
(while (re-search-forward "^[ \t]*#\\+.*\n?" limit t)
(let ((case-fold-search t))
(unless (org-string-match-p
"^[ \t]*#\\+\\(attr_\\|caption\\>\\|label\\>\\)"
(match-string 0))
(remove-text-properties (match-beginning 0) (match-end 0)
'(:org-license-to-kill t))))))))))))
(defvar org-export-latex-header-defs nil
@ -1310,13 +1434,13 @@ links, keywords, lists, tables, fixed-width"
(replace-match "")
(replace-match (format "\\textbf{%s}" (match-string 0)) t t)))
;; convert tags
(when (re-search-forward "\\(:[a-zA-Z0-9_@]+\\)+:" nil t)
(when (re-search-forward "\\(:[a-zA-Z0-9_@#%]+\\)+:" nil t)
(if (or (not org-export-with-tags)
(plist-get remove-list :tags))
(replace-match "")
(replace-match
(org-export-latex-protect-string
(format "\\textbf{%s}"
(format org-export-latex-tag-markup
(save-match-data
(replace-regexp-in-string
"_" "\\\\_" (match-string 0)))))
@ -1589,7 +1713,7 @@ 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 longtblp)
caption shortn label attr floatp placement longtblp)
(if org-export-latex-tables-verbatim
(let* ((tbl (concat "\\begin{verbatim}\n" raw-table
"\\end{verbatim}\n")))
@ -1609,7 +1733,12 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
align (and attr (stringp attr)
(string-match "\\<align=\\([^ \t\n\r]+\\)" attr)
(match-string 1 attr))
floatp (or caption label))
floatp (or caption label)
placement (if (and attr
(stringp attr)
(string-match "[ \t]*\\<placement=\\(\\S-+\\)" attr))
(match-string 1 attr)
"[htb]"))
(setq caption (and caption (org-export-latex-fontify-headline caption)))
(setq lines (org-split-string raw-table "\n"))
(apply 'delete-region (list beg end))
@ -1664,12 +1793,13 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(concat
(if longtblp
(concat "\\begin{longtable}{" align "}\n")
(if floatp "\\begin{table}[htb]\n"))
(if floatp (format "\\begin{table}%s\n" placement)))
(if floatp
(format
"\\caption%s{%s}"
"\\caption%s{%s} %s"
(if shortn (concat "[" shortn "]") "")
(or caption "")))
(or caption "")
(if label (format "\\label{%s}" label) "")))
(if (and longtblp caption) "\\\\\n" "\n")
(if (and org-export-latex-tables-centered (not longtblp))
"\\begin{center}\n")
@ -1741,7 +1871,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 ""))
@ -2213,11 +2343,11 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
"Convert plain text lists in current buffer into LaTeX lists."
(let (res)
(goto-char (point-min))
(while (org-re-search-forward-unprotected org-list-beginning-re nil t)
(while (org-search-forward-unenclosed org-item-beginning-re nil t)
(beginning-of-line)
(setq res (org-list-to-latex (org-list-parse-list t)
org-export-latex-list-parameters))
(while (string-match "^\\(\\\\item[ \t]+\\)\\[@start:\\([0-9]+\\)\\]"
(while (string-match "^\\(\\\\item[ \t]+\\)\\[@\\(?:start:\\)?\\([0-9]+\\)\\]"
res)
(setq res (replace-match
(concat (format "\\setcounter{enumi}{%d}"

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

File diff suppressed because it is too large Load diff

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

@ -5,7 +5,7 @@
;; Author: John Wiegley <johnw@gnu.org>
;; Christopher Suckling <suckling at gmail dot com>
;; Version: 7.01
;; Version: 7.3
;; Keywords: outlines, hypermedia, calendar, wp
;; This file is part of GNU Emacs.

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

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;
@ -38,11 +38,27 @@
(defmacro declare-function (fn file &optional arglist fileonly))))
(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 (or (> emacs-major-version 23)
(and (>= emacs-major-version 23)
(>= emacs-minor-version 2)))
(called-interactively-p ,kind)
(interactive-p))))
(defmacro org-bound-and-true-p (var)
"Return the value of symbol VAR if it is bound, else nil."
`(and (boundp (quote ,var)) ,var))
(defun org-string-nw-p (s)
"Is S a string with a non-white character?"
(and (stringp s)
(org-string-match-p "\\S-" s)
s))
(defun org-not-nil (v)
"If V not nil, and also not the string \"nil\", then return V.
Otherwise return nil."
@ -283,63 +299,6 @@ This is in contrast to merely setting it to 0."
(match-beginning 0) string)))
(replace-match newtext fixedcase literal string))
(defmacro org-with-limited-levels (&rest body)
"Execute BODY with limited number of outline levels."
`(let* ((outline-regexp (org-get-limited-outline-regexp)))
,@body))
(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
(let* ((limit-level (1- org-inlinetask-min-level))
(nstars (if org-odd-levels-only (1- (* limit-level 2)) limit-level)))
(format "\\*\\{1,%d\\} " nstars))))
;;; Saving and restoring visibility
(defun org-outline-overlay-data (&optional use-markers)
"Return a list of the locations of all outline overlays.
The are overlays with the `invisible' property value `outline'.
The return values is a list of cons cells, with start and stop
positions for each overlay.
If USE-MARKERS is set, return the positions as markers."
(let (beg end)
(save-excursion
(save-restriction
(widen)
(delq nil
(mapcar (lambda (o)
(when (eq (overlay-get o 'invisible) 'outline)
(setq beg (overlay-start o)
end (overlay-end o))
(and beg end (> end beg)
(if use-markers
(cons (move-marker (make-marker) beg)
(move-marker (make-marker) end))
(cons beg end)))))
(overlays-in (point-min) (point-max))))))))
(autoload 'show-all "outline" nil t)
(defun org-set-outline-overlay-data (data)
"Create visibility overlays for all positions in DATA.
DATA should have been made by `org-outline-overlay-data'."
(let (o)
(save-excursion
(save-restriction
(widen)
(show-all)
(mapc (lambda (c)
(setq o (make-overlay (car c) (cdr c)))
(overlay-put o 'invisible 'outline))
data)))))
(defmacro org-save-outline-visibility (use-markers &rest body)
"Save and restore outline visibility around BODY.
If USE-MARKERS is non-nil, use markers for the positions.
@ -359,6 +318,22 @@ point nowhere."
(and (markerp (cdr c)) (move-marker (cdr c) nil)))
data)))))
(defmacro org-with-limited-levels (&rest body)
"Execute BODY with limited number of outline levels."
`(let* ((outline-regexp (org-get-limited-outline-regexp)))
,@body))
(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
(let* ((limit-level (1- org-inlinetask-min-level))
(nstars (if org-odd-levels-only (1- (* limit-level 2)) limit-level)))
(format "\\*\\{1,%d\\} " nstars))))
(provide 'org-macs)

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

@ -5,7 +5,7 @@
;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
@ -81,7 +81,7 @@
(mew-case-folder (mew-sinfo-get-case)
(nth 1 (mew-refile-get msgnum)))
(mew-summary-folder-name)))
message-id from to subject desc link)
message-id from to subject desc link date date-ts date-ts-ia)
(save-window-excursion
(if (fboundp 'mew-summary-set-message-buffer)
(mew-summary-set-message-buffer folder-name msgnum)
@ -89,9 +89,19 @@
(setq message-id (mew-header-get-value "Message-Id:"))
(setq from (mew-header-get-value "From:"))
(setq to (mew-header-get-value "To:"))
(setq date (mew-header-get-value "Date:"))
(setq date-ts (and date (format-time-string
(org-time-stamp-format t)
(date-to-time date))))
(setq date-ts-ia (and date (format-time-string
(org-time-stamp-format t t)
(date-to-time date))))
(setq subject (mew-header-get-value "Subject:")))
(org-store-link-props :type "mew" :from from :to to
:subject subject :message-id message-id)
(when date
(org-add-link-props :date date :date-timestamp date-ts
:date-timestamp-inactive date-ts-ia))
(setq message-id (org-remove-angle-brackets message-id))
(setq desc (org-email-link-description))
(setq link (org-make-link "mew:" folder-name

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

@ -6,7 +6,7 @@
;; Author: Thomas Baumann <thomas dot baumann at ch dot tum dot de>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;
@ -83,13 +83,22 @@ 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))
(let ((from (org-mhe-get-header "From:"))
(to (org-mhe-get-header "To:"))
(message-id (org-mhe-get-header "Message-Id:"))
(subject (org-mhe-get-header "Subject:"))
link desc)
(let* ((from (org-mhe-get-header "From:"))
(to (org-mhe-get-header "To:"))
(message-id (org-mhe-get-header "Message-Id:"))
(subject (org-mhe-get-header "Subject:"))
(date (org-mhe-get-header "Date:"))
(date-ts (and date (format-time-string
(org-time-stamp-format t) (date-to-time date))))
(date-ts-ia (and date (format-time-string
(org-time-stamp-format t t)
(date-to-time date))))
link desc)
(org-store-link-props :type "mh" :from from :to to
:subject subject :message-id message-id)
(when date
(org-add-link-props :date date :date-timestamp date-ts
:date-timestamp-inactive date-ts-ia))
(setq desc (org-email-link-description))
(setq link (org-make-link "mhe:" (org-mhe-get-message-real-folder) "#"
(org-remove-angle-brackets message-id)))
@ -181,7 +190,7 @@ you have a better idea of how to do this then please let us know."
(if (equal major-mode 'mh-folder-mode)
(mh-show)
(mh-show-show))
header-field)))
(org-trim header-field))))
(defun org-mhe-follow-link (folder article)
"Follow an MH-E link to FOLDER and ARTICLE.

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

@ -5,7 +5,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;

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

@ -4,7 +4,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;
@ -26,10 +26,11 @@
;;; Commentary:
;;
;; This file contains the code to interact with Richard Moreland's iPhone
;; application MobileOrg. This code is documented in Appendix B of the
;; Org-mode manual. The code is not specific for the iPhone, however.
;; Any external viewer/flagging/editing application that uses the same
;; conventions could be used.
;; application MobileOrg, as well as with the Android version by Matthew Jones.
;; This code is documented in Appendix B of the Org-mode manual. The code is
;; not specific for the iPhone and Android - any external
;; viewer/flagging/editing application that uses the same conventions could
;; be used.
(require 'org)
(require 'org-agenda)
@ -90,12 +91,29 @@ You might want to put this file into a directory where only you have access."
This is a single password which is used for AES-256 encryption. The same
password must also be set in the MobileOrg application. All Org files,
including mobileorg.org will be encrypted using this password.
SECURITY CONSIDERATIONS:
Note that, when Org runs the encryption commands, the password could
be visible on your system with the `ps' command. So this method is only
intended to keep the files secure on the server, not on your own machine."
be visible briefly on your system with the `ps' command. So this method is
only intended to keep the files secure on the server, not on your own machine.
Also, if you set this variable in an init file (.emacs or .emacs.d/init.el
or custom.el...) and if that file is stored in a way so that other can read
it, this also limits the security of this approach. You can also leave
this variable empty - Org will then ask for the password once per Emacs
session."
:group 'org-mobile
:type '(string :tag "Password"))
(defvar org-mobile-encryption-password-session nil)
(defun org-mobile-encryption-password ()
(or (org-string-nw-p org-mobile-encryption-password)
(org-string-nw-p org-mobile-encryption-password-session)
(setq org-mobile-encryption-password-session
(read-passwd "Password for MobileOrg: " t))))
(defcustom org-mobile-inbox-for-pull "~/org/from-mobile.org"
"The file where captured notes and flags will be appended to.
During the execution of `org-mobile-pull', the file
@ -133,7 +151,7 @@ list a list of selection key(s) as string."
(string :tag "Selection Keys"))))
(defcustom org-mobile-force-id-on-agenda-items t
"Non-nil means make all agenda items carry and ID."
"Non-nil means make all agenda items carry an ID."
:group 'org-mobile
:type 'boolean)
@ -331,6 +349,7 @@ agenda view showing the flagged items."
(defun org-mobile-check-setup ()
"Check if org-mobile-directory has been set up."
(org-mobile-cleanup-encryption-tempfile)
(unless (and org-directory
(stringp org-directory)
(string-match "\\S-" org-directory)
@ -356,7 +375,7 @@ agenda view showing the flagged items."
(string-match "\\S-" org-mobile-checksum-binary))
(error "No executable found to compute checksums"))
(when org-mobile-use-encryption
(unless (string-match "\\S-" org-mobile-encryption-password)
(unless (string-match "\\S-" (org-mobile-encryption-password))
(error
"To use encryption, you must set `org-mobile-encryption-password'"))
(unless (file-writable-p org-mobile-encryption-tempfile)
@ -371,6 +390,8 @@ agenda view showing the flagged items."
(lambda (a b) (string< (cdr a) (cdr b)))))
(def-todo (default-value 'org-todo-keywords))
(def-tags (default-value 'org-tag-alist))
(target-file (expand-file-name org-mobile-index-file
org-mobile-directory))
file link-name todo-kwds done-kwds tags drawers entry kwds dwds twds)
(org-prepare-agenda-buffers (mapcar 'car files-alist))
@ -389,7 +410,9 @@ agenda view showing the flagged items."
(t nil)))
org-tag-alist-for-agenda))))
(with-temp-file
(expand-file-name org-mobile-index-file org-mobile-directory)
(if org-mobile-use-encryption
org-mobile-encryption-tempfile
target-file)
(while (setq entry (pop def-todo))
(insert "#+READONLY\n")
(setq kwds (mapcar (lambda (x) (if (string-match "(" x)
@ -430,7 +453,11 @@ agenda view showing the flagged items."
(insert (format "* [[file:%s][%s]]\n"
link-name link-name)))
(push (cons org-mobile-index-file (md5 (buffer-string)))
org-mobile-checksum-files))))
org-mobile-checksum-files))
(when org-mobile-use-encryption
(org-mobile-encrypt-and-move org-mobile-encryption-tempfile
target-file)
(org-mobile-cleanup-encryption-tempfile))))
(defun org-mobile-copy-agenda-files ()
"Copy all agenda files to the stage or WebDAV directory."
@ -452,14 +479,20 @@ agenda view showing the flagged items."
(when (string-match "[a-fA-F0-9]\\{30,40\\}" check)
(push (cons link-name (match-string 0 check))
org-mobile-checksum-files))))
(setq file (expand-file-name org-mobile-capture-file
org-mobile-directory))
(save-excursion
(setq buf (find-file file))
(and (= (point-min) (point-max)) (insert "\n"))
(save-buffer)
(when (and (= (point-min) (point-max)))
(insert "\n")
(save-buffer)
(when org-mobile-use-encryption
(write-file org-mobile-encryption-tempfile)
(org-mobile-encrypt-and-move org-mobile-encryption-tempfile file)))
(push (cons org-mobile-capture-file (md5 (buffer-string)))
org-mobile-checksum-files))
(org-mobile-cleanup-encryption-tempfile)
(kill-buffer buf)))
(defun org-mobile-write-checksums ()
@ -606,14 +639,30 @@ The table of checksums is written to the file mobile-checksums."
(if (org-bound-and-true-p
org-mobile-force-id-on-agenda-items)
(org-id-get m 'create)
(org-entry-get m "ID")))
(or (org-entry-get m "ID")
(org-mobile-get-outline-path-link m))))
(insert " :PROPERTIES:\n :ORIGINAL_ID: " id
"\n :END:\n")))))
(beginning-of-line 2))
(push (cons (file-name-nondirectory file) (md5 (buffer-string)))
(push (cons "agendas.org" (md5 (buffer-string)))
org-mobile-checksum-files))
(message "Agenda written to Org file %s" file)))
(defun org-mobile-get-outline-path-link (pom)
(org-with-point-at pom
(concat "olp:"
(org-mobile-escape-olp (file-name-nondirectory buffer-file-name))
"/"
(mapconcat 'org-mobile-escape-olp
(org-get-outline-path)
"/")
"/"
(org-mobile-escape-olp (nth 4 (org-heading-components))))))
(defun org-mobile-escape-olp (s)
(let ((table '((?: . "%3a") (?\[ . "%5b") (?\] . "%5d") (?/ . "%2f"))))
(org-link-escape s table)))
;;;###autoload
(defun org-mobile-create-sumo-agenda ()
"Create a file that contains all custom agenda views."
@ -632,8 +681,9 @@ The table of checksums is written to the file mobile-checksums."
(when sumo
(org-store-agenda-views))
(when org-mobile-use-encryption
(org-mobile-encrypt-file file1 file)
(delete-file file1))))
(org-mobile-encrypt-and-move file1 file)
(delete-file file1)
(org-mobile-cleanup-encryption-tempfile))))
(defun org-mobile-encrypt-and-move (infile outfile)
"Encrypt INFILE locally to INFILE_enc, then move it to OUTFILE.
@ -649,7 +699,8 @@ encryption program does not understand them."
"Encrypt INFILE to OUTFILE, using `org-mobile-encryption-password'."
(shell-command
(format "openssl enc -aes-256-cbc -salt -pass %s -in %s -out %s"
(shell-quote-argument (concat "pass:" org-mobile-encryption-password))
(shell-quote-argument (concat "pass:"
(org-mobile-encryption-password)))
(shell-quote-argument (expand-file-name infile))
(shell-quote-argument (expand-file-name outfile)))))
@ -657,10 +708,17 @@ encryption program does not understand them."
"Decrypt INFILE to OUTFILE, using `org-mobile-encryption-password'."
(shell-command
(format "openssl enc -d -aes-256-cbc -salt -pass %s -in %s -out %s"
(shell-quote-argument (concat "pass:" org-mobile-encryption-password))
(shell-quote-argument (concat "pass:"
(org-mobile-encryption-password)))
(shell-quote-argument (expand-file-name infile))
(shell-quote-argument (expand-file-name outfile)))))
(defun org-mobile-cleanup-encryption-tempfile ()
"Remove the encryption tempfile if it exists."
(and (stringp org-mobile-encryption-tempfile)
(file-exists-p org-mobile-encryption-tempfile)
(delete-file org-mobile-encryption-tempfile)))
(defun org-mobile-move-capture ()
"Move the contents of the capture file to the inbox file.
Return a marker to the location where the new content has been added.
@ -673,7 +731,7 @@ If nothing new has been added, return nil."
(capture-buffer
(if (not org-mobile-use-encryption)
(find-file-noselect capture-file)
(delete-file org-mobile-encryption-tempfile)
(org-mobile-cleanup-encryption-tempfile)
(setq encfile (concat org-mobile-encryption-tempfile "_enc"))
(copy-file capture-file encfile)
(org-mobile-decrypt-file encfile org-mobile-encryption-tempfile)
@ -698,7 +756,8 @@ If nothing new has been added, return nil."
(kill-buffer capture-buffer)
(when org-mobile-use-encryption
(org-mobile-encrypt-and-move org-mobile-encryption-tempfile
capture-file))
capture-file)
(org-mobile-cleanup-encryption-tempfile))
(if not-empty insertion-point)))
(defun org-mobile-update-checksum-for-capture-file (buffer-string)

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

@ -4,7 +4,7 @@
;;
;; Author: Piotr Zielinski <piotr dot zielinski at gmail dot com>
;; Maintainer: Carsten Dominik <carsten at orgmode dot org>
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;
@ -148,6 +148,7 @@
(declare-function org-agenda-change-all-lines "org-agenda"
(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))
(defvar org-mouse-plain-list-regexp "\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) "
"Regular expression that matches a plain list.")
@ -576,14 +577,11 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
(goto-char (second contextdata))
(re-search-forward ".*" (third contextdata))))))
(defun org-mouse-for-each-item (function)
(save-excursion
(ignore-errors
(while t (org-previous-item)))
(ignore-errors
(while t
(funcall function)
(org-next-item)))))
(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))))
(defun org-mouse-bolp ()
"Return true if there only spaces, tabs, and '*' before point.

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

@ -5,7 +5,7 @@
;; Author: Eric Schulte <schulte dot eric at gmail dot com>
;; Keywords: tables, plotting
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;

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

@ -9,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.01
;; Version: 7.3
;; This file is part of GNU Emacs.
;;
@ -260,7 +260,7 @@ Here is an example:
:group 'org-protocol
:type '(alist))
(defcustom org-protocol-default-template-key "w"
(defcustom org-protocol-default-template-key nil
"The default org-remember-templates key to use."
:group 'org-protocol
:type 'string)

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

@ -5,7 +5,7 @@
;; Author: David O'Toole <dto@gnu.org>
;; Maintainer: Carsten Dominik <carsten DOT dominik AT gmail DOT com>
;; Keywords: hypermedia, outlines, wp
;; Version: 7.01
;; Version: 7.3
;; This file is part of GNU Emacs.
;;
@ -71,11 +71,14 @@ Each element of the alist is a publishing 'project.' The CAR of
each element is a string, uniquely identifying the project. The
CDR of each element is in one of the following forms:
(:property value :property value ... )
1. A well-formed property list with an even number of elements, alternating
keys and values, specifying parameters for the publishing process.
OR,
(:property value :property value ... )
(:components (\"project-1\" \"project-2\" ...))
2. A meta-project definition, specifying of a list of sub-projects:
(:components (\"project-1\" \"project-2\" ...))
When the CDR of an element of org-publish-project-alist is in
this second form, the elements of the list after :components are
@ -92,7 +95,8 @@ Most properties are optional, but some should always be set:
:base-directory Directory containing publishing source files
:base-extension Extension (without the dot!) of source files.
This can be a regular expression.
This can be a regular expression. If not given,
\"org\" will be used as default extension.
:publishing-directory Directory (possibly remote) where output
files will be published
@ -188,7 +192,14 @@ sitemap of files or summary page for a given project.
The following properties control the creation of a concept index.
:makeindex Create a concept index."
:makeindex Create a concept index.
Other properties affecting publication.
:body-only Set this to 't' to publish only the body of the
documents, excluding everything outside and
including the <body> tags in HTML, or
\begin{document}..\end{document} in LaTeX."
:group 'org-publish
:type 'alist)
@ -464,13 +475,19 @@ matching filenames."
(unless (plist-get (cdr prj) :components)
;; [[info:org:Selecting%20files]] shows how this is supposed to work:
(let* ((r (plist-get (cdr prj) :recursive))
(b (expand-file-name (plist-get (cdr prj) :base-directory)))
(b (expand-file-name (file-name-as-directory
(plist-get (cdr prj) :base-directory))))
(x (or (plist-get (cdr prj) :base-extension) "org"))
(e (plist-get (cdr prj) :exclude))
(i (plist-get (cdr prj) :include))
(xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$")))
(when (or
(and i (string-match i filename))
(and
i
(member filename
(mapcar
(lambda (file) (expand-file-name file b))
i)))
(and
(not (and e (string-match e filename)))
(string-match xm filename)))
@ -507,7 +524,9 @@ PUB-DIR is the publishing directory."
(setq export-buf-or-file
(funcall (intern (concat "org-export-as-" format))
(plist-get plist :headline-levels)
nil plist nil nil pub-dir))
nil plist nil
(plist-get plist :body-only)
pub-dir))
(when (and (bufferp export-buf-or-file)
(buffer-live-p export-buf-or-file))
(set-buffer export-buf-or-file)
@ -558,14 +577,32 @@ See `org-publish-org-to' to the list of arguments."
See `org-publish-org-to' to the list of arguments."
(org-publish-org-to "org" plist filename pub-dir))
(defun org-publish-org-to-ascii (plist filename pub-dir)
"Publish an org file to ASCII.
See `org-publish-org-to' to the list of arguments."
(org-publish-with-aux-preprocess-maybe
(org-publish-org-to "ascii" plist filename pub-dir)))
(defun org-publish-org-to-latin1 (plist filename pub-dir)
"Publish an org file to Latin-1.
See `org-publish-org-to' to the list of arguments."
(org-publish-with-aux-preprocess-maybe
(org-publish-org-to "latin1" plist filename pub-dir)))
(defun org-publish-org-to-utf8 (plist filename pub-dir)
"Publish an org file to UTF-8.
See `org-publish-org-to' to the list of arguments."
(org-publish-with-aux-preprocess-maybe
(org-publish-org-to "utf8" plist filename pub-dir)))
(defun org-publish-attachment (plist filename pub-dir)
"Publish a file with no transformation of any kind.
See `org-publish-org-to' to the list of arguments."
;; make sure eshell/cp code is loaded
(unless (file-directory-p pub-dir)
(make-directory pub-dir t))
(or (equal (expand-file-name (file-name-directory filename))
(file-name-as-directory (expand-file-name pub-dir)))
(unless (file-directory-p pub-dir)
(make-directory pub-dir t))
(or (equal (expand-file-name (file-name-directory filename))
(file-name-as-directory (expand-file-name pub-dir)))
(copy-file filename
(expand-file-name (file-name-nondirectory filename) pub-dir)
t)))
@ -585,14 +622,22 @@ See `org-publish-projects'."
(error "File %s not part of any known project"
(abbreviate-file-name filename)))))
(project-plist (cdr project))
(ftname (file-truename filename))
(ftname (expand-file-name filename))
(publishing-function
(or (plist-get project-plist :publishing-function)
'org-publish-org-to-html))
(base-dir (file-name-as-directory
(file-truename (plist-get project-plist :base-directory))))
(pub-dir (file-name-as-directory
(file-truename (plist-get project-plist :publishing-directory))))
(base-dir
(file-name-as-directory
(expand-file-name
(or (plist-get project-plist :base-directory)
(error "Project %s does not have :base-directory defined"
(car project))))))
(pub-dir
(file-name-as-directory
(file-truename
(or (plist-get project-plist :publishing-directory)
(error "Project %s does not have :publishing-directory defined"
(car project))))))
tmp-pub-dir)
(unless no-cache
@ -770,7 +815,6 @@ directory and force publishing all files."
(interactive "P")
(when force
(org-publish-remove-all-timestamps))
;; (org-publish-initialize-files-alist force)
(save-window-excursion
(let ((org-publish-use-timestamps-flag
(if force nil org-publish-use-timestamps-flag)))

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

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;
@ -157,7 +157,7 @@ Furthermore, the following %-escapes will be replaced with content:
Apart from these general escapes, you can access information specific to the
link type that is created. For example, calling `remember' in emails or gnus
will record the author and the subject of the message, which you can access
with %:author and %:subject, respectively. Here is a complete list of what
with %:fromname and %:subject, respectively. Here is a complete list of what
is recorded for each link type.
Link type | Available information
@ -167,7 +167,8 @@ vm, wl, mh, rmail | %:type %:subject %:message-id
| %:from %:fromname %:fromaddress
| %:to %:toname %:toaddress
| %:fromto (either \"to NAME\" or \"from NAME\")
gnus | %:group, for messages also all email fields
gnus | %:group, for messages also all email fields and
| %:org-date (the Date: header in Org format)
w3, w3m | %:type %:url
info | %:type %:file %:node
calendar | %:type %:date"
@ -574,7 +575,7 @@ to be run from that hook to function properly."
'org-tags-completion-function nil nil nil
'org-tags-history)))
(setq ins (mapconcat 'identity
(org-split-string ins (org-re "[^[:alnum:]_@]+"))
(org-split-string ins (org-re "[^[:alnum:]_@#%]+"))
":"))
(when (string-match "\\S-" ins)
(or (equal (char-before) ?:) (insert ":"))

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

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;
@ -59,10 +59,20 @@
(from (mail-fetch-field "from"))
(to (mail-fetch-field "to"))
(subject (mail-fetch-field "subject"))
(date (mail-fetch-field "date"))
(date-ts (and date (format-time-string
(org-time-stamp-format t)
(date-to-time date))))
(date-ts-ia (and date (format-time-string
(org-time-stamp-format t t)
(date-to-time date))))
desc link)
(org-store-link-props
:type "rmail" :from from :to to
:subject subject :message-id message-id)
(when date
(org-add-link-props :date date :date-timestamp date-ts
:date-timestamp-inactive date-ts-ia))
(setq message-id (org-remove-angle-brackets message-id))
(setq desc (org-email-link-description))
(setq link (org-make-link "rmail:" folder "#" message-id))

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

@ -8,7 +8,7 @@
;; Dan Davison <davison at stats dot ox dot ac dot uk>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;
@ -34,6 +34,8 @@
(require 'org-macs)
(require 'org-compat)
(require 'ob-keys)
(require 'ob-comint)
(eval-when-compile
(require 'cl))
@ -107,6 +109,10 @@ editing it with \\[org-edit-src-code]. Has no effect if
:group 'org-edit-structure
:type 'integer)
(defvar org-src-strip-leading-and-trailing-blank-lines nil
"If non-nil, blank lines are removed when exiting the code edit
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
@ -147,7 +153,8 @@ 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))
("asymptote" . asy) ("dot" . fundamental) ("sqlite" . sql)
("calc" . fundamental))
"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
@ -165,6 +172,7 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is
(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)
(defvar org-edit-src-allow-write-back-p t)
@ -181,6 +189,8 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is
immediately; otherwise it will ask whether you want to return
to the existing edit buffer.")
(defvar org-src-babel-info nil)
(define-minor-mode org-src-mode
"Minor mode for language major mode buffers generated by org.
This minor mode is turned on in two situations:
@ -189,26 +199,30 @@ 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)
(defun org-edit-src-code (&optional context code edit-buffer-name quietp)
"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 \\[org-edit-src-exit].
This will remove the original code in the Org buffer, and replace it with
the edited version. Optional argument CONTEXT is used by
\\[org-edit-src-save] when calling this function."
The example is copied to a separate buffer, and that buffer is
switched to the correct language mode. When done, exit with
\\[org-edit-src-exit]. This will remove the original code in the
Org buffer, and replace it with the edited version. Optional
argument CONTEXT is used by \\[org-edit-src-save] when calling
this function. See \\[org-src-window-setup] to configure the
display of windows containing the Org buffer and the code
buffer."
(interactive)
(unless (eq context 'save)
(setq org-edit-src-saved-temp-window-config (current-window-configuration)))
(let ((line (org-current-line))
(col (current-column))
(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))
(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 begline buffer msg)
block-nindent total-nindent ovl lang lang-f single lfmt buffer msg
begline markline markcol line col)
(if (not info)
nil
(setq beg (move-marker beg (nth 0 info))
@ -226,6 +240,10 @@ the edited version. Optional argument CONTEXT is used by
block-nindent (nth 5 info)
lang-f (intern (concat lang "-mode"))
begline (save-excursion (goto-char beg) (org-current-line)))
(if (and mark (>= mark beg) (<= mark end))
(save-excursion (goto-char mark)
(setq markline (org-current-line)
markcol (current-column))))
(if (equal lang-f 'table.el-mode)
(setq lang-f (lambda ()
(text-mode)
@ -235,7 +253,10 @@ the edited version. Optional argument CONTEXT is used by
(org-set-local 'org-edit-src-content-indentation 0))))
(unless (functionp lang-f)
(error "No such language mode: %s" lang-f))
(org-goto-line line)
(save-excursion
(if (> (point) end) (goto-char end))
(setq line (org-current-line)
col (current-column)))
(if (and (setq buffer (org-edit-src-find-buffer beg end))
(if org-src-ask-before-returning-to-edit-buffer
(y-or-n-p "Return to existing edit buffer? [n] will revert changes: ") t))
@ -267,11 +288,16 @@ the edited version. Optional argument CONTEXT is used by
(unless preserve-indentation
(setq total-nindent (or (org-do-remove-indentation) 0)))
(let ((org-inhibit-startup t))
(funcall lang-f))
(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))
(when org-mode-p
@ -279,6 +305,12 @@ the edited version. Optional argument CONTEXT is used by
(while (re-search-forward "^," nil t)
(if (eq (org-current-line) line) (setq total-nindent (1+ total-nindent)))
(replace-match "")))
(when markline
(org-goto-line (1+ (- markline begline)))
(org-move-to-column
(if 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))))
@ -290,7 +322,7 @@ the edited version. Optional argument CONTEXT is used by
(set-buffer-modified-p nil)
(and org-edit-src-persistent-message
(org-set-local 'header-line-format msg)))
(message "%s" msg)
(unless quietp (message "%s" msg))
t)))
(defun org-edit-src-continue (e)
@ -321,6 +353,8 @@ the edited version. Optional argument CONTEXT is used by
(if (eq context 'edit) (delete-other-windows))
(org-switch-to-buffer-other-window buffer)
(if (eq context 'exit) (delete-other-windows)))
('switch-invisibly
(set-buffer buffer))
(t
(message "Invalid value %s for org-src-window-setup"
(symbol-name org-src-window-setup))
@ -552,11 +586,12 @@ the language, a switch telling if the content should be in a single line."
(delta 0) code line col indent)
(when allow-write-back-p
(unless preserve-indentation (untabify (point-min) (point-max)))
(save-excursion
(goto-char (point-min))
(if (looking-at "[ \t\n]*\n") (replace-match ""))
(unless macro
(if (re-search-forward "\n[ \t\n]*\\'" nil t) (replace-match "")))))
(if org-src-strip-leading-and-trailing-blank-lines
(save-excursion
(goto-char (point-min))
(if (looking-at "[ \t\n]*\n") (replace-match ""))
(unless macro
(if (re-search-forward "\n[ \t\n]*\\'" nil t) (replace-match ""))))))
(setq line (if (org-bound-and-true-p org-edit-src-force-single-line)
1
(org-current-line))
@ -654,6 +689,122 @@ the language, a switch telling if the content should be in a single line."
(org-add-hook 'org-src-mode-hook 'org-src-mode-configure-edit-buffer)
(defun org-src-associate-babel-session (info)
"Associate edit buffer with comint session."
(interactive)
(let ((session (cdr (assoc :session (nth 2 info)))))
(and session (not (string= session "none"))
(org-babel-comint-buffer-livep session)
((lambda (f) (and (fboundp f) (funcall f session)))
(intern (format "org-babel-%s-associate-session" (nth 0 info)))))))
(defun org-src-babel-configure-edit-buffer ()
(when org-src-babel-info
(org-src-associate-babel-session org-src-babel-info)))
(org-add-hook 'org-src-mode-hook 'org-src-babel-configure-edit-buffer)
(defmacro org-src-do-at-code-block (&rest body)
"Execute a command from an edit buffer in the Org-mode buffer."
`(let ((beg-marker org-edit-src-beg-marker))
(if beg-marker
(with-current-buffer (marker-buffer beg-marker)
(goto-char (marker-position beg-marker))
,@body))))
(defun org-src-do-key-sequence-at-code-block (&optional key)
"Execute key sequence at code block in the source Org buffer.
The command bound to KEY in the Org-babel key map is executed
remotely with point temporarily at the start of the code block in
the Org buffer.
This command is not bound to a key by default, to avoid conflicts
with language major mode bindings. To bind it to C-c @ in all
language major modes, you could use
(add-hook 'org-src-mode-hook
(lambda () (define-key org-src-mode-map \"\\C-c@\"
'org-src-do-key-sequence-at-code-block)))
In that case, for example, C-c @ t issued in code edit buffers
would tangle the current Org code block, C-c @ e would execute
the block and C-c @ h would display the other available
Org-babel commands."
(interactive "kOrg-babel key: ")
(if (equal key (kbd "C-g")) (keyboard-quit)
(org-edit-src-save)
(org-src-do-at-code-block
(call-interactively
(lookup-key org-babel-map key)))))
(defcustom org-src-tab-acts-natively nil
"If non-nil, the effect of TAB in a code block is as if it were
issued in the language major mode buffer."
:type 'boolean
:group 'org-babel)
(defun org-src-native-tab-command-maybe ()
"Perform language-specific TAB action.
Alter code block according to effect of TAB in the language major
mode."
(and org-src-tab-acts-natively
(let ((org-src-strip-leading-and-trailing-blank-lines nil))
(org-babel-do-key-sequence-in-edit-buffer (kbd "TAB")))))
(add-hook 'org-tab-first-hook 'org-src-native-tab-command-maybe)
(defun org-src-font-lock-fontify-block (lang start end)
"Fontify code block.
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))
(modified (buffer-modified-p))
(org-buffer (current-buffer)) pos next)
(remove-text-properties start end '(face nil))
(with-current-buffer
(get-buffer-create
(concat " org-src-fontification:" (symbol-name lang-mode)))
(delete-region (point-min) (point-max))
(insert string)
(unless (eq major-mode lang-mode) (funcall lang-mode))
(font-lock-fontify-buffer)
(setq pos (point-min))
(while (setq next (next-single-property-change pos 'face))
(put-text-property
(+ start (1- pos)) (+ start next) 'face
(get-text-property pos 'face) org-buffer)
(setq pos next)))
(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
(defun org-src-fontify-block ()
"Fontify code block at point."
(interactive)
(save-excursion
(let ((org-src-fontify-natively t)
(info (org-edit-src-find-region-and-lang)))
(font-lock-fontify-region (nth 0 info) (nth 1 info)))))
(defun org-src-fontify-buffer ()
"Fontify all code blocks in the current buffer"
(interactive)
(org-babel-map-src-blocks nil
(org-src-fontify-block)))
(defun org-src-get-lang-mode (lang)
"Return major mode that should be used for LANG.
LANG is a string, and the returned major mode is a symbol."
(intern
(concat
((lambda (l) (if (symbolp l) (symbol-name l) l))
(or (cdr (assoc lang org-src-lang-modes)) lang)) "-mode")))
(provide 'org-src)
;; arch-tag: 6a1fc84f-dec7-47be-a416-64be56bea5d8

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

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;
@ -342,17 +342,21 @@ available parameters."
(defun org-table-cookie-line-p (line)
"Is this a table line with only alignment/width cookies?"
(save-match-data
(and (string-match "[<>]\\|&[lg]t;" line)
(or (string-match "\\`[ \t]*|[ \t]*/[ \t]*\\(|[ \t<>0-9|lgt&;]+\\)\\'" line)
(string-match "\\(\\`[ \t<>lr0-9|gt&;]+\\'\\)" line))
(or (string-match
"\\`[ \t]*|[ \t]*/[ \t]*\\(|[ \t<>0-9|lrcgt&;]+\\)\\'" line)
(string-match "\\(\\`[ \t<>lrc0-9|gt&;]+\\'\\)" line))
(not (delq nil (mapcar
(lambda (s)
(not (or (equal s "")
(string-match "\\`<\\([lr]?[0-9]+\\|[lr]\\)>\\'" s)
(string-match "\\`&lt;\\([lr]?[0-9]+\\|[lr]\\)&gt;\\'" s))))
(org-split-string (match-string 1 line) "[ \t]*|[ \t]*")))))))
(string-match
"\\`<\\([lrc]?[0-9]+\\|[lrc]\\)>\\'" s)
(string-match
"\\`&lt;\\([lrc]?[0-9]+\\|[lrc]\\)&gt;\\'"
s))))
(org-split-string (match-string 1 line)
"[ \t]*|[ \t]*")))))))
(defconst org-table-translate-regexp
(concat "\\(" "@[-0-9I$]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\)")
@ -369,8 +373,9 @@ and table.el tables."
(if (y-or-n-p "Convert table to Org-mode table? ")
(org-table-convert)))
((org-at-table-p)
(if (y-or-n-p "Convert table to table.el table? ")
(org-table-convert)))
(when (y-or-n-p "Convert table to table.el table? ")
(org-table-align)
(org-table-convert)))
(t (call-interactively 'table-insert))))
(defun org-table-create-or-convert-from-region (arg)
@ -453,7 +458,7 @@ nil When nil, the command tries to be smart and figure out the
(t 1))))
(goto-char beg)
(if (equal separator '(4))
(while (<= (point) end)
(while (< (point) end)
;; parse the csv stuff
(cond
((looking-at "^") (insert "| "))
@ -656,9 +661,9 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
(goto-char beg)
(setq narrow (and org-table-do-narrow
org-format-transports-properties-p
(re-search-forward "<[rl]?[0-9]+>" end t)))
(re-search-forward "<[lrc]?[0-9]+>" end t)))
(goto-char beg)
(setq falign (re-search-forward "<[rl][0-9]*>" end t))
(setq falign (re-search-forward "<[lrc][0-9]*>" end t))
(goto-char beg)
;; Get the rows
(setq lines (org-split-string
@ -699,7 +704,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
(setq c column fmax nil falign1 nil)
(while c
(setq e (pop c))
(when (and (stringp e) (string-match "^<\\([rl]\\)?\\([0-9]+\\)?>$" e))
(when (and (stringp e) (string-match "^<\\([lrc]\\)?\\([0-9]+\\)?>$" e))
(if (match-end 1) (setq falign1 (match-string 1 e)))
(if (and org-table-do-narrow (match-end 2))
(setq fmax (string-to-number (match-string 2 e)) c nil))))
@ -1150,11 +1155,14 @@ 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))
(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))
cnt)))
(defun org-table-current-dline ()
@ -4254,7 +4262,7 @@ so you cannot specify parameters for it."
(lambda (x)
(if (eq x 'hline)
"|----+----|"
(concat "| " (mapconcat 'identity x " | ") " |")))
(concat "| " (mapconcat 'org-html-expand x " | ") " |")))
table)
splicep))
(if (string-match "\n+\\'" html)

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

@ -4,7 +4,7 @@
;;
;; Emacs Lisp Archive Entry
;; Filename: org-taskjuggler.el
;; Version: 7.01
;; Version: 7.3
;; Author: Christian Egli
;; Maintainer: Christian Egli
;; Keywords: org, taskjuggler, project planning
@ -503,7 +503,7 @@ finally add more underscore characters (\"_\")."
(parts (split-string headline))
(id (org-taskjuggler-clean-id (downcase (pop parts)))))
; try to add more parts of the headline to make it unique
(while (member id unique-ids)
(while (and (member id unique-ids) (car parts))
(setq id (concat id "_" (org-taskjuggler-clean-id (downcase (pop parts))))))
; if its still not unique add "_"
(while (member id unique-ids)

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

@ -5,7 +5,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;
@ -31,7 +31,7 @@
(require 'org)
(declare-function org-show-notification "org-clock" (parameters))
(declare-function org-notify "org-clock" (notification &optional play-sound))
(declare-function org-agenda-error "org-agenda" ())
(defvar org-timer-start-time nil
@ -145,25 +145,33 @@ With prefix arg STOP, stop it entirely."
(org-timer-set-mode-line 'off))
;;;###autoload
(defun org-timer (&optional restart)
(defun org-timer (&optional restart no-insert-p)
"Insert a H:MM:SS string from the timer into the buffer.
The first time this command is used, the timer is started. When used with
a \\[universal-argument] prefix, force restarting the timer.
When used with a double prefix argument \
\\[universal-argument] \\universal-argument], change all the timer string
When used with a double prefix argument \\[universal-argument], change all the timer string
in the region by a fixed amount. This can be used to recalibrate a timer
that was not started at the correct moment."
that was not started at the correct moment.
If NO-INSERT-P is non-nil, return the string instead of inserting
it in the buffer."
(interactive "P")
(if (equal restart '(4)) (org-timer-start))
(or org-timer-start-time (org-timer-start))
(insert (org-timer-value-string)))
(when (or (equal restart '(4)) (not org-timer-start-time))
(org-timer-start))
(if no-insert-p
(org-timer-value-string)
(insert (org-timer-value-string))))
(defun org-timer-value-string ()
(format org-timer-format (org-timer-secs-to-hms (floor (org-timer-seconds)))))
(defvar org-timer-timer-is-countdown nil)
(defun org-timer-seconds ()
(- (org-float-time (or org-timer-pause-time (current-time)))
(org-float-time org-timer-start-time)))
(if org-timer-timer-is-countdown
(- (org-float-time org-timer-start-time)
(org-float-time (current-time)))
(- (org-float-time (or org-timer-pause-time (current-time)))
(org-float-time org-timer-start-time))))
;;;###autoload
(defun org-timer-change-times-in-region (beg end delta)
@ -195,19 +203,22 @@ that was not started at the correct moment."
(defun org-timer-item (&optional arg)
"Insert a description-type item with the current timer value."
(interactive "P")
(let ((ind 0))
(save-excursion
(skip-chars-backward " \n\t")
(condition-case nil
(progn
(org-beginning-of-item)
(setq ind (org-get-indentation)))
(error nil)))
(or (bolp) (newline))
(org-indent-line-to ind)
(insert "- ")
(org-timer (if arg '(4)))
(insert ":: ")))
(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 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.
(t
(beginning-of-line)
(org-indent-line-function)
(insert "- ")
(org-timer (when arg '(4)))
(insert ":: "))))
(defun org-timer-fix-incomplete (hms)
"If hms is a H:MM:SS string with missing hour or hour and minute, fix it."
@ -292,7 +303,9 @@ VALUE can be `on', `off', or `pause'."
(when (eval org-timer-current-timer)
(run-hooks 'org-timer-cancel-hook)
(cancel-timer org-timer-current-timer)
(setq org-timer-current-timer nil))
(setq org-timer-current-timer nil)
(setq org-timer-timer-is-countdown nil)
(org-timer-set-mode-line 'off))
(message "Last timer canceled"))
(defun org-timer-show-remaining-time ()
@ -309,17 +322,13 @@ VALUE can be `on', `off', or `pause'."
(message "%d minute(s) %d seconds left before next time out"
rmins rsecs))))
(defun bzg-test (&optional test)
(interactive "P")
test)
;;;###autoload
(defun org-timer-set-timer (&optional opt)
"Prompt for a duration and set a timer.
If `org-timer-default-timer' is not zero, suggest this value as
the default duration for the timer. If a timer is already set,
prompt the use if she wants to replace it.
prompt the user if she wants to replace it.
Called with a numeric prefix argument, use this numeric value as
the duration of the timer.
@ -353,9 +362,11 @@ replace any running timer."
(widen)
(goto-char pos)
(org-show-entry)
(org-get-heading))))
(or (ignore-errors (org-get-heading))
(concat "File:" (file-name-nondirectory (buffer-file-name)))))))
((eq major-mode 'org-mode)
(org-get-heading))
(or (ignore-errors (org-get-heading))
(concat "File:" (file-name-nondirectory (buffer-file-name)))))
(t (error "Not in an Org buffer"))))
timer-set)
(if (or (and org-timer-current-timer
@ -363,6 +374,7 @@ replace any running timer."
(y-or-n-p "Replace current timer? ")))
(not org-timer-current-timer))
(progn
(require 'org-clock)
(when org-timer-current-timer
(cancel-timer org-timer-current-timer))
(setq org-timer-current-timer
@ -370,8 +382,14 @@ replace any running timer."
secs nil `(lambda ()
(setq org-timer-current-timer nil)
(org-notify ,(format "%s: time out" hl) t)
(setq org-timer-timer-is-countdown nil)
(org-timer-set-mode-line 'off)
(run-hooks 'org-timer-done-hook))))
(run-hooks 'org-timer-set-hook))
(run-hooks 'org-timer-set-hook)
(setq org-timer-timer-is-countdown t
org-timer-start-time
(time-add (current-time) (seconds-to-time (* mins 60))))
(org-timer-set-mode-line 'on))
(message "No timer set"))))))
(provide 'org-timer)

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

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;
@ -66,9 +66,19 @@
(to (vm-get-header-contents message "To"))
(from (vm-get-header-contents message "From"))
(message-id (vm-su-message-id message))
(date (vm-get-header-contents message "Date"))
(date-ts (and date (format-time-string
(org-time-stamp-format t)
(date-to-time date))))
(date-ts-ia (and date (format-time-string
(org-time-stamp-format t t)
(date-to-time date))))
desc link)
(org-store-link-props :type "vm" :from from :to to :subject subject
:message-id message-id)
(when date
(org-add-link-props :date date :date-timestamp date-ts
:date-timestamp-inactive date-ts-ia))
(setq message-id (org-remove-angle-brackets message-id))
(setq folder (abbreviate-file-name folder))
(if (and vm-folder-directory

2
lisp/org/org-w3m.el
View file

@ -5,7 +5,7 @@
;; Author: Andy Stewart <lazycat dot manatee at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;

65
lisp/org/org-wl.el
View file

@ -7,7 +7,7 @@
;; David Maus <dmaus at ictsoc dot de>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;
@ -84,6 +84,8 @@ googlegroups otherwise."
(declare-function wl-summary-buffer-msgdb "ext:wl-folder" () t)
(declare-function wl-summary-jump-to-msg-by-message-id "ext:wl-summary"
(&optional id))
(declare-function wl-summary-jump-to-msg "ext:wl-summary"
(&optional number beg end))
(declare-function wl-summary-line-from "ext:wl-summary" ())
(declare-function wl-summary-line-subject "ext:wl-summary" ())
(declare-function wl-summary-message-number "ext:wl-summary" ())
@ -100,6 +102,7 @@ googlegroups otherwise."
(defvar wl-summary-buffer-folder-name)
(defvar wl-folder-group-regexp)
(defvar wl-auto-check-folder-name)
(defvar elmo-nntp-default-server)
(defconst org-wl-folder-types
'(("%" . imap) ("-" . nntp) ("+" . mh) ("=" . spool)
@ -137,18 +140,19 @@ folder name determines the the folder type."
"Return content of FIELD in ENTITY.
FIELD is a symbol of a rfc822 message header field.
ENTITY is a message entity."
(let ((content (elmo-message-entity-field entity field)))
(let ((content (elmo-message-entity-field entity field 'string)))
(if (listp content) (car content) content)))
(defun org-wl-store-link ()
"Store a link to a WL message or folder."
(cond
((memq major-mode '(wl-summary-mode mime-view-mode))
(org-wl-store-link-message))
((eq major-mode 'wl-folder-mode)
(org-wl-store-link-folder))
(t
nil)))
(unless (eobp)
(cond
((memq major-mode '(wl-summary-mode mime-view-mode))
(org-wl-store-link-message))
((eq major-mode 'wl-folder-mode)
(org-wl-store-link-folder))
(t
nil))))
(defun org-wl-store-link-folder ()
"Store a link to a WL folder."
@ -189,10 +193,19 @@ ENTITY is a message entity."
msgnum (wl-summary-buffer-msgdb))))
(message-id
(org-wl-message-field 'message-id wl-message-entity))
(message-id-no-brackets
(org-remove-angle-brackets message-id))
(from (org-wl-message-field 'from wl-message-entity))
(to (org-wl-message-field 'to wl-message-entity))
(xref (org-wl-message-field 'xref wl-message-entity))
(subject (org-wl-message-field 'subject wl-message-entity))
(date (org-wl-message-field 'date wl-message-entity))
(date-ts (and date (format-time-string
(org-time-stamp-format t)
(date-to-time date))))
(date-ts-ia (and date (format-time-string
(org-time-stamp-format t t)
(date-to-time date))))
desc link)
;; remove text properties of subject string to avoid possible bug
@ -212,6 +225,7 @@ ENTITY is a message entity."
org-wl-shimbun-prefer-web-links xref)
(org-store-link-props :type "http" :link xref :description subject
:from from :to to :message-id message-id
:message-id-no-brackets message-id-no-brackets
:subject subject))
((and (eq folder-type 'nntp) org-wl-nntp-prefer-web-links)
(setq link
@ -222,16 +236,35 @@ ENTITY is a message entity."
(org-fixup-message-id-for-http message-id)))
(org-store-link-props :type "http" :link link :description subject
:from from :to to :message-id message-id
:message-id-no-brackets message-id-no-brackets
:subject subject))
(t
(org-store-link-props :type "wl" :from from :to to
:subject subject :message-id message-id)
(setq message-id (org-remove-angle-brackets message-id))
:subject subject :message-id message-id
:message-id-no-brackets message-id-no-brackets)
(setq desc (org-email-link-description))
(setq link (org-make-link "wl:" folder-name "#" message-id))
(setq link (org-make-link "wl:" folder-name "#" message-id-no-brackets))
(org-add-link-props :link link :description desc)))
(when date
(org-add-link-props :date date :date-timestamp date-ts
:date-timestamp-inactive date-ts-ia))
(or link xref)))))))
(defun org-wl-open-nntp (path)
"Follow the nntp: link specified by PATH."
(let* ((spec (split-string path "/"))
(server (split-string (nth 2 spec) "@"))
(group (nth 3 spec))
(article (nth 4 spec)))
(org-wl-open
(concat "-" group ":" (if (cdr server)
(car (split-string (car server) ":"))
"")
(if (string= elmo-nntp-default-server (nth 2 spec))
""
(concat "@" (or (cdr server) (car server))))
(if article (concat "#" article) "")))))
(defun org-wl-open (path)
"Follow the WL message link specified by PATH.
When called with one prefix, open message in namazu search folder
@ -267,8 +300,12 @@ for namazu index."
;; beginning of the current line. So, restore the point
;; in the old buffer.
(goto-char old-point))
(and article (wl-summary-jump-to-msg-by-message-id (org-add-angle-brackets
article))
(when article
(if (org-string-match-p "@" article)
(wl-summary-jump-to-msg-by-message-id (org-add-angle-brackets
article))
(or (wl-summary-jump-to-msg (string-to-number article))
(error "No such message: %s" article)))
(wl-summary-redisplay))))))
(provide 'org-wl)

2
lisp/org/org-xoxo.el
View file

@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;; Version: 7.3
;;
;; This file is part of GNU Emacs.
;;

1081
lisp/org/org.el
View file

File diff suppressed because it is too large Load diff