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

Sync Org 7.9.2 from the commit tagged "release_7.9.2" in Org's Git repo.

Browse source
This commit is contained in:
Bastien Guerry 2012-09-30 17:14:59 +02:00
parent 163227893c
commit 8223b1d233
110 changed files with 20940 additions and 9093 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

204
doc/misc/ChangeLog
View file

@ -1,3 +1,207 @@
2012-09-30 Achim Gratz <Stromeko@Stromeko.DE>
* org.texi: Add description of ORG_ADD_CONTRIB to info
documentation. Add link to Worg for more details.
* org.texi: Clarify installation procedure. Provide link to the
build system description on Worg.
* org.texi: Remove reference to utils/, x11idle.c is now in
contrib/scripts.
* org.texi: Re-normalize to "Org mode" in manual.
* org.texi (Installation): Adapt documentation to new build
system. Mention GNU ELPA (since it needs to be handled like Emacs
built-in Org).
* org.texi: Include "org-version.inc" instead of
"git-describe.texi".
* org.texi: Remove @set for VERSION and DATE and do an @include
git-describe.texi instead.
2012-09-30 Adam Spiers <orgmode@adamspiers.org> (tiny change)
* org.texi: Fix typo in description of the 'Hooks' section.
* org.texi: Add ID to the list of special properties.
2012-09-30 Andrew Hyatt <ahyatt@gmail.com> (tiny change)
* org.texi (Moving subtrees): Document the ability to archive to a
datetree.
2012-09-30 Bastien Guerry <bzg@altern.org>
* org.texi (Installation, Feedback, Batch execution): Use
(add-to-list 'load-path ... t) for the contrib dir.
* org.texi (results): Update documentation for ":results drawer"
and ":results org".
* org.texi (Column width and alignment): Fix typo.
* org.texi (Activation): Point to the "Conflicts" section.
* org.texi (Conflicts): Mention filladapt.el in the list of
conflicting packages.
* org.texi (Activation): Adding org-mode to `auto-mode-alist' is
not needed for versions of Emacs > 22.1.
* org.texi (History and Acknowledgments): Fix typo.
* org.texi (History and Acknowledgments): Add my own
acknowledgments.
* org.texi (Agenda commands): Document the new command and the new
option.
* org.texi (Agenda commands): Delete `org-agenda-action' section.
(Agenda commands): Reorder. Document `*' to toggle persistent
marks.
* org.texi (Agenda dispatcher): Mention
`org-toggle-agenda-sticky'.
(Agenda commands, Exporting Agenda Views): Fix typo.
* org.texi (Templates in contexts, Setting Options): Update to
reflect changes in how contexts options are processed.
* org.texi (Templates in contexts): Document the new structure of
the variables `org-agenda-custom-commands-contexts' and
`org-capture-templates-contexts'.
* org.texi (Templates in contexts): Document the new option
`org-capture-templates-contexts'.
(Storing searches): Document the new option
`org-agenda-custom-commands-contexts'.
* org.texi (Formula syntax for Lisp): Reformat.
* org.texi (Special properties, Column attributes)
(Agenda column view): Document the new special property
CLOCKSUM_T.
* org.texi (Template expansion): Document the new %l template.
* org.texi (Fast access to TODO states): Fix documentation about
allowed characters for fast todo selection.
* org.texi (Weekly/daily agenda): Mention APPT_WARNTIME and its
use in `org-agenda-to-appt'.
* org.texi (Comment lines): Update wrt comments.
* org.texi (Resolving idle time): Document new keybinding.
* org.texi (Clocking commands): Document the use of S-M-<up/down>
on clock timestamps.
* org.texi (Fast access to TODO states): Explicitely says only
letters are supported as fast TODO selection keys.
* org.texi (Link abbreviations): Illustrate the use of the "%h"
specifier. Document the new "%(my-function)" specifier.
* org.texi (Clocking commands): New cindex.
(Clocking commands): Update documentation for `org-clock-in'.
Document `org-clock-in-last'. Mention `org-clock-out' and
`org-clock-in-last' as commands that can be globally bound.
(Resolving idle time): Document continuous clocking.
* org.texi (Top, Introduction): Fix formatting.
(Activation): Add index entries.
(Conventions): Update section.
(Embedded @LaTeX{}): Fix formatting.
* org.texi (Visibility cycling): Document `show-children'.
* org.texi (Using capture): Mention the `org-capture-last-stored'
bookmark as a way to jump to the last stored capture.
* org.texi (Uploading files): Fix typo.
* org.texi (Using capture): Document `C-0' as a prefix argument
for `org-capture'.
* org.texi (Agenda commands): Document persistent marks.
* org.texi (Template expansion): Update doc to reflect change.
* org.texi (Radio tables): Document the :no-escape parameter.
* org.texi (Repeated tasks): Document repeat cookies for years,
months, weeks, days and hours.
* org.texi (Export options): State that you can use the d: option
by specifying a list of drawers.
* org.texi (HTML preamble and postamble): Small doc improvement.
2012-09-30 Brian van den Broek <vanden@gmail.com> (tiny change)
* org.texi: The sections in the Exporting section of the manual
left out articles in the description of the org-export-as-*
commands, among other places. This patch adds them, adds a few
missing prepositions, and switches instances of "an HTML" to "a
html" for internal consistency.
* org.texi: Alter several examples of headings with timestamps in
them to include the timestamps in the body instead of the heading.
2012-09-30 Carsten Dominik <carsten.dominik@gmail.com>
* org.texi (Agenda dispatcher): Document sticky agenda views and
the new key for them.
2012-09-30 Charles <millarc@verizon.net> (tiny change)
* org.texi (Advanced features): Fix error in table.
2012-09-30 Feng Shu <tumashu@gmail.com>
* org.texi (@LaTeX{} fragments): Document imagemagick as an
alternative to dvipng.
2012-09-30 François Allisson <francois@allisson.co> (tiny change)
* org.texi: Remove extra curly bracket.
2012-09-30 Giovanni Ridolfi <giovanni.ridolfi@yahoo.it> (tiny change)
* org.texi (org-clock-in-last and org-clock-cancel): Update the
defkeys.
2012-09-30 Ippei FURUHASHI <top.tuna+orgmode@gmail.com> (tiny change)
* org.texi (Agenda commands): Fix two typos by giving
corresponding function names, according to
`org-agenda-view-mode-dispatch'.
2012-09-30 Jan Bäcker <jan.boecker@jboecker.de>
* org.texi (The spreadsheet): Fix typo.
2012-09-30 Memnon Anon <gegendosenfleisch@gmail.com> (tiny change)
* org.texi (Tracking your habits): Point to the "Tracking TODO
state changes" section.
2012-09-30 Nicolas Goaziou <n.goaziou@gmail.com>
* org.texi (Literal examples): Remove reference to unknown
`org-export-latex-minted' variable. Also simplify footnote since
`org-export-latex-listings' documentation is exhaustive already.
* org.texi (Plain lists): Remove reference to now hard-coded
`bullet' automatic rule.
2012-09-30 Toby S. Cubitt <tsc25@cantab.net>
* org.texi: Updated documentation accordingly.
2012-09-13 Paul Eggert <eggert@cs.ucla.edu>
* texinfo.tex: Merge from gnulib.

1110
doc/misc/org.texi
View file

File diff suppressed because it is too large Load diff

1886
etc/ORG-NEWS
View file

File diff suppressed because it is too large Load diff

1
etc/org/OrgOdtContentTemplate.xml
View file

@ -256,6 +256,7 @@
<text:sequence-decl text:display-outline-level="0" text:name="Drawing"/>
<text:sequence-decl text:display-outline-level="0" text:name="Equation"/>
<text:sequence-decl text:display-outline-level="0" text:name="Figure"/>
<text:sequence-decl text:display-outline-level="0" text:name="Listing"/>
</text:sequence-decls>
</office:text>
</office:body>

5
etc/org/OrgOdtStyles.xml
View file

@ -319,6 +319,11 @@
<style:style style:name="Table" style:family="paragraph" style:parent-style-name="Caption" style:class="extra">
<style:paragraph-properties fo:text-align="center" style:justify-single-word="false"/>
</style:style>
<style:style style:name="Listing" style:family="paragraph" style:parent-style-name="Caption" style:class="extra">
<style:paragraph-properties fo:margin-left="0cm" fo:margin-right="0cm" fo:text-indent="0cm" style:auto-text-indent="false" fo:keep-with-next="always">
<style:tab-stops/>
</style:paragraph-properties>
</style:style>
<style:style style:name="Horizontal_20_Line" style:display-name="Horizontal Line" style:family="paragraph" style:parent-style-name="Standard" style:next-style-name="Text_20_body" style:class="html">
<style:paragraph-properties fo:margin-top="0cm" fo:margin-bottom="0.499cm" style:border-line-width-bottom="0.002cm 0.035cm 0.002cm" fo:padding="0cm" fo:border-left="none" fo:border-right="none" fo:border-top="none" fo:border-bottom="0.039cm double #808080" text:number-lines="false" text:line-number="0" style:join-border="false"/>
<style:text-properties fo:font-size="6pt" style:font-size-asian="6pt" style:font-size-complex="6pt"/>

BIN
etc/refcards/orgcard.pdf
View file

Binary file not shown.

2
etc/refcards/orgcard.tex
View file

@ -1,5 +1,5 @@
% Reference Card for Org Mode
\def\orgversionnumber{7.8.11}
\def\orgversionnumber{7.9}
\def\versionyear{2012} % latest update
\input emacsver.tex

3030
lisp/org/ChangeLog
View file

File diff suppressed because it is too large Load diff

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

@ -61,7 +61,7 @@ is currently being evaluated.")
(org-babel-execute:C++ body params))
(defun org-babel-execute:C++ (body params)
"Execute a block of C++ code with org-babel. This function is
"Execute a block of C++ code with org-babel. This function is
called by `org-babel-execute-src-block'."
(let ((org-babel-c-variant 'cpp)) (org-babel-C-execute body params)))
@ -88,9 +88,7 @@ or `org-babel-execute:C++'."
(cond
((equal org-babel-c-variant 'c) ".c")
((equal org-babel-c-variant 'cpp) ".cpp"))))
(tmp-bin-file (org-babel-temp-file
"C-bin-"
(if (equal system-type 'windows-nt) ".exe" "")))
(tmp-bin-file (org-babel-temp-file "C-bin-" org-babel-exeext))
(cmdline (cdr (assoc :cmdline params)))
(flags (cdr (assoc :flags params)))
(full-body (org-babel-C-expand body params))
@ -118,8 +116,8 @@ or `org-babel-execute:C++'."
(org-babel-pick-name
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))
(org-babel-trim
(org-babel-eval
(concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))))
(org-babel-eval
(concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))))
(defun org-babel-C-expand (body params)
"Expand a block of C or C++ code with org-babel according to
@ -131,22 +129,22 @@ it's header arguments."
(defines (org-babel-read
(or (cdr (assoc :defines params))
(org-babel-read (org-entry-get nil "defines" t))))))
(mapconcat 'identity
(list
;; includes
(mapconcat
(lambda (inc) (format "#include %s" inc))
(if (listp includes) includes (list includes)) "\n")
;; defines
(mapconcat
(lambda (inc) (format "#define %s" inc))
(if (listp defines) defines (list defines)) "\n")
;; variables
(mapconcat 'org-babel-C-var-to-C vars "\n")
;; body
(if main-p
(org-babel-C-ensure-main-wrap body)
body) "\n") "\n")))
(mapconcat 'identity
(list
;; includes
(mapconcat
(lambda (inc) (format "#include %s" inc))
(if (listp includes) includes (list includes)) "\n")
;; defines
(mapconcat
(lambda (inc) (format "#define %s" inc))
(if (listp defines) defines (list defines)) "\n")
;; variables
(mapconcat 'org-babel-C-var-to-C vars "\n")
;; body
(if main-p
(org-babel-C-ensure-main-wrap body)
body) "\n") "\n")))
(defun org-babel-C-ensure-main-wrap (body)
"Wrap body in a \"main\" function call if none exists."

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

@ -39,24 +39,48 @@
(declare-function ess-make-buffer-current "ext:ess-inf" ())
(declare-function ess-eval-buffer "ext:ess-inf" (vis))
(declare-function org-number-sequence "org-compat" (from &optional to inc))
(declare-function org-remove-if-not "org" (predicate seq))
(defconst org-babel-header-arg-names:R
'(width height bg units pointsize antialias quality compression
res type family title fonts version paper encoding
pagecentre colormodel useDingbats horizontal)
(defconst org-babel-header-args:R
'((width . :any)
(height . :any)
(bg . :any)
(units . :any)
(pointsize . :any)
(antialias . :any)
(quality . :any)
(compression . :any)
(res . :any)
(type . :any)
(family . :any)
(title . :any)
(fonts . :any)
(version . :any)
(paper . :any)
(encoding . :any)
(pagecentre . :any)
(colormodel . :any)
(useDingbats . :any)
(horizontal . :any)
(results . ((file list vector table scalar verbatim)
(raw org html latex code pp wrap)
(replace silent append prepend)
(output value graphics))))
"R-specific header arguments.")
(defvar org-babel-default-header-args:R '())
(defvar org-babel-R-command "R --slave --no-save"
"Name of command to use for executing R code.")
(defcustom org-babel-R-command "R --slave --no-save"
"Name of command to use for executing R code."
:group 'org-babel
:version "24.1"
:type 'string)
(defvar ess-local-process-name)
(defvar ess-local-process-name) ; dynamically scoped
(defun org-babel-edit-prep:R (info)
(let ((session (cdr (assoc :session (nth 2 info)))))
(when (and session (string-match "^\\*\\(.+?\\)\\*$" session))
(save-match-data (org-babel-R-initiate-session session nil))
(setq ess-local-process-name (match-string 1 session)))))
(save-match-data (org-babel-R-initiate-session session nil)))))
(defun org-babel-expand-body:R (body params &optional graphics-file)
"Expand BODY according to PARAMS, return the expanded body."
@ -120,7 +144,7 @@ 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"
"Return list of R statements assigning the block's variables."
(let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
(mapcar
(lambda (pair)
@ -146,25 +170,45 @@ 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 (org-babel-temp-file "R-import-")))
(let ((max (apply #'max (mapcar #'length (org-remove-if-not
#'sequencep value))))
(min (apply #'min (mapcar #'length (org-remove-if-not
#'sequencep value))))
(transition-file (org-babel-temp-file "R-import-")))
;; ensure VALUE has an orgtbl structure (depth of at least 2)
(unless (listp (car value)) (setq value (list value)))
(with-temp-file transition-file
(insert (orgtbl-to-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 (org-babel-process-file-name transition-file 'noquote)
(if (or (eq (nth 1 value) 'hline) colnames-p) "TRUE" "FALSE")
(if rownames-p "1" "NULL")))
(insert
(orgtbl-to-tsv value '(:fmt org-babel-R-quote-tsv-field))
"\n"))
(let ((file (org-babel-process-file-name transition-file 'noquote))
(header (if (or (eq (nth 1 value) 'hline) colnames-p)
"TRUE" "FALSE"))
(row-names (if rownames-p "1" "NULL")))
(if (= max min)
(format "%s <- read.table(\"%s\",
header=%s,
row.names=%s,
sep=\"\\t\",
as.is=TRUE)" name file header row-names)
(format "%s <- read.table(\"%s\",
header=%s,
row.names=%s,
sep=\"\\t\",
as.is=TRUE,
fill=TRUE,
col.names = paste(\"V\", seq_len(%d), sep =\"\"))"
name file header row-names max))))
(format "%s <- %s" name (org-babel-R-quote-tsv-field value))))
(defvar ess-ask-for-ess-directory nil)
(defvar ess-ask-for-ess-directory) ; dynamically scoped
(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
(and ess-ask-for-ess-directory (not (cdr (assoc :dir params))))))
(and (and (boundp 'ess-ask-for-ess-directory) ess-ask-for-ess-directory)
(not (cdr (assoc :dir params))))))
(if (org-babel-comint-buffer-livep session)
session
(save-window-excursion
@ -177,7 +221,6 @@ 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
@ -219,7 +262,7 @@ current code buffer."
(setq args (mapconcat
(lambda (pair)
(if (member (car pair) allowed-args)
(format ",%s=%s"
(format ",%s=%S"
(substring (symbol-name (car pair)) 1)
(cdr pair)) ""))
params ""))
@ -245,7 +288,7 @@ current code buffer."
(body result-type result-params 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
string. If RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp."
(case result-type
(value
@ -272,7 +315,7 @@ last statement in BODY, as elisp."
(session body result-type result-params column-names-p row-names-p)
"Evaluate BODY in SESSION.
If RESULT-TYPE equals 'output then return standard output as a
string. If RESULT-TYPE equals 'value then return the value of the
string. If RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp."
(case result-type
(value

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

@ -88,7 +88,7 @@ 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"
"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))))
@ -128,7 +128,7 @@ a variable of the same value."
DATA is a list. Return type as a symbol.
The type is `string' if any element in DATA is
a string. Otherwise, it is either `real', if some elements are
a string. Otherwise, it is either `real', if some elements are
floats, or `int'."
(let* ((type 'int)
find-type ; for byte-compiler

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

@ -33,6 +33,7 @@
;;; Code:
(require 'ob)
(require 'ob-eval)
(require 'org-compat)
(eval-when-compile (require 'cl))
(declare-function org-babel-ref-resolve "ob-ref" (ref))
@ -96,13 +97,13 @@ called by `org-babel-execute-src-block'"
(defun org-babel-awk-var-to-awk (var &optional sep)
"Return a printed value of VAR suitable for parsing with awk."
(flet ((echo-var (v) (if (stringp v) v (format "%S" v))))
(let ((echo-var (lambda (v) (if (stringp v) v (format "%S" v)))))
(cond
((and (listp var) (listp (car var)))
(orgtbl-to-generic var (list :sep (or sep "\t") :fmt #'echo-var)))
(orgtbl-to-generic var (list :sep (or sep "\t") :fmt echo-var)))
((listp var)
(mapconcat #'echo-var var "\n"))
(t (echo-var var)))))
(mapconcat echo-var var "\n"))
(t (funcall echo-var var)))))
(defun org-babel-awk-table-or-string (results)
"If the results look like a table, then convert them into an

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

@ -71,16 +71,16 @@
(cond
((numberp res) res)
((math-read-number res) (math-read-number res))
((listp res) (error "calc error \"%s\" on input \"%s\""
((listp res) (error "Calc error \"%s\" on input \"%s\""
(cadr res) line))
(t (replace-regexp-in-string
"'\\[" "["
"'" ""
(calc-eval
(math-evaluate-expr
;; resolve user variables, calc built in
;; variables are handled automatically
;; upstream by calc
(mapcar #'ob-calc-maybe-resolve-var
(mapcar #'org-babel-calc-maybe-resolve-var
;; parse line into calc objects
(car (math-read-exprs line)))))))))
(calc-eval line))))))))
@ -91,14 +91,14 @@
(calc-eval (calc-top 1)))))
(defvar var-syms) ; Dynamically scoped from org-babel-execute:calc
(defun ob-calc-maybe-resolve-var (el)
(defun org-babel-calc-maybe-resolve-var (el)
(if (consp el)
(if (and (equal 'var (car el)) (member (cadr el) var-syms))
(progn
(calc-recall (cadr el))
(prog1 (calc-top 1)
(calc-pop 1)))
(mapcar #'ob-calc-maybe-resolve-var el))
(mapcar #'org-babel-calc-maybe-resolve-var el))
el))
(provide 'ob-calc)

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

@ -45,7 +45,7 @@
(add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj"))
(defvar org-babel-default-header-args:clojure '())
(defvar org-babel-header-arg-names:clojure '(package))
(defvar org-babel-header-args:clojure '((package . :any)))
(defun org-babel-expand-body:clojure (body params)
"Expand BODY according to PARAMS, return the expanded body."

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

@ -31,6 +31,7 @@
;;; Code:
(require 'ob)
(require 'org-compat)
(require 'comint)
(eval-when-compile (require 'cl))
(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body))
@ -50,7 +51,7 @@ executed inside the protection of `save-excursion' and
`(save-excursion
(save-match-data
(unless (org-babel-comint-buffer-livep ,buffer)
(error "buffer %s doesn't exist or has no process" ,buffer))
(error "Buffer %s does not exist or has no process" ,buffer))
(set-buffer ,buffer)
,@body)))
(def-edebug-spec org-babel-comint-in-buffer (form body))
@ -74,39 +75,40 @@ or user `keyboard-quit' during execution of body."
(full-body (cadr (cdr (cdr meta)))))
`(org-babel-comint-in-buffer ,buffer
(let ((string-buffer "") dangling-text raw)
(flet ((my-filt (text)
(setq string-buffer (concat string-buffer text))))
;; setup filter
(add-hook 'comint-output-filter-functions 'my-filt)
(unwind-protect
(progn
;; got located, and save dangling text
(goto-char (process-mark (get-buffer-process (current-buffer))))
(let ((start (point))
(end (point-max)))
(setq dangling-text (buffer-substring start end))
(delete-region start end))
;; pass FULL-BODY to process
,@body
;; wait for end-of-evaluation indicator
(while (progn
(goto-char comint-last-input-end)
(not (save-excursion
(and (re-search-forward
(regexp-quote ,eoe-indicator) nil t)
(re-search-forward
comint-prompt-regexp nil t)))))
(accept-process-output (get-buffer-process (current-buffer)))
;; thought the following this would allow async
;; background running, but I was wrong...
;; (run-with-timer .5 .5 'accept-process-output
;; (get-buffer-process (current-buffer)))
)
;; replace cut dangling text
(goto-char (process-mark (get-buffer-process (current-buffer))))
(insert dangling-text))
;; remove filter
(remove-hook 'comint-output-filter-functions 'my-filt)))
;; setup filter
(setq comint-output-filter-functions
(cons (lambda (text) (setq string-buffer (concat string-buffer text)))
comint-output-filter-functions))
(unwind-protect
(progn
;; got located, and save dangling text
(goto-char (process-mark (get-buffer-process (current-buffer))))
(let ((start (point))
(end (point-max)))
(setq dangling-text (buffer-substring start end))
(delete-region start end))
;; pass FULL-BODY to process
,@body
;; wait for end-of-evaluation indicator
(while (progn
(goto-char comint-last-input-end)
(not (save-excursion
(and (re-search-forward
(regexp-quote ,eoe-indicator) nil t)
(re-search-forward
comint-prompt-regexp nil t)))))
(accept-process-output (get-buffer-process (current-buffer)))
;; thought the following this would allow async
;; background running, but I was wrong...
;; (run-with-timer .5 .5 'accept-process-output
;; (get-buffer-process (current-buffer)))
)
;; replace cut dangling text
(goto-char (process-mark (get-buffer-process (current-buffer))))
(insert dangling-text))
;; remove filter
(setq comint-output-filter-functions
(cdr comint-output-filter-functions)))
;; remove echo'd FULL-BODY from input
(if (and ,remove-echo ,full-body
(string-match
@ -142,10 +144,10 @@ statement (not large blocks of code)."
(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
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))
(error "Buffer %s does not exist or has no process" buffer))
(if (file-exists-p file) (delete-file file))
(process-send-string
(get-buffer-process buffer)
@ -154,7 +156,7 @@ FILE exists at end of evaluation."
(if (file-remote-p default-directory)
(let (v)
(with-parsed-tramp-file-name default-directory nil
(tramp-flush-directory-property v ""))))
(tramp-flush-directory-property v ""))))
(while (not (file-exists-p file)) (sit-for (or period 0.25))))
(provide 'ob-comint)

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

@ -34,7 +34,7 @@
(defun org-babel-execute:css (body params)
"Execute a block of CSS code.
This function is called by `org-babel-execute-src-block'."
body)
body)
(defun org-babel-prep-session:css (session params)
"Return an error if the :session header argument is set.

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

@ -34,15 +34,28 @@
;; 3) we are adding the "file" and "cmdline" header arguments
;;
;; 4) there are no variables (at least for now)
;;
;; 5) it depends on a variable defined in org-exp-blocks (namely
;; `org-ditaa-jar-path') so be sure you have org-exp-blocks loaded
;;; Code:
(require 'ob)
(defvar org-ditaa-jar-path) ;; provided by org-exp-blocks
(defvar org-babel-default-header-args:ditaa
'((:results . "file") (:exports . "results") (:java . "-Dfile.encoding=UTF-8"))
'((:results . "file")
(:exports . "results")
(:java . "-Dfile.encoding=UTF-8"))
"Default arguments for evaluating a ditaa source block.")
(defvar org-ditaa-jar-path)
(defcustom org-ditaa-jar-option "-jar"
"Option for the ditaa jar file.
Do not leave leading or trailing spaces in this string."
:group 'org-babel
:version "24.1"
:type 'string)
(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'."
@ -55,7 +68,7 @@ This function is called by `org-babel-execute-src-block'."
(cmdline (cdr (assoc :cmdline params)))
(java (cdr (assoc :java params)))
(in-file (org-babel-temp-file "ditaa-"))
(cmd (concat "java " java " -jar "
(cmd (concat "java " java " " org-ditaa-jar-option " "
(shell-quote-argument
(expand-file-name org-ditaa-jar-path))
" " cmdline

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

@ -64,7 +64,8 @@
"Execute a block of Dot code with org-babel.
This function is called by `org-babel-execute-src-block'."
(let* ((result-params (cdr (assoc :result-params params)))
(out-file (cdr (assoc :file params)))
(out-file (cdr (or (assoc :file params)
(error "You need to specify a :file parameter"))))
(cmdline (or (cdr (assoc :cmdline params))
(format "-T%s" (file-name-extension out-file))))
(cmd (or (cdr (assoc :cmd params)) "dot"))

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

@ -41,12 +41,12 @@
(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)))))
vars "\n ")
")\n" body "\n)")
(concat "(let ("
(mapconcat
(lambda (var)
(format "%S" (print `(,(car var) ',(cdr var)))))
vars "\n ")
")\n" body "\n)")
(concat body "\n"))))
(if (or (member "code" result-params)
(member "pp" result-params))

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

@ -64,8 +64,8 @@ STDERR with `org-babel-eval-error-notify'."
(buffer-string)))
(defun org-babel-shell-command-on-region (start end command
&optional output-buffer replace
error-buffer display-error-buffer)
&optional output-buffer replace
error-buffer display-error-buffer)
"Execute COMMAND in an inferior shell with region as input.
Fixes bugs in the emacs 23.1.1 version of `shell-command-on-region'

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

@ -32,10 +32,18 @@
(defvar org-current-export-file)
(defvar org-babel-lob-one-liner-regexp)
(defvar org-babel-ref-split-regexp)
(defvar org-list-forbidden-blocks)
(declare-function org-babel-lob-get-info "ob-lob" ())
(declare-function org-babel-eval-wipe-error-buffer "ob-eval" ())
(add-to-list 'org-export-interblocks '(src org-babel-exp-non-block-elements))
(declare-function org-heading-components "org" ())
(declare-function org-link-search "org" (s &optional type avoid-pos stealth))
(declare-function org-fill-template "org" (template alist))
(declare-function org-in-verbatim-emphasis "org" ())
(declare-function org-in-block-p "org" (names))
(declare-function org-between-regexps-p "org" (start-re end-re &optional lim-up lim-down))
(add-to-list 'org-export-interblocks '(src org-babel-exp-non-block-elements))
(org-export-blocks-add-block '(src org-babel-exp-src-block nil))
(defcustom org-export-babel-evaluate t
@ -47,28 +55,33 @@ process."
:type 'boolean)
(put 'org-export-babel-evaluate 'safe-local-variable (lambda (x) (eq x nil)))
(defun org-babel-exp-get-export-buffer ()
"Return the current export buffer if possible."
(cond
((bufferp org-current-export-file) org-current-export-file)
(org-current-export-file (get-file-buffer org-current-export-file))
('otherwise
(error "Requested export buffer when `org-current-export-file' is nil"))))
(defmacro org-babel-exp-in-export-file (lang &rest body)
(declare (indent 1))
`(let* ((lang-headers (intern (concat "org-babel-default-header-args:" ,lang)))
(heading (nth 4 (ignore-errors (org-heading-components))))
(link (when org-current-export-file
(org-make-link-string
(if heading
(concat org-current-export-file "::" heading)
org-current-export-file))))
(export-buffer (current-buffer)) results)
(when link
(export-buffer (current-buffer))
(original-buffer (org-babel-exp-get-export-buffer)) results)
(when original-buffer
;; resolve parameters in the original file so that
;; headline and file-wide parameters are included, attempt
;; to go to the same heading in the original file
(set-buffer (get-file-buffer org-current-export-file))
(set-buffer original-buffer)
(save-restriction
(condition-case nil
(let ((org-link-search-inhibit-query t))
(org-open-link-from-string link))
(error (when heading
(goto-char (point-min))
(re-search-forward (regexp-quote heading) nil t))))
(when heading
(condition-case nil
(let ((org-link-search-inhibit-query t))
(org-link-search heading))
(error (when heading
(goto-char (point-min))
(re-search-forward (regexp-quote heading) nil t)))))
(setq results ,@body))
(set-buffer export-buffer)
results)))
@ -108,15 +121,25 @@ none ----- do not display either code or results upon export"
(if (boundp lang-headers) (eval lang-headers) nil)
raw-params))))
(setf hash (org-babel-sha1-hash info)))
;; expand noweb references in the original file
(setf (nth 1 info)
(if (and (cdr (assoc :noweb (nth 2 info)))
(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 hash)))))
(defcustom org-babel-exp-call-line-template
""
"Template used to export call lines.
This template may be customized to include the call line name
with any export markup. The template is filled out using
`org-fill-template', and the following %keys may be used.
line --- call line
An example value would be \"\\n: call: %line\" to export the call line
wrapped in a verbatim environment.
Note: the results are inserted separately after the contents of
this template."
:group 'org-babel
:type 'string)
(defvar org-babel-default-lob-header-args)
(defun org-babel-exp-non-block-elements (start end)
"Process inline source and call lines between START and END for export."
@ -147,7 +170,7 @@ none ----- do not display either code or results upon export"
(if (and (cdr (assoc :noweb params))
(string= "yes" (cdr (assoc :noweb params))))
(org-babel-expand-noweb-references
info (get-file-buffer org-current-export-file))
info (org-babel-exp-get-export-buffer))
(nth 1 info)))
(let ((code-replacement (save-match-data
(org-babel-exp-do-export
@ -163,22 +186,24 @@ none ----- do not display either code or results upon export"
(inlinep (match-string 11))
(inline-start (match-end 11))
(inline-end (match-end 0))
(rep (let ((lob-info (org-babel-lob-get-info)))
(save-match-data
(org-babel-exp-do-export
(list "emacs-lisp" "results"
(org-babel-merge-params
org-babel-default-header-args
org-babel-default-lob-header-args
(org-babel-params-from-properties)
(org-babel-parse-header-arguments
(org-babel-clean-text-properties
(concat ":var results="
(mapconcat #'identity
(butlast lob-info)
" ")))))
"" nil (car (last lob-info)))
'lob)))))
(results (save-match-data
(org-babel-exp-do-export
(list "emacs-lisp" "results"
(org-babel-merge-params
org-babel-default-header-args
org-babel-default-lob-header-args
(org-babel-params-from-properties)
(org-babel-parse-header-arguments
(org-no-properties
(concat ":var results="
(mapconcat #'identity
(butlast lob-info)
" ")))))
"" nil (car (last lob-info)))
'lob)))
(rep (org-fill-template
org-babel-exp-call-line-template
`(("line" . ,(nth 0 lob-info))))))
(if inlinep
(save-excursion
(goto-char inline-start)
@ -202,26 +227,58 @@ org-mode text."
(defun org-babel-exp-do-export (info type &optional hash)
"Return a string with the exported content of a code block.
The function respects the value of the :exports header argument."
(flet ((silently () (let ((session (cdr (assoc :session (nth 2 info)))))
(when (not (and session (equal "none" session)))
(org-babel-exp-results info type 'silent))))
(clean () (unless (eq type 'inline) (org-babel-remove-result info))))
(let ((silently (lambda () (let ((session (cdr (assoc :session (nth 2 info)))))
(when (not (and session (equal "none" session)))
(org-babel-exp-results info type 'silent)))))
(clean (lambda () (unless (eq type 'inline) (org-babel-remove-result info)))))
(case (intern (or (cdr (assoc :exports (nth 2 info))) "code"))
('none (silently) (clean) "")
('code (silently) (clean) (org-babel-exp-code info))
('none (funcall silently) (funcall clean) "")
('code (funcall silently) (funcall clean) (org-babel-exp-code info))
('results (org-babel-exp-results info type nil hash) "")
('both (org-babel-exp-results info type nil hash)
(org-babel-exp-code info)))))
(defcustom org-babel-exp-code-template
"#+BEGIN_SRC %lang%flags\n%body\n#+END_SRC"
"Template used to export the body of code blocks.
This template may be customized to include additional information
such as the code block name, or the values of particular header
arguments. The template is filled out using `org-fill-template',
and the following %keys may be used.
lang ------ the language of the code block
name ------ the name of the code block
body ------ the body of the code block
flags ----- the flags passed to the code block
In addition to the keys mentioned above, every header argument
defined for the code block may be used as a key and will be
replaced with its value."
:group 'org-babel
:type 'string)
(defun org-babel-exp-code (info)
"Return the original code block formatted for export."
(setf (nth 1 info)
(if (string= "strip-export" (cdr (assoc :noweb (nth 2 info))))
(replace-regexp-in-string
(org-babel-noweb-wrap) "" (nth 1 info))
(if (org-babel-noweb-p (nth 2 info) :export)
(org-babel-expand-noweb-references
info (org-babel-exp-get-export-buffer))
(nth 1 info))))
(org-fill-template
"#+BEGIN_SRC %lang%flags\n%body\n#+END_SRC"
org-babel-exp-code-template
`(("lang" . ,(nth 0 info))
("flags" . ,((lambda (f) (when f (concat " " f))) (nth 3 info)))
("body" . ,(if (string= (nth 0 info) "org")
(replace-regexp-in-string "^" "," (nth 1 info))
(nth 1 info))))))
(nth 1 info)))
,@(mapcar (lambda (pair)
(cons (substring (symbol-name (car pair)) 1)
(format "%S" (cdr pair))))
(nth 2 info))
("flags" . ,((lambda (f) (when f (concat " " f))) (nth 3 info)))
("name" . ,(or (nth 4 info) "")))))
(defun org-babel-exp-results (info type &optional silent hash)
"Evaluate and return the results of the current code block for export.
@ -232,11 +289,16 @@ inhibit insertion of results into the buffer."
(when (and org-export-babel-evaluate
(not (and hash (equal hash (org-babel-current-result-hash)))))
(let ((lang (nth 0 info))
(body (nth 1 info)))
(body (if (org-babel-noweb-p (nth 2 info) :eval)
(org-babel-expand-noweb-references
info (org-babel-exp-get-export-buffer))
(nth 1 info)))
(info (copy-sequence info)))
;; skip code blocks which we can't evaluate
(when (fboundp (intern (concat "org-babel-execute:" lang)))
(org-babel-eval-wipe-error-buffer)
(prog1 nil
(setf (nth 1 info) body)
(setf (nth 2 info)
(org-babel-exp-in-export-file lang
(org-babel-process-params

60
lisp/org/ob-fortran.el
View file

@ -8,7 +8,7 @@
;; Homepage: http://orgmode.org
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
@ -46,7 +46,7 @@
(defun org-babel-execute:fortran (body params)
"This function should only be called by `org-babel-execute:fortran'"
(let* ((tmp-src-file (org-babel-temp-file "fortran-src-" ".F90"))
(tmp-bin-file (org-babel-temp-file "fortran-bin-"))
(tmp-bin-file (org-babel-temp-file "fortran-bin-" org-babel-exeext))
(cmdline (cdr (assoc :cmdline params)))
(flags (cdr (assoc :flags params)))
(full-body (org-babel-expand-body:fortran body params))
@ -72,8 +72,8 @@
(org-babel-pick-name
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))
(org-babel-trim
(org-babel-eval
(concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))))
(org-babel-eval
(concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))))
(defun org-babel-expand-body:fortran (body params)
"Expand a block of fortran or fortran code with org-babel according to
@ -85,42 +85,42 @@ it's header arguments."
(defines (org-babel-read
(or (cdr (assoc :defines params))
(org-babel-read (org-entry-get nil "defines" t))))))
(mapconcat 'identity
(list
;; includes
(mapconcat
(lambda (inc) (format "#include %s" inc))
(if (listp includes) includes (list includes)) "\n")
;; defines
(mapconcat
(lambda (inc) (format "#define %s" inc))
(if (listp defines) defines (list defines)) "\n")
;; body
(if main-p
(org-babel-fortran-ensure-main-wrap
(concat
;; variables
(mapconcat 'org-babel-fortran-var-to-fortran vars "\n")
body) params)
body) "\n") "\n")))
(mapconcat 'identity
(list
;; includes
(mapconcat
(lambda (inc) (format "#include %s" inc))
(if (listp includes) includes (list includes)) "\n")
;; defines
(mapconcat
(lambda (inc) (format "#define %s" inc))
(if (listp defines) defines (list defines)) "\n")
;; body
(if main-p
(org-babel-fortran-ensure-main-wrap
(concat
;; variables
(mapconcat 'org-babel-fortran-var-to-fortran vars "\n")
body) params)
body) "\n") "\n")))
(defun org-babel-fortran-ensure-main-wrap (body params)
"Wrap body in a \"program ... end program\" block if none exists."
(if (string-match "^[ \t]*program[ \t]*.*" (capitalize body))
(let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
(if vars (error "cannot use :vars if 'program' statement is present"))
body)
(let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
(if vars (error "Cannot use :vars if 'program' statement is present"))
body)
(format "program main\n%s\nend program main\n" body)))
(defun org-babel-prep-session:fortran (session params)
"This function does nothing as fortran is a compiled language with no
support for sessions"
(error "fortran is a compiled languages -- no support for sessions"))
(error "Fortran is a compiled languages -- no support for sessions"))
(defun org-babel-load-session:fortran (session body params)
"This function does nothing as fortran is a compiled language with no
support for sessions"
(error "fortran is a compiled languages -- no support for sessions"))
(error "Fortran is a compiled languages -- no support for sessions"))
;; helper functions
@ -146,15 +146,15 @@ of the same value."
(length val) var val))
((listp val)
(format "real, parameter :: %S(%d) = %s\n"
var (length val) (ob-fortran-transform-list val)))
var (length val) (org-babel-fortran-transform-list val)))
(t
(error (format "the type of parameter %s is not supported by ob-fortran"
var))))))
(defun ob-fortran-transform-list (val)
(defun org-babel-fortran-transform-list (val)
"Return a fortran representation of enclose syntactic lists."
(if (listp val)
(concat "(/" (mapconcat #'ob-fortran-transform-list val ", ") "/)")
(concat "(/" (mapconcat #'org-babel-fortran-transform-list val ", ") "/)")
(format "%S" val)))
(provide 'ob-fortran)

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

@ -87,46 +87,45 @@ code."
(timefmt (plist-get params :timefmt))
(time-ind (or (plist-get params :timeind)
(when timefmt 1)))
(add-to-body (lambda (text) (setq body (concat text "\n" body))))
output)
(flet ((add-to-body (text)
(setq body (concat text "\n" body))))
;; append header argument settings to body
(when title (add-to-body (format "set title '%s'" title))) ;; title
(when lines (mapc (lambda (el) (add-to-body el)) lines)) ;; line
(when sets
(mapc (lambda (el) (add-to-body (format "set %s" el))) sets))
(when x-labels
(add-to-body
(format "set xtics (%s)"
(mapconcat (lambda (pair)
(format "\"%s\" %d" (cdr pair) (car pair)))
x-labels ", "))))
(when y-labels
(add-to-body
(format "set ytics (%s)"
(mapconcat (lambda (pair)
(format "\"%s\" %d" (cdr pair) (car pair)))
y-labels ", "))))
(when time-ind
(add-to-body "set xdata time")
(add-to-body (concat "set timefmt \""
(or timefmt
"%Y-%m-%d-%H:%M:%S") "\"")))
(when out-file (add-to-body (format "set output \"%s\"" out-file)))
(when term (add-to-body (format "set term %s" term)))
;; 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 #'identity
(org-babel-variable-assignments:gnuplot params)
"\n"))
;; replace any variable names preceded by '$' with the actual
;; value of the variable
(mapc (lambda (pair)
(setq body (replace-regexp-in-string
(format "\\$%s" (car pair)) (cdr pair) body)))
vars))
body)))
;; append header argument settings to body
(when title (funcall add-to-body (format "set title '%s'" title))) ;; title
(when lines (mapc (lambda (el) (funcall add-to-body el)) lines)) ;; line
(when sets
(mapc (lambda (el) (funcall add-to-body (format "set %s" el))) sets))
(when x-labels
(funcall add-to-body
(format "set xtics (%s)"
(mapconcat (lambda (pair)
(format "\"%s\" %d" (cdr pair) (car pair)))
x-labels ", "))))
(when y-labels
(funcall add-to-body
(format "set ytics (%s)"
(mapconcat (lambda (pair)
(format "\"%s\" %d" (cdr pair) (car pair)))
y-labels ", "))))
(when time-ind
(funcall add-to-body "set xdata time")
(funcall add-to-body (concat "set timefmt \""
(or timefmt
"%Y-%m-%d-%H:%M:%S") "\"")))
(when out-file (funcall add-to-body (format "set output \"%s\"" out-file)))
(when term (funcall add-to-body (format "set term %s" term)))
;; 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
(funcall 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)
(setq body (replace-regexp-in-string
(format "\\$%s" (car pair)) (cdr pair) body)))
vars))
body))
(defun org-babel-execute:gnuplot (body params)
"Execute a block of Gnuplot code.
@ -183,7 +182,7 @@ This function is called by `org-babel-execute-src-block'."
buffer)))
(defun org-babel-variable-assignments:gnuplot (params)
"Return list of gnuplot statements assigning the block's variables"
"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)))

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

@ -125,12 +125,12 @@ then create one. Return the initialized session."
(current-buffer))))
(defun org-babel-variable-assignments:haskell (params)
"Return list of haskell statements assigning the block's variables"
"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))))
(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.

122
lisp/org/ob-io.el Normal file
View file

@ -0,0 +1,122 @@
;;; ob-io.el --- org-babel functions for Io evaluation
;; Copyright (C) 2012 Free Software Foundation, Inc.
;; Author: Andrzej Lichnerowicz
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Currently only supports the external execution. No session support yet.
;; :results output -- runs in scripting mode
;; :results output repl -- runs in repl mode
;;; Requirements:
;; - Io language :: http://iolanguage.org/
;; - Io major mode :: Can be installed from Io sources
;; https://github.com/stevedekorte/io/blob/master/extras/SyntaxHighlighters/Emacs/io-mode.el
;;; Code:
(require 'ob)
(require 'ob-ref)
(require 'ob-comint)
(require 'ob-eval)
(eval-when-compile (require 'cl))
(add-to-list 'org-babel-tangle-lang-exts '("io" . "io"))
(defvar org-babel-default-header-args:io '())
(defvar org-babel-io-command "io"
"Name of the command to use for executing Io code.")
(defun org-babel-execute:io (body params)
"Execute a block of Io code with org-babel. This function is
called by `org-babel-execute-src-block'"
(message "executing Io source code block")
(let* ((processed-params (org-babel-process-params params))
(session (org-babel-io-initiate-session (nth 0 processed-params)))
(vars (nth 1 processed-params))
(result-params (nth 2 processed-params))
(result-type (cdr (assoc :result-type params)))
(full-body (org-babel-expand-body:generic
body params))
(result (org-babel-io-evaluate
session full-body result-type result-params)))
(org-babel-reassemble-table
result
(org-babel-pick-name
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
(defun org-babel-io-table-or-string (results)
"Convert RESULTS into an appropriate elisp value.
If RESULTS look like a table, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
(org-babel-script-escape results))
(defvar org-babel-io-wrapper-method
"(
%s
) asString print
")
(defun org-babel-io-evaluate (session body &optional result-type result-params)
"Evaluate BODY in external Io process.
If RESULT-TYPE equals 'output then return standard output as a string.
If RESULT-TYPE equals 'value then return the value of the last statement
in BODY as elisp."
(when session (error "Sessions are not (yet) supported for Io"))
(case result-type
(output
(if (member "repl" result-params)
(org-babel-eval org-babel-io-command body)
(let ((src-file (org-babel-temp-file "io-")))
(progn (with-temp-file src-file (insert body))
(org-babel-eval
(concat org-babel-io-command " " src-file) "")))))
(value (let* ((src-file (org-babel-temp-file "io-"))
(wrapper (format org-babel-io-wrapper-method body)))
(with-temp-file src-file (insert wrapper))
((lambda (raw)
(if (member "code" result-params)
raw
(org-babel-io-table-or-string raw)))
(org-babel-eval
(concat org-babel-io-command " " src-file) ""))))))
(defun org-babel-prep-session:io (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(error "Sessions are not (yet) supported for Io"))
(defun org-babel-io-initiate-session (&optional session)
"If there is not a current inferior-process-buffer in SESSION
then create. Return the initialized session. Sessions are not
supported in Io."
nil)
(provide 'ob-io)
;;; ob-io.el ends here

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

@ -130,7 +130,7 @@ specifying a variable of the same value."
session))
(defun org-babel-variable-assignments:js (params)
"Return list of Javascript statements assigning the block's variables"
"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))))
@ -152,9 +152,9 @@ then create. Return the initialized session."
(sit-for .5)
(org-babel-js-initiate-session session))))
((string= "node" org-babel-js-cmd )
(error "session evaluation with node.js is not supported"))
(error "Session evaluation with node.js is not supported"))
(t
(error "sessions are only supported with mozrepl add \":cmd mozrepl\"")))))
(error "Sessions are only supported with mozrepl add \":cmd mozrepl\"")))))
(provide 'ob-js)

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

@ -132,7 +132,7 @@ This function is called by `org-babel-execute-src-block'."
(when (file-exists-p transient-pdf-file)
(delete-file transient-pdf-file))))))
((string-match "\\.\\([^\\.]+\\)$" out-file)
(error "can not create %s files, please specify a .png or .pdf file or try the :imagemagick header argument"
(error "Can not create %s files, please specify a .png or .pdf file or try the :imagemagick header argument"
(match-string 1 out-file))))
nil) ;; signal that output has already been written to file
body))

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

@ -52,8 +52,8 @@ called by `org-babel-execute-src-block'."
(out-file (org-babel-temp-file "ledger-output-")))
(with-temp-file in-file (insert body))
(message "%s" (concat "ledger"
" -f " (org-babel-process-file-name in-file)
" " cmdline))
" -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)

130
lisp/org/ob-lilypond.el
View file

@ -23,10 +23,14 @@
;;; Commentary:
;; Installation / usage info, and examples are available at
;; https://github.com/mjago/ob-lilypond
;; Installation, ob-lilypond documentation, and examples are available at
;; http://orgmode.org/worg/org-contrib/babel/languages/ob-doc-lilypond.html
;;
;; Lilypond documentation can be found at
;; http://lilypond.org/manuals.html
;;; Code:
(require 'ob)
(require 'ob-eval)
(require 'ob-tangle)
@ -36,7 +40,9 @@
(add-to-list 'org-babel-tangle-lang-exts '("LilyPond" . "ly"))
(defvar org-babel-default-header-args:lilypond '()
"Default header arguments for js code blocks.")
"Default header arguments for lilypond code blocks.
NOTE: The arguments are determined at lilypond compile time.
See (ly-set-header-args)")
(defvar ly-compile-post-tangle t
"Following the org-babel-tangle (C-c C-v t) command,
@ -48,14 +54,14 @@ Default value is t")
(defvar ly-display-pdf-post-tangle t
"Following a successful LilyPond compilation
ly-display-pdf-post-tangle determines whether to automate the
drawing / redrawing of the resultant pdf. If the value is nil,
the pdf is not automatically redrawn. Default value is t")
drawing / redrawing of the resultant pdf. If the value is nil,
the pdf is not automatically redrawn. Default value is t")
(defvar ly-play-midi-post-tangle t
"Following a successful LilyPond compilation
ly-play-midi-post-tangle determines whether to automate the
playing of the resultant midi file. If the value is nil,
the midi file is not automatically played. Default value is t")
playing of the resultant midi file. If the value is nil,
the midi file is not automatically played. Default value is t")
(defvar ly-OSX-ly-path
"/Applications/lilypond.app/Contents/Resources/bin/lilypond")
@ -71,24 +77,28 @@ the midi file is not automatically played. Default value is t")
(defvar ly-w32-midi-path "")
(defvar ly-gen-png nil
"Image generation (png) can be turned on by default by setting
"Image generation (png) can be turned on by default by setting
LY-GEN-PNG to t")
(defvar ly-gen-svg nil
"Image generation (SVG) can be turned on by default by setting
"Image generation (SVG) can be turned on by default by setting
LY-GEN-SVG to t")
(defvar ly-gen-html nil
"HTML generation can be turned on by default by setting
"HTML generation can be turned on by default by setting
LY-GEN-HTML to t")
(defvar ly-gen-pdf nil
"PDF generation can be turned on by default by setting
LY-GEN-PDF to t")
(defvar ly-use-eps nil
"You can force the compiler to use the EPS backend by setting
"You can force the compiler to use the EPS backend by setting
LY-USE-EPS to t")
(defvar ly-arrange-mode nil
"Arrange mode is turned on by setting LY-ARRANGE-MODE
to t. In Arrange mode the following settings are altered
to t. In Arrange mode the following settings are altered
from default...
:tangle yes, :noweb yes
:results silent :comments yes.
@ -97,7 +107,6 @@ blocks")
(defun org-babel-expand-body:lilypond (body params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
(mapc
(lambda (pair)
@ -117,7 +126,6 @@ Depending on whether we are in arrange mode either:
1. Attempt to execute lilypond block according to header settings
(This is the default basic mode)
2. Tangle all lilypond blocks and process the result (arrange mode)"
(ly-set-header-args ly-arrange-mode)
(if ly-arrange-mode
(ly-tangle)
@ -125,16 +133,14 @@ Depending on whether we are in arrange mode either:
(defun ly-tangle ()
"ob-lilypond specific tangle, attempts to invoke
=ly-execute-tangled-ly= if tangle is successful. Also passes
=ly-execute-tangled-ly= if tangle is successful. Also passes
specific arguments to =org-babel-tangle="
(interactive)
(if (org-babel-tangle nil "yes" "lilypond")
(ly-execute-tangled-ly) nil))
(defun ly-process-basic (body params)
"Execute a lilypond block in basic mode"
"Execute a lilypond block in basic mode."
(let* ((result-params (cdr (assoc :result-params params)))
(out-file (cdr (assoc :file params)))
(cmdline (or (cdr (assoc :cmdline params))
@ -143,7 +149,6 @@ specific arguments to =org-babel-tangle="
(with-temp-file in-file
(insert (org-babel-expand-body:generic body params)))
(org-babel-eval
(concat
(ly-determine-ly-path)
@ -155,18 +160,15 @@ specific arguments to =org-babel-tangle="
(file-name-sans-extension out-file)
" "
cmdline
in-file) "")
) nil)
in-file) "")) nil)
(defun org-babel-prep-session:lilypond (session params)
"Return an error because LilyPond exporter does not support sessions."
(error "Sorry, LilyPond does not currently support sessions!"))
(defun ly-execute-tangled-ly ()
"Compile result of block tangle with lilypond.
If error in compilation, attempt to mark the error in lilypond org file"
(when ly-compile-post-tangle
(let ((ly-tangled-file (ly-switch-extension
(buffer-file-name) ".lilypond"))
@ -193,24 +195,25 @@ If error in compilation, attempt to mark the error in lilypond org file"
(defun ly-compile-lilyfile (file-name &optional test)
"Compile lilypond file and check for compile errors
FILE-NAME is full path to lilypond (.ly) file"
(message "Compiling LilyPond...")
(let ((arg-1 (ly-determine-ly-path)) ;program
(arg-2 nil) ;infile
(arg-3 "*lilypond*") ;buffer
(arg-4 t) ;display
(arg-5 (if ly-gen-png "--png" "")) ;&rest...
(arg-6 (if ly-gen-html "--html" ""))
(arg-7 (if ly-use-eps "-dbackend=eps" ""))
(arg-8 (if ly-gen-svg "-dbackend=svg" ""))
(arg-9 (concat "--output=" (file-name-sans-extension file-name)))
(arg-10 file-name))
(arg-4 t) ;display
(arg-5 (if ly-gen-png "--png" "")) ;&rest...
(arg-6 (if ly-gen-html "--html" ""))
(arg-7 (if ly-gen-pdf "--pdf" ""))
(arg-8 (if ly-use-eps "-dbackend=eps" ""))
(arg-9 (if ly-gen-svg "-dbackend=svg" ""))
(arg-10 (concat "--output=" (file-name-sans-extension file-name)))
(arg-11 file-name))
(if test
`(,arg-1 ,arg-2 ,arg-3 ,arg-4 ,arg-5
,arg-6 ,arg-7 ,arg-8 ,arg-9 ,arg-10)
`(,arg-1 ,arg-2 ,arg-3 ,arg-4 ,arg-5 ,arg-6
,arg-7 ,arg-8 ,arg-9 ,arg-10 ,arg-11)
(call-process
arg-1 arg-2 arg-3 arg-4 arg-5
arg-6 arg-7 arg-8 arg-9 arg-10))))
arg-1 arg-2 arg-3 arg-4 arg-5 arg-6
arg-7 arg-8 arg-9 arg-10 arg-11))))
(defun ly-check-for-compile-error (file-name &optional test)
"Check for compile error.
@ -229,7 +232,6 @@ nil as file-name since it is unused in this context"
(defun ly-process-compile-error (file-name)
"Process the compilation error that has occurred.
FILE-NAME is full path to lilypond file"
(let ((line-num (ly-parse-line-num)))
(let ((error-lines (ly-parse-error-line file-name line-num)))
(ly-mark-error-line file-name error-lines)
@ -239,7 +241,6 @@ FILE-NAME is full path to lilypond file"
"Mark the erroneous lines in the lilypond org buffer.
FILE-NAME is full path to lilypond file.
LINE is the erroneous line"
(switch-to-buffer-other-window
(concat (file-name-nondirectory
(ly-switch-extension file-name ".org"))))
@ -255,7 +256,6 @@ LINE is the erroneous line"
(defun ly-parse-line-num (&optional buffer)
"Extract error line number."
(when buffer
(set-buffer buffer))
(let ((start
@ -280,7 +280,6 @@ LINE is the erroneous line"
"Extract the erroneous line from the tangled .ly file
FILE-NAME is full path to lilypond file.
LINENO is the number of the erroneous line"
(with-temp-buffer
(insert-file-contents (ly-switch-extension file-name ".ly")
nil nil nil t)
@ -295,7 +294,6 @@ LINENO is the number of the erroneous line"
"Attempt to display the generated pdf file
FILE-NAME is full path to lilypond file
If TEST is non-nil, the shell command is returned and is not run"
(when ly-display-pdf-post-tangle
(let ((pdf-file (ly-switch-extension file-name ".pdf")))
(if (file-exists-p pdf-file)
@ -303,14 +301,17 @@ If TEST is non-nil, the shell command is returned and is not run"
(concat (ly-determine-pdf-path) " " pdf-file)))
(if test
cmd-string
(shell-command cmd-string)))
(message "No pdf file generated so can't display!")))))
(start-process
"\"Audition pdf\""
"*lilypond*"
(ly-determine-pdf-path)
pdf-file)))
(message "No pdf file generated so can't display!")))))
(defun ly-attempt-to-play-midi (file-name &optional test)
"Attempt to play the generated MIDI file
FILE-NAME is full path to lilypond file
If TEST is non-nil, the shell command is returned and is not run"
(when ly-play-midi-post-tangle
(let ((midi-file (ly-switch-extension file-name ".midi")))
(if (file-exists-p midi-file)
@ -318,13 +319,16 @@ If TEST is non-nil, the shell command is returned and is not run"
(concat (ly-determine-midi-path) " " midi-file)))
(if test
cmd-string
(shell-command cmd-string)))
(start-process
"\"Audition midi\""
"*lilypond*"
(ly-determine-midi-path)
midi-file)))
(message "No midi file generated so can't play!")))))
(defun ly-determine-ly-path (&optional test)
"Return correct path to ly binary depending on OS
If TEST is non-nil, it contains a simulation of the OS for test purposes"
(let ((sys-type
(or test system-type)))
(cond ((string= sys-type "darwin")
@ -336,7 +340,6 @@ If TEST is non-nil, it contains a simulation of the OS for test purposes"
(defun ly-determine-pdf-path (&optional test)
"Return correct path to pdf viewer depending on OS
If TEST is non-nil, it contains a simulation of the OS for test purposes"
(let ((sys-type
(or test system-type)))
(cond ((string= sys-type "darwin")
@ -348,7 +351,6 @@ If TEST is non-nil, it contains a simulation of the OS for test purposes"
(defun ly-determine-midi-path (&optional test)
"Return correct path to midi player depending on OS
If TEST is non-nil, it contains a simulation of the OS for test purposes"
(let ((sys-type
(or test test system-type)))
(cond ((string= sys-type "darwin")
@ -358,8 +360,7 @@ If TEST is non-nil, it contains a simulation of the OS for test purposes"
(t ly-nix-midi-path))))
(defun ly-toggle-midi-play ()
"Toggle whether midi will be played following a successful compilation"
"Toggle whether midi will be played following a successful compilation."
(interactive)
(setq ly-play-midi-post-tangle
(not ly-play-midi-post-tangle))
@ -368,8 +369,7 @@ If TEST is non-nil, it contains a simulation of the OS for test purposes"
"ENABLED." "DISABLED."))))
(defun ly-toggle-pdf-display ()
"Toggle whether pdf will be displayed following a successful compilation"
"Toggle whether pdf will be displayed following a successful compilation."
(interactive)
(setq ly-display-pdf-post-tangle
(not ly-display-pdf-post-tangle))
@ -378,26 +378,28 @@ If TEST is non-nil, it contains a simulation of the OS for test purposes"
"ENABLED." "DISABLED."))))
(defun ly-toggle-png-generation ()
"Toggle whether png image will be generated by compilation"
"Toggle whether png image will be generated by compilation."
(interactive)
(setq ly-gen-png
(not ly-gen-png))
(setq ly-gen-png (not ly-gen-png))
(message (concat "PNG image generation has been "
(if ly-gen-png "ENABLED." "DISABLED."))))
(defun ly-toggle-html-generation ()
"Toggle whether html will be generated by compilation"
"Toggle whether html will be generated by compilation."
(interactive)
(setq ly-gen-html
(not ly-gen-html))
(setq ly-gen-html (not ly-gen-html))
(message (concat "HTML generation has been "
(if ly-gen-html "ENABLED." "DISABLED."))))
(defun ly-toggle-arrange-mode ()
"Toggle whether in Arrange mode or Basic mode"
(defun ly-toggle-pdf-generation ()
"Toggle whether pdf will be generated by compilation."
(interactive)
(setq ly-gen-pdf (not ly-gen-pdf))
(message (concat "PDF generation has been "
(if ly-gen-pdf "ENABLED." "DISABLED."))))
(defun ly-toggle-arrange-mode ()
"Toggle whether in Arrange mode or Basic mode."
(interactive)
(setq ly-arrange-mode
(not ly-arrange-mode))
@ -406,18 +408,18 @@ If TEST is non-nil, it contains a simulation of the OS for test purposes"
(defun ly-switch-extension (file-name ext)
"Utility command to swap current FILE-NAME extension with EXT"
(concat (file-name-sans-extension
file-name) ext))
(defun ly-get-header-args (mode)
"Default arguments to use when evaluating a lilypond
source block. These depend upon whether we are in arrange
mode i.e. ARRANGE-MODE is t"
source block. These depend upon whether we are in arrange
mode i.e. ARRANGE-MODE is t"
(cond (mode
'((:tangle . "yes")
(:noweb . "yes")
(:results . "silent")
(:cache . "yes")
(:comments . "yes")))
(t
'((:results . "file")
@ -431,6 +433,4 @@ dependent on LY-ARRANGE-MODE"
(provide 'ob-lilypond)
;;; ob-lilypond.el ends here

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

@ -41,7 +41,7 @@
(add-to-list 'org-babel-tangle-lang-exts '("lisp" . "lisp"))
(defvar org-babel-default-header-args:lisp '())
(defvar org-babel-header-arg-names:lisp '(package))
(defvar org-babel-header-args:lisp '((package . :any)))
(defcustom org-babel-lisp-dir-fmt
"(let ((*default-pathname-defaults* #P%S)) %%s)"
@ -85,8 +85,8 @@ current directory string."
(insert (org-babel-expand-body:lisp body params))
(slime-eval `(swank:eval-and-grab-output
,(let ((dir (if (assoc :dir params)
(cdr (assoc :dir params))
default-directory)))
(cdr (assoc :dir params))
default-directory)))
(format
(if dir (format org-babel-lisp-dir-fmt dir) "(progn %s)")
(buffer-substring-no-properties

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

@ -97,38 +97,49 @@ if so then run the appropriate source block from the Library."
;;;###autoload
(defun org-babel-lob-get-info ()
"Return a Library of Babel function call as a string."
(flet ((nonempty (a b)
(let ((it (match-string a)))
(if (= (length it) 0) (match-string b) it))))
(let ((case-fold-search t))
(save-excursion
(beginning-of-line 1)
(when (looking-at org-babel-lob-one-liner-regexp)
(append
(mapcar #'org-babel-clean-text-properties
(list
(format "%s%s(%s)%s"
(nonempty 3 12)
(if (not (= 0 (length (nonempty 5 14))))
(concat "[" (nonempty 5 14) "]") "")
(or (nonempty 7 16) "")
(or (nonempty 8 19) ""))
(nonempty 9 18)))
(list (length (if (= (length (match-string 12)) 0)
(match-string 2) (match-string 11))))))))))
(let ((case-fold-search t)
(nonempty (lambda (a b)
(let ((it (match-string a)))
(if (= (length it) 0) (match-string b) it)))))
(save-excursion
(beginning-of-line 1)
(when (looking-at org-babel-lob-one-liner-regexp)
(append
(mapcar #'org-no-properties
(list
(format "%s%s(%s)%s"
(funcall nonempty 3 12)
(if (not (= 0 (length (funcall nonempty 5 14))))
(concat "[" (funcall nonempty 5 14) "]") "")
(or (funcall nonempty 7 16) "")
(or (funcall nonempty 8 19) ""))
(funcall nonempty 9 18)))
(list (length (if (= (length (match-string 12)) 0)
(match-string 2) (match-string 11)))))))))
(defun org-babel-lob-execute (info)
"Execute the lob call specified by INFO."
(let ((params (org-babel-process-params
(org-babel-merge-params
org-babel-default-header-args
(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)))))
(let* ((mkinfo (lambda (p) (list "emacs-lisp" "results" p nil nil (nth 2 info))))
(pre-params (org-babel-merge-params
org-babel-default-header-args
(org-babel-params-from-properties)
(org-babel-parse-header-arguments
(org-no-properties
(concat ":var results="
(mapconcat #'identity (butlast info) " "))))))
(pre-info (funcall mkinfo pre-params))
(cache? (and (cdr (assoc :cache pre-params))
(string= "yes" (cdr (assoc :cache pre-params)))))
(new-hash (when cache? (org-babel-sha1-hash pre-info)))
(old-hash (when cache? (org-babel-current-result-hash))))
(if (and cache? (equal new-hash old-hash))
(save-excursion (goto-char (org-babel-where-is-src-block-result))
(forward-line 1)
(message "%S" (org-babel-read-result)))
(prog1 (org-babel-execute-src-block
nil (funcall mkinfo (org-babel-process-params pre-params)))
;; update the hash
(when new-hash (org-babel-set-current-result-hash new-hash))))))
(provide 'ob-lob)

36
lisp/org/ob-maxima.el
View file

@ -48,21 +48,21 @@
(defun org-babel-maxima-expand (body params)
"Expand a block of Maxima code according to its header arguments."
(let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
(mapconcat 'identity
(list
;; graphic output
(let ((graphic-file (org-babel-maxima-graphical-output-file params)))
(if graphic-file
(format
"set_plot_option ([gnuplot_term, png]); set_plot_option ([gnuplot_out_file, %S]);"
graphic-file)
""))
;; variables
(mapconcat 'org-babel-maxima-var-to-maxima vars "\n")
;; body
body
"gnuplot_close ()$")
"\n")))
(mapconcat 'identity
(list
;; graphic output
(let ((graphic-file (org-babel-maxima-graphical-output-file params)))
(if graphic-file
(format
"set_plot_option ([gnuplot_term, png]); set_plot_option ([gnuplot_out_file, %S]);"
graphic-file)
""))
;; variables
(mapconcat 'org-babel-maxima-var-to-maxima vars "\n")
;; body
body
"gnuplot_close ()$")
"\n")))
(defun org-babel-execute:maxima (body params)
"Execute a block of Maxima entries with org-babel. This function is
@ -70,7 +70,7 @@ called by `org-babel-execute-src-block'."
(message "executing Maxima source code block")
(let ((result-params (split-string (or (cdr (assoc :results params)) "")))
(result
(let* ((cmdline (cdr (assoc :cmdline params)))
(let* ((cmdline (or (cdr (assoc :cmdline params)) ""))
(in-file (org-babel-temp-file "maxima-" ".max"))
(cmd (format "%s --very-quiet -r 'batchload(%S)$' %s"
org-babel-maxima-command in-file cmdline)))
@ -110,8 +110,8 @@ of the same value."
(setq val (symbol-name val))
(when (= (length val) 1)
(setq val (string-to-char val))))
(format "%S: %s$" var
(org-babel-maxima-elisp-to-maxima val))))
(format "%S: %s$" var
(org-babel-maxima-elisp-to-maxima val))))
(defun org-babel-maxima-graphical-output-file (params)
"Name of file to which maxima should send graphical output."

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

@ -24,7 +24,7 @@
;;; Commentary:
;;
;; This software provides EMACS org-babel export support for message
;; sequence charts. The mscgen utility is used for processing the
;; sequence charts. The mscgen utility is used for processing the
;; sequence definition, and must therefore be installed in the system.
;;
;; Mscgen is available and documented at
@ -64,13 +64,13 @@
(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'.
Default filetype is png. Modify by setting :filetype parameter to
Default filetype is png. Modify by setting :filetype parameter to
mscgen supported formats."
(let* ((out-file (or (cdr (assoc :file params)) "output.png" ))
(filetype (or (cdr (assoc :filetype params)) "png" )))
(unless (cdr (assoc :file params))
(error "
ERROR: no output file specified. Add \":file name.png\" to the src header"))
ERROR: no output file specified. Add \":file name.png\" to the src header"))
(org-babel-eval (concat "mscgen -T " filetype " -o " out-file) body)
nil)) ;; signal that output has already been written to file

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

@ -72,7 +72,7 @@
(progn (setq out nil) line)
(when (string-match re line)
(progn (setq out t) nil))))
(mapcar #'org-babel-trim (reverse raw))))))))
(mapcar #'org-babel-trim (reverse raw))))))))
(org-babel-reassemble-table
(org-babel-ocaml-parse-output (org-babel-trim clean))
(org-babel-pick-name
@ -93,7 +93,7 @@
(get-buffer tuareg-interactive-buffer-name))))
(defun org-babel-variable-assignments:ocaml (params)
"Return list of ocaml statements assigning the block's variables"
"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))))
@ -131,11 +131,11 @@ Emacs-lisp table, otherwise return the results as a string."
"Convert RESULTS into an elisp table or string.
If the results look like a table, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
(org-babel-script-escape
(replace-regexp-in-string
"\\[|" "[" (replace-regexp-in-string
"|\\]" "]" (replace-regexp-in-string
"; " "," results)))))
(org-babel-script-escape
(replace-regexp-in-string
"\\[|" "[" (replace-regexp-in-string
"|\\]" "]" (replace-regexp-in-string
"; " "," results)))))
(provide 'ob-ocaml)

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

@ -52,7 +52,7 @@
to a non-nil value.")
(defvar org-babel-matlab-emacs-link-wrapper-method
"%s
"%s
if ischar(ans), fid = fopen('%s', 'w'); fprintf(fid, '%%s\\n', ans); fclose(fid);
else, save -ascii %s ans
end
@ -110,7 +110,7 @@ end")
(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"
"Return list of octave statements assigning the block's variables."
(mapcar
(lambda (pair)
(format "%s=%s;"
@ -147,13 +147,13 @@ specifying a variable of the same value."
(defun org-babel-matlab-initiate-session (&optional session params)
"Create a matlab inferior process buffer.
If there is not a current inferior-process-buffer in SESSION then
create. Return the initialized session."
create. Return the initialized session."
(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."
create. Return the initialized session."
(if matlabp (require 'matlab) (require 'octave-inf))
(unless (string= session "none")
(let ((session (or session
@ -225,9 +225,9 @@ value of the last statement in BODY, as elisp."
(message "Waiting for Matlab Emacs Link")
(while (file-exists-p wait-file) (sit-for 0.01))
"")) ;; matlab-shell-run-region doesn't seem to
;; make *matlab* buffer contents easily
;; available, so :results output currently
;; won't work
;; make *matlab* buffer contents easily
;; available, so :results output currently
;; won't work
(org-babel-comint-with-output
(session
(if matlabp
@ -265,7 +265,7 @@ This removes initial blank and comment lines and then calls
(org-babel-import-elisp-from-file temp-file '(16))))
(defun org-babel-octave-read-string (string)
"Strip \\\"s from around octave string"
"Strip \\\"s from around octave string."
(if (string-match "^\"\\([^\000]+\\)\"$" string)
(match-string 1 string)
string))

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

@ -32,7 +32,7 @@
(declare-function org-export-string "org-exp" (string fmt &optional dir))
(defvar org-babel-default-header-args:org
'((:results . "raw silent") (:exports . "results"))
'((:results . "raw silent") (:exports . "code"))
"Default arguments for evaluating a org source block.")
(defvar org-babel-org-default-header

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

@ -47,7 +47,7 @@ This function is called by `org-babel-execute-src-block'."
(result-type (cdr (assoc :result-type params)))
(full-body (org-babel-expand-body:generic
body params (org-babel-variable-assignments:perl params)))
(session (org-babel-perl-initiate-session session)))
(session (org-babel-perl-initiate-session session)))
(org-babel-reassemble-table
(org-babel-perl-evaluate session full-body result-type)
(org-babel-pick-name
@ -57,10 +57,10 @@ This function is called by `org-babel-execute-src-block'."
(defun org-babel-prep-session:perl (session params)
"Prepare SESSION according to the header arguments in PARAMS."
(error "Sessions are not supported for Perl."))
(error "Sessions are not supported for Perl"))
(defun org-babel-variable-assignments:perl (params)
"Return list of perl statements assigning the block's variables"
"Return list of perl statements assigning the block's variables."
(mapcar
(lambda (pair)
(format "$%s=%s;"
@ -81,8 +81,8 @@ specifying a var of the same value."
(defvar org-babel-perl-buffers '(:default . nil))
(defun org-babel-perl-initiate-session (&optional session params)
"Return nil because sessions are not supported by perl"
nil)
"Return nil because sessions are not supported by perl."
nil)
(defvar org-babel-perl-wrapper-method
"
@ -101,7 +101,7 @@ print o join(\"\\n\", @r), \"\\n\"")
If RESULT-TYPE equals 'output then return a list of the outputs
of the statements in BODY, if RESULT-TYPE equals 'value then
return the value of the last statement in BODY, as elisp."
(when session (error "Sessions are not supported for Perl."))
(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 (org-babel-temp-file "perl-")))

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

@ -25,16 +25,16 @@
;;; Commentary:
;; This library enables the use of PicoLisp in the multi-language
;; programming framework Org-Babel. PicoLisp is a minimal yet
;; programming framework Org-Babel. PicoLisp is a minimal yet
;; fascinating lisp dialect and a highly productive application
;; framework for web-based client-server applications on top of
;; object-oriented databases. A good way to learn PicoLisp is to first
;; object-oriented databases. A good way to learn PicoLisp is to first
;; read Paul Grahams essay "The hundred year language"
;; (http://www.paulgraham.com/hundred.html) and then study the various
;; documents and essays published in the PicoLisp wiki
;; (http://picolisp.com/5000/-2.html). PicoLisp is included in some
;; GNU/Linux Distributions, and can be downloaded here:
;; http://software-lab.de/down.html. It ships with a picolisp-mode and
;; http://software-lab.de/down.html. It ships with a picolisp-mode and
;; a inferior-picolisp-mode for Emacs (to be found in the /lib/el/
;; directory).

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

@ -52,7 +52,7 @@
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")))
(error "PlantUML requires a \":file\" header argument")))
(cmdline (cdr (assoc :cmdline params)))
(in-file (org-babel-temp-file "plantuml-"))
(java (or (cdr (assoc :java params)) ""))

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

@ -44,7 +44,7 @@
(defvar org-babel-default-header-args:python '())
(defvar org-babel-python-command "python"
"Name of command for executing python code.")
"Name of command for executing Python code.")
(defvar org-babel-python-mode (if (featurep 'xemacs) 'python-mode 'python)
"Preferred python mode for use in running python interactively.
@ -99,7 +99,7 @@ VARS contains resolved variable references"
;; helper functions
(defun org-babel-variable-assignments:python (params)
"Return list of python statements assigning the block's variables"
"Return a list of Python statements assigning the block's variables."
(mapcar
(lambda (pair)
(format "%s=%s"
@ -160,7 +160,7 @@ then create. Return the initialized session."
(py-shell)
(setq python-buffer (concat "*" bufname "*"))))
(t
(error "No function available for running an inferior python.")))
(error "No function available for running an inferior Python")))
(setq org-babel-python-buffers
(cons (cons session python-buffer)
(assq-delete-all session org-babel-python-buffers)))
@ -190,7 +190,7 @@ open('%s', 'w').write( pprint.pformat(main()) )")
(defun org-babel-python-evaluate
(session body &optional result-type result-params preamble)
"Evaluate BODY as python code."
"Evaluate BODY as Python code."
(if session
(org-babel-python-evaluate-session
session body result-type result-params)
@ -201,7 +201,7 @@ open('%s', 'w').write( pprint.pformat(main()) )")
(body &optional result-type result-params preamble)
"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
string. If RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp."
((lambda (raw)
(if (or (member "code" result-params)
@ -236,24 +236,25 @@ last statement in BODY, as elisp."
(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
string. If RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp."
(flet ((send-wait () (comint-send-input nil t) (sleep-for 0 5))
(let* ((send-wait (lambda () (comint-send-input nil t) (sleep-for 0 5)))
(dump-last-value
(tmp-file pp)
(mapc
(lambda (statement) (insert statement) (send-wait))
(if pp
(list
"import pprint"
(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 (line) (insert line) (send-wait))
(split-string body "[\r\n]"))
(send-wait)))
(lambda
(tmp-file pp)
(mapc
(lambda (statement) (insert statement) (funcall send-wait))
(if pp
(list
"import pprint"
(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 (lambda (body)
(mapc (lambda (line) (insert line) (funcall send-wait))
(split-string body "[\r\n]"))
(funcall send-wait))))
((lambda (results)
(unless (string= (substring org-babel-python-eoe-indicator 1 -1) results)
(if (or (member "code" result-params)
@ -269,25 +270,25 @@ last statement in BODY, as elisp."
(butlast
(org-babel-comint-with-output
(session org-babel-python-eoe-indicator t body)
(input-body body)
(send-wait) (send-wait)
(funcall input-body body)
(funcall send-wait) (funcall send-wait)
(insert org-babel-python-eoe-indicator)
(send-wait))
(funcall send-wait))
2) "\n"))
(value
(let ((tmp-file (org-babel-temp-file "python-")))
(org-babel-comint-with-output
(session org-babel-python-eoe-indicator nil body)
(let ((comint-process-echoes nil))
(input-body body)
(dump-last-value tmp-file (member "pp" result-params))
(send-wait) (send-wait)
(funcall input-body body)
(funcall dump-last-value tmp-file (member "pp" result-params))
(funcall send-wait) (funcall send-wait)
(insert org-babel-python-eoe-indicator)
(send-wait)))
(funcall send-wait)))
(org-babel-eval-read-file tmp-file)))))))
(defun org-babel-python-read-string (string)
"Strip 's from around python string"
"Strip 's from around Python string."
(if (string-match "^'\\([^\000]+\\)'$" string)
(match-string 1 string)
string))

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

@ -120,89 +120,89 @@ the variable."
(defun org-babel-ref-resolve (ref)
"Resolve the reference REF and return its value."
(save-window-excursion
(save-excursion
(let ((case-fold-search t)
type args new-refere new-header-args new-referent result
lob-info split-file split-ref index index-row index-col id)
;; if ref is indexed grab the indices -- beware nested indices
(when (and (string-match "\\[\\([^\\[]+\\)\\]$" ref)
(let ((str (substring ref 0 (match-beginning 0))))
(= (org-count ?( str) (org-count ?) str))))
(setq index (match-string 1 ref))
(setq ref (substring ref 0 (match-beginning 0))))
;; assign any arguments to pass to source block
(when (string-match
"^\\(.+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)\(\\(.*\\)\)$" ref)
(setq new-refere (match-string 1 ref))
(setq new-header-args (match-string 3 ref))
(setq new-referent (match-string 5 ref))
(when (> (length new-refere) 0)
(when (> (length new-referent) 0)
(setq args (mapcar (lambda (ref) (cons :var ref))
(org-babel-ref-split-args new-referent))))
(when (> (length new-header-args) 0)
(setq args (append (org-babel-parse-header-arguments
new-header-args) args)))
(setq ref new-refere)))
(when (string-match "^\\(.+\\):\\(.+\\)$" ref)
(setq split-file (match-string 1 ref))
(setq split-ref (match-string 2 ref))
(find-file split-file) (setq ref split-ref))
(save-restriction
(widen)
(goto-char (point-min))
(if (let ((src-rx (org-babel-named-src-block-regexp-for-name ref))
(res-rx (org-babel-named-data-regexp-for-name ref)))
;; goto ref in the current buffer
(or
;; check for code blocks
(re-search-forward src-rx nil t)
;; check for named data
(re-search-forward res-rx nil t)
;; check for local or global headlines by id
(setq id (org-babel-ref-goto-headline-id ref))
;; check the Library of Babel
(setq lob-info (cdr (assoc (intern ref)
org-babel-library-of-babel)))))
(unless (or lob-info id) (goto-char (match-beginning 0)))
;; ;; TODO: allow searching for names in other buffers
;; (setq id-loc (org-id-find ref 'marker)
;; buffer (marker-buffer id-loc)
;; loc (marker-position id-loc))
;; (move-marker id-loc nil)
(error "reference '%s' not found in this buffer" ref))
(cond
(lob-info (setq type 'lob))
(id (setq type 'id))
((and (looking-at org-babel-src-name-regexp)
(save-excursion
(forward-line 1)
(or (looking-at org-babel-src-block-regexp)
(looking-at org-babel-multi-line-header-regexp))))
(setq type 'source-block))
(t (while (not (setq type (org-babel-ref-at-ref-p)))
(forward-line 1)
(beginning-of-line)
(if (or (= (point) (point-min)) (= (point) (point-max)))
(error "reference not found")))))
(let ((params (append args '((:results . "silent")))))
(setq result
(case type
(results-line (org-babel-read-result))
(table (org-babel-read-table))
(list (org-babel-read-list))
(file (org-babel-read-link))
(source-block (org-babel-execute-src-block
nil nil (if org-babel-update-intermediate
nil params)))
(lob (org-babel-execute-src-block
nil lob-info params))
(id (org-babel-ref-headline-body)))))
(if (symbolp result)
(format "%S" result)
(if (and index (listp result))
(org-babel-ref-index-list index result)
result)))))))
(save-excursion
(let ((case-fold-search t)
type args new-refere new-header-args new-referent result
lob-info split-file split-ref index index-row index-col id)
;; if ref is indexed grab the indices -- beware nested indices
(when (and (string-match "\\[\\([^\\[]+\\)\\]$" ref)
(let ((str (substring ref 0 (match-beginning 0))))
(= (org-count ?( str) (org-count ?) str))))
(setq index (match-string 1 ref))
(setq ref (substring ref 0 (match-beginning 0))))
;; assign any arguments to pass to source block
(when (string-match
"^\\(.+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)\(\\(.*\\)\)$" ref)
(setq new-refere (match-string 1 ref))
(setq new-header-args (match-string 3 ref))
(setq new-referent (match-string 5 ref))
(when (> (length new-refere) 0)
(when (> (length new-referent) 0)
(setq args (mapcar (lambda (ref) (cons :var ref))
(org-babel-ref-split-args new-referent))))
(when (> (length new-header-args) 0)
(setq args (append (org-babel-parse-header-arguments
new-header-args) args)))
(setq ref new-refere)))
(when (string-match "^\\(.+\\):\\(.+\\)$" ref)
(setq split-file (match-string 1 ref))
(setq split-ref (match-string 2 ref))
(find-file split-file) (setq ref split-ref))
(save-restriction
(widen)
(goto-char (point-min))
(if (let ((src-rx (org-babel-named-src-block-regexp-for-name ref))
(res-rx (org-babel-named-data-regexp-for-name ref)))
;; goto ref in the current buffer
(or
;; check for code blocks
(re-search-forward src-rx nil t)
;; check for named data
(re-search-forward res-rx nil t)
;; check for local or global headlines by id
(setq id (org-babel-ref-goto-headline-id ref))
;; check the Library of Babel
(setq lob-info (cdr (assoc (intern ref)
org-babel-library-of-babel)))))
(unless (or lob-info id) (goto-char (match-beginning 0)))
;; ;; TODO: allow searching for names in other buffers
;; (setq id-loc (org-id-find ref 'marker)
;; buffer (marker-buffer id-loc)
;; loc (marker-position id-loc))
;; (move-marker id-loc nil)
(error "Reference '%s' not found in this buffer" ref))
(cond
(lob-info (setq type 'lob))
(id (setq type 'id))
((and (looking-at org-babel-src-name-regexp)
(save-excursion
(forward-line 1)
(or (looking-at org-babel-src-block-regexp)
(looking-at org-babel-multi-line-header-regexp))))
(setq type 'source-block))
(t (while (not (setq type (org-babel-ref-at-ref-p)))
(forward-line 1)
(beginning-of-line)
(if (or (= (point) (point-min)) (= (point) (point-max)))
(error "Reference not found")))))
(let ((params (append args '((:results . "silent")))))
(setq result
(case type
(results-line (org-babel-read-result))
(table (org-babel-read-table))
(list (org-babel-read-list))
(file (org-babel-read-link))
(source-block (org-babel-execute-src-block
nil nil (if org-babel-update-intermediate
nil params)))
(lob (org-babel-execute-src-block
nil lob-info params))
(id (org-babel-ref-headline-body)))))
(if (symbolp result)
(format "%S" result)
(if (and index (listp result))
(org-babel-ref-index-list index result)
result)))))))
(defun org-babel-ref-index-list (index lis)
"Return the subset of LIS indexed by INDEX.
@ -218,28 +218,29 @@ returned, or an empty string or \"*\" both of which are
interpreted to mean the entire range and as such are equivalent
to \"0:-1\"."
(if (and (> (length index) 0) (string-match "^\\([^,]*\\),?" index))
(let ((ind-re "\\(\\([-[:digit:]]+\\):\\([-[:digit:]]+\\)\\|\*\\)")
(length (length lis))
(portion (match-string 1 index))
(remainder (substring index (match-end 0))))
(flet ((wrap (num) (if (< num 0) (+ length num) num))
(open (ls) (if (and (listp ls) (= (length ls) 1)) (car ls) ls)))
(open
(mapcar
(lambda (sub-lis)
(if (listp sub-lis)
(org-babel-ref-index-list remainder sub-lis)
sub-lis))
(if (or (= 0 (length portion)) (string-match ind-re portion))
(mapcar
(lambda (n) (nth n lis))
(apply 'org-number-sequence
(if (and (> (length portion) 0) (match-string 2 portion))
(list
(wrap (string-to-number (match-string 2 portion)))
(wrap (string-to-number (match-string 3 portion))))
(list (wrap 0) (wrap -1)))))
(list (nth (wrap (string-to-number portion)) lis)))))))
(let* ((ind-re "\\(\\([-[:digit:]]+\\):\\([-[:digit:]]+\\)\\|\*\\)")
(lgth (length lis))
(portion (match-string 1 index))
(remainder (substring index (match-end 0)))
(wrap (lambda (num) (if (< num 0) (+ lgth num) num)))
(open (lambda (ls) (if (and (listp ls) (= (length ls) 1)) (car ls) ls))))
(funcall
open
(mapcar
(lambda (sub-lis)
(if (listp sub-lis)
(org-babel-ref-index-list remainder sub-lis)
sub-lis))
(if (or (= 0 (length portion)) (string-match ind-re portion))
(mapcar
(lambda (n) (nth n lis))
(apply 'org-number-sequence
(if (and (> (length portion) 0) (match-string 2 portion))
(list
(funcall wrap (string-to-number (match-string 2 portion)))
(funcall wrap (string-to-number (match-string 3 portion))))
(list (funcall wrap 0) (funcall wrap -1)))))
(list (nth (funcall wrap (string-to-number portion)) lis))))))
lis))
(defun org-babel-ref-split-args (arg-string)

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

@ -64,12 +64,12 @@ This function is called by `org-babel-execute-src-block'."
body params (org-babel-variable-assignments:ruby params)))
(result (if (member "xmp" result-params)
(with-temp-buffer
(require 'rcodetools)
(insert full-body)
(xmp (cdr (assoc :xmp-option params)))
(buffer-string))
(require 'rcodetools)
(insert full-body)
(xmp (cdr (assoc :xmp-option params)))
(buffer-string))
(org-babel-ruby-evaluate
session full-body result-type result-params))))
session full-body result-type result-params))))
(org-babel-reassemble-table
result
(org-babel-pick-name (cdr (assoc :colname-names params))
@ -102,7 +102,7 @@ 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"
"Return list of ruby statements assigning the block's variables."
(mapcar
(lambda (pair)
(format "%s=%s"

120
lisp/org/ob-scala.el Normal file
View file

@ -0,0 +1,120 @@
;;; ob-scala.el --- org-babel functions for Scala evaluation
;; Copyright (C) 2012 Free Software Foundation, Inc.
;; Author: Andrzej Lichnerowicz
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Currently only supports the external execution. No session support yet.
;;; Requirements:
;; - Scala language :: http://www.scala-lang.org/
;; - Scala major mode :: Can be installed from Scala sources
;; https://github.com/scala/scala-dist/blob/master/tool-support/src/emacs/scala-mode.el
;;; Code:
(require 'ob)
(require 'ob-ref)
(require 'ob-comint)
(require 'ob-eval)
(eval-when-compile (require 'cl))
(add-to-list 'org-babel-tangle-lang-exts '("scala" . "scala"))
(defvar org-babel-default-header-args:scala '())
(defvar org-babel-scala-command "scala"
"Name of the command to use for executing Scala code.")
(defun org-babel-execute:scala (body params)
"Execute a block of Scala code with org-babel. This function is
called by `org-babel-execute-src-block'"
(message "executing Scala source code block")
(let* ((processed-params (org-babel-process-params params))
(session (org-babel-scala-initiate-session (nth 0 processed-params)))
(vars (nth 1 processed-params))
(result-params (nth 2 processed-params))
(result-type (cdr (assoc :result-type params)))
(full-body (org-babel-expand-body:generic
body params))
(result (org-babel-scala-evaluate
session full-body result-type result-params)))
(org-babel-reassemble-table
result
(org-babel-pick-name
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
(defun org-babel-scala-table-or-string (results)
"Convert RESULTS into an appropriate elisp value.
If RESULTS look like a table, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
(org-babel-script-escape results))
(defvar org-babel-scala-wrapper-method
"(
%s
) asString print
")
(defun org-babel-scala-evaluate
(session body &optional result-type result-params)
"Evaluate BODY in external Scala process.
If RESULT-TYPE equals 'output then return standard output as a string.
If RESULT-TYPE equals 'value then return the value of the last statement
in BODY as elisp."
(when session (error "Sessions are not (yet) supported for Scala"))
(case result-type
(output
(let ((src-file (org-babel-temp-file "scala-")))
(progn (with-temp-file src-file (insert body))
(org-babel-eval
(concat org-babel-scala-command " " src-file) ""))))
(value
(let* ((src-file (org-babel-temp-file "scala-"))
(wrapper (format org-babel-scala-wrapper-method body)))
(with-temp-file src-file (insert wrapper))
((lambda (raw)
(if (member "code" result-params)
raw
(org-babel-scala-table-or-string raw)))
(org-babel-eval
(concat org-babel-scala-command " " src-file) ""))))))
(defun org-babel-prep-session:scala (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(error "Sessions are not (yet) supported for Scala"))
(defun org-babel-scala-initiate-session (&optional session)
"If there is not a current inferior-process-buffer in SESSION
then create. Return the initialized session. Sessions are not
supported in Scala."
nil)
(provide 'ob-scala)
;;; ob-scala.el ends here

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

@ -23,7 +23,7 @@
;;; Commentary:
;; Org-Babel support for interactive terminals. Mostly shell scripts.
;; Org-Babel support for interactive terminals. Mostly shell scripts.
;; Heavily inspired by 'eev' from Eduardo Ochs
;;
;; Adding :cmd and :terminal as header arguments
@ -64,8 +64,8 @@ In case you want to use a different screen than one selected by your $PATH")
(process-name (concat "org-babel: terminal (" session ")")))
(apply 'start-process process-name "*Messages*"
terminal `("-T" ,(concat "org-babel: " session) "-e" ,org-babel-screen-location
"-c" "/dev/null" "-mS" ,(concat "org-babel-session-" session)
,cmd))
"-c" "/dev/null" "-mS" ,(concat "org-babel-session-" session)
,cmd))
;; XXX: Is there a better way than the following?
(while (not (org-babel-screen-session-socketname session))
;; wait until screen session is available before returning
@ -81,8 +81,8 @@ In case you want to use a different screen than one selected by your $PATH")
(apply 'start-process (concat "org-babel: screen (" session ")") "*Messages*"
org-babel-screen-location
`("-S" ,socket "-X" "eval" "msgwait 0"
,(concat "readreg z " tmpfile)
"paste z"))))))
,(concat "readreg z " tmpfile)
"paste z"))))))
(defun org-babel-screen-session-socketname (session)
"Check if SESSION exists by parsing output of \"screen -ls\"."
@ -137,7 +137,7 @@ The terminal should shortly flicker."
(message (concat "org-babel-screen: Setup "
(if (string-match random-string tmp-string)
"WORKS."
"DOESN'T work.")))))
"DOESN'T work.")))))
(provide 'ob-screen)

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

@ -56,14 +56,13 @@ This will be passed to `shell-command-on-region'")
This function is called by `org-babel-execute-src-block'."
(let* ((session (org-babel-sh-initiate-session
(cdr (assoc :session params))))
(result-params (cdr (assoc :result-params params)))
(stdin ((lambda (stdin) (when stdin (org-babel-sh-var-to-string
(org-babel-ref-resolve stdin))))
(org-babel-ref-resolve stdin))))
(cdr (assoc :stdin params))))
(full-body (org-babel-expand-body:generic
body params (org-babel-variable-assignments:sh params))))
(org-babel-reassemble-table
(org-babel-sh-evaluate session full-body result-params stdin)
(org-babel-sh-evaluate session full-body params stdin)
(org-babel-pick-name
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
@ -91,7 +90,7 @@ 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"
"Return list of shell statements assigning the block's variables."
(let ((sep (cdr (assoc :separator params))))
(mapcar
(lambda (pair)
@ -108,13 +107,13 @@ var of the same value."
(defun org-babel-sh-var-to-string (var &optional sep)
"Convert an elisp value to a string."
(flet ((echo-var (v) (if (stringp v) v (format "%S" v))))
(let ((echo-var (lambda (v) (if (stringp v) v (format "%S" v)))))
(cond
((and (listp var) (listp (car var)))
(orgtbl-to-generic var (list :sep (or sep "\t") :fmt #'echo-var)))
(orgtbl-to-generic var (list :sep (or sep "\t") :fmt echo-var)))
((listp var)
(mapconcat #'echo-var var "\n"))
(t (echo-var var)))))
(mapconcat echo-var var "\n"))
(t (funcall echo-var var)))))
(defun org-babel-sh-table-or-results (results)
"Convert RESULTS to an appropriate elisp value.
@ -134,29 +133,38 @@ Emacs-lisp table, otherwise return the results as a string."
(defvar org-babel-sh-eoe-output "org_babel_sh_eoe"
"String to indicate that evaluation has completed.")
(defun org-babel-sh-evaluate (session body &optional result-params stdin)
(defun org-babel-sh-evaluate (session body &optional params stdin)
"Pass BODY to the Shell process in BUFFER.
If RESULT-TYPE equals 'output then return a list of the outputs
of the statements in BODY, if RESULT-TYPE equals 'value then
return the value of the last statement in BODY."
((lambda (results)
(when results
(if (or (member "scalar" result-params)
(member "verbatim" result-params)
(member "output" result-params))
results
(let ((tmp-file (org-babel-temp-file "sh-")))
(with-temp-file tmp-file (insert results))
(org-babel-import-elisp-from-file tmp-file)))))
(let ((result-params (cdr (assoc :result-params params))))
(if (or (member "scalar" result-params)
(member "verbatim" result-params)
(member "output" result-params))
results
(let ((tmp-file (org-babel-temp-file "sh-")))
(with-temp-file tmp-file (insert results))
(org-babel-import-elisp-from-file tmp-file))))))
(cond
(stdin ; external shell script w/STDIN
(let ((script-file (org-babel-temp-file "sh-script-"))
(stdin-file (org-babel-temp-file "sh-stdin-")))
(with-temp-file script-file (insert body))
(stdin-file (org-babel-temp-file "sh-stdin-"))
(shebang (cdr (assoc :shebang params)))
(padline (not (string= "no" (cdr (assoc :padline params))))))
(with-temp-file script-file
(when shebang (insert (concat shebang "\n")))
(when padline (insert "\n"))
(insert body))
(set-file-modes script-file #o755)
(with-temp-file stdin-file (insert stdin))
(with-temp-buffer
(call-process-shell-command
(format "%s %s" org-babel-sh-command script-file)
(if shebang
script-file
(format "%s %s" org-babel-sh-command script-file))
stdin-file
(current-buffer))
(buffer-string))))
@ -182,7 +190,18 @@ return the value of the last statement in BODY."
(list org-babel-sh-eoe-indicator))))
2)) "\n"))
('otherwise ; external shell script
(org-babel-eval org-babel-sh-command (org-babel-trim body))))))
(if (and (cdr (assoc :shebang params))
(> (length (cdr (assoc :shebang params))) 0))
(let ((script-file (org-babel-temp-file "sh-script-"))
(shebang (cdr (assoc :shebang params)))
(padline (not (string= "no" (cdr (assoc :padline params))))))
(with-temp-file script-file
(when shebang (insert (concat shebang "\n")))
(when padline (insert "\n"))
(insert body))
(set-file-modes script-file #o755)
(org-babel-eval script-file ""))
(org-babel-eval org-babel-sh-command (org-babel-trim body)))))))
(defun org-babel-sh-strip-weird-long-prompt (string)
"Remove prompt cruft from a string of shell output."

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

@ -51,8 +51,9 @@
(defvar org-babel-default-header-args:sql '())
(defvar org-babel-header-arg-names:sql
'(engine out-file))
(defvar org-babel-header-args:sql
'((engine . :any)
(out-file . :any)))
(defun org-babel-expand-body:sql (body params)
"Expand BODY according to the values of PARAMS."
@ -70,6 +71,15 @@ This function is called by `org-babel-execute-src-block'."
(org-babel-temp-file "sql-out-")))
(header-delim "")
(command (case (intern engine)
('dbi (format "dbish --batch '%s' < %s | sed '%s' > %s"
(or cmdline "")
(org-babel-process-file-name in-file)
"/^+/d;s/^\|//;$d"
(org-babel-process-file-name out-file)))
('monetdb (format "mclient -f tab %s < %s > %s"
(or cmdline "")
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)))
('msosql (format "osql %s -s \"\t\" -i %s -o %s"
(or cmdline "")
(org-babel-process-file-name in-file)
@ -80,12 +90,16 @@ This function is called by `org-babel-execute-src-block'."
(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)))))
(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
(case (intern engine)
('dbi "/format partbox\n")
(t ""))
(org-babel-expand-body:sql body params)))
(message command)
(shell-command command)
(if (or (member "scalar" result-params)
@ -134,8 +148,8 @@ This function is called by `org-babel-execute-src-block'."
(with-temp-file data-file
(insert (orgtbl-to-csv
val '(:fmt (lambda (el) (if (stringp el)
el
(format "%S" el)))))))
el
(format "%S" el)))))))
data-file)
(org-babel-temp-file "sql-data-"))
(if (stringp val) val (format "%S" val))))
@ -146,7 +160,7 @@ This function is called by `org-babel-execute-src-block'."
(defun org-babel-prep-session:sql (session params)
"Raise an error because Sql sessions aren't implemented."
(error "sql sessions not yet implemented"))
(error "SQL sessions not yet implemented"))
(provide 'ob-sql)

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

@ -37,8 +37,18 @@
(defvar org-babel-default-header-args:sqlite '())
(defvar org-babel-header-arg-names:sqlite
'(db header echo bail csv column html line list separator nullvalue)
(defvar org-babel-header-args:sqlite
'((db . :any)
(header . :any)
(echo . :any)
(bail . :any)
(csv . :any)
(column . :any)
(html . :any)
(line . :any)
(list . :any)
(separator . :any)
(nullvalue . :any))
"Sqlite specific header args.")
(defun org-babel-expand-body:sqlite (body params)
@ -61,7 +71,7 @@ This function is called by `org-babel-execute-src-block'."
(list :header :echo :bail :column
:csv :html :line :list))))
exit-code)
(unless db (error "ob-sqlite: can't evaluate without a database."))
(unless db (error "ob-sqlite: can't evaluate without a database"))
(with-temp-buffer
(insert
(org-babel-eval
@ -118,8 +128,8 @@ This function is called by `org-babel-execute-src-block'."
(with-temp-file data-file
(insert (orgtbl-to-csv
val '(:fmt (lambda (el) (if (stringp el)
el
(format "%S" el)))))))
el
(format "%S" el)))))))
data-file)
(org-babel-temp-file "sqlite-data-"))
(if (stringp val) val (format "%S" val))))
@ -145,9 +155,9 @@ This function is called by `org-babel-execute-src-block'."
table))
(defun org-babel-prep-session:sqlite (session params)
"Raise an error because support for sqlite sessions isn't implemented.
"Raise an error because support for SQLite sessions isn't implemented.
Prepare SESSION according to the header arguments specified in PARAMS."
(error "sqlite sessions not yet implemented"))
(error "SQLite sessions not yet implemented"))
(provide 'ob-sqlite)

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

@ -99,7 +99,7 @@ as shown in the example below.
(prog1 nil (setq quote t))
(prog1 (if quote
(format "\"%s\"" el)
(org-babel-clean-text-properties el))
(org-no-properties el))
(setq quote nil))))
(cdr var)))))
variables)))

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

@ -122,13 +122,15 @@ represented in the file."
`progn', then kill the FILE buffer returning the result of
evaluating BODY."
(declare (indent 1))
(let ((temp-result (make-symbol "temp-result"))
(let ((temp-path (make-symbol "temp-path"))
(temp-result (make-symbol "temp-result"))
(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))
`(let* ((,temp-path ,file)
(,visited-p (get-file-buffer ,temp-path))
,temp-result ,temp-file)
(org-babel-find-file-noselect-refresh ,temp-path)
(setf ,temp-file (get-file-buffer ,temp-path))
(with-current-buffer ,temp-file
(setf ,temp-result (progn ,@body)))
(unless ,visited-p (kill-buffer ,temp-file))
@ -142,19 +144,19 @@ This function exports the source code using
`org-babel-tangle' and then loads the resulting file using
`load-file'."
(interactive "fFile to load: ")
(flet ((age (file)
(float-time
(time-subtract (current-time)
(nth 5 (or (file-attributes (file-truename file))
(file-attributes file)))))))
(let* ((base-name (file-name-sans-extension file))
(exported-file (concat base-name ".el")))
;; tangle if the org-mode file is newer than the elisp file
(unless (and (file-exists-p exported-file)
(> (age file) (age exported-file)))
(org-babel-tangle-file file exported-file "emacs-lisp"))
(load-file exported-file)
(message "loaded %s" exported-file))))
(let* ((age (lambda (file)
(float-time
(time-subtract (current-time)
(nth 5 (or (file-attributes (file-truename file))
(file-attributes file)))))))
(base-name (file-name-sans-extension file))
(exported-file (concat base-name ".el")))
;; tangle if the org-mode file is newer than the elisp file
(unless (and (file-exists-p exported-file)
(> (funcall age file) (funcall age exported-file)))
(org-babel-tangle-file file exported-file "emacs-lisp"))
(load-file exported-file)
(message "Loaded %s" exported-file)))
;;;###autoload
(defun org-babel-tangle-file (file &optional target-file lang)
@ -189,96 +191,95 @@ exported source code blocks by language."
(run-hooks 'org-babel-pre-tangle-hook)
;; possibly restrict the buffer to the current code block
(save-restriction
(when only-this-block
(unless (org-babel-where-is-src-block-head)
(error "Point is not currently inside of a code block"))
(save-match-data
(unless (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info))))
target-file)
(setq target-file
(read-from-minibuffer "Tangle to: " (buffer-file-name)))))
(narrow-to-region (match-beginning 0) (match-end 0)))
(save-excursion
(let ((block-counter 0)
(org-babel-default-header-args
(if target-file
(org-babel-merge-params org-babel-default-header-args
(list (cons :tangle target-file)))
org-babel-default-header-args))
path-collector)
(mapc ;; map over all languages
(lambda (by-lang)
(let* ((lang (car by-lang))
(specs (cdr by-lang))
(ext (or (cdr (assoc lang org-babel-tangle-lang-exts)) lang))
(lang-f (intern
(concat
(or (and (cdr (assoc lang org-src-lang-modes))
(symbol-name
(cdr (assoc lang org-src-lang-modes))))
lang)
"-mode")))
she-banged)
(mapc
(lambda (spec)
(flet ((get-spec (name)
(cdr (assoc name (nth 4 spec)))))
(let* ((tangle (get-spec :tangle))
(she-bang ((lambda (sheb) (when (> (length sheb) 0) sheb))
(get-spec :shebang)))
(base-name (cond
((string= "yes" tangle)
(file-name-sans-extension
(buffer-file-name)))
((string= "no" tangle) nil)
((> (length tangle) 0) tangle)))
(file-name (when base-name
;; decide if we want to add ext to base-name
(if (and ext (string= "yes" tangle))
(concat base-name "." ext) base-name))))
(when file-name
;; possibly create the parent directories for file
(when ((lambda (m) (and m (not (string= m "no"))))
(get-spec :mkdirp))
(make-directory (file-name-directory file-name) 'parents))
;; delete any old versions of file
(when (and (file-exists-p file-name)
(not (member file-name path-collector)))
(delete-file file-name))
;; drop source-block to file
(with-temp-buffer
(when (fboundp lang-f) (ignore-errors (funcall lang-f)))
(when (and she-bang (not (member file-name she-banged)))
(insert (concat she-bang "\n"))
(setq she-banged (cons file-name she-banged)))
(org-babel-spec-to-string spec)
;; We avoid append-to-file as it does not work with tramp.
(let ((content (buffer-string)))
(with-temp-buffer
(if (file-exists-p file-name)
(insert-file-contents file-name))
(goto-char (point-max))
(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 #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 from %s" block-counter
(if (= block-counter 1) "" "s")
(file-name-nondirectory
(buffer-file-name (or (buffer-base-buffer) (current-buffer)))))
;; run `org-babel-post-tangle-hook' in all tangled files
(when org-babel-post-tangle-hook
(mapc
(lambda (file)
(org-babel-with-temp-filebuffer file
(run-hooks 'org-babel-post-tangle-hook)))
path-collector))
path-collector))))
(when only-this-block
(unless (org-babel-where-is-src-block-head)
(error "Point is not currently inside of a code block"))
(save-match-data
(unless (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info))))
target-file)
(setq target-file
(read-from-minibuffer "Tangle to: " (buffer-file-name)))))
(narrow-to-region (match-beginning 0) (match-end 0)))
(save-excursion
(let ((block-counter 0)
(org-babel-default-header-args
(if target-file
(org-babel-merge-params org-babel-default-header-args
(list (cons :tangle target-file)))
org-babel-default-header-args))
path-collector)
(mapc ;; map over all languages
(lambda (by-lang)
(let* ((lang (car by-lang))
(specs (cdr by-lang))
(ext (or (cdr (assoc lang org-babel-tangle-lang-exts)) lang))
(lang-f (intern
(concat
(or (and (cdr (assoc lang org-src-lang-modes))
(symbol-name
(cdr (assoc lang org-src-lang-modes))))
lang)
"-mode")))
she-banged)
(mapc
(lambda (spec)
(let ((get-spec (lambda (name) (cdr (assoc name (nth 4 spec))))))
(let* ((tangle (funcall get-spec :tangle))
(she-bang ((lambda (sheb) (when (> (length sheb) 0) sheb))
(funcall get-spec :shebang)))
(base-name (cond
((string= "yes" tangle)
(file-name-sans-extension
(buffer-file-name)))
((string= "no" tangle) nil)
((> (length tangle) 0) tangle)))
(file-name (when base-name
;; decide if we want to add ext to base-name
(if (and ext (string= "yes" tangle))
(concat base-name "." ext) base-name))))
(when file-name
;; possibly create the parent directories for file
(when ((lambda (m) (and m (not (string= m "no"))))
(funcall get-spec :mkdirp))
(make-directory (file-name-directory file-name) 'parents))
;; delete any old versions of file
(when (and (file-exists-p file-name)
(not (member file-name path-collector)))
(delete-file file-name))
;; drop source-block to file
(with-temp-buffer
(when (fboundp lang-f) (ignore-errors (funcall lang-f)))
(when (and she-bang (not (member file-name she-banged)))
(insert (concat she-bang "\n"))
(setq she-banged (cons file-name she-banged)))
(org-babel-spec-to-string spec)
;; We avoid append-to-file as it does not work with tramp.
(let ((content (buffer-string)))
(with-temp-buffer
(if (file-exists-p file-name)
(insert-file-contents file-name))
(goto-char (point-max))
(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 #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 from %s" block-counter
(if (= block-counter 1) "" "s")
(file-name-nondirectory
(buffer-file-name (or (buffer-base-buffer) (current-buffer)))))
;; run `org-babel-post-tangle-hook' in all tangled files
(when org-babel-post-tangle-hook
(mapc
(lambda (file)
(org-babel-with-temp-filebuffer file
(run-hooks 'org-babel-post-tangle-hook)))
path-collector))
path-collector))))
(defun org-babel-tangle-clean ()
"Remove comments inserted by `org-babel-tangle'.
@ -290,12 +291,59 @@ references."
(interactive)
(goto-char (point-min))
(while (or (re-search-forward "\\[\\[file:.*\\]\\[.*\\]\\]" nil t)
(re-search-forward "<<[^[:space:]]*>>" nil t))
(re-search-forward (org-babel-noweb-wrap) nil t))
(delete-region (save-excursion (beginning-of-line 1) (point))
(save-excursion (end-of-line 1) (forward-char 1) (point)))))
(defvar org-stored-links)
(defvar org-bracket-link-regexp)
(defun org-babel-spec-to-string (spec)
"Insert SPEC into the current file.
Insert the source-code specified by SPEC into the current
source code file. This function uses `comment-region' which
assumes that the appropriate major-mode is set. SPEC has the
form
(start-line file link source-name params body comment)"
(let* ((start-line (nth 0 spec))
(file (nth 1 spec))
(link (nth 2 spec))
(source-name (nth 3 spec))
(body (nth 5 spec))
(comment (nth 6 spec))
(comments (cdr (assoc :comments (nth 4 spec))))
(padline (not (string= "no" (cdr (assoc :padline (nth 4 spec))))))
(link-p (or (string= comments "both") (string= comments "link")
(string= comments "yes") (string= comments "noweb")))
(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)))
(insert-comment (lambda (text)
(when (and comments (not (string= comments "no"))
(> (length text) 0))
(when padline (insert "\n"))
(comment-region (point) (progn (insert text) (point)))
(end-of-line nil) (insert "\n")))))
(when comment (funcall insert-comment comment))
(when link-p
(funcall
insert-comment
(org-fill-template org-babel-tangle-comment-format-beg link-data)))
(when padline (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
(funcall
insert-comment
(org-fill-template org-babel-tangle-comment-format-end link-data)))))
(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
@ -312,7 +360,8 @@ code blocks by language."
(setq block-counter (+ 1 block-counter))))
(replace-regexp-in-string "[ \t]" "-"
(condition-case nil
(nth 4 (org-heading-components))
(or (nth 4 (org-heading-components))
"(dummy for heading without text)")
(error (buffer-file-name)))))
(let* ((start-line (save-restriction (widen)
(+ 1 (line-number-at-pos (point)))))
@ -326,7 +375,7 @@ code blocks by language."
(link ((lambda (link)
(and (string-match org-bracket-link-regexp link)
(match-string 1 link)))
(org-babel-clean-text-properties
(org-no-properties
(org-store-link nil))))
(source-name
(intern (or (nth 4 info)
@ -351,11 +400,7 @@ code blocks by language."
body params
(and (fboundp assignments-cmd)
(funcall assignments-cmd params))))))
(if (and (cdr (assoc :noweb params)) ;; expand noweb refs
(let ((nowebs (split-string
(cdr (assoc :noweb params)))))
(or (member "yes" nowebs)
(member "tangle" nowebs))))
(if (org-babel-noweb-p params :tangle)
(org-babel-expand-noweb-references info)
(nth 1 info)))))
(comment
@ -392,57 +437,12 @@ code blocks by language."
blocks))
blocks))
(defun org-babel-spec-to-string (spec)
"Insert SPEC into the current file.
Insert the source-code specified by SPEC into the current
source code file. This function uses `comment-region' which
assumes that the appropriate major-mode is set. SPEC has the
form
(start-line file link source-name params body comment)"
(let* ((start-line (nth 0 spec))
(file (nth 1 spec))
(link (nth 2 spec))
(source-name (nth 3 spec))
(body (nth 5 spec))
(comment (nth 6 spec))
(comments (cdr (assoc :comments (nth 4 spec))))
(padline (not (string= "no" (cdr (assoc :padline (nth 4 spec))))))
(link-p (or (string= comments "both") (string= comments "link")
(string= comments "yes") (string= comments "noweb")))
(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 (and comments (not (string= comments "no"))
(> (length text) 0))
(when padline (insert "\n"))
(comment-region (point) (progn (insert text) (point)))
(end-of-line nil) (insert "\n"))))
(when comment (insert-comment comment))
(when link-p
(insert-comment
(org-fill-template org-babel-tangle-comment-format-beg link-data)))
(when padline (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))))))
(defun org-babel-tangle-comment-links ( &optional info)
"Return a list of begin and end link comments for the code block at point."
(let* ((start-line (org-babel-where-is-src-block-head))
(file (buffer-file-name))
(link (org-link-escape (progn (call-interactively 'org-store-link)
(org-babel-clean-text-properties
(org-no-properties
(car (pop org-stored-links))))))
(source-name (nth 4 (or info (org-babel-get-src-block-info 'light))))
(link-data (mapcar (lambda (el)
@ -475,7 +475,7 @@ which enable the original code blocks to be found."
(org-babel-update-block-body new-body)))
(setq counter (+ 1 counter)))
(goto-char end))
(prog1 counter (message "detangled %d code blocks" counter)))))
(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."
@ -498,7 +498,7 @@ which enable the original code blocks to be found."
" ends here") nil t)
(setq end (point-at-bol))))))))
(unless (and start (< start mid) (< mid end))
(error "not in tangled code"))
(error "Not in tangled code"))
(setq body (org-babel-trim (buffer-substring start end))))
(when (string-match "::" path)
(setq path (substring path 0 (match-beginning 0))))

1030
lisp/org/ob.el
View file

File diff suppressed because it is too large Load diff

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

File diff suppressed because it is too large Load diff

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

@ -31,6 +31,7 @@
(require 'org)
(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ())
(declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction))
(defcustom org-archive-default-command 'org-archive-subtree
"The default archiving command."
@ -100,14 +101,14 @@ the archived entry, with a prefix \"ARCHIVE_\", to remember this
information."
:group 'org-archive
:type '(set :greedy t
(const :tag "Time" time)
(const :tag "File" file)
(const :tag "Category" category)
(const :tag "TODO state" todo)
(const :tag "Priority" priority)
(const :tag "Inherited tags" itags)
(const :tag "Outline path" olpath)
(const :tag "Local tags" ltags)))
(const :tag "Time" time)
(const :tag "File" file)
(const :tag "Category" category)
(const :tag "TODO state" todo)
(const :tag "Priority" priority)
(const :tag "Inherited tags" itags)
(const :tag "Outline path" olpath)
(const :tag "Local tags" ltags)))
(defun org-get-local-archive-location ()
"Get the archive location applicable at point."
@ -223,13 +224,14 @@ this heading."
(current-time)))
category todo priority ltags itags atags
;; end of variables that will be used for saving context
location afile heading buffer level newfile-p infile-p visiting)
location afile heading buffer level newfile-p infile-p visiting
datetree-date datetree-subheading-p)
;; Find the local archive location
(setq location (org-get-local-archive-location)
afile (org-extract-archive-file location)
heading (org-extract-archive-heading location)
infile-p (equal file (abbreviate-file-name afile)))
infile-p (equal file (abbreviate-file-name (or afile ""))))
(unless afile
(error "Invalid `org-archive-location'"))
@ -240,6 +242,13 @@ this heading."
(setq buffer (current-buffer)))
(unless buffer
(error "Cannot access file \"%s\"" afile))
(when (string-match "\\`datetree/" heading)
;; Replace with ***, to represent the 3 levels of headings the
;; datetree has.
(setq heading (replace-regexp-in-string "\\`datetree/" "***" heading))
(setq datetree-subheading-p (> (length heading) 3))
(setq datetree-date (org-date-to-gregorian
(or (org-entry-get nil "CLOSED" t) time))))
(if (and (> (length heading) 0)
(string-match "^\\*+" heading))
(setq level (match-end 0))
@ -263,7 +272,7 @@ this heading."
(let (this-command) (org-copy-subtree 1 nil t))
(set-buffer buffer)
;; Enforce org-mode for the archive buffer
(if (not (eq major-mode 'org-mode))
(if (not (derived-mode-p 'org-mode))
;; Force the mode for future visits.
(let ((org-insert-mode-line-in-empty-file t)
(org-inhibit-startup t))
@ -272,6 +281,10 @@ this heading."
(goto-char (point-max))
(insert (format "\nArchived entries from file %s\n\n"
(buffer-file-name this-buffer))))
(when datetree-date
(require 'org-datetree)
(org-datetree-find-date-create datetree-date)
(org-narrow-to-subtree))
;; Force the TODO keywords of the original buffer
(let ((org-todo-line-regexp tr-org-todo-line-regexp)
(org-todo-keywords-1 tr-org-todo-keywords-1)
@ -285,7 +298,7 @@ this heading."
tr-org-odd-levels-only)))
(goto-char (point-min))
(show-all)
(if heading
(if (and heading (not (and datetree-date (not datetree-subheading-p))))
(progn
(if (re-search-forward
(concat "^" (regexp-quote heading)
@ -295,7 +308,8 @@ this heading."
;; Heading not found, just insert it at the end
(goto-char (point-max))
(or (bolp) (insert "\n"))
(insert "\n" heading "\n")
;; datetrees don't need too much spacing
(insert (if datetree-date "" "\n") heading "\n")
(end-of-line 0))
;; Make the subtree visible
(show-subtree)
@ -306,9 +320,10 @@ this heading."
(org-end-of-subtree t))
(skip-chars-backward " \t\r\n")
(and (looking-at "[ \t\r\n]*")
(replace-match "\n\n")))
;; datetree archives don't need so much spacing.
(replace-match (if datetree-date "\n" "\n\n"))))
;; No specific heading, just go to end of file.
(goto-char (point-max)) (insert "\n"))
(goto-char (point-max)) (unless datetree-date (insert "\n")))
;; Paste
(org-paste-subtree (org-get-valid-level level (and heading 1)))
;; Shall we append inherited tags?
@ -336,6 +351,7 @@ this heading."
(setq n (concat "ARCHIVE_" (upcase (symbol-name e))))
(org-entry-put (point) n v)))))
(widen)
;; Save and kill the buffer, if it is not the same buffer.
(when (not (eq this-buffer buffer))
(save-buffer))))

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

@ -36,7 +36,7 @@
:tag "Org Export ASCII"
:group 'org-export)
(defcustom org-export-ascii-underline '(?\- ?\= ?\~ ?^ ?\# ?\$)
(defcustom org-export-ascii-underline '(?\= ?\- ?\~ ?\^ ?\. ?\# ?\$)
"Characters for underlining headings in ASCII export.
In the given sequence, these characters will be used for level 1, 2, ..."
:group 'org-export-ascii
@ -144,9 +144,9 @@ command to convert it."
(interactive "r")
(let (reg ascii buf pop-up-frames)
(save-window-excursion
(if (eq major-mode 'org-mode)
(if (derived-mode-p 'org-mode)
(setq ascii (org-export-region-as-ascii
beg end t 'string))
beg end t 'string))
(setq reg (buffer-substring beg end)
buf (get-buffer-create "*Org tmp*"))
(with-current-buffer buf
@ -154,7 +154,7 @@ command to convert it."
(insert reg)
(org-mode)
(setq ascii (org-export-region-as-ascii
(point-min) (point-max) t 'string)))
(point-min) (point-max) t 'string)))
(kill-buffer buf)))
(delete-region beg end)
(insert ascii)))
@ -193,7 +193,7 @@ in a window. A non-interactive call will only return the buffer."
;;;###autoload
(defun org-export-as-ascii (arg &optional hidden ext-plist
to-buffer body-only pub-dir)
to-buffer body-only pub-dir)
"Export the outline as a pretty ASCII file.
If there is an active region, export only the region.
The prefix ARG specifies how many levels of the outline should become
@ -373,54 +373,54 @@ publishing directory."
(push (concat (make-string (string-width (nth 3 lang-words)) ?=)
"\n") thetoc)
(mapc #'(lambda (line)
(if (string-match org-todo-line-regexp
line)
;; This is a headline
(progn
(setq have-headings t)
(setq level (- (match-end 1) (match-beginning 1)
level-offset)
level (org-tr-level level)
txt (match-string 3 line)
todo
(or (and org-export-mark-todo-in-toc
(match-beginning 2)
(not (member (match-string 2 line)
org-done-keywords)))
(if (string-match org-todo-line-regexp
line)
;; This is a headline
(progn
(setq have-headings t)
(setq level (- (match-end 1) (match-beginning 1)
level-offset)
level (org-tr-level level)
txt (match-string 3 line)
todo
(or (and org-export-mark-todo-in-toc
(match-beginning 2)
(not (member (match-string 2 line)
org-done-keywords)))
; TODO, not DONE
(and org-export-mark-todo-in-toc
(= level umax-toc)
(org-search-todo-below
line lines level))))
(setq txt (org-html-expand-for-ascii txt))
(and org-export-mark-todo-in-toc
(= level umax-toc)
(org-search-todo-below
line lines level))))
(setq txt (org-html-expand-for-ascii txt))
(while (string-match org-bracket-link-regexp txt)
(setq txt
(replace-match
(match-string (if (match-end 2) 3 1) txt)
t t txt)))
(while (string-match org-bracket-link-regexp txt)
(setq txt
(replace-match
(match-string (if (match-end 2) 3 1) txt)
t t txt)))
(if (and (memq org-export-with-tags '(not-in-toc nil))
(string-match
(org-re "[ \t]+:[[:alnum:]_@#%:]+:[ \t]*$")
txt))
(setq txt (replace-match "" t t txt)))
(if (string-match quote-re0 txt)
(setq txt (replace-match "" t t txt 1)))
(if (and (memq org-export-with-tags '(not-in-toc nil))
(string-match
(org-re "[ \t]+:[[:alnum:]_@#%:]+:[ \t]*$")
txt))
(setq txt (replace-match "" t t txt)))
(if (string-match quote-re0 txt)
(setq txt (replace-match "" t t txt 1)))
(if org-export-with-section-numbers
(setq txt (concat (org-section-number level)
" " txt)))
(if (<= level umax-toc)
(progn
(push
(concat
(make-string
(* (max 0 (- level org-min-level)) 4) ?\ )
(format (if todo "%s (*)\n" "%s\n") txt))
thetoc)
(setq org-last-level level))
))))
(if org-export-with-section-numbers
(setq txt (concat (org-section-number level)
" " txt)))
(if (<= level umax-toc)
(progn
(push
(concat
(make-string
(* (max 0 (- level org-min-level)) 4) ?\ )
(format (if todo "%s (*)\n" "%s\n") txt))
thetoc)
(setq org-last-level level))
))))
lines)
(setq thetoc (if have-headings (nreverse thetoc) nil))))

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

@ -78,12 +78,15 @@ Allowed values are:
mv rename the file to move it into the attachment directory
cp copy the file
ln create a hard link. Note that this is not supported
on all systems, and then the result is not defined.
lns create a symbol link. Note that this is not supported
on all systems, and then the result is not defined."
:group 'org-attach
:type '(choice
(const :tag "Copy" cp)
(const :tag "Move/Rename" mv)
(const :tag "Link" ln)))
(const :tag "Hard Link" ln)
(const :tag "Symbol Link" lns)))
(defcustom org-attach-expert nil
"Non-nil means do not show the splash buffer with the attach dispatcher."
@ -130,7 +133,7 @@ Shows a list of commands and prompts for another key to execute a command."
(princ "Select an Attachment Command:
a Select a file and attach it to the task, using `org-attach-method'.
c/m/l Attach a file using copy/move/link method.
c/m/l/y Attach a file using copy/move/link/symbolic-link method.
n Create a new attachment, as an Emacs buffer.
z Synchronize the current task with its attachment
directory, in case you added attachments yourself.
@ -158,6 +161,8 @@ i Make children of the current entry inherit its attachment directory.")))
(let ((org-attach-method 'mv)) (call-interactively 'org-attach-attach)))
((memq c '(?l ?\C-l))
(let ((org-attach-method 'ln)) (call-interactively 'org-attach-attach)))
((memq c '(?y ?\C-y))
(let ((org-attach-method 'lns)) (call-interactively 'org-attach-attach)))
((memq c '(?n ?\C-n)) (call-interactively 'org-attach-new))
((memq c '(?z ?\C-z)) (call-interactively 'org-attach-sync))
((memq c '(?o ?\C-o)) (call-interactively 'org-attach-open))
@ -254,9 +259,9 @@ This checks for the existence of a \".git\" directory in that directory."
(shell-command "git add .")
(shell-command "git ls-files --deleted" t)
(mapc #'(lambda (file)
(unless (string= file "")
(shell-command
(concat "git rm \"" file "\""))))
(unless (string= file "")
(shell-command
(concat "git rm \"" file "\""))))
(split-string (buffer-string) "\n"))
(shell-command "git commit -m 'Synchronized attachments'")))))
@ -282,7 +287,8 @@ Only do this when `org-attach-store-link-p' is non-nil."
(defun org-attach-attach (file &optional visit-dir method)
"Move/copy/link FILE into the attachment directory of the current task.
If VISIT-DIR is non-nil, visit the directory with dired.
METHOD may be `cp', `mv', or `ln', default taken from `org-attach-method'."
METHOD may be `cp', `mv', `ln', or `lns' default taken from
`org-attach-method'."
(interactive "fFile to keep as an attachment: \nP")
(setq method (or method org-attach-method))
(let ((basename (file-name-nondirectory file)))
@ -294,7 +300,8 @@ METHOD may be `cp', `mv', or `ln', default taken from `org-attach-method'."
(cond
((eq method 'mv) (rename-file file fname))
((eq method 'cp) (copy-file file fname))
((eq method 'ln) (add-name-to-file file fname)))
((eq method 'ln) (add-name-to-file file fname))
((eq method 'lns) (make-symbolic-link file fname)))
(org-attach-commit)
(org-attach-tag)
(cond ((eq org-attach-store-link-p 'attached)
@ -319,6 +326,13 @@ Beware that this does not work on systems that do not support hard links.
On some systems, this apparently does copy the file instead."
(interactive)
(let ((org-attach-method 'ln)) (call-interactively 'org-attach-attach)))
(defun org-attach-attach-lns ()
"Attach a file by creating a symbolic link to it.
Beware that this does not work on systems that do not support symbolic links.
On some systems, this apparently does copy the file instead."
(interactive)
(let ((org-attach-method 'lns)) (call-interactively 'org-attach-attach)))
(defun org-attach-new (file)
"Create a new attachment FILE for the current task.
@ -415,7 +429,7 @@ If IN-EMACS is non-nil, force opening in Emacs."
(file (if (= (length files) 1)
(car files)
(org-icompleting-read "Open attachment: "
(mapcar 'list files) nil t))))
(mapcar 'list files) nil t))))
(org-open-file (expand-file-name file attach-dir) in-emacs)))
(defun org-attach-open-in-emacs ()

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

@ -109,17 +109,20 @@
(declare-function bbdb-record-getprop "ext:bbdb" (record property))
(declare-function bbdb-record-name "ext:bbdb" (record))
(declare-function bbdb-records "ext:bbdb"
(&optional dont-check-disk already-in-db-buffer))
(&optional dont-check-disk already-in-db-buffer))
(declare-function bbdb-split "ext:bbdb" (string separators))
(declare-function bbdb-string-trim "ext:bbdb" (string))
(declare-function bbdb-record-get-field "ext:bbdb" (record field))
(declare-function bbdb-search-name "ext:bbdb-com" (regexp &optional layout))
(declare-function bbdb-search-organization "ext:bbdb-com" (regexp &optional layout))
;; `bbdb-record-note' is part of BBDB v3.x
(declare-function bbdb-record-note "ext:bbdb" (record label))
(declare-function calendar-leap-year-p "calendar" (year))
(declare-function diary-ordinal-suffix "diary-lib" (n))
(defvar date) ;; dynamically scoped from Org
(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el
;; Customization
@ -134,30 +137,31 @@
:require 'bbdb)
(defcustom org-bbdb-anniversary-format-alist
'(("birthday" lambda
(name years suffix)
(concat "Birthday: [[bbdb:" name "][" name " ("
(format "%s" years) ; handles numbers as well as strings
suffix ")]]"))
("wedding" lambda
(name years suffix)
(concat "[[bbdb:" name "][" name "'s "
(format "%s" years)
suffix " wedding anniversary]]")))
'(("birthday" .
(lambda (name years suffix)
(concat "Birthday: [[bbdb:" name "][" name " ("
(format "%s" years) ; handles numbers as well as strings
suffix ")]]")))
("wedding" .
(lambda (name years suffix)
(concat "[[bbdb:" name "][" name "'s "
(format "%s" years)
suffix " wedding anniversary]]"))))
"How different types of anniversaries should be formatted.
An alist of elements (STRING . FORMAT) where STRING is the name of an
anniversary class and format is either:
1) A format string with the following substitutions (in order):
* the name of the record containing this anniversary
* the number of years
* an ordinal suffix (st, nd, rd, th) for the year
- the name of the record containing this anniversary
- the number of years
- an ordinal suffix (st, nd, rd, th) for the year
2) A function to be called with three arguments: NAME YEARS SUFFIX
(string int string) returning a string for the diary or nil.
3) An Emacs Lisp form that should evaluate to a string (or nil) in the
scope of variables NAME, YEARS and SUFFIX (among others)."
:type 'sexp
:type '(alist :key-type (string :tag "Class")
:value-type (function :tag "Function"))
:group 'org-bbdb-anniversaries
:require 'bbdb)
@ -203,7 +207,7 @@ date year)."
(company (if (fboundp 'bbdb-record-getprop)
(bbdb-record-getprop rec 'company)
(car (bbdb-record-get-field rec 'organization))))
(link (org-make-link "bbdb:" name)))
(link (concat "bbdb:" name)))
(org-store-link-props :type "bbdb" :name name :company company
:link link :description name)
link)))
@ -217,6 +221,8 @@ italicized, in all other cases it is left unchanged."
(cond
((eq format 'html) (format "<i>%s</i>" desc))
((eq format 'latex) (format "\\textit{%s}" desc))
((eq format 'odt)
(format "<text:span text:style-name=\"Emphasis\">%s</text:span>" desc))
(t desc)))
(defun org-bbdb-open (name)
@ -272,7 +278,7 @@ italicized, in all other cases it is left unchanged."
"Convert YYYY-MM-DD to (month date year).
Argument TIME-STR is the value retrieved from BBDB. If YYYY- is omitted
it will be considered unknown."
(multiple-value-bind (a b c) (values-list (bbdb-split time-str "-"))
(multiple-value-bind (a b c) (values-list (org-split-string time-str "-"))
(if (eq c nil)
(list (string-to-number a)
(string-to-number b)
@ -299,13 +305,19 @@ The hash table is created on first use.")
(defun org-bbdb-make-anniv-hash ()
"Create a hash with anniversaries extracted from BBDB, for fast access.
The anniversaries are assumed to be stored `org-bbdb-anniversary-field'."
(let (split tmp annivs)
(let ((old-bbdb (fboundp 'bbdb-record-getprop))
split tmp annivs)
(clrhash org-bbdb-anniv-hash)
(dolist (rec (bbdb-records))
(when (setq annivs (bbdb-record-getprop
rec org-bbdb-anniversary-field))
(setq annivs (bbdb-split annivs "\n"))
(when (setq annivs (if old-bbdb
(bbdb-record-getprop
rec org-bbdb-anniversary-field)
(bbdb-record-note
rec org-bbdb-anniversary-field)))
(setq annivs (if old-bbdb
(bbdb-split annivs "\n")
;; parameter order is reversed in new bbdb
(bbdb-split "\n" annivs)))
(while annivs
(setq split (org-bbdb-anniv-split (pop annivs)))
(multiple-value-bind (m d y)

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

@ -87,7 +87,7 @@ BEAMER_HEADER_EXTRA, which will be inserted just before \\begin{document}."
(defconst org-beamer-column-widths
"0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 0.0 :ETC"
"The column widths that should be installed as allowed property values.")
"The column widths that should be installed as allowed property values.")
(defconst org-beamer-transitions
"\transblindsvertical \transblindshorizontal \transboxin \transboxout \transdissolve \transduration \transglitter \transsplithorizontalin \transsplithorizontalout \transsplitverticalin \transsplitverticalout \transwipe :ETC"
@ -107,6 +107,7 @@ These are just a completion help.")
("theorem" "t" "\\begin{theorem}%a%U%x" "\\end{theorem}")
("definition" "d" "\\begin{definition}%a%U%x" "\\end{definition}")
("example" "e" "\\begin{example}%a%U%x" "\\end{example}")
("exampleblock" "E" "\\begin{exampleblock}%a{%h}%x" "\\end{exampleblock}")
("proof" "p" "\\begin{proof}%a%U%x" "\\end{proof}")
("beamercolorbox" "o" "\\begin{beamercolorbox}%o{%h}%x" "\\end{beamercolorbox}")
("normal" "h" "%h" "") ; Emit the heading as normal text
@ -117,7 +118,7 @@ These are just a completion help.")
These are the defaults - for user definitions, see
`org-beamer-environments-extra'.
\"normal\" is a special fake environment, which emit the heading as
normal text. It is needed when an environment should be surrounded
normal text. It is needed when an environment should be surrounded
by normal text. Since beamer export converts nodes into environments,
you need to have a node to end the environment.
For example
@ -155,6 +156,12 @@ close The closing string of the environment."
(string :tag "Begin")
(string :tag "End"))))
(defcustom org-beamer-inherited-properties nil
"Properties that should be inherited during beamer export."
:group 'org-beamer
:type '(repeat
(string :tag "Property")))
(defvar org-beamer-frame-level-now nil)
(defvar org-beamer-header-extra nil)
(defvar org-beamer-export-is-beamer-p nil)
@ -488,6 +495,12 @@ The effect is that these values will be accessible during export."
(if (and (not (assoc "BEAMER_env" props))
(looking-at ".*?:B_\\(note\\(NH\\)?\\):"))
(push (cons "BEAMER_env" (match-string 1)) props))
(when (org-bound-and-true-p org-beamer-inherited-properties)
(mapc (lambda (p)
(unless (assoc p props)
(let ((v (org-entry-get nil p 'inherit)))
(and v (push (cons p v) props)))))
org-beamer-inherited-properties))
(put-text-property (point-at-bol) (point-at-eol) 'org-props props)))
(setq org-export-latex-options-plist
(plist-put org-export-latex-options-plist :tags nil))))))
@ -502,7 +515,7 @@ This function will run in the final LaTeX document."
(while (re-search-forward org-beamer-fragile-re nil t)
(save-excursion
;; Are we inside a frame here?
(when (and (re-search-backward "^[ \t]*\\\\\\(begin\\|end\\){frame}"
(when (and (re-search-backward "^[ \t]*\\\\\\(begin\\|end\\){frame}\\(<[^>]*>\\)?"
nil t)
(equal (match-string 1) "begin"))
;; yes, inside a frame, make sure "fragile" is one of the options
@ -520,7 +533,7 @@ This function will run in the final LaTeX document."
:group 'org-beamer
:version "24.1"
:type '(string :tag "Outline frame title")
)
)
(defcustom org-beamer-outline-frame-options nil
"Outline frame options appended after \\begin{frame}.
@ -529,7 +542,7 @@ include square brackets."
:group 'org-beamer
:version "24.1"
:type '(string :tag "Outline frame options")
)
)
(defun org-beamer-fix-toc ()
"Fix the table of contents by removing the vspace line."

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

@ -111,6 +111,7 @@
(require 'bibtex)
(eval-when-compile
(require 'cl))
(require 'org-compat)
(defvar org-bibtex-description nil) ; dynamically scoped from org.el
(defvar org-id-locations)
@ -184,33 +185,33 @@
"Bibtex entry types with required and optional parameters.")
(defvar org-bibtex-fields
'((:address . "Usually the address of the publisher or other type of institution. For major publishing houses, van Leunen recommends omitting the information entirely. For small publishers, on the other hand, you can help the reader by giving the complete address.")
(:annote . "An annotation. It is not used by the standard bibliography styles, but may be used by others that produce an annotated bibliography.")
'((:address . "Usually the address of the publisher or other type of institution. For major publishing houses, van Leunen recommends omitting the information entirely. For small publishers, on the other hand, you can help the reader by giving the complete address.")
(:annote . "An annotation. It is not used by the standard bibliography styles, but may be used by others that produce an annotated bibliography.")
(:author . "The name(s) of the author(s), in the format described in the LaTeX book. Remember, all names are separated with the and keyword, and not commas.")
(:booktitle . "Title of a book, part of which is being cited. See the LaTeX book for how to type titles. For book entries, use the title field instead.")
(:booktitle . "Title of a book, part of which is being cited. See the LaTeX book for how to type titles. For book entries, use the title field instead.")
(:chapter . "A chapter (or section or whatever) number.")
(:crossref . "The database key of the entry being cross referenced.")
(:edition . "The edition of a book for example, 'Second'. This should be an ordinal, and should have the first letter capitalized, as shown here; the standard styles convert to lower case when necessary.")
(:editor . "Name(s) of editor(s), typed as indicated in the LaTeX book. If there is also an author field, then the editor field gives the editor of the book or collection in which the reference appears.")
(:howpublished . "How something strange has been published. The first word should be capitalized.")
(:edition . "The edition of a book for example, 'Second'. This should be an ordinal, and should have the first letter capitalized, as shown here; the standard styles convert to lower case when necessary.")
(:editor . "Name(s) of editor(s), typed as indicated in the LaTeX book. If there is also an author field, then the editor field gives the editor of the book or collection in which the reference appears.")
(:howpublished . "How something strange has been published. The first word should be capitalized.")
(:institution . "The sponsoring institution of a technical report.")
(:journal . "A journal name.")
(:key . "Used for alphabetizing, cross-referencing, and creating a label when the author information is missing. This field should not be confused with the key that appears in the \cite command and at the beginning of the database entry.")
(:month . "The month in which the work was published or, for an unpublished work, in which it was written. You should use the standard three-letter abbreviation,")
(:note . "Any additional information that can help the reader. The first word should be capitalized.")
(:number . "Any additional information that can help the reader. The first word should be capitalized.")
(:key . "Used for alphabetizing, cross-referencing, and creating a label when the author information is missing. This field should not be confused with the key that appears in the \cite command and at the beginning of the database entry.")
(:month . "The month in which the work was published or, for an unpublished work, in which it was written. You should use the standard three-letter abbreviation,")
(:note . "Any additional information that can help the reader. The first word should be capitalized.")
(:number . "Any additional information that can help the reader. The first word should be capitalized.")
(:organization . "The organization that sponsors a conference or that publishes a manual.")
(:pages . "One or more page numbers or range of numbers, such as 42-111 or 7,41,73-97 or 43+ (the ‘+’ in this last example indicates pages following that don’t form simple range). BibTEX requires double dashes for page ranges (--).")
(:publisher . "The publisher’s name.")
(:school . "The name of the school where a thesis was written.")
(:series . "The name of a series or set of books. When citing an entire book, the the title field gives its title and an optional series field gives the name of a series or multi-volume set in which the book is published.")
(:series . "The name of a series or set of books. When citing an entire book, the the title field gives its title and an optional series field gives the name of a series or multi-volume set in which the book is published.")
(:title . "The work’s title, typed as explained in the LaTeX book.")
(:type . "The type of a technical report for example, 'Research Note'.")
(:volume . "The volume of a journal or multi-volume book.")
(:year . "The year of publication or, for an unpublished work, the year it was written. Generally it should consist of four numerals, such as 1984, although the standard styles can handle any year whose last four nonpunctuation characters are numerals, such as '(about 1984)'"))
"Bibtex fields with descriptions.")
(defvar *org-bibtex-entries* nil
(defvar org-bibtex-entries nil
"List to hold parsed bibtex entries.")
(defcustom org-bibtex-autogen-keys nil
@ -229,7 +230,7 @@ For example setting to 'BIB_' would allow interoperability with fireforg."
(defcustom org-bibtex-treat-headline-as-title t
"Treat headline text as title if title property is absent.
If an entry is missing a title property, use the headline text as
the property. If this value is t, `org-bibtex-check' will ignore
the property. If this value is t, `org-bibtex-check' will ignore
a missing title field."
:group 'org-bibtex
:version "24.1"
@ -247,7 +248,7 @@ not placed in the exported bibtex entry."
(defcustom org-bibtex-key-property "CUSTOM_ID"
"Property that holds the bibtex key.
By default, this is CUSTOM_ID, which enables easy linking to
bibtex headlines from within an org file. This can be set to ID
bibtex headlines from within an org file. This can be set to ID
to enable global links, but only with great caution, as global
IDs must be unique."
:group 'org-bibtex
@ -263,12 +264,12 @@ IDs must be unique."
(defcustom org-bibtex-tags-are-keywords nil
"Convert the value of the keywords field to tags and vice versa.
If set to t, comma-separated entries in a bibtex entry's keywords
field will be converted to org tags. Note: spaces will be escaped
field will be converted to org tags. Note: spaces will be escaped
with underscores, and characters that are not permitted in org
tags will be removed.
If t, local tags in an org entry will be exported as a
comma-separated string of keywords when exported to bibtex. Tags
comma-separated string of keywords when exported to bibtex. Tags
defined in `org-bibtex-tags' or `org-bibtex-no-export-tags' will
not be exported."
:group 'org-bibtex
@ -277,7 +278,7 @@ not be exported."
(defcustom org-bibtex-no-export-tags nil
"List of tag(s) that should not be converted to keywords.
This variable is relevant only if `org-bibtex-export-tags-as-keywords` is t."
This variable is relevant only if `org-bibtex-export-tags-as-keywords' is t."
:group 'org-bibtex
:version "24.1"
:type '(repeat :tag "Tag" (string)))
@ -309,71 +310,72 @@ This variable is relevant only if `org-bibtex-export-tags-as-keywords` is t."
(defun org-bibtex-headline ()
"Return a bibtex entry of the given headline as a string."
(flet ((val (key lst) (cdr (assoc key lst)))
(to (string) (intern (concat ":" string)))
(from (key) (substring (symbol-name key) 1))
(flatten (&rest lsts)
(apply #'append (mapcar
(lambda (e)
(if (listp e) (apply #'flatten e) (list e)))
lsts))))
(let ((notes (buffer-string))
(id (org-bibtex-get org-bibtex-key-property))
(type (org-bibtex-get org-bibtex-type-property-name))
(tags (when org-bibtex-tags-are-keywords
(delq nil
(mapcar
(lambda (tag)
(unless (member tag
(append org-bibtex-tags
org-bibtex-no-export-tags))
tag))
(org-get-local-tags-at))))))
(when type
(let ((entry (format
"@%s{%s,\n%s\n}\n" type id
(mapconcat
(lambda (pair)
(format " %s={%s}" (car pair) (cdr pair)))
(remove nil
(if (and org-bibtex-export-arbitrary-fields
org-bibtex-prefix)
(mapcar
(lambda (kv)
(let ((key (car kv)) (val (cdr kv)))
(when (and
(string-match org-bibtex-prefix key)
(not (string=
(downcase (concat org-bibtex-prefix
org-bibtex-type-property-name))
(downcase key))))
(cons (downcase (replace-regexp-in-string
org-bibtex-prefix "" key))
val))))
(org-entry-properties nil 'standard))
(mapcar
(lambda (field)
(let ((value (or (org-bibtex-get (from field))
(and (equal :title field)
(nth 4 (org-heading-components))))))
(when value (cons (from field) value))))
(flatten
(val :required (val (to type) org-bibtex-types))
(val :optional (val (to type) org-bibtex-types))))))
",\n"))))
(with-temp-buffer
(insert entry)
(when tags
(bibtex-beginning-of-entry)
(if (re-search-forward "keywords.*=.*{\\(.*\\)}" nil t)
(progn (goto-char (match-end 1)) (insert ", "))
(bibtex-make-field "keywords" t t))
(insert (mapconcat #'identity tags ", ")))
(buffer-string)))))))
(let* ((val (lambda (key lst) (cdr (assoc key lst))))
(to (lambda (string) (intern (concat ":" string))))
(from (lambda (key) (substring (symbol-name key) 1)))
flatten ; silent compiler warning
(flatten (lambda (&rest lsts)
(apply #'append (mapcar
(lambda (e)
(if (listp e) (apply flatten e) (list e)))
lsts))))
(notes (buffer-string))
(id (org-bibtex-get org-bibtex-key-property))
(type (org-bibtex-get org-bibtex-type-property-name))
(tags (when org-bibtex-tags-are-keywords
(delq nil
(mapcar
(lambda (tag)
(unless (member tag
(append org-bibtex-tags
org-bibtex-no-export-tags))
tag))
(org-get-local-tags-at))))))
(when type
(let ((entry (format
"@%s{%s,\n%s\n}\n" type id
(mapconcat
(lambda (pair)
(format " %s={%s}" (car pair) (cdr pair)))
(remove nil
(if (and org-bibtex-export-arbitrary-fields
org-bibtex-prefix)
(mapcar
(lambda (kv)
(let ((key (car kv)) (val0 (cdr kv)))
(when (and
(string-match org-bibtex-prefix key)
(not (string=
(downcase (concat org-bibtex-prefix
org-bibtex-type-property-name))
(downcase key))))
(cons (downcase (replace-regexp-in-string
org-bibtex-prefix "" key))
val0))))
(org-entry-properties nil 'standard))
(mapcar
(lambda (field)
(let ((value (or (org-bibtex-get (funcall from field))
(and (equal :title field)
(nth 4 (org-heading-components))))))
(when value (cons (funcall from field) value))))
(funcall flatten
(funcall val :required (funcall val (funcall to type) org-bibtex-types))
(funcall val :optional (funcall val (funcall to type) org-bibtex-types))))))
",\n"))))
(with-temp-buffer
(insert entry)
(when tags
(bibtex-beginning-of-entry)
(if (re-search-forward "keywords.*=.*{\\(.*\\)}" nil t)
(progn (goto-char (match-end 1)) (insert ", "))
(bibtex-make-field "keywords" t t))
(insert (mapconcat #'identity tags ", ")))
(buffer-string))))))
(defun org-bibtex-ask (field)
(unless (assoc field org-bibtex-fields)
(error "field:%s is not known" field))
(error "Field:%s is not known" field))
(save-window-excursion
(let* ((name (substring (symbol-name field) 1))
(buf-name (format "*Bibtex Help %s*" name)))
@ -385,7 +387,7 @@ This variable is relevant only if `org-bibtex-export-tags-as-keywords` is t."
(read-from-minibuffer (format "%s: " name))))))
(defun org-bibtex-autokey ()
"Generate an autokey for the current headline"
"Generate an autokey for the current headline."
(org-bibtex-put org-bibtex-key-property
(if org-bibtex-autogen-keys
(let* ((entry (org-bibtex-headline))
@ -404,24 +406,26 @@ This variable is relevant only if `org-bibtex-export-tags-as-keywords` is t."
(read-from-minibuffer "id: "))))
(defun org-bibtex-fleshout (type &optional optional)
"Fleshout the current heading, ensuring that all required fields are present.
"Fleshout current heading, ensuring all required fields are present.
With optional argument OPTIONAL, also prompt for optional fields."
(flet ((val (key lst) (cdr (assoc key lst)))
(keyword (name) (intern (concat ":" (downcase name))))
(name (keyword) (substring (symbol-name keyword) 1)))
(let ((val (lambda (key lst) (cdr (assoc key lst))))
(keyword (lambda (name) (intern (concat ":" (downcase name)))))
(name (lambda (keyword) (substring (symbol-name keyword) 1))))
(dolist (field (append
(if org-bibtex-treat-headline-as-title
(remove :title (val :required (val type org-bibtex-types)))
(val :required (val type org-bibtex-types)))
(when optional (val :optional (val type org-bibtex-types)))))
(remove :title (funcall val :required (funcall val type org-bibtex-types)))
(funcall val :required (funcall val type org-bibtex-types)))
(when optional (funcall val :optional (funcall val type org-bibtex-types)))))
(when (consp field) ; or'd pair of fields e.g., (:editor :author)
(let ((present (first (remove nil
(mapcar
(lambda (f) (when (org-bibtex-get (name f)) f))
field)))))
(setf field (or present (keyword (org-icompleting-read
"Field: " (mapcar #'name field)))))))
(let ((name (name field)))
(let ((present (first (remove
nil
(mapcar
(lambda (f) (when (org-bibtex-get (funcall name f)) f))
field)))))
(setf field (or present (funcall keyword
(org-icompleting-read
"Field: " (mapcar name field)))))))
(let ((name (funcall name field)))
(unless (org-bibtex-get name)
(let ((prop (org-bibtex-ask field)))
(when prop (org-bibtex-put name prop)))))))
@ -546,7 +550,7 @@ Headlines are exported using `org-bibtex-export-headline'."
(error (throw 'bib (point)))))))))
(with-temp-file filename
(insert (mapconcat #'identity bibtex-entries "\n")))
(message "Successfully exported %d bibtex entries to %s"
(message "Successfully exported %d BibTeX entries to %s"
(length bibtex-entries) filename) nil))))
(defun org-bibtex-check (&optional optional)
@ -578,7 +582,7 @@ If nonew is t, add data to the headline of the entry at point."
(type (if (keywordp type) type (intern (concat ":" type))))
(org-bibtex-treat-headline-as-title (if nonew nil t)))
(unless (assoc type org-bibtex-types)
(error "type:%s is not known" type))
(error "Type:%s is not known" type))
(if nonew
(org-back-to-heading)
(org-insert-heading)
@ -597,57 +601,60 @@ With a prefix arg, query for optional fields."
(org-bibtex-create arg t))
(defun org-bibtex-read ()
"Read a bibtex entry and save to `*org-bibtex-entries*'.
"Read a bibtex entry and save to `org-bibtex-entries'.
This uses `bibtex-parse-entry'."
(interactive)
(flet ((keyword (str) (intern (concat ":" (downcase str))))
(clean-space (str) (replace-regexp-in-string
"[[:space:]\n\r]+" " " str))
(strip-delim (str) ; strip enclosing "..." and {...}
(dolist (pair '((34 . 34) (123 . 125) (123 . 125)))
(when (and (= (aref str 0) (car pair))
(= (aref str (1- (length str))) (cdr pair)))
(setf str (substring str 1 (1- (length str)))))) str))
(let ((keyword (lambda (str) (intern (concat ":" (downcase str)))))
(clean-space (lambda (str) (replace-regexp-in-string
"[[:space:]\n\r]+" " " str)))
(strip-delim
(lambda (str) ; strip enclosing "..." and {...}
(dolist (pair '((34 . 34) (123 . 125) (123 . 125)))
(when (and (= (aref str 0) (car pair))
(= (aref str (1- (length str))) (cdr pair)))
(setf str (substring str 1 (1- (length str)))))) str)))
(push (mapcar
(lambda (pair)
(cons (let ((field (keyword (car pair))))
(cons (let ((field (funcall keyword (car pair))))
(case field
(:=type= :type)
(:=key= :key)
(otherwise field)))
(clean-space (strip-delim (cdr pair)))))
(funcall clean-space (funcall strip-delim (cdr pair)))))
(save-excursion (bibtex-beginning-of-entry) (bibtex-parse-entry)))
*org-bibtex-entries*)))
org-bibtex-entries)))
(defun org-bibtex-write ()
"Insert a heading built from the first element of `*org-bibtex-entries*'."
"Insert a heading built from the first element of `org-bibtex-entries'."
(interactive)
(when (= (length *org-bibtex-entries*) 0)
(error "No entries in `*org-bibtex-entries*'."))
(let ((entry (pop *org-bibtex-entries*))
(org-special-properties nil)) ; avoids errors with `org-entry-put'
(flet ((val (field) (cdr (assoc field entry)))
(togtag (tag) (org-toggle-tag tag 'on)))
(org-insert-heading)
(insert (val :title))
(org-bibtex-put "TITLE" (val :title))
(org-bibtex-put org-bibtex-type-property-name (downcase (val :type)))
(dolist (pair entry)
(case (car pair)
(:title nil)
(:type nil)
(:key (org-bibtex-put org-bibtex-key-property (cdr pair)))
(:keywords (if org-bibtex-tags-are-keywords
(mapc
(lambda (kw)
(togtag
(replace-regexp-in-string
"[^[:alnum:]_@#%]" ""
(replace-regexp-in-string "[ \t]+" "_" kw))))
(split-string (cdr pair) ", *"))
(org-bibtex-put (car pair) (cdr pair))))
(otherwise (org-bibtex-put (car pair) (cdr pair)))))
(mapc #'togtag org-bibtex-tags))))
(when (= (length org-bibtex-entries) 0)
(error "No entries in `org-bibtex-entries'"))
(let* ((entry (pop org-bibtex-entries))
(org-special-properties nil) ; avoids errors with `org-entry-put'
(val (lambda (field) (cdr (assoc field entry))))
(togtag (lambda (tag) (org-toggle-tag tag 'on))))
(org-insert-heading)
(insert (funcall val :title))
(org-bibtex-put "TITLE" (funcall val :title))
(org-bibtex-put org-bibtex-type-property-name
(downcase (funcall val :type)))
(dolist (pair entry)
(case (car pair)
(:title nil)
(:type nil)
(:key (org-bibtex-put org-bibtex-key-property (cdr pair)))
(:keywords (if org-bibtex-tags-are-keywords
(mapc
(lambda (kw)
(funcall
togtag
(replace-regexp-in-string
"[^[:alnum:]_@#%]" ""
(replace-regexp-in-string "[ \t]+" "_" kw))))
(split-string (cdr pair) ", *"))
(org-bibtex-put (car pair) (cdr pair))))
(otherwise (org-bibtex-put (car pair) (cdr pair)))))
(mapc togtag org-bibtex-tags)))
(defun org-bibtex-yank ()
"If kill ring holds a bibtex entry yank it as an Org-mode headline."
@ -656,7 +663,7 @@ This uses `bibtex-parse-entry'."
(with-temp-buffer (yank 1) (setf entry (org-bibtex-read)))
(if entry
(org-bibtex-write)
(error "yanked text does not appear to contain a bibtex entry"))))
(error "Yanked text does not appear to contain a BibTeX entry"))))
(defun org-bibtex-export-to-kill-ring ()
"Export current headline to kill ring as bibtex entry."

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

@ -58,6 +58,9 @@
(declare-function org-table-goto-line "org-table" (N))
(declare-function org-pop-to-buffer-same-window "org-compat"
(&optional buffer-or-name norecord label))
(declare-function org-at-encrypted-entry-p "org-crypt" ())
(declare-function org-encrypt-entry "org-crypt" ())
(declare-function org-decrypt-entry "org-crypt" ())
(defvar org-remember-default-headline)
(defvar org-remember-templates)
@ -101,7 +104,7 @@ description A short string describing the template, will be shown during
selection.
type The type of entry. Valid types are:
entry an Org-mode node, with a headline. Will be
entry an Org-mode node, with a headline. Will be
filed as the child of the target entry or as
a top-level entry.
item a plain list item, will be placed in the
@ -183,6 +186,14 @@ properties are:
before and after the new item. Default 0, only common
other value is 1.
:empty-lines-before Set this to the number of lines the should be inserted
before the new item. Overrides :empty-lines for the
number lines inserted before.
:empty-lines-after Set this to the number of lines the should be inserted
after the new item. Overrides :empty-lines for the
number of lines inserted after.
:clock-in Start the clock in this item.
:clock-keep Keep the clock running when filing the captured entry.
@ -211,51 +222,53 @@ will be filed as a child of the target headline. It can also be
freely formatted text. Furthermore, the following %-escapes will
be replaced with content and expanded in this order:
%[pathname] insert the contents of the file given by `pathname'.
%(sexp) evaluate elisp `(sexp)' and replace with the result.
%<...> the result of format-time-string on the ... format specification.
%t time stamp, date only.
%T time stamp with date and time.
%u, %U like the above, but inactive time stamps.
%a annotation, normally the link created with `org-store-link'.
%i initial content, copied from the active region. If %i is
%[pathname] Insert the contents of the file given by `pathname'.
%(sexp) Evaluate elisp `(sexp)' and replace with the result.
%<...> The result of format-time-string on the ... format specification.
%t Time stamp, date only.
%T Time stamp with date and time.
%u, %U Like the above, but inactive time stamps.
%i Initial content, copied from the active region. If %i is
indented, the entire inserted text will be indented as well.
%A like %a, but prompt for the description part.
%c current kill ring head.
%x content of the X clipboard.
%k title of currently clocked task.
%K link to currently clocked task.
%n user name (taken from `user-full-name').
%f file visited by current buffer when org-capture was called.
%F full path of the file or directory visited by current buffer.
%:keyword specific information for certain link types, see below.
%^g prompt for tags, with completion on tags in target file.
%^G prompt for tags, with completion on all tags in all agenda files.
%^t like %t, but prompt for date. Similarly %^T, %^u, %^U.
You may define a prompt like %^{Please specify birthday.
%^C interactive selection of which kill or clip to use.
%^L like %^C, but insert as link.
%^{prop}p prompt the user for a value for property `prop'.
%^{prompt} prompt the user for a string and replace this sequence with it.
%a Annotation, normally the link created with `org-store-link'.
%A Like %a, but prompt for the description part.
%l Like %a, but only insert the literal link.
%c Current kill ring head.
%x Content of the X clipboard.
%k Title of currently clocked task.
%K Link to currently clocked task.
%n User name (taken from `user-full-name').
%f File visited by current buffer when org-capture was called.
%F Full path of the file or directory visited by current buffer.
%:keyword Specific information for certain link types, see below.
%^g Prompt for tags, with completion on tags in target file.
%^G Prompt for tags, with completion on all tags in all agenda files.
%^t Like %t, but prompt for date. Similarly %^T, %^u, %^U.
You may define a prompt like: %^{Please specify birthday}t
%^C Interactive selection of which kill or clip to use.
%^L Like %^C, but insert as link.
%^{prop}p Prompt the user for a value for property `prop'.
%^{prompt} Prompt the user for a string and replace this sequence with it.
A default value and a completion table ca be specified like this:
%^{prompt|default|completion2|completion3|...}.
%? After completing the template, position cursor here.
%\\n Insert the text entered at the nth %^{prompt}, where `n' is
a number, starting from 1.
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
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 in Gnus will record the author and the subject of the message, which you
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, mew, rmail | %:type %:subject %:message-id
| %:from %:fromname %:fromaddress
vm, wl, mh, mew, rmail, | %:type %:subject %:message-id
gnus | %:from %:fromname %:fromaddress
| %:to %:toname %:toaddress
| %:fromto (either \"to NAME\" or \"from NAME\")
| %:date
| %:date-timestamp (as active timestamp)
| %:date %:date-timestamp (as active timestamp)
| %:date-timestamp-inactive (as inactive timestamp)
gnus | %:group, for messages also all email fields
w3, w3m | %:type %:url
@ -266,71 +279,71 @@ calendar | %:type %:date"
:type
'(repeat
(choice :value ("" "" entry (file "~/org/notes.org") "")
(list :tag "Multikey description"
(string :tag "Keys ")
(string :tag "Description"))
(list :tag "Template entry"
(string :tag "Keys ")
(string :tag "Description ")
(choice :tag "Capture Type " :value entry
(const :tag "Org entry" entry)
(const :tag "Plain list item" item)
(const :tag "Checkbox item" checkitem)
(const :tag "Plain text" plain)
(const :tag "Table line" table-line))
(choice :tag "Target location"
(list :tag "File"
(const :format "" file)
(file :tag " File"))
(list :tag "ID"
(const :format "" id)
(string :tag " ID"))
(list :tag "File & Headline"
(const :format "" file+headline)
(file :tag " File ")
(string :tag " Headline"))
(list :tag "File & Outline path"
(const :format "" file+olp)
(file :tag " File ")
(repeat :tag "Outline path" :inline t
(string :tag "Headline")))
(list :tag "File & Regexp"
(const :format "" file+regexp)
(file :tag " File ")
(regexp :tag " Regexp"))
(list :tag "File & Date tree"
(const :format "" file+datetree)
(file :tag " File"))
(list :tag "File & Date tree, prompt for date"
(const :format "" file+datetree+prompt)
(file :tag " File"))
(list :tag "File & function"
(const :format "" file+function)
(file :tag " File ")
(sexp :tag " Function"))
(list :tag "Current clocking task"
(const :format "" clock))
(list :tag "Function"
(const :format "" function)
(sexp :tag " Function")))
(choice :tag "Template"
(string)
(list :tag "File"
(const :format "" file)
(file :tag "Template file"))
(list :tag "Function"
(const :format "" function)
(function :tag "Template function")))
(plist :inline t
;; Give the most common options as checkboxes
:options (((const :format "%v " :prepend) (const t))
((const :format "%v " :immediate-finish) (const t))
((const :format "%v " :empty-lines) (const 1))
((const :format "%v " :clock-in) (const t))
((const :format "%v " :clock-keep) (const t))
((const :format "%v " :clock-resume) (const t))
((const :format "%v " :unnarrowed) (const t))
((const :format "%v " :kill-buffer) (const t))))))))
(list :tag "Multikey description"
(string :tag "Keys ")
(string :tag "Description"))
(list :tag "Template entry"
(string :tag "Keys ")
(string :tag "Description ")
(choice :tag "Capture Type " :value entry
(const :tag "Org entry" entry)
(const :tag "Plain list item" item)
(const :tag "Checkbox item" checkitem)
(const :tag "Plain text" plain)
(const :tag "Table line" table-line))
(choice :tag "Target location"
(list :tag "File"
(const :format "" file)
(file :tag " File"))
(list :tag "ID"
(const :format "" id)
(string :tag " ID"))
(list :tag "File & Headline"
(const :format "" file+headline)
(file :tag " File ")
(string :tag " Headline"))
(list :tag "File & Outline path"
(const :format "" file+olp)
(file :tag " File ")
(repeat :tag "Outline path" :inline t
(string :tag "Headline")))
(list :tag "File & Regexp"
(const :format "" file+regexp)
(file :tag " File ")
(regexp :tag " Regexp"))
(list :tag "File & Date tree"
(const :format "" file+datetree)
(file :tag " File"))
(list :tag "File & Date tree, prompt for date"
(const :format "" file+datetree+prompt)
(file :tag " File"))
(list :tag "File & function"
(const :format "" file+function)
(file :tag " File ")
(sexp :tag " Function"))
(list :tag "Current clocking task"
(const :format "" clock))
(list :tag "Function"
(const :format "" function)
(sexp :tag " Function")))
(choice :tag "Template"
(string)
(list :tag "File"
(const :format "" file)
(file :tag "Template file"))
(list :tag "Function"
(const :format "" function)
(function :tag "Template function")))
(plist :inline t
;; Give the most common options as checkboxes
:options (((const :format "%v " :prepend) (const t))
((const :format "%v " :immediate-finish) (const t))
((const :format "%v " :empty-lines) (const 1))
((const :format "%v " :clock-in) (const t))
((const :format "%v " :clock-keep) (const t))
((const :format "%v " :clock-resume) (const t))
((const :format "%v " :unnarrowed) (const t))
((const :format "%v " :kill-buffer) (const t))))))))
(defcustom org-capture-before-finalize-hook nil
"Hook that is run right before a capture process is finalized.
@ -342,11 +355,25 @@ widened to the entire buffer."
(defcustom org-capture-after-finalize-hook nil
"Hook that is run right after a capture process is finalized.
Suitable for window cleanup"
Suitable for window cleanup."
:group 'org-capture
:version "24.1"
:type 'hook)
(defcustom org-capture-prepare-finalize-hook nil
"Hook that is run before the finalization starts.
The capture buffer is current and still narrowed."
:group 'org-capture
:version "24.1"
:type 'hook)
(defcustom org-capture-bookmark t
"When non-nil, add a bookmark pointing at the last stored
position when capturing."
:group 'org-capture
:version "24.3"
:type 'boolean)
;;; The property list for keeping information about the capture process
(defvar org-capture-plist nil
@ -394,18 +421,80 @@ for a capture buffer.")
"Hook for the minor `org-capture-mode'.")
(define-minor-mode org-capture-mode
"Minor mode for special key bindings in a capture buffer."
"Minor mode for special key bindings in a capture buffer.
Turning on this mode runs the normal hook `org-capture-mode-hook'."
nil " Rem" org-capture-mode-map
(org-set-local
'header-line-format
"Capture buffer. Finish `C-c C-c', refile `C-c C-w', abort `C-c C-k'.")
(run-hooks 'org-capture-mode-hook))
"Capture buffer. Finish `C-c C-c', refile `C-c C-w', abort `C-c C-k'."))
(define-key org-capture-mode-map "\C-c\C-c" 'org-capture-finalize)
(define-key org-capture-mode-map "\C-c\C-k" 'org-capture-kill)
(define-key org-capture-mode-map "\C-c\C-w" 'org-capture-refile)
;;; The main commands
;;;###autoload
(defvar org-capture-initial nil)
(defvar org-capture-entry nil)
(defun org-capture-string (string &optional keys)
(interactive "sInitial text: \n")
(let ((org-capture-initial string)
(org-capture-entry (org-capture-select-template keys)))
(org-capture)))
(defcustom org-capture-templates-contexts nil
"Alist of capture templates and valid contexts.
For example, if you have a capture template \"c\" and you want
this template to be accessible only from `message-mode' buffers,
use this:
'((\"c\" (in-mode . \"message-mode\")))
Here are the available contexts definitions:
in-file: command displayed only in matching files
in-mode: command displayed only in matching modes
not-in-file: command not displayed in matching files
not-in-mode: command not displayed in matching modes
[function]: a custom function taking no argument
If you define several checks, the agenda command will be
accessible if there is at least one valid check.
You can also bind a key to another agenda custom command
depending on contextual rules.
'((\"c\" \"d\" (in-mode . \"message-mode\")))
Here it means: in `message-mode buffers', use \"d\" as the
key for the capture template otherwise associated with \"d\".
\(The template originally associated with \"q\" is not displayed
to avoid duplicates.)"
:version "24.3"
:group 'org-capture
:type '(repeat (list :tag "Rule"
(string :tag " Capture key")
(string :tag "Replace by template")
(repeat :tag "Available when"
(choice
(cons :tag "Condition"
(choice
(const :tag "In file" in-file)
(const :tag "Not in file" not-in-file)
(const :tag "In mode" in-mode)
(const :tag "Not in mode" not-in-mode))
(regexp))
(function :tag "Custom function"))))))
(defcustom org-capture-use-agenda-date nil
"Non-nil means use the date at point when capturing from agendas.
When nil, you can still capturing using the date at point with \\[org-agenda-capture]]."
:group 'org-capture
:version "24.3"
:type 'boolean)
;;;###autoload
(defun org-capture (&optional goto keys)
"Capture something.
@ -424,10 +513,17 @@ stored.
When called with a `C-0' (zero) prefix, insert a template at point.
Lisp programs can set KEYS to a string associated with a template in
`org-capture-templates'. In this case, interactive selection will be
bypassed."
Lisp programs can set KEYS to a string associated with a template
in `org-capture-templates'. In this case, interactive selection
will be bypassed.
If `org-capture-use-agenda-date' is non-nil, capturing from the
agenda will use the date at point as the default date."
(interactive "P")
(when (and org-capture-use-agenda-date
(eq major-mode 'org-agenda-mode))
(setq org-overriding-default-time
(org-get-cursor-date)))
(cond
((equal goto '(4)) (org-capture-goto-target))
((equal goto '(16)) (org-capture-goto-last-stored))
@ -438,9 +534,11 @@ bypassed."
org-capture-link-is-already-stored)
(plist-get org-store-link-plist :annotation)
(ignore-errors (org-store-link nil))))
(initial (and (org-region-active-p)
(buffer-substring (point) (mark))))
(entry (org-capture-select-template keys)))
(entry (or org-capture-entry (org-capture-select-template keys)))
initial)
(setq initial (or org-capture-initial
(and (org-region-active-p)
(buffer-substring (point) (mark)))))
(when (stringp initial)
(remove-text-properties 0 (length initial) '(read-only t) initial))
(when (stringp annotation)
@ -489,7 +587,7 @@ bypassed."
(error "Capture template `%s': %s"
(org-capture-get :key)
(nth 1 error))))
(if (and (eq major-mode 'org-mode)
(if (and (derived-mode-p 'org-mode)
(org-capture-get :clock-in))
(condition-case nil
(progn
@ -530,6 +628,8 @@ captured item after finalizing."
(buffer-base-buffer (current-buffer)))
(error "This does not seem to be a capture buffer for Org-mode"))
(run-hooks 'org-capture-prepare-finalize-hook)
;; Did we start the clock in this capture buffer?
(when (and org-capture-clock-was-started
org-clock-marker (marker-buffer org-clock-marker)
@ -577,9 +677,10 @@ captured item after finalizing."
(goto-char end)
(or (bolp) (newline))
(org-capture-empty-lines-after
(or (org-capture-get :empty-lines 'local) 0))))
(or (org-capture-get :empty-lines-after 'local)
(org-capture-get :empty-lines 'local) 0))))
;; Postprocessing: Update Statistics cookies, do the sorting
(when (eq major-mode 'org-mode)
(when (derived-mode-p 'org-mode)
(save-excursion
(when (ignore-errors (org-back-to-heading))
(org-update-parent-todo-statistics)
@ -594,11 +695,17 @@ captured item after finalizing."
;; Store this place as the last one where we stored something
;; Do the marking in the base buffer, so that it makes sense after
;; the indirect buffer has been killed.
(org-capture-bookmark-last-stored-position)
(when org-capture-bookmark
(org-capture-bookmark-last-stored-position))
;; Run the hook
(run-hooks 'org-capture-before-finalize-hook))
(when (org-capture-get :decrypted)
(save-excursion
(goto-char (org-capture-get :decrypted))
(org-encrypt-entry)))
;; Kill the indirect buffer
(save-buffer)
(let ((return-wconf (org-capture-get :return-to-wconf 'local))
@ -675,8 +782,8 @@ already gone. Any prefix argument will be passed to the refile command."
(defun org-capture-kill ()
"Abort the current capture process."
(interactive)
;; FIXME: This does not do the right thing, we need to remove the new stuff
;; By hand it is easy: undo, then kill the buffer
;; FIXME: This does not do the right thing, we need to remove the
;; new stuff by hand it is easy: undo, then kill the buffer
(let ((org-note-abort t)
(org-capture-before-finalize-hook nil))
(org-capture-finalize)))
@ -700,9 +807,11 @@ already gone. Any prefix argument will be passed to the refile command."
;; store the current point
(org-capture-put :initial-target-position (point)))
(defvar org-time-was-given) ; dynamically scoped parameter
(defun org-capture-set-target-location (&optional target)
"Find target buffer and position and store then in the property list."
(let ((target-entry-p t))
"Find TARGET buffer and position.
Store them in the capture property list."
(let ((target-entry-p t) decrypted-hl-pos)
(setq target (or target (org-capture-get :target)))
(save-excursion
(cond
@ -727,7 +836,7 @@ already gone. Any prefix argument will be passed to the refile command."
(widen)
(let ((hd (nth 2 target)))
(goto-char (point-min))
(unless (eq major-mode 'org-mode)
(unless (derived-mode-p 'org-mode)
(error
"Target buffer \"%s\" for file+headline should be in Org mode"
(current-buffer)))
@ -759,7 +868,7 @@ already gone. Any prefix argument will be passed to the refile command."
(goto-char (if (org-capture-get :prepend)
(match-beginning 0) (match-end 0)))
(org-capture-put :exact-position (point))
(setq target-entry-p (and (eq major-mode 'org-mode) (org-at-heading-p))))
(setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p))))
(error "No match for target regexp in file %s" (nth 1 target))))
((memq (car target) '(file+datetree file+datetree+prompt))
@ -781,11 +890,22 @@ already gone. Any prefix argument will be passed to the refile command."
(let ((prompt-time (org-read-date
nil t nil "Date for tree entry:"
(current-time))))
(org-capture-put :prompt-time prompt-time
:default-time prompt-time)
(org-capture-put
:default-time
(cond ((and (not org-time-was-given)
(not (= (time-to-days prompt-time) (org-today))))
;; Use 00:00 when no time is given for another date than today?
(apply 'encode-time (append '(0 0 0) (cdddr (decode-time prompt-time)))))
((string-match "\\([^ ]+\\)--?[^ ]+[ ]+\\(.*\\)" org-read-date-final-answer)
;; Replace any time range by its start
(apply 'encode-time
(org-read-date-analyze
(replace-match "\\1 \\2" nil nil org-read-date-final-answer)
prompt-time (decode-time prompt-time))))
(t prompt-time)))
(time-to-days prompt-time)))
(t
;; current date, possible corrected for late night workers
;; current date, possibly corrected for late night workers
(org-today))))))
((eq (car target) 'file+function)
@ -794,12 +914,12 @@ already gone. Any prefix argument will be passed to the refile command."
(widen)
(funcall (nth 2 target))
(org-capture-put :exact-position (point))
(setq target-entry-p (and (eq major-mode 'org-mode) (org-at-heading-p))))
(setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p))))
((eq (car target) 'function)
(funcall (nth 1 target))
(org-capture-put :exact-position (point))
(setq target-entry-p (and (eq major-mode 'org-mode) (org-at-heading-p))))
(setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p))))
((eq (car target) 'clock)
(if (and (markerp org-clock-hd-marker)
@ -812,8 +932,14 @@ already gone. Any prefix argument will be passed to the refile command."
(t (error "Invalid capture target specification")))
(when (and (featurep 'org-crypt) (org-at-encrypted-entry-p))
(org-decrypt-entry)
(setq decrypted-hl-pos
(save-excursion (and (org-back-to-heading t) (point)))))
(org-capture-put :buffer (current-buffer) :pos (point)
:target-entry-p target-entry-p))))
:target-entry-p target-entry-p
:decrypted decrypted-hl-pos))))
(defun org-capture-expand-file (file)
"Expand functions and symbols for FILE.
@ -893,7 +1019,7 @@ it. When it is a variable, retrieve the value. Return whatever we get."
(progn
(outline-next-heading)
(or (bolp) (insert "\n")))
(org-end-of-subtree t t)
(org-end-of-subtree t nil)
(or (bolp) (insert "\n")))))
(org-capture-empty-lines-before)
(setq beg (point))
@ -905,8 +1031,9 @@ it. When it is a variable, retrieve the value. Return whatever we get."
(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 ""))))
(if (or (re-search-backward "%\\?" beg t)
(re-search-forward "%\\?" end t))
(replace-match ""))))
(defun org-capture-place-item ()
"Place the template as a new plain list item."
@ -962,7 +1089,9 @@ it. When it is a variable, retrieve the value. Return whatever we get."
(setq end (point))
(org-capture-mark-kill-region beg (1- end))
(org-capture-narrow beg (1- end))
(if (re-search-forward "%\\?" end t) (replace-match ""))))
(if (or (re-search-backward "%\\?" beg t)
(re-search-forward "%\\?" end t))
(replace-match ""))))
(defun org-capture-place-table-line ()
"Place the template as a table line."
@ -982,9 +1111,9 @@ it. When it is a variable, retrieve the value. Return whatever we get."
(setq beg (1+ (point-at-eol))
end (save-excursion (outline-next-heading) (point)))))
(if (re-search-forward org-table-dataline-regexp end t)
(let ((b (org-table-begin)) (e (org-table-end)))
(let ((b (org-table-begin)) (e (org-table-end)) (case-fold-search t))
(goto-char e)
(if (looking-at "[ \t]*#\\+TBLFM:")
(if (looking-at "[ \t]*#\\+tblfm:")
(forward-line 1))
(narrow-to-region b (point)))
(goto-char end)
@ -1040,7 +1169,9 @@ it. When it is a variable, retrieve the value. Return whatever we get."
(setq end (point))))
(goto-char beg)
(org-capture-position-for-last-stored 'table-line)
(if (re-search-forward "%\\?" end t) (replace-match ""))
(if (or (re-search-backward "%\\?" beg t)
(re-search-forward "%\\?" end t))
(replace-match ""))
(org-table-align)))
(defun org-capture-place-plain-text ()
@ -1075,7 +1206,9 @@ Of course, if exact position has been required, just put it there."
(setq end (point))
(org-capture-mark-kill-region beg (1- end))
(org-capture-narrow beg (1- end))
(if (re-search-forward "%\\?" end t) (replace-match ""))))
(if (or (re-search-backward "%\\?" beg t)
(re-search-forward "%\\?" end t))
(replace-match ""))))
(defun org-capture-mark-kill-region (beg end)
"Mark the region that will have to be killed when aborting capture."
@ -1128,7 +1261,8 @@ Of course, if exact position has been required, just put it there."
(defun org-capture-empty-lines-before (&optional n)
"Arrange for the correct number of empty lines before the insertion point.
Point will be after the empty lines, so insertion can directly be done."
(setq n (or n (org-capture-get :empty-lines) 0))
(setq n (or n (org-capture-get :empty-lines-before)
(org-capture-get :empty-lines) 0))
(let ((pos (point)))
(org-back-over-empty-lines)
(delete-region (point) pos)
@ -1137,7 +1271,8 @@ Point will be after the empty lines, so insertion can directly be done."
(defun org-capture-empty-lines-after (&optional n)
"Arrange for the correct number of empty lines after the inserted string.
Point will remain at the first line after the inserted text."
(setq n (or n (org-capture-get :empty-lines) 0))
(setq n (or n (org-capture-get :empty-lines-after)
(org-capture-get :empty-lines) 0))
(org-back-over-empty-lines)
(while (looking-at "[ \t]*\n") (replace-match ""))
(let ((pos (point)))
@ -1153,11 +1288,11 @@ Point will remain at the first line after the inserted text."
(or (bolp) (newline))
(setq beg (point))
(cond
((and (eq type 'entry) (eq major-mode 'org-mode))
((and (eq type 'entry) (derived-mode-p 'org-mode))
(org-capture-verify-tree (org-capture-get :template))
(org-paste-subtree nil template t))
((and (memq type '(item checkitem))
(eq major-mode 'org-mode)
(derived-mode-p 'org-mode)
(save-excursion (skip-chars-backward " \t\n")
(setq pp (point))
(org-in-item-p)))
@ -1225,7 +1360,7 @@ Use PREFIX as a prefix for the name of the indirect buffer."
buf)))))
(defun org-capture-verify-tree (tree)
"Throw error if TREE is not a valid tree"
"Throw error if TREE is not a valid tree."
(unless (org-kill-is-subtree-p tree)
(error "Template is not a valid Org entry or tree")))
@ -1235,7 +1370,8 @@ Use PREFIX as a prefix for the name of the indirect buffer."
"Select a capture template.
Lisp programs can force the template by setting KEYS to a string."
(let ((org-capture-templates
(or org-capture-templates
(or (org-contextualize-keys
org-capture-templates org-capture-templates-contexts)
'(("t" "Task" entry (file+headline "" "Tasks")
"* TODO %?\n %u\n %a")))))
(if keys
@ -1252,8 +1388,7 @@ Lisp programs can force the template by setting KEYS to a string."
The template may still contain \"%?\" for cursor positioning."
(setq template (or template (org-capture-get :template)))
(when (stringp initial)
(setq initial (org-no-properties initial))
(remove-text-properties 0 (length initial) '(read-only t) initial))
(setq initial (org-no-properties initial)))
(let* ((buffer (org-capture-get :buffer))
(file (buffer-file-name (or (buffer-base-buffer buffer) buffer)))
(ct (org-capture-get :default-time))
@ -1288,14 +1423,16 @@ The template may still contain \"%?\" for cursor positioning."
(org-get-x-clipboard 'CLIPBOARD)
(org-get-x-clipboard 'SECONDARY)
v-c)))
(v-A (if (and v-a
(string-match
"\\[\\(\\[.*?\\]\\)\\(\\[.*?\\]\\)?\\]" v-a))
(replace-match "[\\1[%^{Link description}]]" nil nil v-a)
(l-re "\\[\\[\\(.*?\\)\\]\\(\\[.*?\\]\\)?\\]")
(v-A (if (and v-a (string-match l-re v-a))
(replace-match "[[\\1][%^{Link description}]]" nil nil v-a)
v-a))
(v-l (if (and v-a (string-match l-re v-a))
(replace-match "\\1" nil nil v-a)
v-a))
(v-n user-full-name)
(v-k (if (marker-buffer org-clock-marker)
(org-substring-no-properties org-clock-heading)))
(org-no-properties org-clock-heading)))
(v-K (if (marker-buffer org-clock-marker)
(org-make-link-string
(buffer-file-name (marker-buffer org-clock-marker))
@ -1306,7 +1443,7 @@ The template may still contain \"%?\" for cursor positioning."
(org-startup-folded nil)
(org-inhibit-startup t)
org-time-was-given org-end-time-was-given x
prompt completions char time pos default histvar)
prompt completions char time pos default histvar strings)
(setq org-store-link-plist
(plist-put org-store-link-plist :annotation v-a)
@ -1339,15 +1476,7 @@ The template may still contain \"%?\" for cursor positioning."
(error (insert (format "%%![Couldn't insert %s: %s]"
filename error)))))))
;; %() embedded elisp
(goto-char (point-min))
(while (re-search-forward "%\\((.+)\\)" nil t)
(unless (org-capture-escaped-%)
(goto-char (match-beginning 0))
(let ((template-start (point)))
(forward-char 1)
(let ((result (org-eval (read (current-buffer)))))
(delete-region template-start (point))
(insert result)))))
(org-capture-expand-embedded-elisp)
;; The current time
(goto-char (point-min))
@ -1356,7 +1485,7 @@ The template may still contain \"%?\" for cursor positioning."
;; Simple %-escapes
(goto-char (point-min))
(while (re-search-forward "%\\([tTuUaiAcxkKInfF]\\)" nil t)
(while (re-search-forward "%\\([tTuUaliAcxkKInfF]\\)" nil t)
(unless (org-capture-escaped-%)
(when (and initial (equal (match-string 0) "%i"))
(save-match-data
@ -1366,7 +1495,8 @@ The template may still contain \"%?\" for cursor positioning."
(org-split-string initial "\n")
(concat "\n" lead))))))
(replace-match
(or (eval (intern (concat "v-" (match-string 1)))) "")
(or (org-add-props (eval (intern (concat "v-" (match-string 1))))
'(org-protected t)) "")
t t)))
;; From the property list
@ -1383,8 +1513,8 @@ The template may still contain \"%?\" for cursor positioning."
(let ((org-inhibit-startup t)) (org-mode))
;; Interactive template entries
(goto-char (point-min))
(while (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?"
nil t)
(while (and (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" nil t)
(not (get-text-property (1- (point)) 'org-protected)))
(unless (org-capture-escaped-%)
(setq char (if (match-end 3) (match-string-no-properties 3))
prompt (if (match-end 2) (match-string-no-properties 2)))
@ -1415,7 +1545,7 @@ The template may still contain \"%?\" for cursor positioning."
(setq ins (mapconcat 'identity
(org-split-string
ins (org-re "[^[:alnum:]_@#%]+"))
":"))
":"))
(when (string-match "\\S-" ins)
(or (equal (char-before) ?:) (insert ":"))
(insert ins)
@ -1436,7 +1566,7 @@ The template may still contain \"%?\" for cursor positioning."
'(clipboards . 1)
(car clipboards))))))
((equal char "p")
(org-set-property (org-substring-no-properties prompt) nil))
(org-set-property (org-no-properties prompt) nil))
(char
;; These are the date/time related ones
(setq org-time-was-given (equal (upcase char) char))
@ -1448,11 +1578,21 @@ The template may still contain \"%?\" for cursor positioning."
nil nil (list org-end-time-was-given)))
(t
(let (org-completion-use-ido)
(insert (org-completing-read-no-i
(concat (if prompt prompt "Enter string")
(if default (concat " [" default "]"))
": ")
completions nil nil nil histvar default)))))))
(push (org-completing-read-no-i
(concat (if prompt prompt "Enter string")
(if default (concat " [" default "]"))
": ")
completions nil nil nil histvar default)
strings)
(insert (car strings)))))))
;; Replace %n escapes with nth %^{...} string
(setq strings (nreverse strings))
(goto-char (point-min))
(while (re-search-forward "%\\\\\\([1-9][0-9]*\\)" nil t)
(unless (org-capture-escaped-%)
(replace-match
(nth (1- (string-to-number (match-string 1))) strings)
nil t)))
;; Make sure there are no empty lines before the text, and that
;; it ends with a newline character
(goto-char (point-min))
@ -1471,6 +1611,34 @@ The template may still contain \"%?\" for cursor positioning."
t)
nil))
(defun org-capture-expand-embedded-elisp ()
"Evaluate embedded elisp %(sexp) and replace with the result."
(goto-char (point-min))
(while (re-search-forward "%(" nil t)
(unless (org-capture-escaped-%)
(goto-char (match-beginning 0))
(let ((template-start (point)))
(forward-char 1)
(let ((result (org-eval (read (current-buffer)))))
(delete-region template-start (point))
(insert result))))))
(defun org-capture-inside-embedded-elisp-p ()
"Return non-nil if point is inside of embedded elisp %(sexp)."
(let (beg end)
(with-syntax-table emacs-lisp-mode-syntax-table
(save-excursion
;; `looking-at' and `search-backward' below do not match the "%(" if
;; point is in its middle
(when (equal (char-before) ?%)
(backward-char))
(save-match-data
(when (or (looking-at "%(") (search-backward "%(" nil t))
(setq beg (point))
(setq end (progn (forward-char) (forward-sexp) (1- (point)))))))
(when (and beg end)
(and (<= (point) end) (>= (point) beg))))))
;;;###autoload
(defun org-capture-import-remember-templates ()
"Set org-capture-templates to be similar to `org-remember-templates'."

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

File diff suppressed because it is too large Load diff

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

@ -33,9 +33,10 @@
(declare-function org-agenda-redo "org-agenda" ())
(declare-function org-agenda-do-context-action "org-agenda" ())
(declare-function org-clock-sum-today "org-clock" (&optional headline-filter))
(when (featurep 'xemacs)
(error "Do not load this file into XEmacs, use 'org-colview-xemacs.el'."))
(error "Do not load this file into XEmacs, use `org-colview-xemacs.el'"))
;;; Column View
@ -149,6 +150,7 @@ This is the compiled version of the format.")
"Create a new column overlay and add it to the list."
(let ((ov (make-overlay beg end)))
(overlay-put ov 'face (or face 'secondary-selection))
(remove-text-properties 0 (length string) '(face nil) string)
(org-overlay-display ov string face)
(push ov org-columns-overlays)
ov))
@ -186,17 +188,15 @@ This is the compiled version of the format.")
(cons "ITEM"
;; When in a buffer, get the whole line,
;; we'll clean it later…
(if (eq major-mode 'org-mode)
(if (derived-mode-p 'org-mode)
(save-match-data
(org-no-properties
(org-remove-tabs
(buffer-substring-no-properties
(point-at-bol) (point-at-eol)))))
(org-remove-tabs
(buffer-substring-no-properties
(point-at-bol) (point-at-eol))))
;; In agenda, just get the `txt' property
(org-no-properties
(or (org-get-at-bol 'txt)
(buffer-substring
(point) (progn (end-of-line) (point)))))))
(or (org-get-at-bol 'txt)
(buffer-substring-no-properties
(point) (progn (end-of-line) (point))))))
(assoc property props))
width (or (cdr (assoc property org-columns-current-maxwidths))
(nth 2 column)
@ -240,20 +240,20 @@ This is the compiled version of the format.")
(save-excursion
(goto-char beg)
(org-unmodified (insert " ")))))) ;; FIXME: add props and remove later?
;; Make the rest of the line disappear.
(org-unmodified
(setq ov (org-columns-new-overlay beg (point-at-eol)))
(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)
(push ov org-columns-overlays)
(let ((inhibit-read-only t))
(put-text-property (max (point-min) (1- (point-at-bol)))
;; Make the rest of the line disappear.
(org-unmodified
(setq ov (org-columns-new-overlay beg (point-at-eol)))
(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)
(push ov org-columns-overlays)
(let ((inhibit-read-only t))
(put-text-property (max (point-min) (1- (point-at-bol)))
(min (point-max) (1+ (point-at-eol)))
'read-only "Type `e' to edit property")))))
@ -304,7 +304,7 @@ for the duration of the command.")
(org-set-local 'org-columns-current-widths (nreverse widths))
(setq org-columns-full-header-line-format title)
(setq org-columns-previous-hscroll -1)
; (org-columns-hscoll-title)
; (org-columns-hscoll-title)
(org-add-hook 'post-command-hook 'org-columns-hscoll-title nil 'local)))
(defun org-columns-hscoll-title ()
@ -442,8 +442,8 @@ Where possible, use the standard interface for changing this line."
(org-edit-headline))))
((equal key "TODO")
(setq eval '(org-with-point-at
pom
(call-interactively 'org-todo))))
pom
(call-interactively 'org-todo))))
((equal key "PRIORITY")
(setq eval '(org-with-point-at pom
(call-interactively 'org-priority))))
@ -499,7 +499,7 @@ Where possible, use the standard interface for changing this line."
(org-columns-eval eval))
(org-columns-display-here)))
(org-move-to-column col)
(if (and (eq major-mode 'org-mode)
(if (and (derived-mode-p 'org-mode)
(nth 3 (assoc key org-columns-current-fmt-compiled)))
(org-columns-update key)))))))
@ -665,27 +665,38 @@ around it."
(org-open-link-from-string value arg)))
(defun org-columns-get-format-and-top-level ()
(let (fmt)
(when (condition-case nil (org-back-to-heading) (error nil))
(setq fmt (org-entry-get nil "COLUMNS" t)))
(setq fmt (or fmt org-columns-default-format))
(org-set-local 'org-columns-current-fmt fmt)
(org-columns-compile-format fmt)
(if (marker-position org-entry-property-inherited-from)
(move-marker org-columns-top-level-marker
org-entry-property-inherited-from)
(move-marker org-columns-top-level-marker (point)))
(let ((fmt (org-columns-get-format)))
(org-columns-goto-top-level)
fmt))
(defun org-columns ()
"Turn on column view on an org-mode file."
(defun org-columns-get-format (&optional fmt-string)
(interactive)
(let (fmt-as-property fmt)
(when (condition-case nil (org-back-to-heading) (error nil))
(setq fmt-as-property (org-entry-get nil "COLUMNS" t)))
(setq fmt (or fmt-string fmt-as-property org-columns-default-format))
(org-set-local 'org-columns-current-fmt fmt)
(org-columns-compile-format fmt)
fmt))
(defun org-columns-goto-top-level ()
(when (condition-case nil (org-back-to-heading) (error nil))
(org-entry-get nil "COLUMNS" t))
(if (marker-position org-entry-property-inherited-from)
(move-marker org-columns-top-level-marker org-entry-property-inherited-from)
(move-marker org-columns-top-level-marker (point))))
(defun org-columns (&optional columns-fmt-string)
"Turn on column view on an org-mode file.
When COLUMNS-FMT-STRING is non-nil, use it as the column format."
(interactive)
(org-verify-version 'columns)
(org-columns-remove-overlays)
(move-marker org-columns-begin-marker (point))
(let ((org-columns-time (time-to-number-of-days (current-time)))
beg end fmt cache maxwidths)
(setq fmt (org-columns-get-format-and-top-level))
(org-columns-goto-top-level)
(setq fmt (org-columns-get-format columns-fmt-string))
(save-excursion
(goto-char org-columns-top-level-marker)
(setq beg (point))
@ -700,6 +711,11 @@ around it."
(save-restriction
(narrow-to-region beg end)
(org-clock-sum))))
(when (assoc "CLOCKSUM_T" org-columns-current-fmt-compiled)
(save-excursion
(save-restriction
(narrow-to-region beg end)
(org-clock-sum-today))))
(while (re-search-forward org-outline-regexp-bol end t)
(if (and org-columns-skip-archived-trees
(looking-at (concat ".*:" org-archive-tag ":")))
@ -1014,7 +1030,7 @@ Don't set this, this is meant for dynamic scoping.")
(if (marker-position org-columns-begin-marker)
(goto-char org-columns-begin-marker))
(org-columns-remove-overlays)
(if (eq major-mode 'org-mode)
(if (derived-mode-p 'org-mode)
(call-interactively 'org-columns)
(org-agenda-redo)
(call-interactively 'org-agenda-columns)))
@ -1083,6 +1099,14 @@ Don't set this, this is meant for dynamic scoping.")
(while l
(setq sum (+ (string-to-number (pop l)) (/ sum 60))))
sum))
((string-match (concat "\\([0-9.]+\\) *\\("
(regexp-opt (mapcar 'car org-effort-durations))
"\\)") s)
(setq s (concat "0:" (org-duration-string-to-minutes s t)))
(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))
((memq fmt '(estimate)) (org-string-to-estimate s))
@ -1215,13 +1239,16 @@ PARAMS is a property list of parameters:
:vlines When t, make each column a colgroup to enforce vertical lines.
:maxlevel When set to a number, don't capture headlines below this level.
:skip-empty-rows
When t, skip rows where all specifiers other than ITEM are empty."
When t, skip rows where all specifiers other than ITEM are empty.
:format When non-nil, specify the column view format to use."
(let ((pos (move-marker (make-marker) (point)))
(hlines (plist-get params :hlines))
(vlines (plist-get params :vlines))
(maxlevel (plist-get params :maxlevel))
(content-lines (org-split-string (plist-get params :content) "\n"))
(skip-empty-rows (plist-get params :skip-empty-rows))
(columns-fmt (plist-get params :format))
(case-fold-search t)
tbl id idpos nfields tmp recalc line
id-as-string view-file view-pos)
(when (setq id (plist-get params :id))
@ -1250,7 +1277,7 @@ PARAMS is a property list of parameters:
(save-restriction
(widen)
(goto-char (or view-pos (point)))
(org-columns)
(org-columns columns-fmt)
(setq tbl (org-columns-capture-view maxlevel skip-empty-rows))
(setq nfields (length (car tbl)))
(org-columns-quit))))
@ -1287,7 +1314,7 @@ PARAMS is a property list of parameters:
(while (setq line (pop content-lines))
(when (string-match "^#" line)
(insert "\n" line)
(when (string-match "^[ \t]*#\\+TBLFM" line)
(when (string-match "^[ \t]*#\\+tblfm" line)
(setq recalc t))))
(if recalc
(progn (goto-char pos) (org-table-recalculate 'all))
@ -1337,12 +1364,11 @@ and tailing newline characters."
(org-columns-remove-overlays)
(move-marker org-columns-begin-marker (point))
(let ((org-columns-time (time-to-number-of-days (current-time)))
cache maxwidths m p a d fmt)
cache maxwidths m p a d fmt)
(cond
((and (boundp 'org-agenda-overriding-columns-format)
org-agenda-overriding-columns-format)
(setq fmt org-agenda-overriding-columns-format)
(org-set-local 'org-agenda-overriding-columns-format fmt))
(setq fmt org-agenda-overriding-columns-format))
((setq m (org-get-at-bol 'org-hd-marker))
(setq fmt (or (org-entry-get m "COLUMNS" t)
(with-current-buffer (marker-buffer m)
@ -1370,7 +1396,7 @@ and tailing newline characters."
(setq p (org-entry-properties m))
(when (or (not (setq a (assoc org-effort-property p)))
(not (string-match "\\S-" (or (cdr a) ""))))
(not (string-match "\\S-" (or (cdr a) ""))))
;; OK, the property is not defined. Use appointment duration?
(when (and org-agenda-columns-add-appointments-to-effort-sum
(setq d (get-text-property (point) 'duration)))
@ -1397,8 +1423,9 @@ and tailing newline characters."
"Summarize the summarizable columns in column view in the agenda.
This will add overlays to the date lines, to show the summary for each day."
(let* ((fmt (mapcar (lambda (x)
(if (equal (car x) "CLOCKSUM")
(list "CLOCKSUM" (nth 1 x) (nth 2 x) ":" 'add_times
(if (string-match "CLOCKSUM.*" (car x))
(list (match-string 0 (car x))
(nth 1 x) (nth 2 x) ":" 'add_times
nil '+ nil)
x))
org-columns-current-fmt-compiled))
@ -1485,23 +1512,25 @@ This will add overlays to the date lines, to show the summary for each day."
(goto-char (point-min))
(org-columns-get-format-and-top-level)
(while (setq fm (pop fmt))
(if (equal (car fm) "CLOCKSUM")
(org-clock-sum)
(when (and (nth 4 fm)
(setq a (assoc (car fm)
org-columns-current-fmt-compiled))
(equal (nth 4 a) (nth 4 fm)))
(org-columns-compute (car fm)))))))))))
(cond ((equal (car fm) "CLOCKSUM")
(org-clock-sum))
((equal (car fm) "CLOCKSUM_T")
(org-clock-sum-today))
((and (nth 4 fm)
(setq a (assoc (car fm)
org-columns-current-fmt-compiled))
(equal (nth 4 a) (nth 4 fm)))
(org-columns-compute (car fm)))))))))))
(defun org-format-time-period (interval)
"Convert time in fractional days to days/hours/minutes/seconds."
(if (numberp interval)
(let* ((days (floor interval))
(frac-hours (* 24 (- interval days)))
(hours (floor frac-hours))
(minutes (floor (* 60 (- frac-hours hours))))
(seconds (floor (* 60 (- (* 60 (- frac-hours hours)) minutes)))))
(format "%dd %02dh %02dm %02ds" days hours minutes seconds))
(let* ((days (floor interval))
(frac-hours (* 24 (- interval days)))
(hours (floor frac-hours))
(minutes (floor (* 60 (- frac-hours hours))))
(seconds (floor (* 60 (- (* 60 (- frac-hours hours)) minutes)))))
(format "%dd %02dh %02dm %02ds" days hours minutes seconds))
""))
(defun org-estimate-mean-and-var (v)
@ -1519,10 +1548,10 @@ 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 ((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)))))

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

@ -34,7 +34,6 @@
(require 'org-macs)
(declare-function find-library-name "find-func" (library))
(declare-function w32-focus-frame "term/w32-win" (frame))
;; The following constant is for backward compatibility. We do not use
@ -111,6 +110,7 @@ any other entries, and any resulting duplicates will be removed entirely."
t))
t)))
;;;; Emacs/XEmacs compatibility
;; Keys
@ -326,20 +326,8 @@ Works on both Emacs and XEmacs."
string)
(apply 'propertize string properties)))
(defun org-substring-no-properties (string &optional from to)
(if (featurep 'xemacs)
(org-no-properties (substring string (or from 0) to))
(substring-no-properties string from to)))
(defun org-find-library-name (library)
(if (fboundp 'find-library-name)
(file-name-directory (find-library-name library))
; XEmacs does not have `find-library-name'
(flet ((find-library-name-helper (filename ignored-codesys)
filename)
(find-library-name (library)
(find-library library nil 'find-library-name-helper)))
(file-name-directory (find-library-name library)))))
(defmacro org-find-library-dir (library)
`(file-name-directory (locate-library ,library)))
(defun org-count-lines (s)
"How many lines in string S?"
@ -396,7 +384,7 @@ TIME defaults to the current time."
(save-match-data
(apply 'looking-at args))))
; XEmacs does not have `looking-back'.
; XEmacs does not have `looking-back'.
(if (fboundp 'looking-back)
(defalias 'org-looking-back 'looking-back)
(defun org-looking-back (regexp &optional limit greedy)
@ -436,7 +424,7 @@ With two arguments, return floor and remainder of their quotient."
(let ((q (floor x y)))
(list q (- x (if y (* y q) q)))))
;; `pop-to-buffer-same-window' has been introduced with Emacs 24.1.
;; `pop-to-buffer-same-window' has been introduced in Emacs 24.1.
(defun org-pop-to-buffer-same-window
(&optional buffer-or-name norecord label)
"Pop to buffer specified by BUFFER-OR-NAME in the selected window."
@ -445,6 +433,33 @@ With two arguments, return floor and remainder of their quotient."
'pop-to-buffer-same-window buffer-or-name norecord)
(funcall 'switch-to-buffer buffer-or-name norecord)))
;; `condition-case-unless-debug' has been introduced in Emacs 24.1
;; `condition-case-no-debug' has been introduced in Emacs 23.1
(defalias 'org-condition-case-unless-debug
(or (and (fboundp 'condition-case-unless-debug)
'condition-case-unless-debug)
(and (fboundp 'condition-case-no-debug)
'condition-case-no-debug)
'condition-case))
;;;###autoload
(defmacro org-check-version ()
"Try very hard to provide sensible version strings."
(let* ((org-dir (org-find-library-dir "org"))
(org-version.el (concat org-dir "org-version.el"))
(org-fixup.el (concat org-dir "../mk/org-fixup.el")))
(if (require 'org-version org-version.el 'noerror)
'(progn
(autoload 'org-release "org-version.el")
(autoload 'org-git-version "org-version.el"))
(if (require 'org-fixup org-fixup.el 'noerror)
'(org-fixup)
;; provide fallback definitions and complain
(warn "Could not define org version correctly. Check installation!")
'(progn
(defun org-release () "N/A")
(defun org-git-version () "N/A !!check installation!!"))))))
(provide 'org-compat)
;;; org-compat.el ends here

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

@ -75,7 +75,7 @@
(context plain recipients &optional sign always-trust))
(defgroup org-crypt nil
"Org Crypt"
"Org Crypt."
:tag "Org Crypt"
:group 'org)
@ -111,6 +111,7 @@ nil : Leave auto-save-mode enabled.
NOTE: This only works for entries which have a tag
that matches `org-crypt-tag-matcher'."
:group 'org-crypt
:version "24.1"
:type '(choice (const :tag "Always" t)
(const :tag "Never" nil)
(const :tag "Ask" ask)
@ -129,13 +130,13 @@ See `org-crypt-disable-auto-save'."
(eq org-crypt-disable-auto-save t)
(and
(eq org-crypt-disable-auto-save 'ask)
(y-or-n-p "org-decrypt: auto-save-mode may cause leakage. Disable it for current buffer? ")))
(y-or-n-p "org-decrypt: auto-save-mode may cause leakage. Disable it for current buffer? ")))
(message (concat "org-decrypt: Disabling auto-save-mode for " (or (buffer-file-name) (current-buffer))))
; The argument to auto-save-mode has to be "-1", since
; giving a "nil" argument toggles instead of disabling.
; The argument to auto-save-mode has to be "-1", since
; giving a "nil" argument toggles instead of disabling.
(auto-save-mode -1))
((eq org-crypt-disable-auto-save nil)
(message "org-decrypt: Decrypting entry with auto-save-mode enabled. This may cause leakage."))
(message "org-decrypt: Decrypting entry with auto-save-mode enabled. This may cause leakage."))
((eq org-crypt-disable-auto-save 'encrypt)
(message "org-decrypt: Enabling re-encryption on auto-save.")
(add-hook 'auto-save-hook
@ -221,7 +222,7 @@ See `org-crypt-disable-auto-save'."
;; outline property starts at the \n of the heading.
(delete-region (1- (point)) end)
;; Store a checksum of the decrypted and the encrypted
;; text value. This allow to reuse the same encrypted text
;; text value. This allow to reuse the same encrypted text
;; if the text does not change, and therefore avoid a
;; re-encryption process.
(insert "\n" (propertize decrypted-text
@ -251,6 +252,14 @@ See `org-crypt-disable-auto-save'."
(cdr (org-make-tags-matcher org-crypt-tag-matcher))
todo-only)))
(defun org-at-encrypted-entry-p ()
"Is the current entry encrypted?"
(unless (org-before-first-heading-p)
(save-excursion
(org-back-to-heading t)
(search-forward "-----BEGIN PGP MESSAGE-----"
(save-excursion (org-end-of-subtree t)) t))))
(defun org-crypt-use-before-save-magic ()
"Add a hook to automatically encrypt entries before a file is saved to disk."
(add-hook

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

@ -26,18 +26,18 @@
;; Synopsis
;; ========
;;
;; Allows org-mode to make use of the Emacs `etags' system. Defines tag
;; Allows org-mode to make use of the Emacs `etags' system. Defines tag
;; destinations in org-mode files as any text between <<double angled
;; brackets>>. This allows the tags-generation program `exuberant ctags' to
;; parse these files and create tag tables that record where these
;; destinations are found. Plain [[links]] in org mode files which do not have
;; destinations are found. Plain [[links]] in org mode files which do not have
;; <<matching destinations>> within the same file will then be interpreted as
;; links to these 'tagged' destinations, allowing seamless navigation between
;; multiple org-mode files. Topics can be created in any org mode file and
;; will always be found by plain links from other files. Other file types
;; multiple org-mode files. Topics can be created in any org mode file and
;; will always be found by plain links from other files. Other file types
;; recognized by ctags (source code files, latex files, etc) will also be
;; available as destinations for plain links, and similarly, org-mode links
;; will be available as tags from source files. Finally, the function
;; will be available as tags from source files. Finally, the function
;; `org-ctags-find-tag-interactive' lets you choose any known tag, using
;; autocompletion, and quickly jump to it.
;;
@ -82,25 +82,25 @@
;; =====
;;
;; When you click on a link "[[foo]]" and org cannot find a matching "<<foo>>"
;; in the current buffer, the tags facility will take over. The file TAGS in
;; in the current buffer, the tags facility will take over. The file TAGS in
;; the active directory is examined to see if the tags facility knows about
;; "<<foo>>" in any other files. If it does, the matching file will be opened
;; "<<foo>>" in any other files. If it does, the matching file will be opened
;; and the cursor will jump to the position of "<<foo>>" in that file.
;;
;; User-visible functions:
;; - `org-ctags-find-tag-interactive': type a tag (plain link) name and visit
;; it. With autocompletion. Bound to ctrl-O in the above setup.
;; - All the etags functions should work. These include:
;; it. With autocompletion. Bound to ctrl-O in the above setup.
;; - All the etags functions should work. These include:
;;
;; M-. `find-tag' -- finds the tag at point
;;
;; C-M-. find-tag based on regular expression
;;
;; M-x tags-search RET -- like C-M-. but searches through ENTIRE TEXT
;; of ALL the files referenced in the TAGS file. A quick way to
;; of ALL the files referenced in the TAGS file. A quick way to
;; search through an entire 'project'.
;;
;; M-* "go back" from a tag jump. Like `org-mark-ring-goto'.
;; M-* "go back" from a tag jump. Like `org-mark-ring-goto'.
;; You may need to bind this key yourself with (eg)
;; (global-set-key (kbd "<M-kp-multiply>") 'pop-tag-mark)
;;
@ -116,8 +116,8 @@
;; 1. You re-run (org-ctags-create-tags "directory") to rebuild the file.
;; 2. You put the function `org-ctags-ask-rebuild-tags-file-then-find-tag' in
;; your `org-open-link-functions' list, as is done in the setup
;; above. This will cause the TAGS file to be rebuilt whenever a link
;; cannot be found. This may be slow with large file collections however.
;; above. This will cause the TAGS file to be rebuilt whenever a link
;; cannot be found. This may be slow with large file collections however.
;; 3. You run the following from the command line (all 1 line):
;;
;; ctags --langdef=orgmode --langmap=orgmode:.org
@ -126,7 +126,7 @@
;;
;; If you are paranoid, you might want to run (org-ctags-create-tags
;; "/path/to/org/files") at startup, by including the following toplevel form
;; in .emacs. However this can cause a pause of several seconds if ctags has
;; in .emacs. However this can cause a pause of several seconds if ctags has
;; to scan lots of files.
;;
;; (progn
@ -193,6 +193,7 @@ Created as a local variable in each buffer.")
The following patterns are replaced in the string:
`%t' - replaced with the capitalized title of the hyperlink"
:group 'org-ctags
:version "24.1"
:type 'string)
@ -247,7 +248,7 @@ buffer position where the tag is found."
((re-search-backward " \n\\(.*\\),[0-9]+\n")
(list (match-string 1) line pos))
(t ; can't find a file name preceding the matched
; tag??
; tag??
(error "Malformed TAGS file: %s" (buffer-name))))))
(t ; tag not found
nil))))))
@ -308,7 +309,7 @@ The new topic will be titled NAME (or TITLE if supplied)."
activate compile)
"Before trying to find a tag, save our current position on org mark ring."
(save-excursion
(if (and (eq major-mode 'org-mode) org-ctags-enabled-p)
(if (and (derived-mode-p 'org-mode) org-ctags-enabled-p)
(org-mark-ring-push))))
@ -411,7 +412,7 @@ asked before creating a new file."
(defun org-ctags-append-topic (name &optional narrowp)
"This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS.
Append a new toplevel heading to the end of the current buffer. The
Append a new toplevel heading to the end of the current buffer. The
heading contains NAME surrounded by <<angular brackets>>, thus making
the heading a destination for the tag `NAME'."
(interactive "sTopic: ")
@ -456,12 +457,12 @@ to rebuild (update) the TAGS file."
"This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS.
Wrapper for org-ctags-rebuild-tags-file-then-find-tag."
(if (and (buffer-file-name)
(y-or-n-p
(format
"Tag `%s' not found. Rebuild table `%s/TAGS' and look again?"
name
(file-name-directory (buffer-file-name)))))
(org-ctags-rebuild-tags-file-then-find-tag name)
(y-or-n-p
(format
"Tag `%s' not found. Rebuild table `%s/TAGS' and look again?"
name
(file-name-directory (buffer-file-name)))))
(org-ctags-rebuild-tags-file-then-find-tag name)
nil))
@ -533,7 +534,7 @@ a new topic."
(t
;; New tag
(run-hook-with-args-until-success
'org-open-link-functions tag))))))
'org-open-link-functions tag))))))
(org-ctags-enable)

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

@ -38,6 +38,15 @@ This is normally one, but if the buffer has an entry with a DATE_TREE
property (any value), the date tree will become a subtree under that entry,
so the base level will be properly adjusted.")
(defcustom org-datetree-add-timestamp nil
"When non-nil, add a time stamp when create a datetree entry."
:group 'org-capture
:version "24.3"
:type '(choice
(const :tag "Do not add a time stamp" nil)
(const :tag "Add an inactive time stamp" inactive)
(const :tag "Add an active time stamp" active)))
;;;###autoload
(defun org-datetree-find-date-create (date &optional keep-restriction)
"Find or create an entry for DATE.
@ -63,7 +72,7 @@ tree can be found."
(goto-char (prog1 (point) (widen))))))
(defun org-datetree-find-year-create (year)
(let ((re "^\\*+[ \t]+\\([12][0-9][0-9][0-9]\\)$")
(let ((re "^\\*+[ \t]+\\([12][0-9][0-9][0-9]\\)\\s-*$")
match)
(goto-char (point-min))
(while (and (setq match (re-search-forward re nil t))
@ -119,7 +128,7 @@ tree can be found."
(org-datetree-insert-line year month day)))))
(defun org-datetree-insert-line (year &optional month day)
(let ((pos (point)))
(let ((pos (point)) ts-type)
(skip-chars-backward " \t\n")
(delete-region (point) pos)
(insert "\n" (make-string org-datetree-base-level ?*) " \n")
@ -136,6 +145,10 @@ tree can be found."
(insert (format " %s"
(format-time-string
"%B" (encode-time 0 0 0 1 month year))))))
(when (and day (setq ts-type org-datetree-add-timestamp))
(insert "\n")
(org-indent-line)
(org-insert-time-stamp (encode-time 0 0 0 day month year) nil ts-type))
(beginning-of-line 1)))
(defun org-datetree-file-entry-under (txt date)
@ -155,42 +168,42 @@ before running this command, even though the command tries to be smart."
(let ((dre (concat "\\<" org-deadline-string "\\>[ \t]*\\'"))
(sre (concat "\\<" org-scheduled-string "\\>[ \t]*\\'"))
dct ts tmp date year month day pos hdl-pos)
(while (re-search-forward org-ts-regexp nil t)
(catch 'next
(setq ts (match-string 0))
(setq tmp (buffer-substring
(max (point-at-bol) (- (match-beginning 0)
org-ds-keyword-length))
(match-beginning 0)))
(if (or (string-match "-\\'" tmp)
(string-match dre tmp)
(string-match sre tmp))
(while (re-search-forward org-ts-regexp nil t)
(catch 'next
(setq ts (match-string 0))
(setq tmp (buffer-substring
(max (point-at-bol) (- (match-beginning 0)
org-ds-keyword-length))
(match-beginning 0)))
(if (or (string-match "-\\'" tmp)
(string-match dre tmp)
(string-match sre tmp))
(throw 'next nil))
(setq dct (decode-time (org-time-string-to-time (match-string 0)))
date (list (nth 4 dct) (nth 3 dct) (nth 5 dct))
year (nth 2 date)
month (car date)
day (nth 1 date)
pos (point))
(org-back-to-heading t)
(setq hdl-pos (point))
(unless (org-up-heading-safe)
;; No parent, we are not in a date tree
(goto-char pos)
(throw 'next nil))
(setq dct (decode-time (org-time-string-to-time (match-string 0)))
date (list (nth 4 dct) (nth 3 dct) (nth 5 dct))
year (nth 2 date)
month (car date)
day (nth 1 date)
pos (point))
(org-back-to-heading t)
(setq hdl-pos (point))
(unless (org-up-heading-safe)
;; No parent, we are not in a date tree
(goto-char pos)
(throw 'next nil))
(unless (looking-at "\\*+[ \t]+[0-9]+-[0-1][0-9]-[0-3][0-9]")
;; Parent looks wrong, we are not in a date tree
(goto-char pos)
(throw 'next nil))
(when (looking-at (format "\\*+[ \t]+%d-%02d-%02d" year month day))
;; At correct date already, do nothing
(unless (looking-at "\\*+[ \t]+[0-9]+-[0-1][0-9]-[0-3][0-9]")
;; Parent looks wrong, we are not in a date tree
(goto-char pos)
(throw 'next nil))
(when (looking-at (format "\\*+[ \t]+%d-%02d-%02d" year month day))
;; At correct date already, do nothing
(progn (goto-char pos) (throw 'next nil)))
;; OK, we need to refile this entry
(goto-char hdl-pos)
(org-cut-subtree)
(save-excursion
(save-restriction
(org-datetree-file-entry-under (current-kill 0) date)))))))
;; OK, we need to refile this entry
(goto-char hdl-pos)
(org-cut-subtree)
(save-excursion
(save-restriction
(org-datetree-file-entry-under (current-kill 0) date)))))))
(provide 'org-datetree)

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

@ -163,7 +163,7 @@ avoid same set of footnote IDs being used multiple times."
"A list of DocBook expressions to convert emphasis fontifiers.
Each element of the list is a list of three elements.
The first element is the character used as a marker for fontification.
The second element is a formatting string to wrap fontified text with.
The second element is a format string to wrap fontified text with.
The third element decides whether to protect converted text from other
conversions."
:group 'org-export-docbook
@ -295,7 +295,7 @@ then use this command to convert it."
(interactive "r")
(let (reg docbook buf)
(save-window-excursion
(if (eq major-mode 'org-mode)
(if (derived-mode-p 'org-mode)
(setq docbook (org-export-region-as-docbook
beg end t 'string))
(setq reg (buffer-substring beg end)
@ -629,7 +629,7 @@ publishing directory."
(insert org-export-docbook-doctype))
(insert "<!-- Date: " date " -->\n")
(insert (format "<!-- DocBook XML file generated by Org-mode %s Emacs %s -->\n"
org-version emacs-major-version))
(org-version) emacs-major-version))
(insert org-export-docbook-article-header)
(insert (format
"\n <title>%s</title>
@ -1018,11 +1018,11 @@ publishing directory."
(t
;; This line either is list item or end a list.
(when (when (get-text-property 0 'list-item line)
(setq line (org-export-docbook-list-line
line
(get-text-property 0 'list-item line)
(get-text-property 0 'list-struct line)
(get-text-property 0 'list-prevs line)))))
(setq line (org-export-docbook-list-line
line
(get-text-property 0 'list-item line)
(get-text-property 0 'list-struct line)
(get-text-property 0 'list-prevs line)))))
;; Empty lines start a new paragraph. If hand-formatted lists
;; are not fully interpreted, lines starting with "-", "+", "*"
@ -1066,7 +1066,7 @@ publishing directory."
(if (eq major-mode (default-value 'major-mode))
(nxml-mode)))
;; Remove empty paragraphs. Replace them with a newline.
;; Remove empty paragraphs. Replace them with a newline.
(goto-char (point-min))
(while (re-search-forward
"[ \r\n\t]*\\(<para>\\)[ \r\n\t]*</para>[ \r\n\t]*" nil t)
@ -1355,10 +1355,10 @@ that need to be preserved in later phase of DocBook exporting."
(concat replaced line)))
(defun org-export-docbook-list-line (line pos struct prevs)
"Insert list syntax in export buffer. Return LINE, maybe modified.
"Insert list syntax in export buffer. Return LINE, maybe modified.
POS is the item position or line position the line had before
modifications to buffer. STRUCT is the list structure. PREVS is
modifications to buffer. STRUCT is the list structure. PREVS is
the alist of previous items."
(let* ((get-type
(function

4356
lisp/org/org-element.el Normal file
View file

File diff suppressed because it is too large Load diff

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

@ -252,7 +252,7 @@ loaded, add these packages to `org-export-latex-packages-alist'."
"* Other"
"** Misc. (often used)"
("circ" "\\circ" t "&circ;" "^" "^" "ˆ")
("circ" "\\^{}" nil "&circ;" "^" "^" "ˆ")
("vert" "\\vert{}" t "&#124;" "|" "|" "|")
("brvbar" "\\textbrokenbar{}" nil "&brvbar;" "|" "¦" "¦")
("sect" "\\S" nil "&sect;" "paragraph" "§" "§")
@ -260,6 +260,11 @@ loaded, add these packages to `org-export-latex-packages-alist'."
("lt" "\\textless{}" nil "&lt;" "<" "<" "<")
("gt" "\\textgreater{}" nil "&gt;" ">" ">" ">")
("tilde" "\\~{}" nil "&tilde;" "~" "~" "~")
("slash" "/" nil "/" "/" "/" "/")
("plus" "+" nil "+" "+" "+" "+")
("under" "\\_" nil "_" "_" "_" "_")
("equal" "=" nil "=" "=" "=" "=")
("asciicirc" "\\textasciicircum{}" nil "^" "^" "^" "^")
("dagger" "\\textdagger{}" nil "&dagger;" "[dagger]" "[dagger]" "†")
("Dagger" "\\textdaggerdbl{}" nil "&Dagger;" "[doubledagger]" "[doubledagger]" "‡")
@ -492,34 +497,31 @@ Kind can be any of `latex', `html', `ascii', `latin1', or `utf8'."
;; Helpfunctions to create a table for orgmode.org/worg/org-symbols.org
(defun org-entities-create-table ()
"Create an org-mode table with all entities."
"Create an Org mode table with all entities."
(interactive)
(let ((ll org-entities)
(pos (point))
e latex mathp html latin utf8 name ascii)
(let ((pos (point)) e latex mathp html latin utf8 name ascii)
(insert "|Name|LaTeX code|LaTeX|HTML code |HTML|ASCII|Latin1|UTF-8\n|-\n")
(while ll
(when (listp e)
(setq e (pop ll))
(setq name (car e)
latex (nth 1 e)
mathp (nth 2 e)
html (nth 3 e)
ascii (nth 4 e)
latin (nth 5 e)
utf8 (nth 6 e))
(if (equal ascii "|") (setq ascii "\\vert"))
(if (equal latin "|") (setq latin "\\vert"))
(if (equal utf8 "|") (setq utf8 "\\vert"))
(if (equal ascii "=>") (setq ascii "= >"))
(if (equal latin "=>") (setq latin "= >"))
(insert "|" name
"|" (format "=%s=" latex)
"|" (format (if mathp "$%s$" "$\\mbox{%s}$")
latex)
"|" (format "=%s=" html) "|" html
"|" ascii "|" latin "|" utf8
"|\n")))
(mapc (lambda (e) (when (listp e)
(setq name (car e)
latex (nth 1 e)
mathp (nth 2 e)
html (nth 3 e)
ascii (nth 4 e)
latin (nth 5 e)
utf8 (nth 6 e))
(if (equal ascii "|") (setq ascii "\\vert"))
(if (equal latin "|") (setq latin "\\vert"))
(if (equal utf8 "|") (setq utf8 "\\vert"))
(if (equal ascii "=>") (setq ascii "= >"))
(if (equal latin "=>") (setq latin "= >"))
(insert "|" name
"|" (format "=%s=" latex)
"|" (format (if mathp "$%s$" "$\\mbox{%s}$")
latex)
"|" (format "=%s=" html) "|" html
"|" ascii "|" latin "|" utf8
"|\n")))
org-entities)
(goto-char pos)
(org-table-align)))

20
lisp/org/org-eshell.el
View file

@ -37,18 +37,18 @@
followed by a colon."
(let* ((buffer-and-command
(if (string-match "\\([A-Za-z0-9-+*]+\\):\\(.*\\)" link)
(list (match-string 1 link)
(match-string 2 link))
(list (match-string 1 link)
(match-string 2 link))
(list eshell-buffer-name link)))
(eshell-buffer-name (car buffer-and-command))
(command (cadr buffer-and-command)))
(if (get-buffer eshell-buffer-name)
(org-pop-to-buffer-same-window eshell-buffer-name)
(eshell))
(goto-char (point-max))
(eshell-kill-input)
(insert command)
(eshell-send-input)))
(if (get-buffer eshell-buffer-name)
(org-pop-to-buffer-same-window eshell-buffer-name)
(eshell))
(goto-char (point-max))
(eshell-kill-input)
(insert command)
(eshell-send-input)))
(defun org-eshell-store-link ()
"Store a link that, when opened, switches back to the current eshell buffer
@ -57,7 +57,7 @@
(let* ((command (concat "cd " dired-directory))
(link (concat (buffer-name) ":" command)))
(org-store-link-props
:link (org-make-link "eshell:" link)
:link (concat "eshell:" link)
:description command))))
(provide 'org-eshell)

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

@ -72,8 +72,13 @@
(eval-when-compile
(require 'cl))
(require 'org)
(require 'find-func)
(require 'org-compat)
(declare-function org-split-string "org" (string &optional separators))
(declare-function org-remove-indentation "org" (code &optional n))
(defvar org-protecting-blocks nil) ; From org.el
(defun org-export-blocks-set (var value)
"Set the value of `org-export-blocks' and install fontification."
@ -142,7 +147,6 @@ export function should accept three arguments."
(defun org-export-blocks-html-quote (body &optional open close)
"Protect BODY from org html export.
The optional OPEN and CLOSE tags will be inserted around BODY."
(concat
"\n#+BEGIN_HTML\n"
(or open "")
@ -160,6 +164,7 @@ The optional OPEN and CLOSE tags will be inserted around BODY."
(or close "")
"#+END_LaTeX\n"))
(defvar org-src-preserve-indentation) ; From org-src.el
(defun org-export-blocks-preprocess ()
"Export all blocks according to the `org-export-blocks' block export alist.
Does not export block types specified in specified in BLOCKS
@ -167,65 +172,70 @@ which defaults to the value of `org-export-blocks-witheld'."
(interactive)
(save-window-excursion
(let ((case-fold-search t)
(types '())
matched indentation type func
(interblock (lambda (start end)
(mapcar (lambda (pair) (funcall (second pair) start end))
org-export-interblocks)))
matched indentation type types func
start end body headers preserve-indent progress-marker)
(flet ((interblock (start end)
(mapcar (lambda (pair) (funcall (second pair) start end))
org-export-interblocks)))
(goto-char (point-min))
(setq start (point))
(let ((beg-re "^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]"))
(while (re-search-forward beg-re nil t)
(let* ((match-start (copy-marker (match-beginning 0)))
(body-start (copy-marker (match-end 0)))
(indentation (length (match-string 1)))
(inner-re (format "^[ \t]*#\\+\\(begin\\|end\\)_%s"
(regexp-quote (downcase (match-string 2)))))
(type (intern (downcase (match-string 2))))
(headers (save-match-data
(org-split-string (match-string 3) "[ \t]+")))
(balanced 1)
(preserve-indent (or org-src-preserve-indentation
(member "-i" headers)))
match-end)
(while (and (not (zerop balanced))
(re-search-forward inner-re nil t))
(if (string= (downcase (match-string 1)) "end")
(decf balanced)
(incf balanced)))
(when (not (zerop balanced))
(error "unbalanced begin/end_%s blocks with %S"
type (buffer-substring match-start (point))))
(setq match-end (copy-marker (match-end 0)))
(unless preserve-indent
(setq body (save-match-data (org-remove-indentation
(buffer-substring
body-start (match-beginning 0))))))
(unless (memq type types) (setq types (cons type types)))
(save-match-data (interblock start match-start))
(when (setq func (cadr (assoc type org-export-blocks)))
(let ((replacement (save-match-data
(if (memq type org-export-blocks-witheld) ""
(apply func body headers)))))
(when replacement
(delete-region match-start match-end)
(goto-char match-start) (insert replacement)
(if preserve-indent
;; indent only the code block markers
(save-excursion
(indent-line-to indentation) ; indent end_block
(goto-char match-start)
(indent-line-to indentation)) ; indent begin_block
;; indent everything
(indent-code-rigidly match-start (point) indentation)))))
;; cleanup markers
(set-marker match-start nil)
(set-marker body-start nil)
(set-marker match-end nil))
(setq start (point))))
(interblock start (point-max))
(run-hooks 'org-export-blocks-postblock-hook)))))
(goto-char (point-min))
(setq start (point))
(let ((beg-re "^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]"))
(while (re-search-forward beg-re nil t)
(let* ((match-start (copy-marker (match-beginning 0)))
(body-start (copy-marker (match-end 0)))
(indentation (length (match-string 1)))
(inner-re (format "^[ \t]*#\\+\\(begin\\|end\\)_%s"
(regexp-quote (downcase (match-string 2)))))
(type (intern (downcase (match-string 2))))
(headers (save-match-data
(org-split-string (match-string 3) "[ \t]+")))
(balanced 1)
(preserve-indent (or org-src-preserve-indentation
(member "-i" headers)))
match-end)
(while (and (not (zerop balanced))
(re-search-forward inner-re nil t))
(if (string= (downcase (match-string 1)) "end")
(decf balanced)
(incf balanced)))
(when (not (zerop balanced))
(error "Unbalanced begin/end_%s blocks with %S"
type (buffer-substring match-start (point))))
(setq match-end (copy-marker (match-end 0)))
(unless preserve-indent
(setq body (save-match-data (org-remove-indentation
(buffer-substring
body-start (match-beginning 0))))))
(unless (memq type types) (setq types (cons type types)))
(save-match-data (funcall interblock start match-start))
(when (setq func (cadr (assoc type org-export-blocks)))
(let ((replacement (save-match-data
(if (memq type org-export-blocks-witheld) ""
(apply func body headers)))))
;; ;; un-comment this code after the org-element merge
;; (save-match-data
;; (when (and replacement (string= replacement ""))
;; (delete-region
;; (car (org-element-collect-affiliated-keyword))
;; match-start)))
(when replacement
(delete-region match-start match-end)
(goto-char match-start) (insert replacement)
(if preserve-indent
;; indent only the code block markers
(save-excursion
(indent-line-to indentation) ; indent end_block
(goto-char match-start)
(indent-line-to indentation)) ; indent begin_block
;; indent everything
(indent-code-rigidly match-start (point) indentation)))))
;; cleanup markers
(set-marker match-start nil)
(set-marker body-start nil)
(set-marker match-end nil))
(setq start (point))))
(funcall interblock start (point-max))
(run-hooks 'org-export-blocks-postblock-hook))))
;;================================================================================
;; type specific functions
@ -233,14 +243,14 @@ which defaults to the value of `org-export-blocks-witheld'."
;;--------------------------------------------------------------------------------
;; ditaa: create images from ASCII art using the ditaa utility
(defcustom org-ditaa-jar-path (expand-file-name
"ditaa.jar"
(file-name-as-directory
(expand-file-name
"scripts"
(file-name-as-directory
(expand-file-name
"../contrib"
(file-name-directory (find-library-name "org")))))))
"ditaa.jar"
(file-name-as-directory
(expand-file-name
"scripts"
(file-name-as-directory
(expand-file-name
"../contrib"
(file-name-directory (org-find-library-dir "org")))))))
"Path to the ditaa jar executable."
:group 'org-babel
:type 'string)
@ -273,29 +283,29 @@ passed to the ditaa utility as command line arguments."
(org-split-string body "\n")
"\n")))
(prog1
(cond
((member org-export-current-backend '(html latex docbook))
(unless (file-exists-p out-file)
(mapc ;; remove old hashed versions of this file
(lambda (file)
(when (and (string-match (concat (regexp-quote (car out-file-parts))
"_\\([[:alnum:]]+\\)\\."
(regexp-quote (cdr out-file-parts)))
file)
(= (length (match-string 1 out-file)) 40))
(delete-file (expand-file-name file
(file-name-directory out-file)))))
(directory-files (or (file-name-directory out-file)
default-directory)))
(with-temp-file data-file (insert body))
(message (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file))
(shell-command (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file)))
(format "\n[[file:%s]]\n" out-file))
(t (concat
"\n#+BEGIN_EXAMPLE\n"
body (if (string-match "\n$" body) "" "\n")
"#+END_EXAMPLE\n")))
(message "begin_ditaa blocks are DEPRECATED, use begin_src blocks"))))
(cond
((member org-export-current-backend '(html latex docbook))
(unless (file-exists-p out-file)
(mapc ;; remove old hashed versions of this file
(lambda (file)
(when (and (string-match (concat (regexp-quote (car out-file-parts))
"_\\([[:alnum:]]+\\)\\."
(regexp-quote (cdr out-file-parts)))
file)
(= (length (match-string 1 out-file)) 40))
(delete-file (expand-file-name file
(file-name-directory out-file)))))
(directory-files (or (file-name-directory out-file)
default-directory)))
(with-temp-file data-file (insert body))
(message (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file))
(shell-command (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file)))
(format "\n[[file:%s]]\n" out-file))
(t (concat
"\n#+BEGIN_EXAMPLE\n"
body (if (string-match "\n$" body) "" "\n")
"#+END_EXAMPLE\n")))
(message "begin_ditaa blocks are DEPRECATED, use begin_src blocks"))))
;;--------------------------------------------------------------------------------
;; dot: create graphs using the dot graphing language
@ -332,29 +342,29 @@ digraph data_relationships {
(cons raw-out-file "png")))
(out-file (concat (car out-file-parts) "_" hash "." (cdr out-file-parts))))
(prog1
(cond
((member org-export-current-backend '(html latex docbook))
(unless (file-exists-p out-file)
(mapc ;; remove old hashed versions of this file
(lambda (file)
(when (and (string-match (concat (regexp-quote (car out-file-parts))
"_\\([[:alnum:]]+\\)\\."
(regexp-quote (cdr out-file-parts)))
file)
(= (length (match-string 1 out-file)) 40))
(delete-file (expand-file-name file
(file-name-directory out-file)))))
(directory-files (or (file-name-directory out-file)
default-directory)))
(with-temp-file data-file (insert body))
(message (concat "dot " data-file " " args " -o " out-file))
(shell-command (concat "dot " data-file " " args " -o " out-file)))
(format "\n[[file:%s]]\n" out-file))
(t (concat
"\n#+BEGIN_EXAMPLE\n"
body (if (string-match "\n$" body) "" "\n")
"#+END_EXAMPLE\n")))
(message "begin_dot blocks are DEPRECATED, use begin_src blocks"))))
(cond
((member org-export-current-backend '(html latex docbook))
(unless (file-exists-p out-file)
(mapc ;; remove old hashed versions of this file
(lambda (file)
(when (and (string-match (concat (regexp-quote (car out-file-parts))
"_\\([[:alnum:]]+\\)\\."
(regexp-quote (cdr out-file-parts)))
file)
(= (length (match-string 1 out-file)) 40))
(delete-file (expand-file-name file
(file-name-directory out-file)))))
(directory-files (or (file-name-directory out-file)
default-directory)))
(with-temp-file data-file (insert body))
(message (concat "dot " data-file " " args " -o " out-file))
(shell-command (concat "dot " data-file " " args " -o " out-file)))
(format "\n[[file:%s]]\n" out-file))
(t (concat
"\n#+BEGIN_EXAMPLE\n"
body (if (string-match "\n$" body) "" "\n")
"#+END_EXAMPLE\n")))
(message "begin_dot blocks are DEPRECATED, use begin_src blocks"))))
;;--------------------------------------------------------------------------------
;; comment: export comments in author-specific css-stylable divs

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

@ -1,4 +1,4 @@
;;; org-exp.el --- ASCII, HTML, XOXO and iCalendar export for Org-mode
;;; org-exp.el --- Export internals for Org-mode
;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
@ -190,16 +190,31 @@ This option can also be set with the +OPTIONS line, e.g. \"-:nil\"."
("eo" "A&#365;toro" "Dato" "Enhavo" "Piednotoj")
("es" "Autor" "Fecha" "&Iacute;ndice" "Pies de p&aacute;gina")
("fi" "Tekij&auml;" "P&auml;iv&auml;m&auml;&auml;r&auml;" "Sis&auml;llysluettelo" "Alaviitteet")
("fr" "Auteur" "Date" "Table des mati&egrave;res" "Notes de bas de page")
("fr" "Auteur" "Date" "Sommaire" "Notes de bas de page")
("hu" "Szerz&otilde;" "D&aacute;tum" "Tartalomjegyz&eacute;k" "L&aacute;bjegyzet")
("is" "H&ouml;fundur" "Dagsetning" "Efnisyfirlit" "Aftanm&aacute;lsgreinar")
("it" "Autore" "Data" "Indice" "Note a pi&egrave; di pagina")
;; Use numeric character entities for proper rendering of non-UTF8 documents
;; ("ja" "著者" "日付" "目次" "脚注")
("ja" "&#33879;&#32773;" "&#26085;&#20184;" "&#30446;&#27425;" "&#33050;&#27880;")
("nl" "Auteur" "Datum" "Inhoudsopgave" "Voetnoten")
("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&#x015b;ci" "Przypis")
("sv" "F&ouml;rfattare" "Datum" "Inneh&aring;ll" "Fotnoter"))
;; Use numeric character entities for proper rendering of non-UTF8 documents
;; ("ru" "Автор" "Дата" "Содержание" "Сноски")
("ru" "&#1040;&#1074;&#1090;&#1086;&#1088;" "&#1044;&#1072;&#1090;&#1072;" "&#1057;&#1086;&#1076;&#1077;&#1088;&#1078;&#1072;&#1085;&#1080;&#1077;" "&#1057;&#1085;&#1086;&#1089;&#1082;&#1080;")
("sv" "F&ouml;rfattare" "Datum" "Inneh&aring;ll" "Fotnoter")
;; Use numeric character entities for proper rendering of non-UTF8 documents
;; ("uk" "Автор" "Дата" "Зміст" "Примітки")
("uk" "&#1040;&#1074;&#1090;&#1086;&#1088;" "&#1044;&#1072;&#1090;&#1072;" "&#1047;&#1084;&#1110;&#1089;&#1090;" "&#1055;&#1088;&#1080;&#1084;&#1110;&#1090;&#1082;&#1080;")
;; Use numeric character entities for proper rendering of non-UTF8 documents
;; ("zh-CN" "作者" "日期" "目录" "脚注")
("zh-CN" "&#20316;&#32773;" "&#26085;&#26399;" "&#30446;&#24405;" "&#33050;&#27880;")
;; Use numeric character entities for proper rendering of non-UTF8 documents
;; ("zh-TW" "作者" "日期" "目錄" "腳註")
("zh-TW" "&#20316;&#32773;" "&#26085;&#26399;" "&#30446;&#37636;" "&#33139;&#35387;"))
"Terms used in export text, translated to different languages.
Use the variable `org-export-default-language' to set the language,
or use the +OPTION lines for a per-file setting."
@ -525,12 +540,14 @@ This option can also be set with the +OPTIONS line, e.g. \"LaTeX:mathjax\".
Allowed values are:
nil Don't do anything.
verbatim Keep everything 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.
nil Don't do anything.
verbatim Keep everything in verbatim
dvipng Process the LaTeX fragments to images.
This will also include processing of non-math environments.
imagemagick Convert the LaTeX fragments to pdf files and use imagemagick
to convert pdf files to png files.
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."
@ -540,6 +557,7 @@ is not available on all systems."
(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 imagemagick to make images" imagemagick)
(const :tag "Use MathJax to display math" mathjax)
(const :tag "Leave math verbatim" verbatim)))
@ -623,7 +641,7 @@ table.el tables."
(defvar org-export-current-backend nil
"During export, this will be bound to a symbol such as 'html,
'latex, 'docbook, 'ascii, etc, indicating which of the export
backends is in use. Otherwise it has the value nil. Users
backends is in use. Otherwise it has the value nil. Users
should not attempt to change the value of this variable
directly, but it can be used in code to test whether export is
in progress, and if so, what the backend is.")
@ -702,7 +720,7 @@ Each element is a list of 3 items:
2. The string that can be used in the OPTION lines to set this option,
or nil if this option cannot be changed in this way
3. The customization variable that sets the default for this option."
)
)
(defun org-default-export-plist ()
"Return the property list with default settings for the export variables."
@ -713,8 +731,7 @@ Each element is a list of 3 items:
(setq s (nth 2 e)
v (cond
((assq s letbind) (nth 1 (assq s letbind)))
((boundp s) (symbol-value s))
(t nil))
((boundp s) (symbol-value s)))
rtn (cons (car e) (cons v rtn))))
rtn))
@ -957,6 +974,8 @@ Pressing `1' will switch between these two options."
(let* ((bg (org-xor (equal arg '(16)) org-export-run-in-background))
(subtree-p (or (org-region-active-p)
(eq org-export-initial-scope 'subtree)))
(regb (and (org-region-active-p) (region-beginning)))
(rege (and (org-region-active-p) (region-end)))
(help "[t] insert the export option template
\[v] limit export to visible part of outline tree
\[1] switch buffer/subtree export
@ -1037,6 +1056,10 @@ Pressing `1' will switch between these two options."
((not subtree-p)
(setq subtree-p t)
(setq bpos (point))
(org-mark-subtree)
(org-activate-mark)
(setq regb (and (org-region-active-p) (region-beginning)))
(setq rege (and (org-region-active-p) (region-end)))
(message "Export subtree: "))))
(when (eq r1 ?\ )
(let ((case-fold-search t)
@ -1074,8 +1097,9 @@ Pressing `1' will switch between these two options."
"-f" (symbol-name (nth 1 ass)))))
(set-process-sentinel p 'org-export-process-sentinel)
(message "Background process \"%s\": started" p))
;; background processing not requested, or not possible
(if subtree-p (progn (org-mark-subtree) (org-activate-mark)))
;; set the mark correctly when exporting a subtree
(if subtree-p (let (deactivate-mark) (push-mark rege t t) (goto-char regb)))
(call-interactively (nth 1 ass))
(when (and bpos (get-buffer-window cbuf))
(let ((cw (selected-window)))
@ -1184,7 +1208,7 @@ on this string to produce the exported version."
(when (plist-get parameters :footnotes)
(org-footnote-normalize nil parameters))
;; Change lists ending. Other parts of export may insert blank
;; Change lists ending. Other parts of export may insert blank
;; lines and lists' structure could be altered.
(org-export-mark-list-end)
@ -1300,11 +1324,8 @@ on this string to produce the exported version."
;; Remove or replace comments
(org-export-handle-comments (plist-get parameters :comments))
;; Remove #+TBLFM and #+TBLNAME lines
(org-export-handle-table-metalines)
;; Remove #+results and #+name lines
(org-export-res/src-name-cleanup)
;; Remove #+TBLFM #+TBLNAME #+NAME #+RESULTS lines
(org-export-handle-metalines)
;; Run the final hook
(run-hooks 'org-export-preprocess-final-hook)
@ -1406,53 +1427,53 @@ the current file."
(goto-char (point-min))
(while (re-search-forward org-bracket-link-regexp nil t)
(org-if-unprotected-at (1+ (match-beginning 0))
(let* ((org-link-search-must-match-exact-headline t)
(md (match-data))
(desc (match-end 2))
(link (org-link-unescape (match-string 1)))
(slink (org-solidify-link-text link))
found props pos cref
(target
(cond
((= (string-to-char link) ?#)
;; user wants exactly this link
link)
((cdr (assoc slink target-alist))
(or (cdr (assoc (assoc slink target-alist)
org-export-preferred-target-alist))
(cdr (assoc slink target-alist))))
((and (string-match "^id:" link)
(cdr (assoc (substring link 3) target-alist))))
((string-match "^(\\(.*\\))$" link)
(setq cref (match-string 1 link))
(concat "coderef:" cref))
((string-match org-link-types-re link) nil)
((or (file-name-absolute-p link)
(string-match "^\\." link))
nil)
(t
(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-at-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))
(setq props (text-properties-at (point)))
(delete-region (match-beginning 1) (match-end 1))
(setq pos (point))
(insert target)
(unless desc (insert "][" link))
(add-text-properties pos (point) props))))))
(let* ((org-link-search-must-match-exact-headline t)
(md (match-data))
(desc (match-end 2))
(link (org-link-unescape (match-string 1)))
(slink (org-solidify-link-text link))
found props pos cref
(target
(cond
((= (string-to-char link) ?#)
;; user wants exactly this link
link)
((cdr (assoc slink target-alist))
(or (cdr (assoc (assoc slink target-alist)
org-export-preferred-target-alist))
(cdr (assoc slink target-alist))))
((and (string-match "^id:" link)
(cdr (assoc (substring link 3) target-alist))))
((string-match "^(\\(.*\\))$" link)
(setq cref (match-string 1 link))
(concat "coderef:" cref))
((string-match org-link-types-re link) nil)
((or (file-name-absolute-p link)
(string-match "^\\." link))
nil)
(t
(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-at-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))
(setq props (text-properties-at (point)))
(delete-region (match-beginning 1) (match-end 1))
(setq pos (point))
(insert target)
(unless desc (insert "][" link))
(add-text-properties pos (point) props))))))
(defun org-export-remember-html-container-classes ()
"Store the HTML_CONTAINER_CLASS properties in a text property."
@ -1462,8 +1483,10 @@ the current file."
"^[ \t]*:HTML_CONTAINER_CLASS:[ \t]+\\(.+\\)$" nil t)
(setq class (match-string 1))
(save-excursion
(org-back-to-heading t)
(put-text-property (point-at-bol) (point-at-eol) 'html-container-class class)))))
(when (re-search-backward "^\\*" (point-min) t)
(org-back-to-heading t)
(put-text-property (point-at-bol) (point-at-eol)
'html-container-class class))))))
(defvar org-export-format-drawer-function nil
"Function to be called to format the contents of a drawer.
@ -1532,8 +1555,8 @@ removed as well."
select-tags "\\|")
"\\):"))
(re-excl (concat ":\\(" (mapconcat 'regexp-quote
exclude-tags "\\|")
"\\):"))
exclude-tags "\\|")
"\\):"))
beg end cont)
(goto-char (point-min))
(when (and select-tags
@ -1594,8 +1617,8 @@ When it is a list of strings, keep only tasks with these TODO keywords."
org-todo-keywords-1))))
"\\|")
"\\)\\($\\|[ \t]\\)"))
(case-fold-search nil)
beg)
(case-fold-search nil)
beg)
(goto-char (point-min))
(while (re-search-forward re nil t)
(org-if-unprotected
@ -1741,7 +1764,7 @@ from the buffer."
(add-text-properties
(point-at-bol) (min (1+ (point-at-eol)) (point-max))
`(org-protected t original-indentation ,ind org-native-text t)))))
;; Delete #+ATTR_BACKEND: stuff of another backend. Those
;; Delete #+ATTR_BACKEND: stuff of another backend. Those
;; matching the current backend will be taken care of by
;; `org-export-attach-captions-and-attributes'
(goto-char (point-min))
@ -1819,9 +1842,9 @@ These special cookies will later be interpreted by the backend."
(replace-match ""))
(unless (bolp) (insert "\n"))
;; As org-list-end is inserted at column 0, it would end
;; by indentation any list. It can be problematic when
;; by indentation any list. It can be problematic when
;; there are lists within lists: the inner list end would
;; also become the outer list end. To avoid this, text
;; also become the outer list end. To avoid this, text
;; property `original-indentation' is added, as
;; `org-list-struct' pays attention to it when reading a
;; list.
@ -1838,7 +1861,7 @@ These special properties will later be interpreted by the backend."
;; Mark a list with 3 properties: `list-item' which is
;; position at beginning of line, `list-struct' which is
;; list structure, and `list-prevs' which is the alist of
;; item and its predecessor. Leave point at list ending.
;; item and its predecessor. Leave point at list ending.
(lambda (ctxt)
(let* ((struct (org-list-struct))
(top (org-list-get-top-point struct))
@ -1866,9 +1889,9 @@ These special properties will later be interpreted by the backend."
'list-struct struct
'list-prevs prevs)))
poi)
;; Take care of bottom point. As babel may have inserted
;; Take care of bottom point. As babel may have inserted
;; a new list in buffer, list ending isn't always
;; marked. Now mark every list ending and add properties
;; marked. Now mark every list ending and add properties
;; useful to line processing exporters.
(goto-char bottom)
(when (or (looking-at "^ORG-LIST-END-MARKER\n")
@ -1878,8 +1901,8 @@ These special properties will later be interpreted by the backend."
(unless (bolp) (insert "\n"))
(insert
(org-add-props "ORG-LIST-END-MARKER\n" (list 'list-item bottom
'list-struct struct
'list-prevs prevs)))
'list-struct struct
'list-prevs prevs)))
;; Following property is used by LaTeX exporter.
(add-text-properties top (point) (list 'list-context ctxt)))))))
;; Mark lists except for backends not interpreting them.
@ -1971,29 +1994,33 @@ table line. If it is a link, add it to the line containing the link."
"Remove comments, or convert to backend-specific format.
ORG-COMMENTSP can be a format string for publishing comments.
When it is nil, all comments will be removed."
(let ((re "^\\(#\\|[ \t]*#\\+ \\)\\(.*\n?\\)")
pos)
(let ((re "^[ \t]*#\\( \\|$\\)"))
(goto-char (point-min))
(while (or (looking-at re)
(re-search-forward re nil t))
(setq pos (match-beginning 0))
(if (get-text-property pos 'org-protected)
(goto-char (1+ pos))
(if (and org-commentsp
(not (equal (char-before (match-end 1)) ?+)))
(progn (add-text-properties
(match-beginning 0) (match-end 0) '(org-protected t))
(replace-match (org-add-props
(format org-commentsp (match-string 2))
nil 'org-protected t)
t t))
(goto-char (1+ pos))
(replace-match "")
(goto-char (max (point-min) (1- pos))))))))
(while (re-search-forward re nil t)
(let ((pos (match-beginning 0))
(end (progn (forward-line) (point))))
(if (get-text-property pos 'org-protected)
(forward-line)
(if (not org-commentsp) (delete-region pos end)
(add-text-properties pos end '(org-protected t))
(replace-match
(org-add-props
(format org-commentsp (buffer-substring (match-end 0) end))
nil 'org-protected t)
t t)))))
;; Hack attack: previous implementation also removed keywords at
;; column 0. Brainlessly do it again.
(goto-char (point-min))
(while (re-search-forward "^#\\+" nil t)
(unless (get-text-property (point-at-bol) 'org-protected)
(delete-region (point-at-bol) (progn (forward-line) (point)))))))
(defun org-export-handle-table-metalines ()
"Remove table specific metalines #+TBLNAME: and #+TBLFM:."
(let ((re "^[ \t]*#\\+TBL\\(NAME\\|FM\\):\\(.*\n?\\)")
(defun org-export-handle-metalines ()
"Remove tables and source blocks metalines.
This function should only be called after all block processing
has taken place."
(let ((re "^[ \t]*#\\+\\(tbl\\(?:name\\|fm\\)\\|results\\(?:\\[[a-z0-9]+\\]\\)?\\|name\\):\\(.*\n?\\)")
(case-fold-search t)
pos)
(goto-char (point-min))
(while (or (looking-at re)
@ -2005,18 +2032,6 @@ When it is nil, all comments will be removed."
(replace-match "")
(goto-char (max (point-min) (1- pos)))))))
(defun org-export-res/src-name-cleanup ()
"Clean up #+results and #+name lines for export.
This function should only be called after all block processing
has taken place."
(interactive)
(save-excursion
(goto-char (point-min))
(let ((case-fold-search t))
(while (org-re-search-forward-unprotected
"#\\+\\(name\\|results\\(\\[[a-z0-9]+\\]\\)?\\):" nil t)
(delete-region (match-beginning 0) (progn (forward-line) (point)))))))
(defun org-export-mark-radio-links ()
"Find all matches for radio targets and turn them into internal links."
(let ((re-radio (and org-target-link-regexp
@ -2146,8 +2161,8 @@ can work correctly."
(goto-char (point-min))
(while (re-search-forward "\\(\\(\\[\\|\\]\\)\\[[^]]*?\\)[ \t]*\n[ \t]*\\([^]]*\\]\\(\\[\\|\\]\\)\\)" nil t)
(org-if-unprotected-at (match-beginning 1)
(replace-match "\\1 \\3")
(goto-char (match-beginning 0)))))
(replace-match "\\1 \\3")
(goto-char (match-beginning 0)))))
(defun org-export-concatenate-multiline-emphasis ()
"Find multi-line emphasis and put it all into a single line.
@ -2372,7 +2387,7 @@ TYPE must be a string, any of:
(if (stringp val) val (format "%s" val))
"\n")
(concat "\n" ind-str)))))
;; Eventually do the replacement, if VAL isn't nil. Move
;; Eventually do the replacement, if VAL isn't nil. Move
;; point at beginning of macro for recursive expansions.
(when val
(replace-match val t t)
@ -2391,13 +2406,14 @@ TYPE must be a string, any of:
(defun org-export-handle-include-files ()
"Include the contents of include files, with proper formatting."
(let ((case-fold-search t)
params file markup lang start end prefix prefix1 switches all minlevel lines)
params file markup lang start end prefix prefix1 switches all minlevel currentlevel addlevel lines)
(goto-char (point-min))
(while (re-search-forward "^#\\+INCLUDE:?[ \t]+\\(.*\\)" nil t)
(while (re-search-forward "^#\\+include:[ \t]+\\(.*\\)" nil t)
(setq params (read (concat "(" (match-string 1) ")"))
prefix (org-get-and-remove-property 'params :prefix)
prefix1 (org-get-and-remove-property 'params :prefix1)
minlevel (org-get-and-remove-property 'params :minlevel)
addlevel (org-get-and-remove-property 'params :addlevel)
lines (org-get-and-remove-property 'params :lines)
file (org-symname-or-string (pop params))
markup (org-symname-or-string (pop params))
@ -2406,6 +2422,7 @@ TYPE must be a string, any of:
switches (mapconcat #'(lambda (x) (format "%s" x)) params " ")
start nil end nil)
(delete-region (match-beginning 0) (match-end 0))
(setq currentlevel (or (org-current-level) 0))
(if (or (not file)
(not (file-exists-p file))
(not (file-readable-p file)))
@ -2421,7 +2438,7 @@ TYPE must be a string, any of:
end (format "#+end_%s" markup))))
(insert (or start ""))
(insert (org-get-file-contents (expand-file-name file)
prefix prefix1 markup minlevel lines))
prefix prefix1 markup currentlevel minlevel addlevel lines))
(or (bolp) (newline))
(insert (or end ""))))
all))
@ -2438,13 +2455,15 @@ TYPE must be a string, any of:
(when intersection
(error "Recursive #+INCLUDE: %S" intersection))))))
(defun org-get-file-contents (file &optional prefix prefix1 markup minlevel lines)
(defun org-get-file-contents (file &optional prefix prefix1 markup minlevel parentlevel addlevel lines)
"Get the contents of FILE and return them as a string.
If PREFIX is a string, prepend it to each line. If PREFIX1
is a string, prepend it to the first line instead of PREFIX.
If MARKUP, don't protect org-like lines, the exporter will
take care of the block they are in. If LINES is a string
specifying a range of lines, include only those lines ."
take care of the block they are in. If ADDLEVEL is a number,
demote included file to current heading level+ADDLEVEL.
If LINES is a string specifying a range of lines,
include only those lines."
(if (stringp markup) (setq markup (downcase markup)))
(with-temp-buffer
(insert-file-contents file)
@ -2477,6 +2496,14 @@ specifying a range of lines, include only those lines ."
(when minlevel
(dotimes (lvl minlevel)
(org-map-region 'org-demote (point-min) (point-max))))
(when addlevel
(let ((inclevel (or (if (org-before-first-heading-p)
(1- (and (outline-next-heading)
(org-current-level)))
(1- (org-current-level)))
0)))
(dotimes (level (- (+ parentlevel addlevel) inclevel))
(org-map-region 'org-demote (point-min) (point-max)))))
(buffer-string)))
(defun org-get-and-remove-property (listvar prop)
@ -2548,7 +2575,7 @@ in the list) and remove property and value from the list in LISTVAR."
(defvar org-export-latex-minted-options) ;; defined in org-latex.el
(defun org-remove-formatting-on-newlines-in-region (beg end)
"Remove formatting on newline characters"
"Remove formatting on newline characters."
(interactive "r")
(save-excursion
(goto-char beg)
@ -2562,10 +2589,10 @@ in the list) and remove property and value from the list in LISTVAR."
The CODE is marked up in `org-export-current-backend' format.
Check if a function by name
\"org-<backend>-format-source-code-or-example\" is bound. If yes,
use it as the custom formatter. Otherwise, use the default
formatter. Default formatters are provided for docbook, html,
latex and ascii backends. For example, use
\"org-<backend>-format-source-code-or-example\" is bound. If yes,
use it as the custom formatter. Otherwise, use the default
formatter. Default formatters are provided for docbook, html,
latex and ascii backends. For example, use
`org-html-format-source-code-or-example' to provide a custom
formatter for export to \"html\".
@ -2703,65 +2730,64 @@ INDENT was the original indentation of the block."
(setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt))
(cond
((and lang org-export-latex-listings)
(flet ((make-option-string
(pair)
(concat (first pair)
(if (> (length (second pair)) 0)
(concat "=" (second pair))))))
(let* ((lang-sym (intern lang))
(minted-p (eq org-export-latex-listings 'minted))
(listings-p (not minted-p))
(backend-lang
(or (cadr
(assq
lang-sym
(cond
(minted-p org-export-latex-minted-langs)
(listings-p org-export-latex-listings-langs))))
lang))
(custom-environment
(cadr
(assq
lang-sym
org-export-latex-custom-lang-environments))))
(concat
(when (and listings-p (not custom-environment))
(format
"\\lstset{%s}\n"
(mapconcat
#'make-option-string
(append org-export-latex-listings-options
`(("language" ,backend-lang))) ",")))
(when (and caption org-export-latex-listings-w-names)
(format
"\n%s $\\equiv$ \n"
(replace-regexp-in-string "_" "\\\\_" caption)))
(cond
(custom-environment
(format "\\begin{%s}\n%s\\end{%s}\n"
custom-environment rtn custom-environment))
(listings-p
(format "\\begin{%s}\n%s\\end{%s}"
"lstlisting" rtn "lstlisting"))
(minted-p
(format
"\\begin{minted}[%s]{%s}\n%s\\end{minted}"
(mapconcat #'make-option-string
org-export-latex-minted-options ",")
backend-lang rtn)))))))
(let* ((make-option-string
(lambda (pair)
(concat (first pair)
(if (> (length (second pair)) 0)
(concat "=" (second pair))))))
(lang-sym (intern lang))
(minted-p (eq org-export-latex-listings 'minted))
(listings-p (not minted-p))
(backend-lang
(or (cadr
(assq
lang-sym
(cond
(minted-p org-export-latex-minted-langs)
(listings-p org-export-latex-listings-langs))))
lang))
(custom-environment
(cadr
(assq
lang-sym
org-export-latex-custom-lang-environments))))
(concat
(when (and listings-p (not custom-environment))
(format
"\\lstset{%s}\n"
(mapconcat
make-option-string
(append org-export-latex-listings-options
`(("language" ,backend-lang))) ",")))
(when (and caption org-export-latex-listings-w-names)
(format
"\n%s $\\equiv$ \n"
(replace-regexp-in-string "_" "\\\\_" caption)))
(cond
(custom-environment
(format "\\begin{%s}\n%s\\end{%s}\n"
custom-environment rtn custom-environment))
(listings-p
(format "\\begin{%s}\n%s\\end{%s}"
"lstlisting" rtn "lstlisting"))
(minted-p
(format
"\\begin{minted}[%s]{%s}\n%s\\end{minted}"
(mapconcat make-option-string
org-export-latex-minted-options ",")
backend-lang rtn))))))
(t (concat (car org-export-latex-verbatim-wrap)
rtn (cdr org-export-latex-verbatim-wrap)))))
((eq org-export-current-backend 'ascii)
;; This is not HTML or LaTeX, so just make it an example.
(setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt))
(concat caption "\n"
((eq org-export-current-backend 'ascii)
;; This is not HTML or LaTeX, so just make it an example.
(setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt))
(concat caption "\n"
(concat
(mapconcat
(lambda (l) (concat " " l))
(org-split-string rtn "\n")
"\n")
"\n")
))
"\n")))
(t
(error "Don't know how to markup source or example block in %s"
(upcase backend-name)))))
@ -2787,7 +2813,7 @@ backend-specific lines pre-pended or appended to the original
source block.
NUMBER is non-nil if the literal example specifies \"+n\" or
\"-n\" switch. If NUMBER is non-nil add line numbers.
\"-n\" switch. If NUMBER is non-nil add line numbers.
CONT is non-nil if the literal example specifies \"+n\" switch.
If CONT is nil, start numbering this block from 1. Otherwise
@ -2837,7 +2863,7 @@ block numbering. When non-nil do the following:
(fm
(cond
((eq org-export-current-backend 'html) (format "<span class=\"linenr\">%s</span>"
fmt))
fmt))
((eq org-export-current-backend 'ascii) fmt)
((eq org-export-current-backend 'latex) fmt)
((eq org-export-current-backend 'docbook) fmt)
@ -2915,7 +2941,7 @@ block numbering. When non-nil do the following:
(setq lv (- (match-end 1) (match-beginning 1))
todo (and (match-beginning 2)
(not (member (match-string 2 line)
org-done-keywords))))
org-done-keywords))))
; TODO, not DONE
(if (<= lv level) (throw 'exit nil))
(if todo (throw 'exit t))))))))
@ -3202,8 +3228,7 @@ Does include HTML export options as well as TODO and CATEGORY stuff."
(or org-tag-alist (org-get-buffer-tags)) " ") "")
(mapconcat 'identity org-file-tags " ")
org-archive-location
"org file:~/org/%s.org"
))
"org file:~/org/%s.org"))
;;;###autoload
(defun org-insert-export-options-template ()
@ -3244,8 +3269,7 @@ If yes remove the column and the special lines."
(mapcar (lambda (x)
(cond ((member x '("<" "&lt;")) :start)
((member x '(">" "&gt;")) :end)
((member x '("<>" "&lt;&gt;")) :startend)
(t nil)))
((member x '("<>" "&lt;&gt;")) :startend)))
(org-split-string x "[ \t]*|[ \t]*")))
nil)
((org-table-cookie-line-p x)
@ -3266,8 +3290,7 @@ If yes remove the column and the special lines."
(mapcar (lambda (x)
(cond ((member x '("<" "&lt;")) :start)
((member x '(">" "&gt;")) :end)
((member x '("<>" "&lt;&gt;")) :startend)
(t nil)))
((member x '("<>" "&lt;&gt;")) :startend)))
(cdr (org-split-string x "[ \t]*|[ \t]*"))))
nil)
((org-table-cookie-line-p x)
@ -3284,18 +3307,20 @@ 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 (not s)
"" ; Return a string when argument is nil
(when (memq org-export-with-tags '(not-in-toc nil))
(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)
(setq s (replace-match "" t t s))))
(when org-export-remove-timestamps-from-toc
(while (string-match org-maybe-keyword-time-regexp s)
(setq s (replace-match "" t t s))))
(while (string-match org-bracket-link-regexp s)
(setq s (replace-match (match-string (if (match-end 3) 3 1) s)
t t s)))
(while (string-match "\\[\\([0-9]\\|fn:[^]]*\\)\\]" s)
(setq s (replace-match "" t t s)))
s)
(while (string-match org-bracket-link-regexp s)
(setq s (replace-match (match-string (if (match-end 3) 3 1) s)
t t s)))
(while (string-match "\\[\\([0-9]\\|fn:[^]]*\\)\\]" s)
(setq s (replace-match "" t t s)))
s))
(defun org-get-text-property-any (pos prop &optional object)

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

@ -287,12 +287,14 @@ column view defines special faces for each outline level. See the file
(defface org-date-selected
(org-compatible-face nil
'((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold nil))
(((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold nil))
(((class color) (min-colors 8) (background light)) (:foreground "red" :bold nil))
(((class color) (min-colors 8) (background dark)) (:foreground "red" :bold nil))
'((((class color) (min-colors 16) (background light)) (:foreground "Red1" :inverse-video t))
(((class color) (min-colors 16) (background dark)) (:foreground "Pink" :inverse-video t))
(((class color) (min-colors 8) (background light)) (:foreground "red" :inverse-video t))
(((class color) (min-colors 8) (background dark)) (:foreground "red" :inverse-video t))
(t (:inverse-video t))))
"Face for highlighting the calendar day when using `org-read-date'."
"Face for highlighting the calendar day when using `org-read-date'.
Using a bold face here might cause discrepencies while displaying the
calendar."
:group 'org-faces)
(defface org-sexp-date
@ -309,6 +311,11 @@ Note that the variable `org-tag-faces' can be used to overrule this face for
specific tags."
:group 'org-faces)
(defface org-list-dt
'((t (:bold t)))
"Default face for definition terms in lists."
:group 'org-faces)
(defface org-todo ; font-lock-warning-face
(org-compatible-face nil
'((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t))
@ -381,8 +388,8 @@ determines if it is a foreground or a background color."
(cons
(string :tag "Keyword")
(choice :tag "Face "
(string :tag "Color")
(sexp :tag "Face")))))
(string :tag "Color")
(sexp :tag "Face")))))
(defcustom org-priority-faces nil
"Faces for specific Priorities.
@ -398,8 +405,8 @@ determines if it is a foreground or a background color."
(cons
(character :tag "Priority")
(choice :tag "Face "
(string :tag "Color")
(sexp :tag "Face")))))
(string :tag "Color")
(sexp :tag "Face")))))
(defvar org-tags-special-faces-re nil)
(defun org-set-tag-faces (var value)
@ -412,7 +419,7 @@ determines if it is a foreground or a background color."
(defface org-checkbox
(org-compatible-face 'bold
'((t (:bold t))))
"Face for checkboxes"
"Face for checkboxes."
:group 'org-faces)
@ -439,8 +446,8 @@ changes."
(cons
(string :tag "Tag ")
(choice :tag "Face"
(string :tag "Foreground color")
(sexp :tag "Face")))))
(string :tag "Foreground color")
(sexp :tag "Face")))))
(defface org-table ;; originally copied from font-lock-function-name-face
(org-compatible-face nil
@ -484,9 +491,9 @@ changes."
:version "22.1")
(defface org-document-title
'((((class color) (background light)) (:foreground "midnight blue" :weight bold :height 1.44))
(((class color) (background dark)) (:foreground "pale turquoise" :weight bold :height 1.44))
(t (:weight bold :height 1.44)))
'((((class color) (background light)) (:foreground "midnight blue" :weight bold))
(((class color) (background dark)) (:foreground "pale turquoise" :weight bold))
(t (:weight bold)))
"Face for document title, i.e. that which follows the #+TITLE: keyword."
:group 'org-faces)
@ -549,9 +556,9 @@ follows a #+DATE:, #+AUTHOR: or #+EMAIL: keyword."
:version "22.1")
(org-copy-face 'org-block 'org-quote
"Face for #+BEGIN_QUOTE ... #+END_QUOTE blocks.")
"Face for #+BEGIN_QUOTE ... #+END_QUOTE blocks.")
(org-copy-face 'org-block 'org-verse
"Face for #+BEGIN_VERSE ... #+END_VERSE blocks.")
"Face for #+BEGIN_VERSE ... #+END_VERSE blocks.")
(defcustom org-fontify-quote-and-verse-blocks nil
"Non-nil means, add a special face to #+begin_quote and #+begin_verse block.
@ -574,8 +581,8 @@ content of these blocks will still be treated as Org syntax."
(((class color) (min-colors 8))
(:background "cyan" :foreground "black"))
(t (:inverse-video t))))
"Basic face for displaying the secondary selection."
:group 'org-faces)
"Basic face for displaying the secondary selection."
:group 'org-faces)
(defface org-agenda-structure ;; originally copied from font-lock-function-name-face
(org-compatible-face nil
@ -602,7 +609,7 @@ content of these blocks will still be treated as Org syntax."
"Face used in agenda for weekend days.
See the variable `org-agenda-weekend-days' for a definition of which days
belong to the weekend."
:weight 'bold)
:weight 'bold)
(defface org-scheduled
(org-compatible-face nil
@ -727,8 +734,8 @@ month and 365.24 days for a year)."
(defconst org-level-faces
'(org-level-1 org-level-2 org-level-3 org-level-4
org-level-5 org-level-6 org-level-7 org-level-8
))
org-level-5 org-level-6 org-level-7 org-level-8
))
(defcustom org-n-level-faces (length org-level-faces)
"The number of different faces to be used for headlines.
@ -738,14 +745,14 @@ If it is less than 8, the level-1 face gets re-used for level N+1 etc."
:group 'org-faces)
(defcustom org-cycle-level-faces t
"Non-nil means level styles cycle after level `org-n-level-faces'.
"Non-nil means level styles cycle after level `org-n-level-faces'.
Then so level org-n-level-faces+1 is styled like level 1.
If nil, then all levels >=org-n-level-faces are styled like
level org-n-level-faces"
:group 'org-appearance
:group 'org-faces
:version "24.1"
:type 'boolean)
:group 'org-appearance
:group 'org-faces
:version "24.1"
:type 'boolean)
(defface org-latex-and-export-specials
(let ((font (cond ((assq :inherit custom-face-attributes)

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

@ -80,7 +80,7 @@
;; that received the input of the feed. You should add FEEDSTATUS
;; to your list of drawers in the files that receive feed input:
;;
;; #+DRAWERS: PROPERTIES LOGBOOK FEEDSTATUS
;; #+DRAWERS: PROPERTIES CLOCK LOGBOOK RESULTS FEEDSTATUS
;;
;; Acknowledgments
;; ---------------
@ -100,6 +100,10 @@
(declare-function xml-get-attribute-or-nil "xml" (node attribute))
(declare-function xml-substitute-special "xml" (string))
(declare-function org-capture-escaped-% "org-capture" ())
(declare-function org-capture-inside-embedded-elisp-p "org-capture" ())
(declare-function org-capture-expand-embedded-elisp "org-capture" ())
(defgroup org-feed nil
"Options concerning RSS feeds as inputs for Org files."
:tag "Org Feed"
@ -179,34 +183,34 @@ Here are the keyword-value pair allows in `org-feed-alist'.
:group 'org-feed
:type '(repeat
(list :value ("" "http://" "" "")
(string :tag "Name")
(string :tag "Feed URL")
(file :tag "File for inbox")
(string :tag "Headline for inbox")
(repeat :inline t
(choice
(list :inline t :tag "Filter"
(const :filter)
(symbol :tag "Filter Function"))
(list :inline t :tag "Template"
(const :template)
(string :tag "Template"))
(list :inline t :tag "Formatter"
(const :formatter)
(symbol :tag "Formatter Function"))
(list :inline t :tag "New items handler"
(const :new-handler)
(symbol :tag "Handler Function"))
(list :inline t :tag "Changed items"
(const :changed-handler)
(symbol :tag "Handler Function"))
(list :inline t :tag "Parse Feed"
(const :parse-feed)
(symbol :tag "Parse Feed Function"))
(list :inline t :tag "Parse Entry"
(const :parse-entry)
(symbol :tag "Parse Entry Function"))
)))))
(string :tag "Name")
(string :tag "Feed URL")
(file :tag "File for inbox")
(string :tag "Headline for inbox")
(repeat :inline t
(choice
(list :inline t :tag "Filter"
(const :filter)
(symbol :tag "Filter Function"))
(list :inline t :tag "Template"
(const :template)
(string :tag "Template"))
(list :inline t :tag "Formatter"
(const :formatter)
(symbol :tag "Formatter Function"))
(list :inline t :tag "New items handler"
(const :new-handler)
(symbol :tag "Handler Function"))
(list :inline t :tag "Changed items"
(const :changed-handler)
(symbol :tag "Handler Function"))
(list :inline t :tag "Parse Feed"
(const :parse-feed)
(symbol :tag "Parse Feed Function"))
(list :inline t :tag "Parse Entry"
(const :parse-entry)
(symbol :tag "Parse Entry Function"))
)))))
(defcustom org-feed-drawer "FEEDSTATUS"
"The name of the drawer for feed status information.
@ -225,12 +229,14 @@ Any fields from the feed item can be interpolated into the template with
%name, for example %title, %description, %pubDate etc. In addition, the
following special escapes are valid as well:
%h the title, or the first line of the description
%t the date as a stamp, either from <pubDate> (if present), or
the current date.
%T date and time
%u,%U like %t,%T, but inactive time stamps
%a A link, from <guid> if that is a permalink, else from <link>"
%h The title, or the first line of the description
%t The date as a stamp, either from <pubDate> (if present), or
the current date
%T Date and time
%u,%U Like %t,%T, but inactive time stamps
%a A link, from <guid> if that is a permalink, else from <link>
%(sexp) Evaluate elisp `(sexp)' and replace with the result, the simple
%-escapes above can be used as arguments, e.g. %(capitalize \\\"%h\\\")"
:group 'org-feed
:type '(string :tag "Template"))
@ -251,7 +257,7 @@ of the file pointed to by the URL."
(const :tag "Externally with wget" wget)
(function :tag "Function")))
(defcustom org-feed-before-adding-hook nil
(defcustom org-feed-before-adding-hook nil
"Hook that is run before adding new feed items to a file.
You might want to commit the file in its current state to version control,
for example."
@ -450,8 +456,8 @@ Switch to that buffer, and return the position of that headline."
nil t)
(goto-char (match-beginning 0))
(goto-char (point-max))
(insert "\n\n* " heading "\n\n")
(org-back-to-heading t))
(insert "\n\n* " heading "\n\n")
(org-back-to-heading t))
(point))
(defun org-feed-read-previous-status (pos drawer)
@ -506,9 +512,10 @@ This will find DRAWER and extract the alist."
ENTRY is a property list. This function adds a `:formatted-for-org' property
and returns the full property list.
If that property is already present, nothing changes."
(require 'org-capture)
(if formatter
(funcall formatter entry)
(let (dlines fmt tmp indent time name
(let (dlines time escape name tmp
v-h v-t v-T v-u v-U v-a)
(setq dlines (org-split-string (or (plist-get entry :description) "???")
"\n")
@ -527,20 +534,35 @@ If that property is already present, nothing changes."
""))
(with-temp-buffer
(insert template)
;; Simple %-escapes
;; before embedded elisp to support simple %-escapes as
;; arguments for embedded elisp
(goto-char (point-min))
(while (re-search-forward "%\\([a-zA-Z]+\\)" nil t)
(setq name (match-string 1))
(cond
((member name '("h" "t" "T" "u" "U" "a"))
(replace-match (symbol-value (intern (concat "v-" name))) t t))
((setq tmp (plist-get entry (intern (concat ":" name))))
(save-excursion
(save-match-data
(beginning-of-line 1)
(when (looking-at (concat "^\\([ \t]*\\)%" name "[ \t]*$"))
(setq tmp (org-feed-make-indented-block
tmp (org-get-indentation))))))
(replace-match tmp t t))))
(unless (org-capture-escaped-%)
(setq name (match-string 1)
escape (org-capture-inside-embedded-elisp-p))
(cond
((member name '("h" "t" "T" "u" "U" "a"))
(setq tmp (symbol-value (intern (concat "v-" name)))))
((setq tmp (plist-get entry (intern (concat ":" name))))
(save-excursion
(save-match-data
(beginning-of-line 1)
(when (looking-at
(concat "^\\([ \t]*\\)%" name "[ \t]*$"))
(setq tmp (org-feed-make-indented-block
tmp (org-get-indentation))))))))
(when tmp
;; escape string delimiters `"' when inside %() embedded lisp
(when escape
(setq tmp (replace-regexp-in-string "\"" "\\\\\"" tmp)))
(replace-match tmp t t))))
;; %() embedded elisp
(org-capture-expand-embedded-elisp)
(decode-coding-string
(buffer-string) (detect-coding-region (point-min) (point-max) t))))))

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

@ -57,6 +57,7 @@
(declare-function org-mark-ring-push "org" (&optional pos buffer))
(declare-function org-show-context "org" (&optional key))
(declare-function org-trim "org" (s))
(declare-function org-skip-whitespace "org" ())
(declare-function outline-next-heading "outline")
(declare-function org-skip-whitespace "org" ())
@ -277,9 +278,7 @@ otherwise."
(concat org-outline-regexp-bol "\\|"
org-footnote-definition-re "\\|"
"^[ \t]*$") bound 'move))
(progn (goto-char (match-beginning 0))
(org-skip-whitespace)
(point-at-bol))
(match-beginning 0)
(point)))))
(list label beg end
(org-trim (buffer-substring-no-properties beg-def end)))))))))
@ -362,7 +361,7 @@ Return a non-nil value when a definition has been found."
(looking-at (format "\\[%s\\]\\|\\[%s:" label label))
(goto-char (match-end 0))
(org-show-context 'link-search)
(when (eq major-mode 'org-mode)
(when (derived-mode-p 'org-mode)
(message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'."))
t)))
@ -451,7 +450,8 @@ or new, let the user edit the definition of the footnote."
(error "Cannot insert a footnote here"))
(let* ((lbls (and (not (equal org-footnote-auto-label 'random))
(org-footnote-all-labels)))
(propose (org-footnote-unique-label lbls))
(propose (and (not (equal org-footnote-auto-label 'random))
(org-footnote-unique-label lbls)))
(label
(org-footnote-normalize-label
(cond
@ -489,7 +489,7 @@ or new, let the user edit the definition of the footnote."
(let ((label (org-footnote-normalize-label label)))
(cond
;; In an Org file.
((eq major-mode 'org-mode)
((derived-mode-p 'org-mode)
;; If `org-footnote-section' is defined, find it, or create it
;; at the end of the buffer.
(when org-footnote-section
@ -553,7 +553,7 @@ or new, let the user edit the definition of the footnote."
(backward-char)
;; Only notify user about next possible action when in an Org
;; buffer, as the bindings may have different meanings otherwise.
(when (eq major-mode 'org-mode)
(when (derived-mode-p 'org-mode)
(message
"Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'."))))
@ -713,7 +713,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
;; 2. Find and remove the footnote section, if any. Also
;; determine where footnotes shall be inserted (INS-POINT).
(cond
((and org-footnote-section (eq major-mode 'org-mode))
((and org-footnote-section (derived-mode-p 'org-mode))
(goto-char (point-min))
(if (re-search-forward
(concat "^\\*[ \t]+" (regexp-quote org-footnote-section)
@ -729,7 +729,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
;; of the section containing their first reference.
;; Nevertheless, in an export situation, set insertion point to
;; `point-max' by default.
((eq major-mode 'org-mode)
((derived-mode-p 'org-mode)
(when export-props
(goto-char (point-max))
(skip-chars-backward " \r\t\n")
@ -790,7 +790,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
;; No footnote: exit.
((not ref-table))
;; Cases when footnotes should be inserted in one place.
((or (not (eq major-mode 'org-mode))
((or (not (derived-mode-p 'org-mode))
org-footnote-section
export-props)
;; Insert again the section title, if any. Ensure that title,
@ -799,7 +799,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
;; separate section with a blank line, unless explicitly
;; stated in `org-blank-before-new-entry'.
(cond
((not (eq major-mode 'org-mode))
((not (derived-mode-p 'org-mode))
(skip-chars-backward " \t\n\r")
(delete-region (point) ins-point)
(unless (bolp) (newline))
@ -845,7 +845,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
(beginning-of-line 0)
(while (and (not (bobp)) (= (char-after) ?#))
(beginning-of-line 0))
(if (looking-at "[ \t]*#\\+TBLFM:") (beginning-of-line 2))
(if (let ((case-fold-search t)) (looking-at "[ \t]*#\\+tblfm:")) (beginning-of-line 2))
(end-of-line 1)
(skip-chars-backward "\n\r\t ")
(forward-line))
@ -872,7 +872,11 @@ Return the number of footnotes removed."
(while (re-search-forward def-re nil t)
(let ((full-def (org-footnote-at-definition-p)))
(when full-def
(delete-region (nth 1 full-def) (nth 2 full-def))
;; Remove the footnote, and all blank lines before it.
(goto-char (nth 1 full-def))
(skip-chars-backward " \r\t\n")
(unless (bolp) (forward-line))
(delete-region (point) (nth 2 full-def))
(incf ndef))))
ndef)))
@ -888,7 +892,7 @@ If LABEL is non-nil, delete that footnote instead."
(label (cond
;; LABEL is provided as argument.
(label)
;; Footnote reference at point. If the footnote is
;; Footnote reference at point. If the footnote is
;; anonymous, delete it and exit instead.
((setq x (org-footnote-at-reference-p))
(or (car x)

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

@ -60,7 +60,7 @@
(require 'xml)
(require 'org)
;(require 'rx)
;(require 'rx)
(require 'org-exp)
(eval-when-compile (require 'cl))
@ -139,7 +139,7 @@ NOT READY YET."
;;;###autoload
(defun org-export-as-freemind (&optional hidden ext-plist
to-buffer body-only pub-dir)
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
@ -258,22 +258,22 @@ The characters \"&<> will be escaped."
;;(org-freemind-unescape-str-to-org "&#x6d;A&#x224C;B&lt;C&#x3C;&#x3D;")
;;(org-freemind-unescape-str-to-org "&#x3C;&lt;")
(defun org-freemind-unescape-str-to-org (fm-str)
"Do some html-unescaping of FM-STR and return the result.
"Do some html-unescaping of FM-STR and return the result.
This is the opposite of `org-freemind-escape-str-from-org' but it
will also unescape &#nn;."
(let ((org-str fm-str))
(setq org-str (replace-regexp-in-string "&quot;" "\"" org-str))
(setq org-str (replace-regexp-in-string "&amp;" "&" org-str))
(setq org-str (replace-regexp-in-string "&lt;" "<" org-str))
(setq org-str (replace-regexp-in-string "&gt;" ">" org-str))
(setq org-str (replace-regexp-in-string
"&#x\\([a-f0-9]\\{2,4\\}\\);"
(lambda (m)
(char-to-string
(+ (string-to-number (match-string 1 m) 16)
0 ;?\x800 ;; What is this for? Encoding?
)))
org-str))))
(let ((org-str fm-str))
(setq org-str (replace-regexp-in-string "&quot;" "\"" org-str))
(setq org-str (replace-regexp-in-string "&amp;" "&" org-str))
(setq org-str (replace-regexp-in-string "&lt;" "<" org-str))
(setq org-str (replace-regexp-in-string "&gt;" ">" org-str))
(setq org-str (replace-regexp-in-string
"&#x\\([a-f0-9]\\{2,4\\}\\);"
(lambda (m)
(char-to-string
(+ (string-to-number (match-string 1 m) 16)
0 ;?\x800 ;; What is this for? Encoding?
)))
org-str))))
;; (let* ((str1 "a quote: \", an amp: &, lt: <; over 256: öåäÖÅÄ")
;; (str2 (org-freemind-escape-str-from-org str1))
@ -291,7 +291,7 @@ MATCHED is the link just matched."
(is-img (and (image-type-from-file-name link)
(let ((url-type (substring link 0 col-pos)))
(member url-type '("file" "http" "https")))))
)
)
(if is-img
;; Fix-me: I can't find a way to get the border to "shrink
;; wrap" around the image using <div>.
@ -334,7 +334,7 @@ MATCHED is the link just matched."
"\\[\\[\\(.*?\\)]\\[\\(.*?\\)]]"
;;"<a href=\"\\1\">\\2</a>"
'org-freemind-convert-links-helper
fm-str)))
fm-str t t)))
;;(org-freemind-convert-links-to-org "<a href=\"http://www.somewhere/\">link-text</a>")
(defun org-freemind-convert-links-to-org (fm-str)
@ -380,7 +380,7 @@ MATCHED is the link just matched."
(dolist (cc (append matched nil))
(if (= 32 cc)
;;(setq res (concat res "&nbsp;"))
;; We need to use the numerical version. Otherwise Freemind
;; We need to use the numerical version. Otherwise Freemind
;; ver 0.9.0 RC9 can not export to html/javascript.
(progn
(if (< 0 bi)
@ -410,7 +410,7 @@ MATCHED is the link just matched."
(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
;; 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).
@ -455,8 +455,7 @@ DRAWERS-REGEXP are converted to freemind notes."
note-res
"</body>\n"
"</html>\n"
"</richcontent>\n"))
)
"</richcontent>\n")))
;; There is always an LF char:
(when (> (length text) 1)
@ -467,10 +466,10 @@ DRAWERS-REGEXP are converted to freemind notes."
(if (= 0 (length org-freemind-node-css-style))
""
(concat
"<style type=\"text/css\">\n"
"<!--\n"
"<style type=\"text/css\">\n"
"<!--\n"
org-freemind-node-css-style
"-->\n"
"-->\n"
"</style>\n"))
"</head>\n"
"<body>\n"))
@ -520,14 +519,15 @@ DRAWERS-REGEXP are converted to freemind notes."
(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)
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-link
this-m2-escaped
this-rich-node
this-rich-note
@ -560,6 +560,10 @@ DRAWERS-REGEXP are converted to freemind notes."
(add-to-list 'this-icons "full-7"))
))))
(setq this-m2 (org-trim this-m2))
(when (string-match org-bracket-link-analytic-regexp this-m2)
(setq this-m2-link (concat "link=\"" (match-string 1 this-m2)
(match-string 3 this-m2) "\" ")
this-m2 (replace-match "\\5" nil nil this-m2 0)))
(setq this-m2-escaped (org-freemind-escape-str-from-org this-m2))
(let ((node-notes (org-freemind-org-text-to-freemind-subnode/note
this-m2-escaped
@ -569,7 +573,8 @@ DRAWERS-REGEXP are converted to freemind notes."
(setq this-rich-node (nth 0 node-notes))
(setq this-rich-note (nth 1 node-notes)))
(with-current-buffer mm-buffer
(insert "<node text=\"" this-m2-escaped "\"")
(insert "<node " (if this-m2-link this-m2-link "")
"text=\"" this-m2-escaped "\"")
(org-freemind-get-node-style this-m2)
(when (> next-level current-level)
(unless (or this-children-visible
@ -784,15 +789,15 @@ Otherwise give an error say the file exists."
;;; (unless (if node-at-line-last
;;; (>= (point) node-at-line-last)
;;; nil)
;; Write last node:
(setq this-m2 next-m2)
(setq current-level next-level)
(setq next-node-start (if node-at-line-last
(1+ node-at-line-last)
(point-max)))
(setq num-left-nodes (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))
(with-current-buffer mm-buffer (insert "</node>\n"))
;)
;; Write last node:
(setq this-m2 next-m2)
(setq current-level next-level)
(setq next-node-start (if node-at-line-last
(1+ node-at-line-last)
(point-max)))
(setq num-left-nodes (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))
(with-current-buffer mm-buffer (insert "</node>\n"))
;)
)
(with-current-buffer mm-buffer
(while (> current-level base-level)
@ -1032,7 +1037,7 @@ PATH should be a list of steps, where each step has the form
(let* ((child-attr-list (cadr child))
(step-attr-copy (copy-sequence step-attr-list)))
(dolist (child-attr child-attr-list)
;; Compare attr names:
;; Compare attr names:
(when (org-freemind-symbols= (caar step-attr-copy) (car child-attr))
;; Compare values:
(let ((step-val (cdar step-attr-copy))
@ -1066,12 +1071,12 @@ PATH should be a list of steps, where each step has the form
(defun org-freemind-test-get-tree-text ()
(let ((node '(p nil "\n"
(a
((href . "link"))
"text")
"\n"
(b nil "hej")
"\n")))
(a
((href . "link"))
"text")
"\n"
(b nil "hej")
"\n")))
(org-freemind-get-tree-text node)))
;; (org-freemind-test-get-tree-text)
@ -1085,11 +1090,9 @@ PATH should be a list of steps, where each step has the form
;;(a (setq is-link t) )
((h1 h2 h3 h4 h5 h6 p)
;;(setq ntxt (concat "\n" ntxt))
(setq lf-after 2)
)
(setq lf-after 2))
(br
(setq lf-after 1)
)
(setq lf-after 1))
(t
(cond
((stringp n)
@ -1106,8 +1109,7 @@ PATH should be a list of steps, where each step has the form
(let ((att (car att-val))
(val (cdr att-val)))
(when (eq att 'href)
(setq link val)))))
)))))
(setq link val))))))))))
(if lf-after
(setq ntxt (concat ntxt (make-string lf-after ?\n)))
(setq ntxt (concat ntxt " ")))
@ -1184,7 +1186,7 @@ PATH should be a list of steps, where each step has the form
(org-freemind-node-to-org child (1+ level) skip-levels)))))
;; Fix-me: put back special things, like drawers that are stored in
;; the notes. Should maybe all notes contents be put in drawers?
;; the notes. Should maybe all notes contents be put in drawers?
;;;###autoload
(defun org-freemind-to-org-mode (mm-file org-file)
"Convert FreeMind file MM-FILE to `org-mode' file ORG-FILE."

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

@ -32,6 +32,7 @@
;;; Code:
(require 'org)
(require 'gnus-util)
(eval-when-compile (require 'gnus-sum))
;; Declare external functions and variables
@ -100,11 +101,11 @@ If `org-store-link' was called with a prefix arg the meaning of
(if (and (string-match "^nntp" group) ;; Only for nntp groups
(org-xor current-prefix-arg
org-gnus-prefer-web-links))
(org-make-link (if (string-match "gmane" unprefixed-group)
"http://news.gmane.org/"
"http://groups.google.com/group/")
unprefixed-group)
(org-make-link "gnus:" group))))
(concat (if (string-match "gmane" unprefixed-group)
"http://news.gmane.org/"
"http://groups.google.com/group/")
unprefixed-group)
(concat "gnus:" group))))
(defun org-gnus-article-link (group newsgroups message-id x-no-archive)
"Create a link to a Gnus article.
@ -125,7 +126,7 @@ If `org-store-link' was called with a prefix arg the meaning of
"http://mid.gmane.org/%s"
"http://groups.google.com/groups/search?as_umsgid=%s")
(org-fixup-message-id-for-http message-id))
(org-make-link "gnus:" group "#" message-id)))
(concat "gnus:" group "#" message-id)))
(defun org-gnus-store-link ()
"Store a link to a Gnus folder or message."
@ -206,7 +207,7 @@ If `org-store-link' was called with a prefix arg the meaning of
desc link
newsgroup xarchive) ; those are always nil for gcc
(and (not gcc)
(error "Can not create link: No Gcc header found."))
(error "Can not create link: No Gcc header found"))
(org-store-link-props :type "gnus" :from from :subject subject
:message-id id :group gcc :to to)
(setq desc (org-email-link-description)
@ -233,9 +234,9 @@ If `org-store-link' was called with a prefix arg the meaning of
(setq group (match-string 1 path)
article (match-string 3 path))
(when group
(setq group (org-substring-no-properties group)))
(setq group (org-no-properties group)))
(when article
(setq article (org-substring-no-properties article)))
(setq article (org-no-properties article)))
(org-gnus-follow-link group article)))
(defun org-gnus-follow-link (&optional group article)
@ -244,9 +245,9 @@ If `org-store-link' was called with a prefix arg the meaning of
(funcall (cdr (assq 'gnus org-link-frame-setup)))
(if gnus-other-frame-object (select-frame gnus-other-frame-object))
(when group
(setq group (org-substring-no-properties group)))
(setq group (org-no-properties group)))
(when article
(setq article (org-substring-no-properties article)))
(setq article (org-no-properties article)))
(cond ((and group article)
(gnus-activate-group group)
(condition-case nil
@ -272,7 +273,7 @@ If `org-store-link' was called with a prefix arg the meaning of
;; stop on integer overflows
(> articles 0))
(setq group-opened (gnus-group-read-group
articles nil group)
articles t group)
articles (if (< articles 16)
(1+ articles)
(* articles 2))))

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

@ -67,6 +67,12 @@ relative to the current effective date."
:group 'org-habit
:type 'boolean)
(defcustom org-habit-show-all-today nil
"If non-nil, will show the consistency graph of all habits on
today's agenda, even if they are not scheduled."
:group 'org-habit
:type 'boolean)
(defcustom org-habit-today-glyph ?!
"Glyph character used to identify today."
:group 'org-habit

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

File diff suppressed because it is too large Load diff

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

@ -28,8 +28,7 @@
(require 'org-exp)
(eval-when-compile
(require 'cl))
(eval-when-compile (require 'cl))
(declare-function org-bbdb-anniv-export-ical "org-bbdb" nil)
@ -194,7 +193,7 @@ or if they are only using it locally."
(defcustom org-icalendar-timezone (getenv "TZ")
"The time zone string for iCalendar export.
When nil of the empty string, use the abbreviation retrieved from Emacs."
When nil or the empty string, use output from \(current-time-zone\)."
:group 'org-export-icalendar
:type '(choice
(const :tag "Unspecified" nil)
@ -257,7 +256,7 @@ The file is stored under the name `org-combined-agenda-icalendar-file'."
If COMBINE is non-nil, combine all calendar entries into a single large
file and store it under the name `org-combined-agenda-icalendar-file'."
(save-excursion
(org-prepare-agenda-buffers files)
(org-agenda-prepare-buffers files)
(let* ((dir (org-export-directory
:ical (list :publishing-directory
org-export-publishing-directory)))
@ -288,20 +287,19 @@ file and store it under the name `org-combined-agenda-icalendar-file'."
(let ((standard-output ical-buffer))
(if combine
(and (not started) (setq started t)
(org-start-icalendar-file org-icalendar-combined-name))
(org-start-icalendar-file category))
(org-print-icalendar-entries combine)
(org-icalendar-start-file org-icalendar-combined-name))
(org-icalendar-start-file category))
(org-icalendar-print-entries combine)
(when (or (and combine (not files)) (not combine))
(when (and combine org-icalendar-include-bbdb-anniversaries)
(require 'org-bbdb)
(org-bbdb-anniv-export-ical))
(org-finish-icalendar-file)
(org-icalendar-finish-file)
(set-buffer ical-buffer)
(run-hooks 'org-before-save-iCalendar-file-hook)
(save-buffer)
(run-hooks 'org-after-save-iCalendar-file-hook)
(and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait))
))))
(and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait))))))
(org-release-buffers org-agenda-new-buffers))))
(defvar org-before-save-iCalendar-file-hook nil
@ -315,18 +313,18 @@ A good way to use this is to tell a desktop calendar application to re-read
the iCalendar file.")
(defvar org-agenda-default-appointment-duration) ; defined in org-agenda.el
(defun org-print-icalendar-entries (&optional combine)
(defun org-icalendar-print-entries (&optional combine)
"Print iCalendar entries for the current Org-mode file to `standard-output'.
When COMBINE is non nil, add the category to each line."
(require 'org-agenda)
(let ((re1 (concat org-ts-regexp "\\|<%%([^>\n]+>"))
(re2 (concat "--?-?\\(" org-ts-regexp "\\)"))
(dts (org-ical-ts-to-string
(dts (org-icalendar-ts-to-string
(format-time-string (cdr org-time-stamp-formats) (current-time))
"DTSTART"))
hd ts ts2 state status (inc t) pos b sexp rrule
scheduledp deadlinep todo prefix due start tags
tmp pri categories location summary desc uid alarm
tmp pri categories location summary desc uid alarm alarm-time
(sexp-buffer (get-buffer-create "*ical-tmp*")))
(org-refresh-category-properties)
(save-excursion
@ -359,26 +357,25 @@ 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-time (org-entry-get nil "APPT_WARNTIME")
alarm-time (if alarm-time (string-to-number alarm-time) 0)
alarm ""
deadlinep nil scheduledp nil)
(setq tmp (buffer-substring (max (point-min) (- pos org-ds-keyword-length)) pos)
deadlinep (string-match org-deadline-regexp tmp)
scheduledp (string-match org-scheduled-regexp tmp)
todo (org-get-todo-state))
;; donep (org-entry-is-done-p)
(if (looking-at re2)
(progn
(goto-char (match-end 0))
(setq ts2 (match-string 1)
inc (not (string-match "[0-9]\\{1,2\\}:[0-9][0-9]" ts2))))
(setq tmp (buffer-substring (max (point-min)
(- pos org-ds-keyword-length))
pos)
ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts)
(setq ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts)
(progn
(setq inc nil)
(replace-match "\\1" t nil ts))
ts)
deadlinep (string-match org-deadline-regexp tmp)
scheduledp (string-match org-scheduled-regexp tmp)
todo (org-get-todo-state)
;; donep (org-entry-is-done-p)
))
ts)))
(when (and (not org-icalendar-use-plain-timestamp)
(not deadlinep) (not scheduledp))
(throw :skip t))
@ -403,12 +400,12 @@ When COMBINE is non nil, add the category to each line."
(if (or (string-match org-tr-regexp hd)
(string-match org-ts-regexp hd))
(setq hd (replace-match "" t t hd)))
(if (string-match "\\+\\([0-9]+\\)\\([dwmy]\\)>" ts)
(if (string-match "\\+\\([0-9]+\\)\\([hdwmy]\\)>" ts)
(setq rrule
(concat "\nRRULE:FREQ="
(cdr (assoc
(match-string 2 ts)
'(("d" . "DAILY")("w" . "WEEKLY")
'(("h" . "HOURLY")("d" . "DAILY")("w" . "WEEKLY")
("m" . "MONTHLY")("y" . "YEARLY"))))
";INTERVAL=" (match-string 1 ts)))
(setq rrule ""))
@ -419,11 +416,11 @@ When COMBINE is non nil, add the category to each line."
;; (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)
(if (and (or (> alarm-time 0) (> org-icalendar-alarm-time 0))
(car t1) (nth 1 t1) (nth 2 t1))
(setq alarm (format "\nBEGIN:VALARM\nACTION:DISPLAY\nDESCRIPTION:%s\nTRIGGER:-P0DT0H%dM0S\nEND:VALARM" summary org-icalendar-alarm-time))
(setq alarm ""))
)
(setq alarm (format "\nBEGIN:VALARM\nACTION:DISPLAY\nDESCRIPTION:%s\nTRIGGER:-P0DT0H%dM0S\nEND:VALARM"
summary (or alarm-time org-icalendar-alarm-time)))
(setq alarm "")))
(if (string-match org-bracket-link-regexp summary)
(setq summary
(replace-match (if (match-end 3)
@ -446,8 +443,8 @@ SUMMARY:%s%s%s
CATEGORIES:%s%s
END:VEVENT\n"
(concat prefix uid)
(org-ical-ts-to-string ts "DTSTART")
(org-ical-ts-to-string ts2 "DTEND" inc)
(org-icalendar-ts-to-string ts "DTSTART")
(org-icalendar-ts-to-string ts2 "DTEND" inc)
rrule summary
(if (and desc (string-match "\\S-" desc))
(concat "\nDESCRIPTION: " desc) "")
@ -525,13 +522,13 @@ END:VEVENT\n"
due (and (member 'todo-due org-icalendar-use-deadline)
(org-entry-get nil "DEADLINE"))
start (and (member 'todo-start org-icalendar-use-scheduled)
(org-entry-get nil "SCHEDULED"))
(org-entry-get nil "SCHEDULED"))
categories (org-export-get-categories)
uid (if org-icalendar-store-UID
(org-id-get-create)
(or (org-id-get) (org-id-new))))
(and due (setq due (org-ical-ts-to-string due "DUE")))
(and start (setq start (org-ical-ts-to-string start "DTSTART")))
(and due (setq due (org-icalendar-ts-to-string due "DUE")))
(and start (setq start (org-icalendar-ts-to-string start "DTSTART")))
(if (string-match org-bracket-link-regexp hd)
(setq hd (replace-match (if (match-end 3) (match-string 3 hd)
@ -588,10 +585,10 @@ characters."
(if (not s)
nil
(if is-body
(let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?"))
(re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?")))
(while (string-match re s) (setq s (replace-match "" t t s)))
(while (string-match re2 s) (setq s (replace-match "" t t s))))
(let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?"))
(re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?")))
(while (string-match re s) (setq s (replace-match "" t t s)))
(while (string-match re2 s) (setq s (replace-match "" t t s))))
(setq s (replace-regexp-in-string "[[:space:]]+" " " s)))
(let ((start 0))
(while (string-match "\\([,;]\\)" s start)
@ -634,7 +631,7 @@ not used right now."
(when (string-match "[;,:]" s) (setq s (concat "\"" s "\"")))
s))
(defun org-start-icalendar-file (name)
(defun org-icalendar-start-file (name)
"Start an iCalendar file by inserting the header."
(let ((user user-full-name)
(name (or name "unknown"))
@ -651,11 +648,11 @@ X-WR-TIMEZONE:%s
X-WR-CALDESC:%s
CALSCALE:GREGORIAN\n" name user timezone description))))
(defun org-finish-icalendar-file ()
(defun org-icalendar-finish-file ()
"Finish an iCalendar file by inserting the END statement."
(princ "END:VCALENDAR\n"))
(defun org-ical-ts-to-string (s keyword &optional inc)
(defun org-icalendar-ts-to-string (s keyword &optional inc)
"Take a time string S and convert it to iCalendar format.
KEYWORD is added in front, to make a complete line like DTSTART....
When INC is non-nil, increase the hour by two (if time string contains
@ -680,7 +677,7 @@ a time), or the day by one (if it does not contain a time)."
(replace-regexp-in-string "%Z"
org-icalendar-timezone
org-icalendar-date-time-format)
";VALUE=DATE:%Y%m%d"))
";VALUE=DATE:%Y%m%d"))
(concat keyword (format-time-string fmt time
(and (org-icalendar-use-UTC-date-timep)
have-time))))))

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

@ -83,6 +83,47 @@
:tag "Org ID"
:group 'org)
(define-obsolete-variable-alias
'org-link-to-org-use-id 'org-id-link-to-org-use-id "24.3")
(defcustom org-id-link-to-org-use-id nil
"Non-nil means storing a link to an Org file will use entry IDs.
The variable can have the following values:
t Create an ID if needed to make a link to the current entry.
create-if-interactive
If `org-store-link' is called directly (interactively, as a user
command), do create an ID to support the link. But when doing the
job for capture, only use the ID if it already exists. The
purpose of this setting is to avoid proliferation of unwanted
IDs, just because you happen to be in an Org file when you
call `org-capture' that automatically and preemptively creates a
link. If you do want to get an ID link in a capture template to
an entry not having an ID, create it first by explicitly creating
a link to it, using `C-c C-l' first.
create-if-interactive-and-no-custom-id
Like create-if-interactive, but do not create an ID if there is
a CUSTOM_ID property defined in the entry.
use-existing
Use existing ID, do not create one.
nil Never use an ID to make a link, instead link using a text search for
the headline text."
:group 'org-link-store
:group 'org-id
:version "24.3"
:type '(choice
(const :tag "Create ID to make link" t)
(const :tag "Create if storing link interactively"
create-if-interactive)
(const :tag "Create if storing link interactively and no CUSTOM_ID is present"
create-if-interactive-and-no-custom-id)
(const :tag "Only use existing" use-existing)
(const :tag "Do not use ID to create link" nil)))
(defcustom org-id-uuid-program "uuidgen"
"The uuidgen program."
:group 'org-id
@ -216,8 +257,7 @@ In any case, the ID of the entry is returned."
(setq id (org-id-new prefix))
(org-entry-put pom "ID" id)
(org-id-add-location id (buffer-file-name (buffer-base-buffer)))
id)
(t nil)))))
id)))))
;;;###autoload
(defun org-id-get-with-outline-path-completion (&optional targets)
@ -273,7 +313,7 @@ With optional argument MARKERP, return the position as a new marker."
(when file
(setq where (org-id-find-id-in-file id file markerp)))
(unless where
(org-id-update-id-locations)
(org-id-update-id-locations nil t)
(setq file (org-id-find-id-file id))
(when file
(setq where (org-id-find-id-in-file id file markerp))))
@ -403,7 +443,7 @@ and time is the usual three-integer representation of time."
;; Storing ID locations (files)
(defun org-id-update-id-locations (&optional files)
(defun org-id-update-id-locations (&optional files silent)
"Scan relevant files for IDs.
Store the relation between files and corresponding IDs.
This will scan all agenda files, all associated archives, and all
@ -427,11 +467,11 @@ When CHECK is given, prepare detailed information about duplicate IDs."
(if (symbolp org-id-extra-files)
(symbol-value org-id-extra-files)
org-id-extra-files)
;; Files associated with live org-mode buffers
;; Files associated with live org-mode buffers
(delq nil
(mapcar (lambda (b)
(with-current-buffer b
(and (eq major-mode 'org-mode) (buffer-file-name))))
(and (derived-mode-p 'org-mode) (buffer-file-name))))
(buffer-list)))
;; All files known to have IDs
org-id-files)))
@ -441,8 +481,9 @@ When CHECK is given, prepare detailed information about duplicate IDs."
(setq files (delq 'agenda-archives (copy-sequence files))))
(setq nfiles (length files))
(while (setq file (pop files))
(message "Finding ID locations (%d/%d files): %s"
(- nfiles (length files)) nfiles file)
(unless silent
(message "Finding ID locations (%d/%d files): %s"
(- nfiles (length files)) nfiles file))
(setq tfile (file-truename file))
(when (and (file-exists-p file) (not (member tfile seen)))
(push tfile seen)
@ -505,7 +546,7 @@ When CHECK is given, prepare detailed information about duplicate IDs."
(goto-char (point-min))
(setq org-id-locations (read (current-buffer))))
(error
(message "Could not read org-id-values from %s. Setting it to nil."
(message "Could not read org-id-values from %s. Setting it to nil."
org-id-locations-file))))
(setq org-id-files (mapcar 'car org-id-locations))
(setq org-id-locations (org-id-alist-to-hash org-id-locations))))
@ -600,8 +641,8 @@ optional argument MARKERP, return the position as a new marker."
(defun org-id-store-link ()
"Store a link to the current entry, using its ID."
(interactive)
(when (and (buffer-file-name (buffer-base-buffer)) (eq major-mode 'org-mode))
(let* ((link (org-make-link "id:" (org-id-get-create)))
(when (and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
(let* ((link (concat "id:" (org-id-get-create)))
(case-fold-search nil)
(desc (save-excursion
(org-back-to-heading t)

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

@ -45,6 +45,7 @@
(declare-function org-inlinetask-get-task-level "org-inlinetask" ())
(declare-function org-inlinetask-in-task-p "org-inlinetask" ())
(declare-function org-list-item-body-column "org-list" (item))
(defvar org-inlinetask-show-first-star)
(defgroup org-indent nil
"Options concerning dynamic virtual outline indentation."
@ -159,72 +160,75 @@ properties, after each buffer modification, on the modified zone.
The process is synchronous. Though, initial indentation of
buffer, which can take a few seconds on large buffers, is done
during idle time." nil " Ind" nil
(cond
((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 - 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 can crash Emacs 23.1 - refusing to turn it on!")
(ding)
(sit-for 1)
(setq org-indent-mode nil))
(org-indent-mode
;; mode was turned on.
(org-set-local 'indent-tabs-mode nil)
(or org-indent-strings (org-indent-initialize))
(org-set-local 'org-indent-initial-marker (copy-marker 1))
(when org-indent-mode-turns-off-org-adapt-indentation
(org-set-local 'org-adapt-indentation nil))
(when org-indent-mode-turns-on-hiding-stars
(org-set-local 'org-hide-leading-stars-before-indent-mode
org-hide-leading-stars)
(org-set-local 'org-hide-leading-stars t))
(make-local-variable 'buffer-substring-filters)
(add-to-list 'buffer-substring-filters
'org-indent-remove-properties-from-string)
(org-add-hook 'after-change-functions 'org-indent-refresh-maybe nil 'local)
(org-add-hook 'before-change-functions
'org-indent-notify-modified-headline nil 'local)
(and font-lock-mode (org-restart-font-lock))
(org-indent-remove-properties (point-min) (point-max))
;; Submit current buffer to initialize agent. If it's the first
;; buffer submitted, also start the agent. Current buffer is
;; pushed in both cases to avoid a race condition.
(if org-indent-agentized-buffers
(push (current-buffer) org-indent-agentized-buffers)
(cond
((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 - 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 can crash Emacs 23.1 - refusing to turn it on!")
(ding)
(sit-for 1)
(setq org-indent-mode nil))
(org-indent-mode
;; mode was turned on.
(org-set-local 'indent-tabs-mode nil)
(or org-indent-strings (org-indent-initialize))
(org-set-local 'org-indent-initial-marker (copy-marker 1))
(when org-indent-mode-turns-off-org-adapt-indentation
(org-set-local 'org-adapt-indentation nil))
(when org-indent-mode-turns-on-hiding-stars
(org-set-local 'org-hide-leading-stars-before-indent-mode
org-hide-leading-stars)
(org-set-local 'org-hide-leading-stars t))
(make-local-variable 'filter-buffer-substring-functions)
(add-hook 'filter-buffer-substring-functions
(lambda (fun start end delete)
(org-indent-remove-properties-from-string
(funcall fun start end delete))))
(org-add-hook 'after-change-functions 'org-indent-refresh-maybe nil 'local)
(org-add-hook 'before-change-functions
'org-indent-notify-modified-headline nil 'local)
(and font-lock-mode (org-restart-font-lock))
(org-indent-remove-properties (point-min) (point-max))
;; Submit current buffer to initialize agent. If it's the first
;; buffer submitted, also start the agent. Current buffer is
;; pushed in both cases to avoid a race condition.
(if org-indent-agentized-buffers
(push (current-buffer) org-indent-agentized-buffers)
(setq org-indent-agent-timer
(run-with-idle-timer 0.2 t #'org-indent-initialize-agent))))
(t
;; mode was turned off (or we refused to turn it on)
(kill-local-variable 'org-adapt-indentation)
(setq org-indent-agentized-buffers
(delq (current-buffer) org-indent-agentized-buffers))
(when (markerp org-indent-initial-marker)
(set-marker org-indent-initial-marker nil))
(when (boundp 'org-hide-leading-stars-before-indent-mode)
(org-set-local 'org-hide-leading-stars
org-hide-leading-stars-before-indent-mode))
(setq buffer-substring-filters
(delq 'org-indent-remove-properties-from-string
buffer-substring-filters))
(remove-hook 'after-change-functions 'org-indent-refresh-maybe 'local)
(remove-hook 'before-change-functions
'org-indent-notify-modified-headline 'local)
(org-with-wide-buffer
(org-indent-remove-properties (point-min) (point-max)))
(and font-lock-mode (org-restart-font-lock))
(redraw-display))))
(push (current-buffer) org-indent-agentized-buffers)
(setq org-indent-agent-timer
(run-with-idle-timer 0.2 t #'org-indent-initialize-agent))))
(t
;; mode was turned off (or we refused to turn it on)
(kill-local-variable 'org-adapt-indentation)
(setq org-indent-agentized-buffers
(delq (current-buffer) org-indent-agentized-buffers))
(when (markerp org-indent-initial-marker)
(set-marker org-indent-initial-marker nil))
(when (boundp 'org-hide-leading-stars-before-indent-mode)
(org-set-local 'org-hide-leading-stars
org-hide-leading-stars-before-indent-mode))
(remove-hook 'filter-buffer-substring-functions
(lambda (fun start end delete)
(org-indent-remove-properties-from-string
(funcall fun start end delete))))
(remove-hook 'after-change-functions 'org-indent-refresh-maybe 'local)
(remove-hook 'before-change-functions
'org-indent-notify-modified-headline 'local)
(org-with-wide-buffer
(org-indent-remove-properties (point-min) (point-max)))
(and font-lock-mode (org-restart-font-lock))
(redraw-display))))
(defun org-indent-indent-buffer ()
"Add indentation properties to the accessible part of the buffer."
(interactive)
(if (not (eq major-mode 'org-mode))
(if (not (derived-mode-p 'org-mode))
(error "Not in Org mode")
(message "Setting buffer indentation. It may take a few seconds...")
(message "Setting buffer indentation. It may take a few seconds...")
(org-indent-remove-properties (point-min) (point-max))
(org-indent-add-properties (point-min) (point-max))
(message "Indentation of buffer set.")))
@ -293,8 +297,10 @@ Assume point is at beginning of line."
(let ((stars (aref org-indent-stars
(min l org-indent-max-levels))))
(and stars
(concat org-indent-inlinetask-first-star
(substring stars 1)))))
(if (org-bound-and-true-p org-inlinetask-show-first-star)
(concat org-indent-inlinetask-first-star
(substring stars 1))
stars))))
(h (aref org-indent-stars
(min l org-indent-max-levels)))
(t (aref org-indent-strings
@ -414,12 +420,12 @@ This function is meant to be called by `after-change-functions'."
(goto-char beg)
(beginning-of-line)
(re-search-forward org-outline-regexp-bol end t)))
(let ((end (save-excursion
(goto-char end)
(org-with-limited-levels (outline-next-heading))
(point))))
(setq org-indent-modified-headline-flag nil)
(org-indent-add-properties beg end))
(let ((end (save-excursion
(goto-char end)
(org-with-limited-levels (outline-next-heading))
(point))))
(setq org-indent-modified-headline-flag nil)
(org-indent-add-properties beg end))
;; Otherwise, only set properties on modified area.
(org-indent-add-properties beg end)))))

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

@ -48,9 +48,9 @@
"Store a link to an Info file and node."
(when (eq major-mode 'Info-mode)
(let (link desc)
(setq link (org-make-link "info:"
(file-name-nondirectory Info-current-file)
"#" Info-current-node))
(setq link (concat "info:"
(file-name-nondirectory Info-current-file)
"#" Info-current-node))
(setq desc (concat (file-name-nondirectory Info-current-file)
"#" Info-current-node))
(org-store-link-props :type "info" :file Info-current-file

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

@ -90,6 +90,9 @@
(defcustom org-inlinetask-min-level 15
"Minimum level a headline must have before it is treated as an inline task.
Don't set it to something higher than `29' or clocking will break since this
is the hardcoded maximum number of stars `org-clock-sum' will work with.
It is strongly recommended that you set `org-cycle-max-level' not at all,
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
@ -99,6 +102,12 @@ the value of this variable."
(const :tag "Off" nil)
(integer)))
(defcustom org-inlinetask-show-first-star nil
"Non-nil means display the first star of an inline task as additional marker.
When nil, the first star is not shown."
:tag "Org Inline Tasks"
:group 'org-structure)
(defcustom org-inlinetask-export t
"Non-nil means export inline tasks.
When nil, they will not be exported."
@ -329,75 +338,75 @@ Either remove headline and meta data, or do special formatting."
(end (copy-marker (save-excursion
(org-inlinetask-goto-end) (point))))
content)
;; Delete SCHEDULED, DEADLINE...
(while (re-search-forward keywords-re end t)
(delete-region (point-at-bol) (1+ (point-at-eol))))
(goto-char beg)
;; Delete drawers
(while (re-search-forward org-drawer-regexp end t)
(when (save-excursion (re-search-forward org-property-end-re nil t))
(delete-region beg (1+ (match-end 0)))))
;; Get CONTENT, if any.
(goto-char beg)
(forward-line 1)
(unless (= (point) end)
(setq content (buffer-substring (point)
(save-excursion (goto-char end)
(forward-line -1)
(point)))))
;; Remove the task.
(goto-char beg)
(delete-region beg end)
(when (and org-inlinetask-export
(assq org-export-current-backend
org-inlinetask-export-templates))
;; Format CONTENT, if appropriate.
(setq content
(if (not (and content (string-match "\\S-" content)))
""
;; Ensure CONTENT has minimal indentation, a single
;; newline character at its boundaries, and isn't
;; protected.
(when (string-match "\\`\\([ \t]*\n\\)+" content)
(setq content (substring content (match-end 0))))
(when (string-match "[ \t\n]+\\'" content)
(setq content (substring content 0 (match-beginning 0))))
(org-add-props
(concat "\n\n" (org-remove-indentation content) "\n\n")
'(org-protected nil org-native-text nil))))
;; Delete SCHEDULED, DEADLINE...
(while (re-search-forward keywords-re end t)
(delete-region (point-at-bol) (1+ (point-at-eol))))
(goto-char beg)
;; Delete drawers
(while (re-search-forward org-drawer-regexp end t)
(when (save-excursion (re-search-forward org-property-end-re nil t))
(delete-region beg (1+ (match-end 0)))))
;; Get CONTENT, if any.
(goto-char beg)
(forward-line 1)
(unless (= (point) end)
(setq content (buffer-substring (point)
(save-excursion (goto-char end)
(forward-line -1)
(point)))))
;; Remove the task.
(goto-char beg)
(delete-region beg end)
(when (and org-inlinetask-export
(assq org-export-current-backend
org-inlinetask-export-templates))
;; Format CONTENT, if appropriate.
(setq content
(if (not (and content (string-match "\\S-" content)))
""
;; Ensure CONTENT has minimal indentation, a single
;; newline character at its boundaries, and isn't
;; protected.
(when (string-match "\\`\\([ \t]*\n\\)+" content)
(setq content (substring content (match-end 0))))
(when (string-match "[ \t\n]+\\'" content)
(setq content (substring content 0 (match-beginning 0))))
(org-add-props
(concat "\n\n" (org-remove-indentation content) "\n\n")
'(org-protected nil org-native-text nil))))
(when (string-match org-complex-heading-regexp headline)
(let* ((nil-to-str
(function
;; Change nil arguments into empty strings.
(lambda (el) (or (eval el) ""))))
;; Set up keywords provided to templates.
(todo (or (match-string 2 headline) ""))
(class (or (and (eq "" todo) "")
(if (member todo org-done-keywords) "done" "todo")))
(priority (or (match-string 3 headline) ""))
(heading (or (match-string 4 headline) ""))
(tags (or (match-string 5 headline) ""))
;; Read `org-inlinetask-export-templates'.
(backend-spec (assq org-export-current-backend
org-inlinetask-export-templates))
(format-str (org-add-props (nth 1 backend-spec)
'(org-protected t org-native-text t)))
(tokens (cadr (nth 2 backend-spec)))
;; Build export string. Ensure it won't break
;; surrounding lists by giving it arbitrary high
;; indentation.
(export-str (org-add-props
(eval (append '(format format-str)
(mapcar nil-to-str tokens)))
'(original-indentation 1000))))
;; Ensure task starts a new paragraph.
(unless (or (bobp)
(save-excursion (forward-line -1)
(looking-at "[ \t]*$")))
(insert "\n"))
(insert export-str)
(unless (bolp) (insert "\n")))))))))
(when (string-match org-complex-heading-regexp headline)
(let* ((nil-to-str
(function
;; Change nil arguments into empty strings.
(lambda (el) (or (eval el) ""))))
;; Set up keywords provided to templates.
(todo (or (match-string 2 headline) ""))
(class (or (and (eq "" todo) "")
(if (member todo org-done-keywords) "done" "todo")))
(priority (or (match-string 3 headline) ""))
(heading (or (match-string 4 headline) ""))
(tags (or (match-string 5 headline) ""))
;; Read `org-inlinetask-export-templates'.
(backend-spec (assq org-export-current-backend
org-inlinetask-export-templates))
(format-str (org-add-props (nth 1 backend-spec)
'(org-protected t org-native-text t)))
(tokens (cadr (nth 2 backend-spec)))
;; Build export string. Ensure it won't break
;; surrounding lists by giving it arbitrary high
;; indentation.
(export-str (org-add-props
(eval (append '(format format-str)
(mapcar nil-to-str tokens)))
'(original-indentation 1000))))
;; Ensure task starts a new paragraph.
(unless (or (bobp)
(save-excursion (forward-line -1)
(looking-at "[ \t]*$")))
(insert "\n"))
(insert export-str)
(unless (bolp) (insert "\n")))))))))
(defun org-inlinetask-get-current-indentation ()
"Get the indentation of the last non-while line above this one."
@ -423,18 +432,21 @@ Either remove headline and meta data, or do special formatting."
(1- (* 2 (or org-inlinetask-min-level 200)))
(or org-inlinetask-min-level 200)))
(re (concat "^\\(\\*\\)\\(\\*\\{"
(format "%d" (- nstars 3))
",\\}\\)\\(\\*\\* .*\\)"))
(format "%d" (- nstars 3))
",\\}\\)\\(\\*\\* .*\\)"))
;; Virtual indentation will add the warning face on the first
;; star. Thus, in that case, only hide it.
;; star. Thus, in that case, only hide it.
(start-face (if (and (org-bound-and-true-p org-indent-mode)
(> org-indent-indentation-per-level 1))
'org-hide
'org-warning)))
(while (re-search-forward re limit t)
(add-text-properties (match-beginning 1) (match-end 1)
`(face ,start-face font-lock-fontified t))
(add-text-properties (match-beginning 2) (match-end 2)
(if org-inlinetask-show-first-star
(add-text-properties (match-beginning 1) (match-end 1)
`(face ,start-face font-lock-fontified t)))
(add-text-properties (match-beginning
(if org-inlinetask-show-first-star 2 1))
(match-end 2)
'(face org-hide font-lock-fontified t))
(add-text-properties (match-beginning 3) (match-end 3)
'(face org-inlinetask font-lock-fontified t)))))
@ -452,7 +464,7 @@ Either remove headline and meta data, or do special formatting."
((= end start))
;; Inlinetask was folded: expand it.
((get-char-property (1+ start) 'invisible)
(outline-flag-region start end nil))
(org-show-entry))
(t (outline-flag-region start end t)))))
(defun org-inlinetask-remove-END-maybe ()

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

@ -81,10 +81,10 @@
"Parse LINK and dispatch to the correct function based on the client found."
(let ((link (org-irc-parse-link link)))
(cond
((eq org-irc-client 'erc)
(org-irc-visit-erc link))
(t
(error "erc only known client")))))
((eq org-irc-client 'erc)
(org-irc-visit-erc link))
(t
(error "ERC only known client")))))
(defun org-irc-parse-link (link)
"Parse an IRC LINK and return the attributes found.
@ -102,8 +102,8 @@ attributes that are found."
(defun org-irc-store-link ()
"Dispatch to the appropriate function to store a link to an IRC session."
(cond
((eq major-mode 'erc-mode)
(org-irc-erc-store-link))))
((eq major-mode 'erc-mode)
(org-irc-erc-store-link))))
(defun org-irc-elipsify-description (string &optional after)
"Remove unnecessary white space from STRING and add ellipses if necessary.
@ -140,9 +140,9 @@ result is a cons of the filename and search string."
(when (search-backward-regexp "^[^ ]" nil t)
(buffer-substring-no-properties (point-at-bol)
(point-at-eol))))
(when (search-backward erc-line nil t)
(buffer-substring-no-properties (point-at-bol)
(point-at-eol)))))))
(when (search-backward erc-line nil t)
(buffer-substring-no-properties (point-at-bol)
(point-at-eol)))))))
(defun org-irc-erc-store-link ()
"Store a link to the IRC log file or the session itself.
@ -164,27 +164,27 @@ the session itself."
:link (concat "file:" (car parsed-line) "::"
(cadr parsed-line)))
t)
(error "This ERC session is not being logged")))
(let* ((link-text (org-irc-get-erc-link))
(link (org-irc-parse-link link-text)))
(if link-text
(progn
(org-store-link-props
:type "irc"
:link (org-make-link "irc:/" link-text)
:description (concat "irc session '" link-text "'")
:server (car (car link))
:port (or (string-to-number (cadr (pop link))) erc-default-port)
:nick (pop link))
t)
(error "Failed to create ('irc:/' style) ERC link")))))
(error "This ERC session is not being logged")))
(let* ((link-text (org-irc-get-erc-link))
(link (org-irc-parse-link link-text)))
(if link-text
(progn
(org-store-link-props
:type "irc"
:link (concat "irc:/" link-text)
:description (concat "irc session '" link-text "'")
:server (car (car link))
:port (or (string-to-number (cadr (pop link))) erc-default-port)
:nick (pop link))
t)
(error "Failed to create ('irc:/' style) ERC link")))))
(defun org-irc-get-erc-link ()
"Return an org compatible irc:/ link from an ERC buffer."
(let* ((session-port (if (numberp erc-session-port)
(number-to-string erc-session-port)
erc-session-port))
(link (concat erc-session-server ":" session-port)))
erc-session-port))
(link (concat erc-session-server ":" session-port)))
(concat link "/"
(if (and (erc-default-target)
(erc-channel-p (erc-default-target))
@ -192,19 +192,19 @@ the session itself."
;; we can get a nick
(let ((nick (car (get-text-property (point) 'erc-data))))
(concat (erc-default-target) "/" nick))
(erc-default-target)))))
(erc-default-target)))))
(defun org-irc-get-current-erc-port ()
"Return the current port as a number.
Return the current port number or, if none is set, return the ERC
default."
(cond
((stringp erc-session-port)
(string-to-number erc-session-port))
((numberp erc-session-port)
erc-session-port)
(t
erc-default-port)))
((stringp erc-session-port)
(string-to-number erc-session-port))
((numberp erc-session-port)
erc-session-port)
(t
erc-default-port)))
(defun org-irc-visit-erc (link)
"Visit an ERC buffer based on criteria found in LINK."
@ -242,13 +242,13 @@ default."
(progn
(goto-char (point-max))
(insert (concat nick ": ")))
(error "%s not found in %s" nick chan-name)))))
(progn
(org-pop-to-buffer-same-window server-buffer)
(erc-cmd-JOIN chan-name))))
(org-pop-to-buffer-same-window server-buffer)))
;; no server match, make new connection
(erc-select :server server :port port))))
(error "%s not found in %s" nick chan-name)))))
(progn
(org-pop-to-buffer-same-window server-buffer)
(erc-cmd-JOIN chan-name))))
(org-pop-to-buffer-same-window server-buffer)))
;; no server match, make new connection
(erc-select :server server :port port))))
(provide 'org-irc)

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

@ -99,13 +99,69 @@ means to use the maximum value consistent with other options."
(lambda (x)
(list 'cons (list 'const (car x))
'(choice
(symbol :tag "Publishing/Export property")
(string :tag "Value"))))
(symbol :tag "Publishing/Export property")
(string :tag "Value"))))
org-infojs-opts-table)))
(defcustom org-infojs-template
"<script type=\"text/javascript\" src=\"%SCRIPT_PATH\"></script>
<script type=\"text/javascript\" >
"<script type=\"text/javascript\" src=\"%SCRIPT_PATH\">
/**
*
* @source: %SCRIPT_PATH
*
* @licstart The following is the entire license notice for the
* JavaScript code in %SCRIPT_PATH.
*
* Copyright (C) 2012 Sebastian Rose
*
*
* The JavaScript code in this tag is free software: you can
* redistribute it and/or modify it under the terms of the GNU
* General Public License (GNU GPL) as published by the Free Software
* Foundation, either version 3 of the License, or (at your option)
* any later version. The code is distributed WITHOUT ANY WARRANTY;
* without even the implied warranty of MERCHANTABILITY or FITNESS
* FOR A PARTICULAR PURPOSE. See the GNU GPL for more details.
*
* As additional permission under GNU GPL version 3 section 7, you
* may distribute non-source (e.g., minimized or compacted) forms of
* that code without the copy of the GNU GPL normally required by
* section 4, provided you include this license notice and a URL
* through which recipients can access the Corresponding Source.
*
* @licend The above is the entire license notice
* for the JavaScript code in %SCRIPT_PATH.
*
*/
</script>
<script type=\"text/javascript\">
/*
@licstart The following is the entire license notice for the
JavaScript code in this tag.
Copyright (C) 2012 Free Software Foundation, Inc.
The JavaScript code in this tag is free software: you can
redistribute it and/or modify it under the terms of the GNU
General Public License (GNU GPL) as published by the Free Software
Foundation, either version 3 of the License, or (at your option)
any later version. The code is distributed WITHOUT ANY WARRANTY;
without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU GPL for more details.
As additional permission under GNU GPL version 3 section 7, you
may distribute non-source (e.g., minimized or compacted) forms of
that code without the copy of the GNU GPL normally required by
section 4, provided you include this license notice and a URL
through which recipients can access the Corresponding Source.
@licend The above is the entire license notice
for the JavaScript code in this tag.
*/
<!--/*--><![CDATA[/*><!--*/
%MANAGER_OPTIONS
org_html_manager.setup(); // activate after the parameters are set
@ -127,67 +183,67 @@ Option settings will replace the %MANAGER-OPTIONS cookie."
exp-plist
;; We do want to use the script, set it up
(let ((template org-infojs-template)
(ptoc (plist-get exp-plist :table-of-contents))
(hlevels (plist-get exp-plist :headline-levels))
tdepth sdepth s v e opt var val table default)
(setq sdepth hlevels
tdepth hlevels)
(if (integerp ptoc) (setq tdepth (min ptoc tdepth)))
(setq v (plist-get exp-plist :infojs-opt)
table org-infojs-opts-table)
(while (setq e (pop table))
(setq opt (car e) var (nth 1 e)
default (cdr (assoc opt org-infojs-options)))
(and (symbolp default) (not (memq default '(t nil)))
(setq default (plist-get exp-plist default)))
(if (and v (string-match (format " %s:\\(\\S-+\\)" opt) v))
(setq val (match-string 1 v))
(setq val default))
(cond
((eq opt 'path)
(and (string-match "%SCRIPT_PATH" template)
(setq template (replace-match val t t template))))
((eq opt 'sdepth)
(if (integerp (read val))
(setq sdepth (min (read val) hlevels))))
((eq opt 'tdepth)
(if (integerp (read val))
(setq tdepth (min (read val) hlevels))))
(t
(setq val
(cond
((or (eq val t) (equal val "t")) "1")
((or (eq val nil) (equal val "nil")) "0")
((stringp val) val)
(t (format "%s" val))))
(push (cons var val) s))))
(ptoc (plist-get exp-plist :table-of-contents))
(hlevels (plist-get exp-plist :headline-levels))
tdepth sdepth s v e opt var val table default)
(setq sdepth hlevels
tdepth hlevels)
(if (integerp ptoc) (setq tdepth (min ptoc tdepth)))
(setq v (plist-get exp-plist :infojs-opt)
table org-infojs-opts-table)
(while (setq e (pop table))
(setq opt (car e) var (nth 1 e)
default (cdr (assoc opt org-infojs-options)))
(and (symbolp default) (not (memq default '(t nil)))
(setq default (plist-get exp-plist default)))
(if (and v (string-match (format " %s:\\(\\S-+\\)" opt) v))
(setq val (match-string 1 v))
(setq val default))
(cond
((eq opt 'path)
(setq template
(replace-regexp-in-string "%SCRIPT_PATH" val template t t)))
((eq opt 'sdepth)
(if (integerp (read val))
(setq sdepth (min (read val) hlevels))))
((eq opt 'tdepth)
(if (integerp (read val))
(setq tdepth (min (read val) hlevels))))
(t
(setq val
(cond
((or (eq val t) (equal val "t")) "1")
((or (eq val nil) (equal val "nil")) "0")
((stringp val) val)
(t (format "%s" val))))
(push (cons var val) s))))
;; Now we set the depth of the *generated* TOC to SDEPTH, because the
;; toc will actually determine the splitting. How much of the toc will
;; actually be displayed is governed by the TDEPTH option.
(setq exp-plist (plist-put exp-plist :table-of-contents sdepth))
;; Now we set the depth of the *generated* TOC to SDEPTH, because the
;; toc will actually determine the splitting. How much of the toc will
;; actually be displayed is governed by the TDEPTH option.
(setq exp-plist (plist-put exp-plist :table-of-contents sdepth))
;; The table of contents should not show more sections then we generate
(setq tdepth (min tdepth sdepth))
(push (cons "TOC_DEPTH" tdepth) s)
;; The table of contents should not show more sections then we generate
(setq tdepth (min tdepth sdepth))
(push (cons "TOC_DEPTH" tdepth) s)
(setq s (mapconcat
(lambda (x) (format "org_html_manager.set(\"%s\", \"%s\");"
(car x) (cdr x)))
s "\n"))
(when (and s (> (length s) 0))
(and (string-match "%MANAGER_OPTIONS" template)
(setq s (replace-match s t t template))
(setq exp-plist
(plist-put
exp-plist :style-extra
(concat (or (plist-get exp-plist :style-extra) "") "\n" s)))))
;; This script absolutely needs the table of contents, to we change that
;; setting
(if (not (plist-get exp-plist :table-of-contents))
(setq exp-plist (plist-put exp-plist :table-of-contents t)))
;; Return the modified property list
exp-plist)))
(setq s (mapconcat
(lambda (x) (format "org_html_manager.set(\"%s\", \"%s\");"
(car x) (cdr x)))
s "\n"))
(when (and s (> (length s) 0))
(and (string-match "%MANAGER_OPTIONS" template)
(setq s (replace-match s t t template))
(setq exp-plist
(plist-put
exp-plist :style-extra
(concat (or (plist-get exp-plist :style-extra) "") "\n" s)))))
;; This script absolutely needs the table of contents, to we change that
;; setting
(if (not (plist-get exp-plist :table-of-contents))
(setq exp-plist (plist-put exp-plist :table-of-contents t)))
;; Return the modified property list
exp-plist)))
(defun org-infojs-options-inbuffer-template ()
(format "#+INFOJS_OPT: view:%s toc:%s ltoc:%s mouse:%s buttons:%s path:%s"

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

@ -235,7 +235,7 @@ are written as utf8 files."
"Alist of LaTeX expressions to convert emphasis fontifiers.
Each element of the list is a list of three elements.
The first element is the character used as a marker for fontification.
The second element is a formatting string to wrap fontified text with.
The second element is a format string to wrap fontified text with.
If it is \"\\verb\", Org will automatically select a delimiter
character that is not in the string. \"\\protectedtexttt\" will use \\texttt
to typeset and try to protect special characters.
@ -247,7 +247,7 @@ conversions."
(defcustom org-export-latex-title-command "\\maketitle"
"The command used to insert the title just after \\begin{document}.
If this string contains the formatting specification \"%s\" then
it will be used as a formatting string, passing the title as an
it will be used as a format string, passing the title as an
argument."
:group 'org-export-latex
:type 'string)
@ -321,6 +321,18 @@ will be filled with the link, the second with its description."
:version "24.1"
:type 'string)
(defcustom org-export-latex-hyperref-options-format
"\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={Emacs Org-mode version %s}}\n"
"A format string for hyperref options.
When non-nil, it must contain three %s format specifications
which will respectively be replaced by the document's keywords,
its description and the Org's version number, as a string. Set
this option to the empty string if you don't want to include
hyperref options altogether."
:type 'string
:version "24.3"
:group 'org-export-latex)
(defcustom org-export-latex-footnote-separator "\\textsuperscript{,}\\,"
"Text used to separate footnotes."
:group 'org-export-latex
@ -377,6 +389,33 @@ When nil, grouping causes only separation lines between groups."
:group 'org-export-latex
:type 'boolean)
(defcustom org-export-latex-tables-tstart nil
"LaTeX command for top rule for tables."
:group 'org-export-latex
:version "24.1"
:type '(choice
(const :tag "Nothing" nil)
(string :tag "String")
(const :tag "Booktabs default: \\toprule" "\\toprule")))
(defcustom org-export-latex-tables-hline "\\hline"
"LaTeX command to use for a rule somewhere in the middle of a table."
:group 'org-export-latex
:version "24.1"
:type '(choice
(string :tag "String")
(const :tag "Standard: \\hline" "\\hline")
(const :tag "Booktabs default: \\midrule" "\\midrule")))
(defcustom org-export-latex-tables-tend nil
"LaTeX command for bottom rule for tables."
:group 'org-export-latex
:version "24.1"
:type '(choice
(const :tag "Nothing" nil)
(string :tag "String")
(const :tag "Booktabs default: \\bottomrule" "\\bottomrule")))
(defcustom org-export-latex-low-levels 'itemize
"How to convert sections below the current level of sectioning.
This is specified by the `org-export-headline-levels' option or the
@ -518,9 +557,9 @@ pygmentize -L lexers
"Association list of options for the latex listings package.
These options are supplied as a comma-separated list to the
\\lstset command. Each element of the association list should be
\\lstset command. Each element of the association list should be
a list containing two strings: the name of the option, and the
value. For example,
value. For example,
(setq org-export-latex-listings-options
'((\"basicstyle\" \"\\small\")
@ -542,9 +581,9 @@ languages."
"Association list of options for the latex minted package.
These options are supplied within square brackets in
\\begin{minted} environments. Each element of the alist should be
\\begin{minted} environments. Each element of the alist should be
a list containing two strings: the name of the option, and the
value. For example,
value. For example,
(setq org-export-latex-minted-options
'((\"bgcolor\" \"bg\") (\"frame\" \"lines\")))
@ -553,7 +592,7 @@ will result in src blocks being exported with
\\begin{minted}[bgcolor=bg,frame=lines]{<LANG>}
as the start of the minted environment. Note that the same
as the start of the minted environment. Note that the same
options will be applied to blocks of all languages."
:group 'org-export-latex
:version "24.1"
@ -565,7 +604,7 @@ options will be applied to blocks of all languages."
(defvar org-export-latex-custom-lang-environments nil
"Association list mapping languages to language-specific latex
environments used during export of src blocks by the listings
and minted latex packages. For example,
and minted latex packages. For example,
(setq org-export-latex-custom-lang-environments
'((python \"pythoncode\")))
@ -607,6 +646,12 @@ and `org-export-with-tags' instead."
:version "24.1"
:type 'string)
(defcustom org-export-latex-link-with-unknown-path-format "\\texttt{%s}"
"Format string for links with unknown path type."
:group 'org-export-latex
:version "24.3"
:type 'string)
(defcustom org-export-latex-inline-image-extensions
'("pdf" "jpeg" "jpg" "png" "ps" "eps")
"Extensions of image files that can be inlined into LaTeX.
@ -632,11 +677,24 @@ allowed. The default we use here encompasses both."
'("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. %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.
"Commands to process a LaTeX file to a PDF file and process latex
fragments to pdf files.By default,this is a list of strings,and each of
strings will be given to the shell 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.
If you set `org-create-formula-image-program'
`org-export-with-LaTeX-fragments' to 'imagemagick, you can add a
sublist which contains your own command(s) for LaTeX fragments
previewing, like this:
'(\"xelatex -interaction nonstopmode -output-directory %o %f\"
\"xelatex -interaction nonstopmode -output-directory %o %f\"
;; use below command(s) to convert latex fragments
(\"xelatex %f\"))
With no such sublist, the default command used to convert LaTeX
fragments will be the first string in the list.
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
@ -661,28 +719,28 @@ This function should accept the file name as its single argument."
(string :tag "Shell command"))
(const :tag "2 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 "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"))
"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"))
"bibtex %b"
"pdflatex -interaction nonstopmode -output-directory %o %f"
"pdflatex -interaction nonstopmode -output-directory %o %f"))
(const :tag "2 runs of xelatex"
("xelatex -interaction nonstopmode -output-directory %o %f"
"xelatex -interaction nonstopmode -output-directory %o %f"))
"xelatex -interaction nonstopmode -output-directory %o %f"))
(const :tag "3 runs of xelatex"
("xelatex -interaction nonstopmode -output-directory %o %f"
"xelatex -interaction nonstopmode -output-directory %o %f"
"xelatex -interaction nonstopmode -output-directory %o %f"))
"xelatex -interaction nonstopmode -output-directory %o %f"
"xelatex -interaction nonstopmode -output-directory %o %f"))
(const :tag "xelatex,bibtex,xelatex,xelatex"
("xelatex -interaction nonstopmode -output-directory %o %f"
"bibtex %b"
"xelatex -interaction nonstopmode -output-directory %o %f"
"xelatex -interaction nonstopmode -output-directory %o %f"))
"bibtex %b"
"xelatex -interaction nonstopmode -output-directory %o %f"
"xelatex -interaction nonstopmode -output-directory %o %f"))
(const :tag "texi2dvi"
("texi2dvi -p -b -c -V %f"))
(const :tag "rubber"
@ -750,7 +808,7 @@ then use this command to convert it."
(interactive "r")
(let (reg latex buf)
(save-window-excursion
(if (eq major-mode 'org-mode)
(if (derived-mode-p 'org-mode)
(setq latex (org-export-region-as-latex
beg end t 'string))
(setq reg (buffer-substring beg end)
@ -985,7 +1043,7 @@ when PUB-DIR is set, use this as the publishing directory."
(when (and text (not (eq to-buffer 'string)))
(insert (org-export-latex-content
text '(lists tables fixed-width keywords))
"\n\n"))
"\n\n"))
;; insert lines before the first headline
(unless (or skip (string-match "^\\*" first-lines))
@ -1034,6 +1092,11 @@ when PUB-DIR is set, use this as the publishing directory."
(if (looking-at "[\n \t]+")
(replace-match "\n")))
;; Ensure we have a final newline
(goto-char (point-max))
(or (eq (char-before) ?\n)
(insert ?\n))
(run-hooks 'org-export-latex-final-hook)
(if to-buffer
(unless (eq major-mode 'latex-mode) (latex-mode))
@ -1084,22 +1147,24 @@ when PUB-DIR is set, use this as the publishing directory."
(funcall cmds (shell-quote-argument file))
(while cmds
(setq cmd (pop cmds))
(while (string-match "%b" cmd)
(setq cmd (replace-match
(save-match-data
(shell-quote-argument base))
t t cmd)))
(while (string-match "%f" cmd)
(setq cmd (replace-match
(save-match-data
(shell-quote-argument file))
t t cmd)))
(while (string-match "%o" cmd)
(setq cmd (replace-match
(save-match-data
(shell-quote-argument output-dir))
t t cmd)))
(shell-command cmd outbuf)))))
(cond
((not (listp cmd))
(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"))
(setq errors (org-export-latex-get-error outbuf))
(if (not (file-exists-p pdffile))
@ -1471,11 +1536,10 @@ OPT-PLIST is the options plist for current buffer."
(or (plist-get opt-plist :date)
org-export-latex-date-format)))
;; add some hyperref options
;; FIXME: let's have a defcustom for this?
(format "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={%s}}\n"
(org-export-latex-fontify-headline keywords)
(org-export-latex-fontify-headline description)
(concat "Emacs Org-mode version " org-version))
(format org-export-latex-hyperref-options-format
(org-export-latex-fontify-headline keywords)
(org-export-latex-fontify-headline description)
(org-version))
;; beginning of the document
"\n\\begin{document}\n\n"
;; insert the title command
@ -1569,7 +1633,7 @@ links, keywords, lists, tables, fixed-width"
(unless (memq 'fixed-width exclude-list)
(org-export-latex-fixed-width
(plist-get org-export-latex-options-plist :fixed-width)))
;; return string
;; return string
(buffer-substring (point-min) (point-max))))
(defun org-export-latex-protect-string (s)
@ -1691,13 +1755,13 @@ links, keywords, lists, tables, fixed-width"
(let ((org-display-custom-times org-export-latex-display-custom-times))
(while (re-search-forward org-ts-regexp-both nil t)
(org-if-unprotected-at (1- (point))
(replace-match
(org-export-latex-protect-string
(format (if (string= "<" (substring (match-string 0) 0 1))
org-export-latex-timestamp-markup
org-export-latex-timestamp-inactive-markup)
(substring (org-translate-time (match-string 0)) 1 -1)))
t t)))))
(replace-match
(org-export-latex-protect-string
(format (if (string= "<" (substring (match-string 0) 0 1))
org-export-latex-timestamp-markup
org-export-latex-timestamp-inactive-markup)
(substring (org-translate-time (match-string 0)) 1 -1)))
t t)))))
(defun org-export-latex-quotation-marks ()
"Export quotation marks depending on language conventions."
@ -1723,8 +1787,7 @@ See the `org-export-latex.el' code for a complete conversion table."
(goto-char (point-min))
(while (re-search-forward c nil t)
;; Put the point where to check for org-protected
(unless (or (get-text-property (match-beginning 2) 'org-protected)
(save-match-data (org-at-table.el-p)))
(unless (get-text-property (match-beginning 2) 'org-protected)
(cond ((member (match-string 2) '("\\$" "$"))
(if (equal (match-string 2) "\\$")
nil
@ -1752,7 +1815,7 @@ See the `org-export-latex.el' code for a complete conversion table."
(replace-match (match-string 2) t t)
(replace-match (concat (match-string 1) "\\"
(match-string 2)) t t)))))
(unless (save-match-data (org-inside-latex-math-p))
(unless (save-match-data (or (org-inside-latex-math-p) (org-at-table-p)))
(cond ((equal (match-string 2) "\\")
(replace-match (or (save-match-data
(org-export-latex-treat-backslash-char
@ -1877,19 +1940,19 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(goto-char (point-min))
(while (re-search-forward "^[ \t]*:\\([ \t]\\|$\\)" nil t)
(unless (get-text-property (point) 'org-example)
(if opt
(progn (goto-char (match-beginning 0))
(insert "\\begin{verbatim}\n")
(while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$")
(replace-match (concat (match-string 1)
(match-string 2)) t t)
(forward-line))
(insert "\\end{verbatim}\n"))
(progn (goto-char (match-beginning 0))
(while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$")
(replace-match (concat "%" (match-string 1)
(match-string 2)) t t)
(forward-line)))))))
(if opt
(progn (goto-char (match-beginning 0))
(insert "\\begin{verbatim}\n")
(while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$")
(replace-match (concat (match-string 1)
(match-string 2)) t t)
(forward-line))
(insert "\\end{verbatim}\n"))
(progn (goto-char (match-beginning 0))
(while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$")
(replace-match (concat "%" (match-string 1)
(match-string 2)) t t)
(forward-line)))))))
(defvar org-table-last-alignment) ; defined in org-table.el
(defvar org-table-last-column-widths) ; defined in org-table.el
@ -1915,7 +1978,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 width shortn label attr floatp placement
caption width shortn label attr hfmt floatp placement
longtblp tblenv tabular-env)
(if org-export-latex-tables-verbatim
(let* ((tbl (concat "\\begin{verbatim}\n" raw-table
@ -1952,6 +2015,9 @@ 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))
hfmt (and attr (stringp attr)
(string-match "\\<hfmt=\\(\\S-+\\)" attr)
(match-string 1 attr))
floatp (or caption label (string= "table*" tblenv))
placement (if (and attr
(stringp attr)
@ -1967,7 +2033,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(when org-table-clean-did-remove-column
(pop org-table-last-alignment)
(pop org-table-last-column-widths))
;; make a formatting string to reflect alignment
;; make a format string to reflect alignment
(setq olines lines)
(while (and (not line-fmt) (setq line (pop olines)))
(unless (string-match "^[ \t]*|-" line)
@ -2034,14 +2100,21 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
align))
(orgtbl-to-latex
lines
`(:tstart nil :tend nil
`(:tstart ,org-export-latex-tables-tstart
:tend ,org-export-latex-tables-tend
:hline ,org-export-latex-tables-hline
:skipheadrule ,longtblp
:hfmt ,hfmt
:hlend ,(if longtblp
(format "\\\\
\\hline
%s
\\endhead
\\hline\\multicolumn{%d}{r}{Continued on next page}\\
%s\\multicolumn{%d}{r}{Continued on next page}\\
\\endfoot
\\endlastfoot" (length org-table-last-alignment))
\\endlastfoot"
org-export-latex-tables-hline
org-export-latex-tables-hline
(length org-table-last-alignment))
nil)))
(if (not longtblp) (format "\n\\end{%s}" tabular-env))
(if longtblp "\n" (if org-export-latex-tables-centered
@ -2272,8 +2345,8 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(insert
(save-match-data
(funcall fnc (org-link-unescape raw-path) desc 'latex))))
(t (insert "\\texttt{" desc "}")))))))
;; Unrecognized path type
(t (insert (format org-export-latex-link-with-unknown-path-format desc))))))))
(defun org-export-latex-format-image (path caption label attr &optional shortn)
@ -2382,7 +2455,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
;; Compute string to insert (FNOTE), and protect the outside
;; macro from further transformation. When footnote at
;; point is referring to a previously defined footnote, use
;; \footnotemark. Otherwise, use \footnote.
;; \footnotemark. Otherwise, use \footnote.
(let ((fnote (if (member lbl org-export-latex-footmark-seen)
(org-export-latex-protect-string
(format "\\footnotemark[%s]" lbl))
@ -2607,7 +2680,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(defun org-export-latex-lists ()
"Convert plain text lists in current buffer into LaTeX lists."
;; `org-list-end-re' output has changed since preprocess from
;; org-exp.el. Make sure it is taken into account.
;; org-exp.el. Make sure it is taken into account.
(let ((org-list-end-re "^ORG-LIST-END-MARKER\n"))
(mapc
(lambda (e)
@ -2638,181 +2711,181 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(append org-list-export-context '(nil)))))
(defconst org-latex-entities
'("\\!"
"\\'"
"\\+"
"\\,"
"\\-"
"\\:"
"\\;"
"\\<"
"\\="
"\\>"
"\\Huge"
"\\LARGE"
"\\Large"
"\\Styles"
"\\\\"
"\\`"
"\\\""
"\\addcontentsline"
"\\address"
"\\addtocontents"
"\\addtocounter"
"\\addtolength"
"\\addvspace"
"\\alph"
"\\appendix"
"\\arabic"
"\\author"
"\\begin{array}"
"\\begin{center}"
"\\begin{description}"
"\\begin{enumerate}"
"\\begin{eqnarray}"
"\\begin{equation}"
"\\begin{figure}"
"\\begin{flushleft}"
"\\begin{flushright}"
"\\begin{itemize}"
"\\begin{list}"
"\\begin{minipage}"
"\\begin{picture}"
"\\begin{quotation}"
"\\begin{quote}"
"\\begin{tabbing}"
"\\begin{table}"
"\\begin{tabular}"
"\\begin{thebibliography}"
"\\begin{theorem}"
"\\begin{titlepage}"
"\\begin{verbatim}"
"\\begin{verse}"
"\\bf"
"\\bf"
"\\bibitem"
"\\bigskip"
"\\cdots"
"\\centering"
"\\circle"
"\\cite"
"\\cleardoublepage"
"\\clearpage"
"\\cline"
"\\closing"
"\\dashbox"
"\\date"
"\\ddots"
"\\dotfill"
"\\em"
"\\fbox"
"\\flushbottom"
"\\fnsymbol"
"\\footnote"
"\\footnotemark"
"\\footnotesize"
"\\footnotetext"
"\\frac"
"\\frame"
"\\framebox"
"\\hfill"
"\\hline"
"\\hrulespace"
"\\hspace"
"\\huge"
"\\hyphenation"
"\\include"
"\\includeonly"
"\\indent"
"\\input"
"\\it"
"\\kill"
"\\label"
"\\large"
"\\ldots"
"\\line"
"\\linebreak"
"\\linethickness"
"\\listoffigures"
"\\listoftables"
"\\location"
"\\makebox"
"\\maketitle"
"\\mark"
"\\mbox"
"\\medskip"
"\\multicolumn"
"\\multiput"
"\\newcommand"
"\\newcounter"
"\\newenvironment"
"\\newfont"
"\\newlength"
"\\newline"
"\\newpage"
"\\newsavebox"
"\\newtheorem"
"\\nocite"
"\\nofiles"
"\\noindent"
"\\nolinebreak"
"\\nopagebreak"
"\\normalsize"
"\\onecolumn"
"\\opening"
"\\oval"
"\\overbrace"
"\\overline"
"\\pagebreak"
"\\pagenumbering"
"\\pageref"
"\\pagestyle"
"\\par"
"\\parbox"
"\\put"
"\\raggedbottom"
"\\raggedleft"
"\\raggedright"
"\\raisebox"
"\\ref"
"\\rm"
"\\roman"
"\\rule"
"\\savebox"
"\\sc"
"\\scriptsize"
"\\setcounter"
"\\setlength"
"\\settowidth"
"\\sf"
"\\shortstack"
"\\signature"
"\\sl"
"\\small"
"\\smallskip"
"\\sqrt"
"\\tableofcontents"
"\\telephone"
"\\thanks"
"\\thispagestyle"
"\\tiny"
"\\title"
"\\tt"
"\\twocolumn"
"\\typein"
"\\typeout"
"\\underbrace"
"\\underline"
"\\usebox"
"\\usecounter"
"\\value"
"\\vdots"
"\\vector"
"\\verb"
"\\vfill"
"\\vline"
"\\vspace")
"A list of LaTeX commands to be protected when performing conversion.")
'("\\!"
"\\'"
"\\+"
"\\,"
"\\-"
"\\:"
"\\;"
"\\<"
"\\="
"\\>"
"\\Huge"
"\\LARGE"
"\\Large"
"\\Styles"
"\\\\"
"\\`"
"\\\""
"\\addcontentsline"
"\\address"
"\\addtocontents"
"\\addtocounter"
"\\addtolength"
"\\addvspace"
"\\alph"
"\\appendix"
"\\arabic"
"\\author"
"\\begin{array}"
"\\begin{center}"
"\\begin{description}"
"\\begin{enumerate}"
"\\begin{eqnarray}"
"\\begin{equation}"
"\\begin{figure}"
"\\begin{flushleft}"
"\\begin{flushright}"
"\\begin{itemize}"
"\\begin{list}"
"\\begin{minipage}"
"\\begin{picture}"
"\\begin{quotation}"
"\\begin{quote}"
"\\begin{tabbing}"
"\\begin{table}"
"\\begin{tabular}"
"\\begin{thebibliography}"
"\\begin{theorem}"
"\\begin{titlepage}"
"\\begin{verbatim}"
"\\begin{verse}"
"\\bf"
"\\bf"
"\\bibitem"
"\\bigskip"
"\\cdots"
"\\centering"
"\\circle"
"\\cite"
"\\cleardoublepage"
"\\clearpage"
"\\cline"
"\\closing"
"\\dashbox"
"\\date"
"\\ddots"
"\\dotfill"
"\\em"
"\\fbox"
"\\flushbottom"
"\\fnsymbol"
"\\footnote"
"\\footnotemark"
"\\footnotesize"
"\\footnotetext"
"\\frac"
"\\frame"
"\\framebox"
"\\hfill"
"\\hline"
"\\hrulespace"
"\\hspace"
"\\huge"
"\\hyphenation"
"\\include"
"\\includeonly"
"\\indent"
"\\input"
"\\it"
"\\kill"
"\\label"
"\\large"
"\\ldots"
"\\line"
"\\linebreak"
"\\linethickness"
"\\listoffigures"
"\\listoftables"
"\\location"
"\\makebox"
"\\maketitle"
"\\mark"
"\\mbox"
"\\medskip"
"\\multicolumn"
"\\multiput"
"\\newcommand"
"\\newcounter"
"\\newenvironment"
"\\newfont"
"\\newlength"
"\\newline"
"\\newpage"
"\\newsavebox"
"\\newtheorem"
"\\nocite"
"\\nofiles"
"\\noindent"
"\\nolinebreak"
"\\nopagebreak"
"\\normalsize"
"\\onecolumn"
"\\opening"
"\\oval"
"\\overbrace"
"\\overline"
"\\pagebreak"
"\\pagenumbering"
"\\pageref"
"\\pagestyle"
"\\par"
"\\parbox"
"\\put"
"\\raggedbottom"
"\\raggedleft"
"\\raggedright"
"\\raisebox"
"\\ref"
"\\rm"
"\\roman"
"\\rule"
"\\savebox"
"\\sc"
"\\scriptsize"
"\\setcounter"
"\\setlength"
"\\settowidth"
"\\sf"
"\\shortstack"
"\\signature"
"\\sl"
"\\small"
"\\smallskip"
"\\sqrt"
"\\tableofcontents"
"\\telephone"
"\\thanks"
"\\thispagestyle"
"\\tiny"
"\\title"
"\\tt"
"\\twocolumn"
"\\typein"
"\\typeout"
"\\underbrace"
"\\underline"
"\\usebox"
"\\usecounter"
"\\value"
"\\vdots"
"\\vector"
"\\verb"
"\\vfill"
"\\vline"
"\\vspace")
"A list of LaTeX commands to be protected when performing conversion.")
(defconst org-latex-entities-regexp
(let (names rest)

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

@ -236,8 +236,7 @@ Otherwise, two of them will be necessary."
:group 'org-plain-lists
:type 'boolean)
(defcustom org-list-automatic-rules '((bullet . t)
(checkbox . t)
(defcustom org-list-automatic-rules '((checkbox . t)
(indent . t))
"Non-nil means apply set of rules when acting on lists.
By default, automatic actions are taken when using
@ -247,27 +246,21 @@ By default, automatic actions are taken when using
\\[org-insert-todo-heading]. You can disable individually these
rules by setting them to nil. Valid rules are:
bullet when non-nil, cycling bullet do not allow lists at
column 0 to have * as a bullet and descriptions lists
to be numbered.
checkbox when non-nil, checkbox statistics is updated each time
you either insert a new checkbox or toggle a checkbox.
It also prevents from inserting a checkbox in a
description item.
indent when non-nil, indenting or outdenting list top-item
with its subtree will move the whole list and
outdenting a list whose bullet is * to column 0 will
change that bullet to \"-\"."
:group 'org-plain-lists
:version "24.1"
:type '(alist :tag "Sets of rules"
:key-type
(choice
(const :tag "Bullet" bullet)
(const :tag "Checkbox" checkbox)
(const :tag "Indent" indent))
:value-type
(boolean :tag "Activate" :value t)))
:group 'org-plain-lists
:version "24.1"
:type '(alist :tag "Sets of rules"
:key-type
(choice
(const :tag "Checkbox" checkbox)
(const :tag "Indent" indent))
:value-type
(boolean :tag "Activate" :value t)))
(defcustom org-list-use-circular-motion nil
"Non-nil means commands implying motion in lists should be cyclic.
@ -491,7 +484,7 @@ group 4: description tag")
(defun org-at-item-description-p ()
"Is point at a description list item?"
(org-list-at-regexp-after-bullet-p "\\(\\S-.+\\)[ \t]+::[ \t]+"))
(org-list-at-regexp-after-bullet-p "\\(\\S-.+\\)[ \t]+::\\([ \t]+\\|$\\)"))
(defun org-at-item-checkbox-p ()
"Is point at a line starting a plain-list item with a checklet?"
@ -628,12 +621,15 @@ Assume point is at an item."
;; Return association at point.
(lambda (ind)
(looking-at org-list-full-item-re)
(list (point)
ind
(match-string-no-properties 1) ; bullet
(match-string-no-properties 2) ; counter
(match-string-no-properties 3) ; checkbox
(match-string-no-properties 4))))) ; description tag
(let ((bullet (match-string-no-properties 1)))
(list (point)
ind
bullet
(match-string-no-properties 2) ; counter
(match-string-no-properties 3) ; checkbox
;; Description tag.
(and (save-match-data (string-match "[-+*]" bullet))
(match-string-no-properties 4)))))))
(end-before-blank
(function
;; Ensure list ends at the first blank line.
@ -694,7 +690,7 @@ Assume point is at an item."
(forward-line -1))
((looking-at "^[ \t]*$")
(forward-line -1))
;; From there, point is not at an item. Interpret
;; From there, point is not at an item. Interpret
;; line's indentation:
;; - text at column 0 is necessarily out of any list.
;; Dismiss data recorded above BEG-CELL. Jump to
@ -1015,10 +1011,45 @@ Possible types are `descriptive', `ordered' and `unordered'. The
type is determined by the first item of the list."
(let ((first (org-list-get-list-begin item struct prevs)))
(cond
((org-list-get-tag first struct) 'descriptive)
((string-match "[[:alnum:]]" (org-list-get-bullet first struct)) 'ordered)
((org-list-get-tag first struct) 'descriptive)
(t 'unordered))))
(defun org-list-get-item-number (item struct prevs parents)
"Return ITEM's sequence number.
STRUCT is the list structure. PREVS is the alist of previous
items, as returned by `org-list-prevs-alist'. PARENTS is the
alist of ancestors, as returned by `org-list-parents-alist'.
Return value is a list of integers. Counters have an impact on
that value."
(let ((get-relative-number
(function
(lambda (item struct prevs)
;; Return relative sequence number of ITEM in the sub-list
;; it belongs. STRUCT is the list structure. PREVS is
;; the alist of previous items.
(let ((seq 0) (pos item) counter)
(while (and (not (setq counter (org-list-get-counter pos struct)))
(setq pos (org-list-get-prev-item pos struct prevs)))
(incf seq))
(if (not counter) (1+ seq)
(cond
((string-match "[A-Za-z]" counter)
(+ (- (string-to-char (upcase (match-string 0 counter))) 64)
seq))
((string-match "[0-9]+" counter)
(+ (string-to-number (match-string 0 counter)) seq))
(t (1+ seq)))))))))
;; Cons each parent relative number into return value (OUT).
(let ((out (list (funcall get-relative-number item struct prevs)))
(parent item))
(while (setq parent (org-list-get-parent parent struct parents))
(push (funcall get-relative-number parent struct prevs) out))
;; Return value.
out)))
;;; Searching
@ -1225,8 +1256,15 @@ This function modifies STRUCT."
(let* ((item (progn (goto-char pos) (goto-char (org-list-get-item-begin))))
(item-end (org-list-get-item-end item struct))
(item-end-no-blank (org-list-get-item-end-before-blank item struct))
(beforep (and (looking-at org-list-full-item-re)
(<= pos (match-end 0))))
(beforep
(progn
(looking-at org-list-full-item-re)
;; Do not count tag in a non-descriptive list.
(<= pos (if (and (match-beginning 4)
(save-match-data
(string-match "[.)]" (match-string 1))))
(match-beginning 4)
(match-end 0)))))
(split-line-p (org-get-alist-option org-M-RET-may-split-line 'item))
(blank-nb (org-list-separating-blank-lines-number
pos struct prevs))
@ -1270,9 +1308,8 @@ This function modifies STRUCT."
(insert body item-sep)
;; 5. Add new item to STRUCT.
(mapc (lambda (e)
(let ((p (car e))
(end (nth 6 e)))
(cond
(let ((p (car e)) (end (nth 6 e)))
(cond
;; Before inserted item, positions don't change but
;; an item ending after insertion has its end shifted
;; by SIZE-OFFSET.
@ -1591,7 +1628,7 @@ as returned by `org-list-prevs-alist'."
(if (> ascii 90)
(throw 'exit nil)
(setq item (org-list-get-next-item item struct prevs)))))
;; All items checked. All good.
;; All items checked. All good.
t))))
(defun org-list-inc-bullet-maybe (bullet)
@ -1808,7 +1845,6 @@ Initial position of cursor is restored after the changes."
(inlinetask-re (and (featurep 'org-inlinetask)
(org-inlinetask-outline-regexp)))
(item-re (org-item-re))
(box-rule-p (cdr (assq 'checkbox org-list-automatic-rules)))
(shift-body-ind
(function
;; Shift the indentation between END and BEG by DELTA.
@ -1842,14 +1878,11 @@ Initial position of cursor is restored after the changes."
(old-bul (org-list-get-bullet item old-struct))
(new-box (org-list-get-checkbox item struct)))
(looking-at org-list-full-item-re)
;; a. Replace bullet
;; a. Replace bullet
(unless (equal old-bul new-bul)
(replace-match new-bul nil nil nil 1))
;; b. Replace checkbox.
;; b. Replace checkbox.
(cond
((and new-box box-rule-p
(save-match-data (org-at-item-description-p)))
(message "Cannot add a checkbox to a description list item"))
((equal (match-string 3) new-box))
((and (match-string 3) new-box)
(replace-match new-box nil nil nil 3))
@ -1859,7 +1892,7 @@ Initial position of cursor is restored after the changes."
(t (let ((counterp (match-end 2)))
(goto-char (if counterp (1+ counterp) (match-end 1)))
(insert (concat new-box (unless counterp " "))))))
;; c. Indent item to appropriate column.
;; c. Indent item to appropriate column.
(unless (= new-ind old-ind)
(delete-region (goto-char (point-at-bol))
(progn (skip-chars-forward " \t") (point)))
@ -2007,7 +2040,7 @@ Possible values are: `folded', `children' or `subtree'. See
(let (bpos bcol tpos tcol)
(save-excursion
(goto-char item)
(looking-at "[ \t]*\\(\\S-+\\)\\(.*[ \t]+::\\)?[ \t]+")
(looking-at "[ \t]*\\(\\S-+\\)\\(.*[ \t]+::\\)?\\([ \t]+\\|$\\)")
(setq bpos (match-beginning 1) tpos (match-end 0)
bcol (progn (goto-char bpos) (current-column))
tcol (progn (goto-char tpos) (current-column)))
@ -2164,20 +2197,19 @@ item is invisible."
(org-list-struct)))
(prevs (org-list-prevs-alist struct))
;; If we're in a description list, ask for the new term.
(desc (when (org-list-get-tag itemp struct)
(concat (read-string "Term: ") " :: ")))
;; Don't insert a checkbox if checkbox rule is applied
;; and it is a description item.
(checkp (and checkbox
(or (not desc)
(not (cdr (assq 'checkbox
org-list-automatic-rules)))))))
(desc (when (eq (org-list-get-list-type itemp struct prevs)
'descriptive)
(concat (read-string "Term: ") " :: "))))
(setq struct
(org-list-insert-item pos struct prevs checkp desc))
(org-list-insert-item pos struct prevs checkbox desc))
(org-list-write-struct struct (org-list-parents-alist struct))
(when checkp (org-update-checkbox-count-maybe))
(when checkbox (org-update-checkbox-count-maybe))
(looking-at org-list-full-item-re)
(goto-char (match-end 0))
(goto-char (if (and (match-beginning 4)
(save-match-data
(string-match "[.)]" (match-string 1))))
(match-beginning 4)
(match-end 0)))
t)))))
(defun org-list-repair ()
@ -2206,7 +2238,6 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is
(prevs (org-list-prevs-alist struct))
(list-beg (org-list-get-first-item (point) struct prevs))
(bullet (org-list-get-bullet list-beg struct))
(bullet-rule-p (cdr (assq 'bullet org-list-automatic-rules)))
(alpha-p (org-list-use-alpha-bul-p list-beg struct prevs))
(case-fold-search nil)
(current (cond
@ -2221,22 +2252,21 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is
(bullet-list
(append '("-" "+" )
;; *-bullets are not allowed at column 0.
(unless (and bullet-rule-p
(looking-at "\\S-")) '("*"))
(unless (looking-at "\\S-") '("*"))
;; Description items cannot be numbered.
(unless (or (eq org-plain-list-ordered-item-terminator ?\))
(and bullet-rule-p (org-at-item-description-p)))
(org-at-item-description-p))
'("1."))
(unless (or (eq org-plain-list-ordered-item-terminator ?.)
(and bullet-rule-p (org-at-item-description-p)))
(org-at-item-description-p))
'("1)"))
(unless (or (not alpha-p)
(eq org-plain-list-ordered-item-terminator ?\))
(and bullet-rule-p (org-at-item-description-p)))
(org-at-item-description-p))
'("a." "A."))
(unless (or (not alpha-p)
(eq org-plain-list-ordered-item-terminator ?.)
(and bullet-rule-p (org-at-item-description-p)))
(org-at-item-description-p))
'("a)" "A)"))))
(len (length bullet-list))
(item-index (- len (length (member current bullet-list))))
@ -2339,13 +2369,13 @@ in subtree, ignoring drawers."
(lambda (e) (or (< e lim-up) (> e lim-down)))
(mapcar 'car struct))))
(mapc (lambda (e) (org-list-set-checkbox
e struct
;; If there is no box at item, leave as-is
;; unless function was called with C-u prefix.
(let ((cur-box (org-list-get-checkbox e struct)))
(if (or cur-box (equal toggle-presence '(4)))
ref-checkbox
cur-box))))
e struct
;; If there is no box at item, leave as-is
;; unless function was called with C-u prefix.
(let ((cur-box (org-list-get-checkbox e struct)))
(if (or cur-box (equal toggle-presence '(4)))
ref-checkbox
cur-box))))
items-to-toggle)
(setq block-item (org-list-struct-fix-box
struct parents prevs orderedp))
@ -2792,11 +2822,10 @@ COMPARE-FUNC to compare entries."
(sort-func (cond
((= dcst ?a) 'string<)
((= dcst ?f) compare-func)
((= dcst ?t) '<)
(t nil)))
((= dcst ?t) '<)))
(next-record (lambda ()
(skip-chars-forward " \r\t\n")
(beginning-of-line)))
(skip-chars-forward " \r\t\n")
(beginning-of-line)))
(end-record (lambda ()
(goto-char (org-list-get-item-end-before-blank
(point) struct))))
@ -2910,7 +2939,7 @@ Point is left at list end."
(goto-char e)
(looking-at "[ \t]*\\S-+\\([ \t]+\\[@\\(start:\\)?\\([0-9]+\\|[a-zA-Z]\\)\\]\\)?[ \t]*")
(match-end 0)))
;; Get counter number. For alphabetic counter, get
;; Get counter number. For alphabetic counter, get
;; its position in the alphabet.
(counter (let ((c (org-list-get-counter e struct)))
(cond
@ -3116,7 +3145,7 @@ items."
((and counter (eq type 'ordered))
(concat (eval icount) "%s"))
(t (concat (eval istart) "%s")))
(eval iend)))
(eval iend)))
(first (car item)))
;; Replace checkbox if any is found.
(cond
@ -3173,21 +3202,21 @@ with overruling parameters for `org-list-to-generic'."
list
(org-combine-plists
'(:splice nil :ostart "\\begin{enumerate}\n" :oend "\\end{enumerate}"
:ustart "\\begin{itemize}\n" :uend "\\end{itemize}"
:dstart "\\begin{description}\n" :dend "\\end{description}"
:dtstart "[" :dtend "] "
:istart "\\item " :iend "\n"
:icount (let ((enum (nth depth '("i" "ii" "iii" "iv"))))
(if enum
;; LaTeX increments counter just before
;; using it, so set it to the desired
;; value, minus one.
(format "\\setcounter{enum%s}{%s}\n\\item "
enum (1- counter))
"\\item "))
:csep "\n"
:cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}"
:cbtrans "\\texttt{[-]}")
:ustart "\\begin{itemize}\n" :uend "\\end{itemize}"
:dstart "\\begin{description}\n" :dend "\\end{description}"
:dtstart "[" :dtend "] "
:istart "\\item " :iend "\n"
:icount (let ((enum (nth depth '("i" "ii" "iii" "iv"))))
(if enum
;; LaTeX increments counter just before
;; using it, so set it to the desired
;; value, minus one.
(format "\\setcounter{enum%s}{%s}\n\\item "
enum (1- counter))
"\\item "))
:csep "\n"
:cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}"
:cbtrans "\\texttt{[-]}")
params)))
(defun org-list-to-html (list &optional params)
@ -3198,15 +3227,15 @@ with overruling parameters for `org-list-to-generic'."
list
(org-combine-plists
'(:splice nil :ostart "<ol>\n" :oend "\n</ol>"
:ustart "<ul>\n" :uend "\n</ul>"
:dstart "<dl>\n" :dend "\n</dl>"
:dtstart "<dt>" :dtend "</dt>\n"
:ddstart "<dd>" :ddend "</dd>"
:istart "<li>" :iend "</li>"
:icount (format "<li value=\"%s\">" counter)
:isep "\n" :lsep "\n" :csep "\n"
:cbon "<code>[X]</code>" :cboff "<code>[ ]</code>"
:cbtrans "<code>[-]</code>")
:ustart "<ul>\n" :uend "\n</ul>"
:dstart "<dl>\n" :dend "\n</dl>"
:dtstart "<dt>" :dtend "</dt>\n"
:ddstart "<dd>" :ddend "</dd>"
:istart "<li>" :iend "</li>"
:icount (format "<li value=\"%s\">" counter)
:isep "\n" :lsep "\n" :csep "\n"
:cbon "<code>[X]</code>" :cboff "<code>[ ]</code>"
:cbtrans "<code>[-]</code>")
params)))
(defun org-list-to-texinfo (list &optional params)
@ -3217,14 +3246,14 @@ with overruling parameters for `org-list-to-generic'."
list
(org-combine-plists
'(:splice nil :ostart "@itemize @minus\n" :oend "@end itemize"
:ustart "@enumerate\n" :uend "@end enumerate"
:dstart "@table @asis\n" :dend "@end table"
:dtstart " " :dtend "\n"
:istart "@item\n" :iend "\n"
:icount "@item\n"
:csep "\n"
:cbon "@code{[X]}" :cboff "@code{[ ]}"
:cbtrans "@code{[-]}")
:ustart "@enumerate\n" :uend "@end enumerate"
:dstart "@table @asis\n" :dend "@end table"
:dtstart " " :dtend "\n"
:istart "@item\n" :iend "\n"
:icount "@item\n"
:csep "\n"
:cbon "@code{[X]}" :cboff "@code{[ ]}"
:cbtrans "@code{[-]}")
params)))
(defun org-list-to-subtree (list &optional params)

107
lisp/org/org-lparse.el
View file

@ -67,7 +67,7 @@ lists."
((file-exists-p file-or-buf) file-or-buf)
(t (error "org-lparse-and-open: This shouldn't happen"))))
(message "Opening file %s" f)
(org-open-file f)
(org-open-file f 'system)
(when org-export-kill-product-buffer-when-displayed
(kill-buffer (current-buffer))))))
@ -89,9 +89,9 @@ emacs --batch
No file is created. The prefix ARG is passed through to
`org-lparse'."
(let ((tempbuf (format "*Org %s Export*" (upcase backend))))
(org-lparse backend backend arg nil nil tempbuf)
(when org-export-show-temporary-export-buffer
(switch-to-buffer-other-window tempbuf))))
(org-lparse backend backend arg nil nil tempbuf)
(when org-export-show-temporary-export-buffer
(switch-to-buffer-other-window tempbuf))))
;;;###autoload
(defun org-replace-region-by (backend beg end)
@ -101,7 +101,7 @@ itemized list in org-mode syntax in an HTML buffer and then use
this command to convert it."
(let (reg backend-string buf pop-up-frames)
(save-window-excursion
(if (eq major-mode 'org-mode)
(if (derived-mode-p 'org-mode)
(setq backend-string (org-lparse-region backend beg end t 'string))
(setq reg (buffer-substring beg end)
buf (get-buffer-create "*Org tmp*"))
@ -145,16 +145,16 @@ in a window. A non-interactive call will only return the buffer."
(defvar org-lparse-par-open nil)
(defun org-lparse-should-inline-p (filename descp)
"Return non-nil if link FILENAME should be inlined.
"Return non-nil if link FILENAME should be inlined.
The decision to inline the FILENAME link is based on the current
settings. DESCP is the boolean of whether there was a link
description. See variables `org-export-html-inline-images' and
`org-export-html-inline-image-extensions'."
(let ((inline-images (org-lparse-get 'INLINE-IMAGES))
(inline-image-extensions
(org-lparse-get 'INLINE-IMAGE-EXTENSIONS)))
(and (or (eq t inline-images) (and inline-images (not descp)))
(org-file-image-p filename inline-image-extensions))))
(let ((inline-images (org-lparse-get 'INLINE-IMAGES))
(inline-image-extensions
(org-lparse-get 'INLINE-IMAGE-EXTENSIONS)))
(and (or (eq t inline-images) (and inline-images (not descp)))
(org-file-image-p filename inline-image-extensions))))
(defun org-lparse-format-org-link (line opt-plist)
"Return LINE with markup of Org mode links.
@ -435,6 +435,10 @@ PUB-DIR specifies the publishing directory."
(let* ((org-lparse-backend (intern native-backend))
(org-lparse-other-backend (and target-backend
(intern target-backend))))
(add-hook 'org-export-preprocess-hook
'org-lparse-strip-experimental-blocks-maybe)
(add-hook 'org-export-preprocess-after-blockquote-hook
'org-lparse-preprocess-after-blockquote)
(unless (org-lparse-backend-is-native-p native-backend)
(error "Don't know how to export natively to backend %s" native-backend))
@ -443,7 +447,11 @@ PUB-DIR specifies the publishing directory."
(error "Don't know how to export to backend %s %s" target-backend
(format "via %s" native-backend)))
(run-hooks 'org-export-first-hook)
(org-do-lparse arg hidden ext-plist to-buffer body-only pub-dir)))
(org-do-lparse arg hidden ext-plist to-buffer body-only pub-dir)
(remove-hook 'org-export-preprocess-hook
'org-lparse-strip-experimental-blocks-maybe)
(remove-hook 'org-export-preprocess-after-blockquote-hook
'org-lparse-preprocess-after-blockquote)))
(defcustom org-lparse-use-flashy-warning nil
"Control flashing of messages logged with `org-lparse-warn'.
@ -509,7 +517,7 @@ This is a helper routine for interactive use."
(message "Exported to %s" out-file)
(when prefix-arg
(message "Opening %s..." out-file)
(org-open-file out-file))
(org-open-file out-file 'system))
out-file)
(t
(message "Export to %s failed" out-file)
@ -565,7 +573,7 @@ and then converted to \"doc\" then org-lparse-backend is set to
(defun org-do-lparse (arg &optional hidden ext-plist
to-buffer body-only pub-dir)
"Export the outline to various formats.
See `org-lparse' for more information. This function is a
See `org-lparse' for more information. This function is a
html-agnostic version of the `org-export-as-html' function in 7.5
version."
;; Make sure we have a file name when we need it.
@ -771,7 +779,7 @@ version."
;; collection
org-lparse-collect-buffer
(org-lparse-collect-count 0) ; things will get haywire if
; collections are chained. Use
; collections are chained. Use
; this variable to assert this
; pre-requisite
org-lparse-toc
@ -901,7 +909,6 @@ version."
(funcall f style env-options-plist)
(throw 'nextline nil))))
(run-hooks 'org-export-html-after-blockquotes-hook)
(when (org-lparse-current-environment-p 'verse)
(let ((i (org-get-string-indentation line)))
(if (> i 0)
@ -1158,7 +1165,7 @@ version."
(defun org-lparse-table-get-colalign-info (lines)
(let ((col-cookies (org-find-text-property-in-string
'org-col-cookies (car lines))))
'org-col-cookies (car lines))))
(when (and col-cookies org-table-clean-did-remove-column)
(setq col-cookies
(mapcar (lambda (x) (cons (1- (car x)) (cdr x))) col-cookies)))
@ -1218,7 +1225,11 @@ for formatting. This is required for the DocBook exporter."
;; column and the special lines
(setq lines (org-table-clean-before-export lines)))
(let* ((caption (org-find-text-property-in-string 'org-caption (car lines)))
(short-caption (or (org-find-text-property-in-string
'org-caption-shortn (car lines)) caption))
(caption (and caption (org-xml-encode-org-text caption)))
(short-caption (and short-caption
(org-xml-encode-plain-text short-caption)))
(label (org-find-text-property-in-string 'org-label (car lines)))
(org-lparse-table-colalign-info (org-lparse-table-get-colalign-info lines))
(attributes (org-find-text-property-in-string 'org-attributes
@ -1229,11 +1240,13 @@ for formatting. This is required for the DocBook exporter."
(cdr lines))))))
(setq lines (org-lparse-org-table-to-list-table lines splice))
(org-lparse-insert-list-table
lines splice caption label attributes head org-lparse-table-colalign-info)))
lines splice caption label attributes head org-lparse-table-colalign-info
short-caption)))
(defun org-lparse-insert-list-table (lines &optional splice
caption label attributes head
org-lparse-table-colalign-info)
caption label attributes head
org-lparse-table-colalign-info
short-caption)
(or (featurep 'org-table) ; required for
(require 'org-table)) ; `org-table-number-regexp'
(let* ((org-lparse-table-rownum -1) org-lparse-table-ncols i (cnt 0)
@ -1253,7 +1266,7 @@ for formatting. This is required for the DocBook exporter."
(insert (org-lparse-format-table-row line) "\n")))
(t
(setq org-lparse-table-is-styled t)
(org-lparse-begin 'TABLE caption label attributes)
(org-lparse-begin 'TABLE caption label attributes short-caption)
(setq org-lparse-table-begin-marker (point))
(org-lparse-begin-table-rowgroup head)
(while (setq line (pop lines))
@ -1284,13 +1297,14 @@ But it has the disadvantage, that no cell- or row-spanning is allowed."
(org-lparse-table-cur-rowgrp-is-hdr
org-export-highlight-first-table-line)
(caption nil)
(short-caption nil)
(attributes nil)
(label nil)
(org-lparse-table-style 'table-table)
(org-lparse-table-is-styled nil)
fields org-lparse-table-ncols i (org-lparse-table-rownum -1)
(empty (org-lparse-format 'SPACES 1)))
(org-lparse-begin 'TABLE caption label attributes)
(org-lparse-begin 'TABLE caption label attributes short-caption)
(while (setq line (pop lines))
(cond
((string-match "^[ \t]*\\+-" line)
@ -1320,9 +1334,9 @@ But it has the disadvantage, that no cell- or row-spanning is allowed."
(defvar table-source-languages) ; defined in table.el
(defun org-lparse-format-table-table-using-table-generate-source (backend
lines
&optional
spanned-only)
lines
&optional
spanned-only)
"Format a table into BACKEND, using `table-generate-source' from table.el.
Use SPANNED-ONLY to suppress exporting of simple table.el tables.
@ -1353,9 +1367,9 @@ for further information."
(set-buffer " org-tmp2 ")
(buffer-substring (point-min) (point-max)))
(t
;; table.el doesn't support the given backend. Currently this
;; table.el doesn't support the given backend. Currently this
;; happens in case of odt export. Strip the table from the
;; generated document. A better alternative would be to embed
;; generated document. A better alternative would be to embed
;; the table as ascii text in the output document.
(org-lparse-warn
(concat
@ -1706,7 +1720,12 @@ information."
(org-lparse-end-paragraph)
(org-lparse-end-list-item (or type "u")))
(defun org-lparse-preprocess-after-blockquote-hook ()
(define-obsolete-function-alias
'org-lparse-preprocess-after-blockquote-hook
'org-lparse-preprocess-after-blockquote
"24.3")
(defun org-lparse-preprocess-after-blockquote ()
"Treat `org-lparse-special-blocks' specially."
(goto-char (point-min))
(while (re-search-forward
@ -1719,10 +1738,12 @@ information."
(format "ORG-%s-END %s" (upcase (match-string 2))
(match-string 3))) t t))))
(add-hook 'org-export-preprocess-after-blockquote-hook
'org-lparse-preprocess-after-blockquote-hook)
(define-obsolete-function-alias
'org-lparse-strip-experimental-blocks-maybe-hook
'org-lparse-strip-experimental-blocks-maybe
"24.3")
(defun org-lparse-strip-experimental-blocks-maybe-hook ()
(defun org-lparse-strip-experimental-blocks-maybe ()
"Strip \"list-table\" and \"annotation\" blocks.
Stripping happens only when the exported backend is not one of
\"odt\" or \"xhtml\"."
@ -1737,9 +1758,6 @@ Stripping happens only when the exported backend is not one of
(when (member (match-string 1) org-lparse-special-blocks)
(replace-match "" t t))))))
(add-hook 'org-export-preprocess-hook
'org-lparse-strip-experimental-blocks-maybe-hook)
(defvar org-lparse-list-table-p nil
"Non-nil if `org-do-lparse' is within a list-table.")
@ -1871,7 +1889,7 @@ See `org-xhtml-entity-format-callbacks-alist' for more information."
(replace-match
(let ((org-lparse-encode-pending t))
(org-lparse-format 'FONTIFY
(match-string 1 line) "target"))
(match-string 1 line) "target"))
t t line)))
(when (string-match
(org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt)
@ -1923,8 +1941,7 @@ See `org-xhtml-entity-format-callbacks-alist' for more information."
(cond
((string= align "l") "left")
((string= align "r") "right")
((string= align "c") "center")
(t nil))))))))
((string= align "c") "center"))))))))
(incf org-lparse-table-rownum)
(let ((i -1))
(org-lparse-format
@ -2036,8 +2053,8 @@ When TITLE is nil, just close all open levels."
(defvar org-lparse-outline-text-open)
(defun org-lparse-begin-outline-and-outline-text (level1 snumber title tags
target extra-targets
extra-class)
target extra-targets
extra-class)
(org-lparse-begin
'OUTLINE level1 snumber title tags target extra-targets extra-class)
(org-lparse-begin-outline-text level1 snumber extra-class))
@ -2087,7 +2104,7 @@ When TITLE is nil, just close all open levels."
;; Note that org-tables are NOT multi-line and each line is mapped to
;; a unique row in the exported document. So if an exported table
;; needs to contain a single paragraph (with copious text) it needs to
;; be typed up in a single line. Editing such long lines using the
;; be typed up in a single line. Editing such long lines using the
;; table editor will be a cumbersome task. Furthermore inclusion of
;; multi-paragraph text in a table cell is well-nigh impossible.
;;
@ -2232,11 +2249,11 @@ Replaces invalid characters with \"_\"."
(defun org-lparse-format-extra-targets (extra-targets)
(if (not extra-targets) ""
(mapconcat (lambda (x)
(setq x (org-solidify-link-text
(if (org-uuidgen-p x) (concat "ID-" x) x)))
(org-lparse-format 'ANCHOR "" x))
extra-targets "")))
(mapconcat (lambda (x)
(setq x (org-solidify-link-text
(if (org-uuidgen-p x) (concat "ID-" x) x)))
(org-lparse-format 'ANCHOR "" x))
extra-targets "")))
(defun org-lparse-format-org-tags (tags)
(if (not tags) ""

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

@ -47,7 +47,7 @@
(require 'org)
(defgroup org-mac-flagged-mail nil
"Options concerning linking to flagged Mail.app messages"
"Options concerning linking to flagged Mail.app messages."
:tag "Org Mail.app"
:group 'org-link)
@ -84,15 +84,15 @@ This will use the command `open' with the message URL."
(do-applescript
(concat
"tell application \"Mail\"\n"
"set theLinkList to {}\n"
"set theSelection to selection\n"
"repeat with theMessage in theSelection\n"
"set theID to message id of theMessage\n"
"set theSubject to subject of theMessage\n"
"set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
"copy theLink to end of theLinkList\n"
"end repeat\n"
"return theLinkList as string\n"
"set theLinkList to {}\n"
"set theSelection to selection\n"
"repeat with theMessage in theSelection\n"
"set theID to message id of theMessage\n"
"set theSubject to subject of theMessage\n"
"set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
"copy theLink to end of theLinkList\n"
"end repeat\n"
"return theLinkList as string\n"
"end tell")))
(defun as-get-flagged-mail ()
@ -101,47 +101,47 @@ This will use the command `open' with the message URL."
(concat
;; Is Growl installed?
"tell application \"System Events\"\n"
"set growlHelpers to the name of every process whose creator type contains \"GRRR\"\n"
"if (count of growlHelpers) > 0 then\n"
"set growlHelperApp to item 1 of growlHelpers\n"
"else\n"
"set growlHelperApp to \"\"\n"
"end if\n"
"set growlHelpers to the name of every process whose creator type contains \"GRRR\"\n"
"if (count of growlHelpers) > 0 then\n"
"set growlHelperApp to item 1 of growlHelpers\n"
"else\n"
"set growlHelperApp to \"\"\n"
"end if\n"
"end tell\n"
;; Get links
"tell application \"Mail\"\n"
"set theMailboxes to every mailbox of account \"" org-mac-mail-account "\"\n"
"set theLinkList to {}\n"
"repeat with aMailbox in theMailboxes\n"
"set theSelection to (every message in aMailbox whose flagged status = true)\n"
"repeat with theMessage in theSelection\n"
"set theID to message id of theMessage\n"
"set theSubject to subject of theMessage\n"
"set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
"copy theLink to end of theLinkList\n"
"set theMailboxes to every mailbox of account \"" org-mac-mail-account "\"\n"
"set theLinkList to {}\n"
"repeat with aMailbox in theMailboxes\n"
"set theSelection to (every message in aMailbox whose flagged status = true)\n"
"repeat with theMessage in theSelection\n"
"set theID to message id of theMessage\n"
"set theSubject to subject of theMessage\n"
"set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
"copy theLink to end of theLinkList\n"
;; Report progress through Growl
;; This "double tell" idiom is described in detail at
;; http://macscripter.net/viewtopic.php?id=24570 The
;; script compiler needs static knowledge of the
;; growlHelperApp. Hmm, since we're compiling
;; on-the-fly here, this is likely to be way less
;; portable than I'd hoped. It'll work when the name
;; is still "GrowlHelperApp", though.
"if growlHelperApp is not \"\" then\n"
"tell application \"GrowlHelperApp\"\n"
"tell application growlHelperApp\n"
"set the allNotificationsList to {\"FlaggedMail\"}\n"
"set the enabledNotificationsList to allNotificationsList\n"
"register as application \"FlaggedMail\" all notifications allNotificationsList default notifications enabledNotificationsList icon of application \"Mail\"\n"
"notify with name \"FlaggedMail\" title \"Importing flagged message\" description theSubject application name \"FlaggedMail\"\n"
"end tell\n"
"end tell\n"
"end if\n"
"end repeat\n"
"end repeat\n"
"return theLinkList as string\n"
;; Report progress through Growl
;; This "double tell" idiom is described in detail at
;; http://macscripter.net/viewtopic.php?id=24570 The
;; script compiler needs static knowledge of the
;; growlHelperApp. Hmm, since we're compiling
;; on-the-fly here, this is likely to be way less
;; portable than I'd hoped. It'll work when the name
;; is still "GrowlHelperApp", though.
"if growlHelperApp is not \"\" then\n"
"tell application \"GrowlHelperApp\"\n"
"tell application growlHelperApp\n"
"set the allNotificationsList to {\"FlaggedMail\"}\n"
"set the enabledNotificationsList to allNotificationsList\n"
"register as application \"FlaggedMail\" all notifications allNotificationsList default notifications enabledNotificationsList icon of application \"Mail\"\n"
"notify with name \"FlaggedMail\" title \"Importing flagged message\" description theSubject application name \"FlaggedMail\"\n"
"end tell\n"
"end tell\n"
"end if\n"
"end repeat\n"
"end repeat\n"
"return theLinkList as string\n"
"end tell")))
(defun org-mac-message-get-links (&optional select-or-flag)

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

@ -54,21 +54,22 @@
(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)))
`(with-no-warnings (called-interactively-p ,kind)) ;; defined with no argument in <=23.1
`(interactive-p))))
`(interactive-p)
(if (or (> emacs-major-version 23)
(and (>= emacs-major-version 23)
(>= emacs-minor-version 2)))
;; defined with no argument in <=23.1
`(with-no-warnings (called-interactively-p ,kind))
`(interactive-p))))
(def-edebug-spec org-called-interactively-p (&optional ("quote" symbolp)))
(when (and (not (fboundp 'with-silent-modifications))
(or (< emacs-major-version 23)
(and (= emacs-major-version 23)
(< emacs-minor-version 2))))
(defmacro with-silent-modifications (&rest body)
`(org-unmodified ,@body))
(def-edebug-spec with-silent-modifications (body)))
(or (< emacs-major-version 23)
(and (= emacs-major-version 23)
(< emacs-minor-version 2))))
(defmacro with-silent-modifications (&rest body)
`(org-unmodified ,@body))
(def-edebug-spec with-silent-modifications (body)))
(defmacro org-bound-and-true-p (var)
"Return the value of symbol VAR if it is bound, else nil."
@ -129,15 +130,15 @@ Also, do not record undo information."
`(if (and (boundp 'partial-completion-mode)
partial-completion-mode
(fboundp 'partial-completion-mode))
(unwind-protect
(progn
(partial-completion-mode -1)
,@body)
(partial-completion-mode 1))
(unwind-protect
(progn
(partial-completion-mode -1)
,@body)
(partial-completion-mode 1))
,@body))
(def-edebug-spec org-without-partial-completion (body))
;; FIXME: Slated for removal. Current Org mode does not support Emacs < 22
;; FIXME: Slated for removal. Current Org mode does not support Emacs < 22
(defmacro org-maybe-intangible (props)
"Add '(intangible t) to PROPS if Emacs version is earlier than Emacs 22.
In Emacs 21, invisible text is not avoided by the command loop, so the
@ -238,10 +239,15 @@ We use a macro so that the test can happen at compilation time."
s)
(match-string-no-properties num string)))
(defsubst org-no-properties (s)
(defsubst org-no-properties (s &optional restricted)
"Remove all text properties from string S.
When RESTRICTED is non-nil, only remove the properties listed
in `org-rm-props'."
(if (fboundp 'set-text-properties)
(set-text-properties 0 (length s) nil s)
(remove-text-properties 0 (length s) org-rm-props s))
(if restricted
(remove-text-properties 0 (length s) org-rm-props s)
(set-text-properties 0 (length s) nil s)))
s)
(defsubst org-get-alist-option (option key)
@ -363,18 +369,19 @@ point nowhere."
(def-edebug-spec org-save-outline-visibility (form body))
(defmacro org-with-wide-buffer (&rest body)
"Execute body while temporarily widening the buffer."
`(save-excursion
(save-restriction
"Execute body while temporarily widening the buffer."
`(save-excursion
(save-restriction
(widen)
,@body)))
(def-edebug-spec org-with-wide-buffer (body))
(defmacro org-with-limited-levels (&rest body)
"Execute BODY with limited number of outline levels."
`(let* ((org-outline-regexp (org-get-limited-outline-regexp))
`(let* ((org-called-with-limited-levels t)
(org-outline-regexp (org-get-limited-outline-regexp))
(outline-regexp org-outline-regexp)
(org-outline-regexp-at-bol (concat "^" org-outline-regexp)))
(org-outline-regexp-bol (concat "^" org-outline-regexp)))
,@body))
(def-edebug-spec org-with-limited-levels (body))
@ -384,14 +391,14 @@ point nowhere."
(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 (eq major-mode 'org-mode)) (not (featurep 'org-inlinetask)))
(if (or (not (derived-mode-p 'org-mode)) (not (featurep 'org-inlinetask)))
org-outline-regexp
(let* ((limit-level (1- org-inlinetask-min-level))
(nstars (if org-odd-levels-only (1- (* limit-level 2)) limit-level)))
(format "\\*\\{1,%d\\} " nstars))))
(defun org-format-seconds (string seconds)
"Compatibility function replacing format-seconds"
"Compatibility function replacing format-seconds."
(if (fboundp 'format-seconds)
(format-seconds string seconds)
(format-time-string string (seconds-to-time seconds))))
@ -403,12 +410,12 @@ The number of levels is controlled by `org-inlinetask-min-level'"
(defun org-make-parameter-alist (flat)
"Return alist based on FLAT.
FLAT is a list with alternating symbol names and values. The
FLAT is a list with alternating symbol names and values. The
returned alist is a list of lists with the symbol name in car and
the value in cdr."
(when flat
(cons (list (car flat) (cadr flat))
(org-make-parameter-alist (cddr flat)))))
(org-make-parameter-alist (cddr flat)))))
(provide 'org-macs)

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

@ -103,8 +103,7 @@
: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
"#" message-id))
(setq link (concat "mew:" folder-name "#" message-id))
(org-add-link-props :link link :description desc)
link)))

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

@ -99,8 +99,8 @@ supported by MH-E."
(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)))
(setq link (concat "mhe:" (org-mhe-get-message-real-folder) "#"
(org-remove-angle-brackets message-id)))
(org-add-link-props :link link :description desc)
link))))
@ -179,17 +179,17 @@ you have a better idea of how to do this then please let us know."
(num (org-mhe-get-message-num))
(buffer (get-buffer-create (concat "show-" folder)))
(header-field))
(with-current-buffer buffer
(mh-display-msg num folder)
(if (equal major-mode 'mh-folder-mode)
(mh-header-display)
(mh-show-header-display))
(set-buffer buffer)
(setq header-field (mh-get-header-field header))
(if (equal major-mode 'mh-folder-mode)
(mh-show)
(mh-show-show))
(org-trim header-field))))
(with-current-buffer buffer
(mh-display-msg num folder)
(if (equal major-mode 'mh-folder-mode)
(mh-header-display)
(mh-show-header-display))
(set-buffer buffer)
(setq header-field (mh-get-header-field header))
(if (equal major-mode 'mh-folder-mode)
(mh-show)
(mh-show-show))
(org-trim header-field))))
(defun org-mhe-follow-link (folder article)
"Follow an MH-E link to FOLDER and ARTICLE.

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

@ -236,7 +236,7 @@ by the mobile device, this hook should be used to copy the capture file
directory `org-mobile-directory'.")
(defvar org-mobile-post-pull-hook nil
"Hook run after running `org-mobile-pull'.
"Hook run after running `org-mobile-pull', only if new items were found.
If Emacs does not have direct write access to the WebDAV directory used
by the mobile device, this hook should be used to copy the emptied
capture file `mobileorg.org' back to the WebDAV directory, for example
@ -300,6 +300,8 @@ Also exclude files matching `org-mobile-files-exclude-regexp'."
(push (cons file link-name) rtn)))
(nreverse rtn)))
(defvar org-agenda-filter)
;;;###autoload
(defun org-mobile-push ()
"Push the current state of Org affairs to the WebDAV directory.
@ -316,7 +318,9 @@ create all custom agenda views, for upload to the mobile phone."
(org-mobile-check-setup)
(org-mobile-prepare-file-lists)
(message "Creating agendas...")
(let ((inhibit-redisplay t)) (org-mobile-create-sumo-agenda))
(let ((inhibit-redisplay t)
(org-agenda-files (mapcar 'car org-mobile-files-alist)))
(org-mobile-create-sumo-agenda))
(message "Creating agendas...done")
(org-save-all-org-buffers) ; to save any IDs created by this process
(message "Copying files...")
@ -402,7 +406,7 @@ agenda view showing the flagged items."
(error "Cannot write to encryption tempfile %s"
org-mobile-encryption-tempfile))
(unless (executable-find "openssl")
(error "openssl is needed to encrypt files"))))
(error "OpenSSL is needed to encrypt files"))))
(defun org-mobile-create-index-file ()
"Write the index file in the WebDAV directory."
@ -414,21 +418,14 @@ agenda view showing the flagged items."
org-mobile-directory))
file link-name todo-kwds done-kwds tags drawers entry kwds dwds twds)
(org-prepare-agenda-buffers (mapcar 'car files-alist))
(org-agenda-prepare-buffers (mapcar 'car files-alist))
(setq done-kwds (org-uniquify org-done-keywords-for-agenda))
(setq todo-kwds (org-delete-all
done-kwds
(org-uniquify org-todo-keywords-for-agenda)))
(setq drawers (org-uniquify org-drawers-for-agenda))
(setq tags (org-uniquify
(delq nil
(mapcar
(lambda (e)
(cond ((stringp e) e)
((listp e)
(if (stringp (car e)) (car e) nil))
(t nil)))
org-tag-alist-for-agenda))))
(setq tags (mapcar 'car (org-global-tags-completion-table
(mapcar 'car files-alist))))
(with-temp-file
(if org-mobile-use-encryption
org-mobile-encryption-tempfile
@ -454,8 +451,7 @@ agenda view showing the flagged items."
((eq (car x) :startgroup) "{")
((eq (car x) :endgroup) "}")
((eq (car x) :newline) nil)
((listp x) (car x))
(t nil)))
((listp x) (car x))))
def-tags))
(setq def-tags (delq nil def-tags))
(setq tags (org-delete-all def-tags tags))
@ -579,7 +575,7 @@ The table of checksums is written to the file mobile-checksums."
(concat "<after>KEYS=" key " TITLE: "
(if (and (stringp desc) (> (length desc) 0))
desc (symbol-name type))
" " match "</after>"))
"</after>"))
settings))
(push (list type match settings) new))
((or (functionp (nth 2 e)) (symbolp (nth 2 e)))
@ -596,7 +592,7 @@ The table of checksums is written to the file mobile-checksums."
(setq settings
(cons (list 'org-agenda-title-append
(concat "<after>KEYS=" gkey "#" (number-to-string
(setq cnt (1+ cnt)))
(setq cnt (1+ cnt)))
" TITLE: " gdesc " " match "</after>"))
settings))
(push (list type match settings) new)))))
@ -827,107 +823,95 @@ If BEG and END are given, only do this in that region."
(not (equal (downcase (substring (match-string 1) 0 2)) "f("))
(incf cnt-new)))
;; Find and apply the edits
(goto-char beg)
(while (re-search-forward
"^\\*+[ \t]+F(\\([^():\n]*\\)\\(:\\([^()\n]*\\)\\)?)[ \t]+\\[\\[\\(\\(id\\|olp\\):\\([^]\n]+\\)\\)" end t)
(setq id-pos (condition-case msg
(org-mobile-locate-entry (match-string 4))
(error (nth 1 msg))))
(when (and (markerp id-pos)
(not (member (marker-buffer id-pos) buf-list)))
(org-mobile-timestamp-buffer (marker-buffer id-pos))
(push (marker-buffer id-pos) buf-list))
(if (or (not id-pos) (stringp id-pos))
(progn
(goto-char (+ 2 (point-at-bol)))
(insert id-pos " ")
(incf cnt-error))
(add-text-properties (point-at-bol) (point-at-eol)
(list 'org-mobile-marker
(or id-pos "Linked entry not found")))))
;; OK, now go back and start applying
(goto-char beg)
(while (re-search-forward "^\\*+[ \t]+F(\\([^():\n]*\\)\\(:\\([^()\n]*\\)\\)?)" end t)
(catch 'next
(setq id-pos (get-text-property (point-at-bol) 'org-mobile-marker))
(if (not (markerp id-pos))
(progn
(incf cnt-error)
(insert "UNKNOWN PROBLEM"))
(let* ((action (match-string 1))
(data (and (match-end 3) (match-string 3)))
(bos (point-at-bol))
(eos (save-excursion (org-end-of-subtree t t)))
(cmd (if (equal action "")
'(progn
(incf cnt-flag)
(org-toggle-tag "FLAGGED" 'on)
(and note
(org-entry-put nil "THEFLAGGINGNOTE" note)))
(incf cnt-edit)
(cdr (assoc action org-mobile-action-alist))))
(note (and (equal action "")
(buffer-substring (1+ (point-at-eol)) eos)))
(org-inhibit-logging 'note) ;; Do not take notes interactively
old new)
(goto-char bos)
(move-marker bos-marker (point))
(if (re-search-forward "^** Old value[ \t]*$" eos t)
(setq old (buffer-substring
(1+ (match-end 0))
(progn (outline-next-heading) (point)))))
(if (re-search-forward "^** New value[ \t]*$" eos t)
(setq new (buffer-substring
(1+ (match-end 0))
(progn (outline-next-heading)
(if (eobp) (org-back-over-empty-lines))
(point)))))
(setq old (and old (if (string-match "\\S-" old) old nil)))
(setq new (and new (if (string-match "\\S-" new) new nil)))
(if (and note (> (length note) 0))
;; Make Note into a single line, to fit into a property
(setq note (mapconcat 'identity
(org-split-string (org-trim note) "\n")
"\\n")))
(unless (equal data "body")
(setq new (and new (org-trim new))
old (and old (org-trim old))))
(goto-char (+ 2 bos-marker))
(unless (markerp id-pos)
(insert "BAD REFERENCE ")
(incf cnt-error)
(throw 'next t))
(unless cmd
(insert "BAD FLAG ")
(incf cnt-error)
(throw 'next t))
;; Remember this place so that we can return
(move-marker marker (point))
(setq org-mobile-error nil)
(save-excursion
(condition-case msg
(org-with-point-at id-pos
(progn
(eval cmd)
(if (member "FLAGGED" (org-get-tags))
(add-to-list 'org-mobile-last-flagged-files
(buffer-file-name (current-buffer))))))
(error (setq org-mobile-error msg))))
(when org-mobile-error
(org-pop-to-buffer-same-window (marker-buffer marker))
(goto-char marker)
(incf cnt-error)
(insert (if (stringp (nth 1 org-mobile-error))
(nth 1 org-mobile-error)
"EXECUTION FAILED")
" ")
(throw 'next t))
;; If we get here, the action has been applied successfully
;; So remove the entry
(goto-char bos-marker)
(delete-region (point) (org-end-of-subtree t t))))))
(let* ((action (match-string 1))
(data (and (match-end 3) (match-string 3)))
(id-pos (condition-case msg
(org-mobile-locate-entry (match-string 4))
(error (nth 1 msg))))
(bos (point-at-bol))
(eos (save-excursion (org-end-of-subtree t t)))
(cmd (if (equal action "")
'(progn
(incf cnt-flag)
(org-toggle-tag "FLAGGED" 'on)
(and note
(org-entry-put nil "THEFLAGGINGNOTE" note)))
(incf cnt-edit)
(cdr (assoc action org-mobile-action-alist))))
(note (and (equal action "")
(buffer-substring (1+ (point-at-eol)) eos)))
(org-inhibit-logging 'note) ;; Do not take notes interactively
old new)
(goto-char bos)
(when (and (markerp id-pos)
(not (member (marker-buffer id-pos) buf-list)))
(org-mobile-timestamp-buffer (marker-buffer id-pos))
(push (marker-buffer id-pos) buf-list))
(unless (markerp id-pos)
(goto-char (+ 2 (point-at-bol)))
(if (stringp id-pos)
(insert id-pos " ")
(insert "BAD REFERENCE "))
(incf cnt-error)
(throw 'next t))
(unless cmd
(insert "BAD FLAG ")
(incf cnt-error)
(throw 'next t))
(move-marker bos-marker (point))
(if (re-search-forward "^** Old value[ \t]*$" eos t)
(setq old (buffer-substring
(1+ (match-end 0))
(progn (outline-next-heading) (point)))))
(if (re-search-forward "^** New value[ \t]*$" eos t)
(setq new (buffer-substring
(1+ (match-end 0))
(progn (outline-next-heading)
(if (eobp) (org-back-over-empty-lines))
(point)))))
(setq old (and old (if (string-match "\\S-" old) old nil)))
(setq new (and new (if (string-match "\\S-" new) new nil)))
(if (and note (> (length note) 0))
;; Make Note into a single line, to fit into a property
(setq note (mapconcat 'identity
(org-split-string (org-trim note) "\n")
"\\n")))
(unless (equal data "body")
(setq new (and new (org-trim new))
old (and old (org-trim old))))
(goto-char (+ 2 bos-marker))
;; Remember this place so that we can return
(move-marker marker (point))
(setq org-mobile-error nil)
(save-excursion
(condition-case msg
(org-with-point-at id-pos
(progn
(eval cmd)
(unless (member data (list "delete" "archive" "archive-sibling" "addheading"))
(if (member "FLAGGED" (org-get-tags))
(add-to-list 'org-mobile-last-flagged-files
(buffer-file-name (current-buffer)))))))
(error (setq org-mobile-error msg))))
(when org-mobile-error
(org-pop-to-buffer-same-window (marker-buffer marker))
(goto-char marker)
(incf cnt-error)
(insert (if (stringp (nth 1 org-mobile-error))
(nth 1 org-mobile-error)
"EXECUTION FAILED")
" ")
(throw 'next t))
;; If we get here, the action has been applied successfully
;; So remove the entry
(goto-char bos-marker)
(delete-region (point) (org-end-of-subtree t t)))))
(save-buffer)
(move-marker marker nil)
(move-marker end nil)
@ -988,7 +972,19 @@ is currently a noop.")
(if (string-match "\\`id:\\(.*\\)$" link)
(org-id-find (match-string 1 link) 'marker)
(if (not (string-match "\\`olp:\\(.*?\\):\\(.*\\)$" link))
nil
; not found with path, but maybe it is to be inserted
; in top level of the file?
(if (not (string-match "\\`olp:\\(.*?\\)$" link))
nil
(let ((file (match-string 1 link)))
(setq file (org-link-unescape file))
(setq file (expand-file-name file org-directory))
(save-excursion
(find-file file)
(goto-char (point-max))
(newline)
(goto-char (point-max))
(move-marker (make-marker) (point)))))
(let ((file (match-string 1 link))
(path (match-string 2 link)))
(setq file (org-link-unescape file))
@ -1004,7 +1000,7 @@ The edit only takes place if the current value is equal (except for
white space) the OLD. If this is so, OLD will be replace by NEW
and the command will return t. If something goes wrong, a string will
be returned that indicates what went wrong."
(let (current old1 new1)
(let (current old1 new1 level)
(if (stringp what) (setq what (intern what)))
(cond
@ -1062,6 +1058,36 @@ be returned that indicates what went wrong."
(org-set-tags nil 'align))
(t (error "Heading changed in MobileOrg and on the computer")))))
((eq what 'addheading)
(if (org-on-heading-p) ; if false we are in top-level of file
(progn
(end-of-line 1)
(org-insert-heading-respect-content)
(org-demote))
(beginning-of-line)
(insert "* "))
(insert new))
((eq what 'refile)
(org-copy-subtree)
(org-with-point-at (org-mobile-locate-entry new)
(if (org-on-heading-p) ; if false we are in top-level of file
(progn
(setq level (org-get-valid-level (funcall outline-level) 1))
(org-end-of-subtree t t)
(org-paste-subtree level))
(org-paste-subtree 1)))
(org-cut-subtree))
((eq what 'delete)
(org-cut-subtree))
((eq what 'archive)
(org-archive-subtree))
((eq what 'archive-sibling)
(org-archive-to-archive-sibling))
((eq what 'body)
(setq current (buffer-substring (min (1+ (point-at-eol)) (point-max))
(save-excursion (outline-next-heading)

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

@ -260,7 +260,7 @@ after the current heading."
(interactive)
(case (org-mouse-line-position)
(:beginning (beginning-of-line)
(org-insert-heading))
(org-insert-heading))
(t (org-mouse-next-heading)
(org-insert-heading))))
@ -269,10 +269,8 @@ after the current heading."
For the acceptable UNITS, see `org-timestamp-change'."
(interactive)
(flet ((org-read-date (&rest rest) (current-time)))
(org-time-stamp nil))
(when shift
(org-timestamp-change shift units)))
(org-time-stamp nil)
(when shift (org-timestamp-change shift units)))
(defun org-mouse-keyword-menu (keywords function &optional selected itemformat)
"A helper function.
@ -295,19 +293,19 @@ string to (format ITEMFORMAT keyword). If it is neither a string
nor a function, elements of KEYWORDS are used directly."
(mapcar
`(lambda (keyword)
(vector (cond
((functionp ,itemformat) (funcall ,itemformat keyword))
((stringp ,itemformat) (format ,itemformat keyword))
(t keyword))
(list 'funcall ,function keyword)
:style (cond
((null ,selected) t)
((functionp ,selected) 'toggle)
(t 'radio))
:selected (if (functionp ,selected)
(and (funcall ,selected keyword) t)
(equal ,selected keyword))))
keywords))
(vector (cond
((functionp ,itemformat) (funcall ,itemformat keyword))
((stringp ,itemformat) (format ,itemformat keyword))
(t keyword))
(list 'funcall ,function keyword)
:style (cond
((null ,selected) t)
((functionp ,selected) 'toggle)
(t 'radio))
:selected (if (functionp ,selected)
(and (funcall ,selected keyword) t)
(equal ,selected keyword))))
keywords))
(defun org-mouse-remove-match-and-spaces ()
"Remove the match, make just one space around the point."
@ -375,8 +373,7 @@ nor a function, elements of KEYWORDS are used directly."
(defun org-mouse-set-priority (priority)
"Set the priority of the current headline to PRIORITY."
(flet ((read-char-exclusive () priority))
(org-priority)))
(org-priority priority))
(defvar org-mouse-priority-regexp "\\[#\\([A-Z]\\)\\]"
"Regular expression matching the priority indicator.
@ -410,8 +407,8 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
(> (match-end 0) point))))))
(defun org-mouse-priority-list ()
(loop for priority from ?A to org-lowest-priority
collect (char-to-string priority)))
(loop for priority from ?A to org-lowest-priority
collect (char-to-string priority)))
(defun org-mouse-todo-menu (state)
"Create the menu with TODO keywords."
@ -464,12 +461,12 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
(defun org-mouse-agenda-type (type)
(case type
('tags "Tags: ")
('todo "TODO: ")
('tags-tree "Tags tree: ")
('todo-tree "TODO tree: ")
('occur-tree "Occur tree: ")
(t "Agenda command ???")))
('tags "Tags: ")
('todo "TODO: ")
('tags-tree "Tags tree: ")
('todo-tree "TODO tree: ")
('occur-tree "Occur tree: ")
(t "Agenda command ???")))
(defun org-mouse-list-options-menu (alloptions &optional function)
(let ((options (save-match-data
@ -488,8 +485,8 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
" ")
nil nil nil 1)
(when (functionp ',function) (funcall ',function)))
:style 'toggle
:selected (and (member name options) t)))))
:style 'toggle
:selected (and (member name options) t)))))
(defun org-mouse-clip-text (text maxlength)
(if (> (length text) maxlength)
@ -532,19 +529,18 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
,@(org-mouse-keyword-menu
(mapcar 'car org-agenda-custom-commands)
#'(lambda (key)
(eval `(flet ((read-char-exclusive () (string-to-char ,key)))
(org-agenda nil))))
(eval `(org-agenda nil (string-to-char ,key))))
nil
#'(lambda (key)
(let ((entry (assoc key org-agenda-custom-commands)))
(org-mouse-clip-text
(cond
((stringp (nth 1 entry)) (nth 1 entry))
((stringp (nth 2 entry))
(concat (org-mouse-agenda-type (nth 1 entry))
(nth 2 entry)))
(t "Agenda Command '%s'"))
30))))
(let ((entry (assoc key org-agenda-custom-commands)))
(org-mouse-clip-text
(cond
((stringp (nth 1 entry)) (nth 1 entry))
((stringp (nth 2 entry))
(concat (org-mouse-agenda-type (nth 1 entry))
(nth 2 entry)))
(t "Agenda Command '%s'"))
30))))
"--"
["Delete Blank Lines" delete-blank-lines
:visible (org-mouse-empty-line)]
@ -597,21 +593,21 @@ This means, between the beginning of line and the point."
(beginning-of-line))
(defadvice dnd-insert-text (around org-mouse-dnd-insert-text activate)
(if (eq major-mode 'org-mode)
(if (derived-mode-p 'org-mode)
(org-mouse-insert-item text)
ad-do-it))
(defadvice dnd-open-file (around org-mouse-dnd-open-file activate)
(if (eq major-mode 'org-mode)
(if (derived-mode-p 'org-mode)
(org-mouse-insert-item uri)
ad-do-it))
(defun org-mouse-match-closure (function)
(let ((match (match-data t)))
`(lambda (&rest rest)
(save-match-data
(set-match-data ',match)
(apply ',function rest)))))
(save-match-data
(set-match-data ',match)
(apply ',function rest)))))
(defun org-mouse-yank-link (click)
(interactive "e")
@ -623,234 +619,234 @@ This means, between the beginning of line and the point."
(insert-for-yank (concat " [[" (current-kill 0) "]] ")))
(defun org-mouse-context-menu (&optional event)
(let ((stamp-prefixes (list org-deadline-string org-scheduled-string))
(contextlist (org-context)))
(flet ((get-context (context) (org-mouse-get-context contextlist context)))
(cond
((org-mouse-mark-active)
(let ((region-string (buffer-substring (region-beginning) (region-end))))
(let* ((stamp-prefixes (list org-deadline-string org-scheduled-string))
(contextlist (org-context))
(get-context (lambda (context) (org-mouse-get-context contextlist context))))
(cond
((org-mouse-mark-active)
(let ((region-string (buffer-substring (region-beginning) (region-end))))
(popup-menu
`(nil
["Sparse Tree" (org-occur ',region-string)]
["Find in Buffer" (occur ',region-string)]
["Grep in Current Dir"
(grep (format "grep -rnH -e '%s' *" ',region-string))]
["Grep in Parent Dir"
(grep (format "grep -rnH -e '%s' ../*" ',region-string))]
"--"
["Convert to Link"
(progn (save-excursion (goto-char (region-beginning)) (insert "[["))
(save-excursion (goto-char (region-end)) (insert "]]")))]
["Insert Link Here" (org-mouse-yank-link ',event)]))))
((save-excursion (beginning-of-line) (looking-at "#\\+STARTUP: \\(.*\\)"))
(popup-menu
`(nil
["Sparse Tree" (org-occur ',region-string)]
["Find in Buffer" (occur ',region-string)]
["Grep in Current Dir"
(grep (format "grep -rnH -e '%s' *" ',region-string))]
["Grep in Parent Dir"
(grep (format "grep -rnH -e '%s' ../*" ',region-string))]
"--"
["Convert to Link"
(progn (save-excursion (goto-char (region-beginning)) (insert "[["))
(save-excursion (goto-char (region-end)) (insert "]]")))]
["Insert Link Here" (org-mouse-yank-link ',event)]))))
((save-excursion (beginning-of-line) (looking-at "#\\+STARTUP: \\(.*\\)"))
(popup-menu
`(nil
,@(org-mouse-list-options-menu (mapcar 'car org-startup-options)
'org-mode-restart))))
((or (eolp)
(and (looking-at "\\( \\|\t\\)\\(+:[0-9a-zA-Z_:]+\\)?\\( \\|\t\\)+$")
(org-looking-back " \\|\t")))
(org-mouse-popup-global-menu))
((get-context :checkbox)
(popup-menu
'(nil
["Toggle" org-toggle-checkbox t]
["Remove" org-mouse-remove-match-and-spaces t]
""
["All Clear" (org-mouse-for-each-item
(lambda ()
(when (save-excursion (org-at-item-checkbox-p))
(replace-match "[ ]"))))]
["All Set" (org-mouse-for-each-item
,@(org-mouse-list-options-menu (mapcar 'car org-startup-options)
'org-mode-restart))))
((or (eolp)
(and (looking-at "\\( \\|\t\\)\\(+:[0-9a-zA-Z_:]+\\)?\\( \\|\t\\)+$")
(org-looking-back " \\|\t")))
(org-mouse-popup-global-menu))
((funcall get-context :checkbox)
(popup-menu
'(nil
["Toggle" org-toggle-checkbox t]
["Remove" org-mouse-remove-match-and-spaces t]
""
["All Clear" (org-mouse-for-each-item
(lambda ()
(when (save-excursion (org-at-item-checkbox-p))
(replace-match "[ ]"))))]
["All Set" (org-mouse-for-each-item
(lambda ()
(when (save-excursion (org-at-item-checkbox-p))
(replace-match "[X]"))))]
["All Toggle" (org-mouse-for-each-item 'org-toggle-checkbox) t]
["All Remove" (org-mouse-for-each-item
(lambda ()
(when (save-excursion (org-at-item-checkbox-p))
(org-mouse-remove-match-and-spaces))))]
)))
((and (org-mouse-looking-at "\\b\\w+" "a-zA-Z0-9_")
(member (match-string 0) org-todo-keywords-1))
(popup-menu
`(nil
,@(org-mouse-todo-menu (match-string 0))
"--"
["Check TODOs" org-show-todo-tree t]
["List all TODO keywords" org-todo-list t]
[,(format "List only %s" (match-string 0))
(org-todo-list (match-string 0)) t]
)))
((and (org-mouse-looking-at "\\b[A-Z]+:" "A-Z")
(member (match-string 0) stamp-prefixes))
(popup-menu
`(nil
,@(org-mouse-keyword-replace-menu stamp-prefixes)
"--"
["Check Deadlines" org-check-deadlines t]
)))
((org-mouse-looking-at org-mouse-priority-regexp "[]A-Z#") ; priority
(popup-menu `(nil ,@(org-mouse-keyword-replace-menu
(org-mouse-priority-list) 1 "Priority %s" t))))
((get-context :link)
(popup-menu
'(nil
["Open" org-open-at-point t]
["Open in Emacs" (org-open-at-point t) t]
"--"
["Copy link" (org-kill-new (match-string 0))]
["Cut link"
(progn
(kill-region (match-beginning 0) (match-end 0))
(just-one-space))]
"--"
["Grep for TODOs"
(grep (format "grep -nH -i 'todo\\|fixme' %s*" (match-string 2)))]
; ["Paste file link" ((insert "file:") (yank))]
)))
((org-mouse-looking-at ":\\([A-Za-z0-9_]+\\):" "A-Za-z0-9_" -1) ;tags
(popup-menu
`(nil
[,(format "Display '%s'" (match-string 1))
(org-tags-view nil ,(match-string 1))]
[,(format "Sparse Tree '%s'" (match-string 1))
(org-tags-sparse-tree nil ,(match-string 1))]
"--"
,@(org-mouse-tag-menu))))
((org-at-timestamp-p)
(popup-menu
'(nil
["Show Day" org-open-at-point t]
["Change Timestamp" org-time-stamp t]
["Delete Timestamp" (org-mouse-delete-timestamp) t]
["Compute Time Range" org-evaluate-time-range (org-at-date-range-p)]
"--"
["Set for Today" org-mouse-timestamp-today]
["Set for Tomorrow" (org-mouse-timestamp-today 1 'day)]
["Set in 1 Week" (org-mouse-timestamp-today 7 'day)]
["Set in 2 Weeks" (org-mouse-timestamp-today 14 'day)]
["Set in a Month" (org-mouse-timestamp-today 1 'month)]
"--"
["+ 1 Day" (org-timestamp-change 1 'day)]
["+ 1 Week" (org-timestamp-change 7 'day)]
["+ 1 Month" (org-timestamp-change 1 'month)]
"--"
["- 1 Day" (org-timestamp-change -1 'day)]
["- 1 Week" (org-timestamp-change -7 'day)]
["- 1 Month" (org-timestamp-change -1 'month)])))
((get-context :table-special)
(let ((mdata (match-data)))
(incf (car mdata) 2)
(store-match-data mdata))
(message "match: %S" (match-string 0))
(popup-menu `(nil ,@(org-mouse-keyword-replace-menu
'(" " "!" "^" "_" "$" "#" "*" "'") 0
(lambda (mark)
(case (string-to-char mark)
(? "( ) Nothing Special")
(?! "(!) Column Names")
(?^ "(^) Field Names Above")
(?_ "(^) Field Names Below")
(?$ "($) Formula Parameters")
(?# "(#) Recalculation: Auto")
(?* "(*) Recalculation: Manual")
(?' "(') Recalculation: None"))) t))))
((assq :table contextlist)
(popup-menu
'(nil
["Align Table" org-ctrl-c-ctrl-c]
["Blank Field" org-table-blank-field]
["Edit Field" org-table-edit-field]
"--"
("Column"
["Move Column Left" org-metaleft]
["Move Column Right" org-metaright]
["Delete Column" org-shiftmetaleft]
["Insert Column" org-shiftmetaright]
"--"
["Enable Narrowing" (setq org-table-limit-column-width (not org-table-limit-column-width)) :selected org-table-limit-column-width :style toggle])
("Row"
["Move Row Up" org-metaup]
["Move Row Down" org-metadown]
["Delete Row" org-shiftmetaup]
["Insert Row" org-shiftmetadown]
["Sort lines in region" org-table-sort-lines (org-at-table-p)]
"--"
["Insert Hline" org-table-insert-hline])
("Rectangle"
["Copy Rectangle" org-copy-special]
["Cut Rectangle" org-cut-special]
["Paste Rectangle" org-paste-special]
["Fill Rectangle" org-table-wrap-region])
"--"
["Set Column Formula" org-table-eval-formula]
["Set Field Formula" (org-table-eval-formula '(4))]
["Edit Formulas" org-table-edit-formulas]
"--"
["Recalculate Line" org-table-recalculate]
["Recalculate All" (org-table-recalculate '(4))]
["Iterate All" (org-table-recalculate '(16))]
"--"
["Toggle Recalculate Mark" org-table-rotate-recalc-marks]
["Sum Column/Rectangle" org-table-sum
:active (or (org-at-table-p) (org-region-active-p))]
["Field Info" org-table-field-info]
["Debug Formulas"
(setq org-table-formula-debug (not org-table-formula-debug))
:style toggle :selected org-table-formula-debug]
)))
((and (assq :headline contextlist) (not (eolp)))
(let ((priority (org-mouse-get-priority t)))
["All Toggle" (org-mouse-for-each-item 'org-toggle-checkbox) t]
["All Remove" (org-mouse-for-each-item
(lambda ()
(when (save-excursion (org-at-item-checkbox-p))
(org-mouse-remove-match-and-spaces))))]
)))
((and (org-mouse-looking-at "\\b\\w+" "a-zA-Z0-9_")
(member (match-string 0) org-todo-keywords-1))
(popup-menu
`("Headline Menu"
("Tags and Priorities"
,@(org-mouse-keyword-menu
(org-mouse-priority-list)
#'(lambda (keyword)
(org-mouse-set-priority (string-to-char keyword)))
priority "Priority %s")
"--"
,@(org-mouse-tag-menu))
("TODO Status"
,@(org-mouse-todo-menu (org-get-todo-state)))
["Show Tags"
(with-current-buffer org-mouse-main-buffer (org-agenda-show-tags))
:visible (not org-mouse-direct)]
["Show Priority"
(with-current-buffer org-mouse-main-buffer (org-agenda-show-priority))
:visible (not org-mouse-direct)]
,@(if org-mouse-direct '("--") nil)
["New Heading" org-mouse-insert-heading :visible org-mouse-direct]
["Set Deadline"
(progn (org-mouse-end-headline) (insert " ") (org-deadline))
:active (not (save-excursion
(org-mouse-re-search-line org-deadline-regexp)))]
["Schedule Task"
(progn (org-mouse-end-headline) (insert " ") (org-schedule))
:active (not (save-excursion
(org-mouse-re-search-line org-scheduled-regexp)))]
["Insert Timestamp"
(progn (org-mouse-end-headline) (insert " ") (org-time-stamp nil)) t]
; ["Timestamp (inactive)" org-time-stamp-inactive t]
`(nil
,@(org-mouse-todo-menu (match-string 0))
"--"
["Archive Subtree" org-archive-subtree]
["Cut Subtree" org-cut-special]
["Copy Subtree" org-copy-special]
["Paste Subtree" org-paste-special :visible org-mouse-direct]
("Sort Children"
["Alphabetically" (org-sort-entries nil ?a)]
["Numerically" (org-sort-entries nil ?n)]
["By Time/Date" (org-sort-entries nil ?t)]
"--"
["Reverse Alphabetically" (org-sort-entries nil ?A)]
["Reverse Numerically" (org-sort-entries nil ?N)]
["Reverse By Time/Date" (org-sort-entries nil ?T)])
["Check TODOs" org-show-todo-tree t]
["List all TODO keywords" org-todo-list t]
[,(format "List only %s" (match-string 0))
(org-todo-list (match-string 0)) t]
)))
((and (org-mouse-looking-at "\\b[A-Z]+:" "A-Z")
(member (match-string 0) stamp-prefixes))
(popup-menu
`(nil
,@(org-mouse-keyword-replace-menu stamp-prefixes)
"--"
["Move Trees" org-mouse-move-tree :active nil]
))))
(t
(org-mouse-popup-global-menu))))))
["Check Deadlines" org-check-deadlines t]
)))
((org-mouse-looking-at org-mouse-priority-regexp "[]A-Z#") ; priority
(popup-menu `(nil ,@(org-mouse-keyword-replace-menu
(org-mouse-priority-list) 1 "Priority %s" t))))
((funcall get-context :link)
(popup-menu
'(nil
["Open" org-open-at-point t]
["Open in Emacs" (org-open-at-point t) t]
"--"
["Copy link" (org-kill-new (match-string 0))]
["Cut link"
(progn
(kill-region (match-beginning 0) (match-end 0))
(just-one-space))]
"--"
["Grep for TODOs"
(grep (format "grep -nH -i 'todo\\|fixme' %s*" (match-string 2)))]
; ["Paste file link" ((insert "file:") (yank))]
)))
((org-mouse-looking-at ":\\([A-Za-z0-9_]+\\):" "A-Za-z0-9_" -1) ;tags
(popup-menu
`(nil
[,(format "Display '%s'" (match-string 1))
(org-tags-view nil ,(match-string 1))]
[,(format "Sparse Tree '%s'" (match-string 1))
(org-tags-sparse-tree nil ,(match-string 1))]
"--"
,@(org-mouse-tag-menu))))
((org-at-timestamp-p)
(popup-menu
'(nil
["Show Day" org-open-at-point t]
["Change Timestamp" org-time-stamp t]
["Delete Timestamp" (org-mouse-delete-timestamp) t]
["Compute Time Range" org-evaluate-time-range (org-at-date-range-p)]
"--"
["Set for Today" org-mouse-timestamp-today]
["Set for Tomorrow" (org-mouse-timestamp-today 1 'day)]
["Set in 1 Week" (org-mouse-timestamp-today 7 'day)]
["Set in 2 Weeks" (org-mouse-timestamp-today 14 'day)]
["Set in a Month" (org-mouse-timestamp-today 1 'month)]
"--"
["+ 1 Day" (org-timestamp-change 1 'day)]
["+ 1 Week" (org-timestamp-change 7 'day)]
["+ 1 Month" (org-timestamp-change 1 'month)]
"--"
["- 1 Day" (org-timestamp-change -1 'day)]
["- 1 Week" (org-timestamp-change -7 'day)]
["- 1 Month" (org-timestamp-change -1 'month)])))
((funcall get-context :table-special)
(let ((mdata (match-data)))
(incf (car mdata) 2)
(store-match-data mdata))
(message "match: %S" (match-string 0))
(popup-menu `(nil ,@(org-mouse-keyword-replace-menu
'(" " "!" "^" "_" "$" "#" "*" "'") 0
(lambda (mark)
(case (string-to-char mark)
(? "( ) Nothing Special")
(?! "(!) Column Names")
(?^ "(^) Field Names Above")
(?_ "(^) Field Names Below")
(?$ "($) Formula Parameters")
(?# "(#) Recalculation: Auto")
(?* "(*) Recalculation: Manual")
(?' "(') Recalculation: None"))) t))))
((assq :table contextlist)
(popup-menu
'(nil
["Align Table" org-ctrl-c-ctrl-c]
["Blank Field" org-table-blank-field]
["Edit Field" org-table-edit-field]
"--"
("Column"
["Move Column Left" org-metaleft]
["Move Column Right" org-metaright]
["Delete Column" org-shiftmetaleft]
["Insert Column" org-shiftmetaright]
"--"
["Enable Narrowing" (setq org-table-limit-column-width (not org-table-limit-column-width)) :selected org-table-limit-column-width :style toggle])
("Row"
["Move Row Up" org-metaup]
["Move Row Down" org-metadown]
["Delete Row" org-shiftmetaup]
["Insert Row" org-shiftmetadown]
["Sort lines in region" org-table-sort-lines (org-at-table-p)]
"--"
["Insert Hline" org-table-insert-hline])
("Rectangle"
["Copy Rectangle" org-copy-special]
["Cut Rectangle" org-cut-special]
["Paste Rectangle" org-paste-special]
["Fill Rectangle" org-table-wrap-region])
"--"
["Set Column Formula" org-table-eval-formula]
["Set Field Formula" (org-table-eval-formula '(4))]
["Edit Formulas" org-table-edit-formulas]
"--"
["Recalculate Line" org-table-recalculate]
["Recalculate All" (org-table-recalculate '(4))]
["Iterate All" (org-table-recalculate '(16))]
"--"
["Toggle Recalculate Mark" org-table-rotate-recalc-marks]
["Sum Column/Rectangle" org-table-sum
:active (or (org-at-table-p) (org-region-active-p))]
["Field Info" org-table-field-info]
["Debug Formulas"
(setq org-table-formula-debug (not org-table-formula-debug))
:style toggle :selected org-table-formula-debug]
)))
((and (assq :headline contextlist) (not (eolp)))
(let ((priority (org-mouse-get-priority t)))
(popup-menu
`("Headline Menu"
("Tags and Priorities"
,@(org-mouse-keyword-menu
(org-mouse-priority-list)
#'(lambda (keyword)
(org-mouse-set-priority (string-to-char keyword)))
priority "Priority %s")
"--"
,@(org-mouse-tag-menu))
("TODO Status"
,@(org-mouse-todo-menu (org-get-todo-state)))
["Show Tags"
(with-current-buffer org-mouse-main-buffer (org-agenda-show-tags))
:visible (not org-mouse-direct)]
["Show Priority"
(with-current-buffer org-mouse-main-buffer (org-agenda-show-priority))
:visible (not org-mouse-direct)]
,@(if org-mouse-direct '("--") nil)
["New Heading" org-mouse-insert-heading :visible org-mouse-direct]
["Set Deadline"
(progn (org-mouse-end-headline) (insert " ") (org-deadline))
:active (not (save-excursion
(org-mouse-re-search-line org-deadline-regexp)))]
["Schedule Task"
(progn (org-mouse-end-headline) (insert " ") (org-schedule))
:active (not (save-excursion
(org-mouse-re-search-line org-scheduled-regexp)))]
["Insert Timestamp"
(progn (org-mouse-end-headline) (insert " ") (org-time-stamp nil)) t]
; ["Timestamp (inactive)" org-time-stamp-inactive t]
"--"
["Archive Subtree" org-archive-subtree]
["Cut Subtree" org-cut-special]
["Copy Subtree" org-copy-special]
["Paste Subtree" org-paste-special :visible org-mouse-direct]
("Sort Children"
["Alphabetically" (org-sort-entries nil ?a)]
["Numerically" (org-sort-entries nil ?n)]
["By Time/Date" (org-sort-entries nil ?t)]
"--"
["Reverse Alphabetically" (org-sort-entries nil ?A)]
["Reverse Numerically" (org-sort-entries nil ?N)]
["Reverse By Time/Date" (org-sort-entries nil ?T)])
"--"
["Move Trees" org-mouse-move-tree :active nil]
))))
(t
(org-mouse-popup-global-menu)))))
(defun org-mouse-mark-active ()
(and mark-active transient-mark-mode))
@ -868,55 +864,55 @@ This means, between the beginning of line and the point."
(mouse-drag-region event)))
(add-hook 'org-mode-hook
#'(lambda ()
(setq org-mouse-context-menu-function 'org-mouse-context-menu)
#'(lambda ()
(setq org-mouse-context-menu-function 'org-mouse-context-menu)
(when (memq 'context-menu org-mouse-features)
(org-defkey org-mouse-map [mouse-3] nil)
(org-defkey org-mode-map [mouse-3] 'org-mouse-show-context-menu))
(org-defkey org-mode-map [down-mouse-1] 'org-mouse-down-mouse)
(when (memq 'context-menu org-mouse-features)
(org-defkey org-mouse-map [C-drag-mouse-1] 'org-mouse-move-tree)
(org-defkey org-mouse-map [C-down-mouse-1] 'org-mouse-move-tree-start))
(when (memq 'yank-link org-mouse-features)
(org-defkey org-mode-map [S-mouse-2] 'org-mouse-yank-link)
(org-defkey org-mode-map [drag-mouse-3] 'org-mouse-yank-link))
(when (memq 'move-tree org-mouse-features)
(org-defkey org-mouse-map [drag-mouse-3] 'org-mouse-move-tree)
(org-defkey org-mouse-map [down-mouse-3] 'org-mouse-move-tree-start))
(when (memq 'context-menu org-mouse-features)
(org-defkey org-mouse-map [mouse-3] nil)
(org-defkey org-mode-map [mouse-3] 'org-mouse-show-context-menu))
(org-defkey org-mode-map [down-mouse-1] 'org-mouse-down-mouse)
(when (memq 'context-menu org-mouse-features)
(org-defkey org-mouse-map [C-drag-mouse-1] 'org-mouse-move-tree)
(org-defkey org-mouse-map [C-down-mouse-1] 'org-mouse-move-tree-start))
(when (memq 'yank-link org-mouse-features)
(org-defkey org-mode-map [S-mouse-2] 'org-mouse-yank-link)
(org-defkey org-mode-map [drag-mouse-3] 'org-mouse-yank-link))
(when (memq 'move-tree org-mouse-features)
(org-defkey org-mouse-map [drag-mouse-3] 'org-mouse-move-tree)
(org-defkey org-mouse-map [down-mouse-3] 'org-mouse-move-tree-start))
(when (memq 'activate-stars org-mouse-features)
(font-lock-add-keywords
nil
`((,org-outline-regexp
0 `(face org-link mouse-face highlight keymap ,org-mouse-map)
'prepend))
t))
(when (memq 'activate-stars org-mouse-features)
(font-lock-add-keywords
nil
`((,org-outline-regexp
0 `(face org-link mouse-face highlight keymap ,org-mouse-map)
'prepend))
t))
(when (memq 'activate-bullets org-mouse-features)
(font-lock-add-keywords
nil
`(("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +"
(1 `(face org-link keymap ,org-mouse-map mouse-face highlight)
'prepend)))
t))
(when (memq 'activate-bullets org-mouse-features)
(font-lock-add-keywords
nil
`(("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +"
(1 `(face org-link keymap ,org-mouse-map mouse-face highlight)
'prepend)))
t))
(when (memq 'activate-checkboxes org-mouse-features)
(font-lock-add-keywords
nil
`(("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[ X]\\]\\)"
(2 `(face bold keymap ,org-mouse-map mouse-face highlight) t)))
t))
(when (memq 'activate-checkboxes org-mouse-features)
(font-lock-add-keywords
nil
`(("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[ X]\\]\\)"
(2 `(face bold keymap ,org-mouse-map mouse-face highlight) t)))
t))
(defadvice org-open-at-point (around org-mouse-open-at-point activate)
(let ((context (org-context)))
(cond
((assq :headline-stars context) (org-cycle))
((assq :checkbox context) (org-toggle-checkbox))
((assq :item-bullet context)
(let ((org-cycle-include-plain-lists t)) (org-cycle)))
((org-footnote-at-reference-p) nil)
(t ad-do-it))))))
(defadvice org-open-at-point (around org-mouse-open-at-point activate)
(let ((context (org-context)))
(cond
((assq :headline-stars context) (org-cycle))
((assq :checkbox context) (org-toggle-checkbox))
((assq :item-bullet context)
(let ((org-cycle-include-plain-lists t)) (org-cycle)))
((org-footnote-at-reference-p) nil)
(t ad-do-it))))))
(defun org-mouse-move-tree-start (event)
(interactive "e")
@ -936,42 +932,42 @@ This means, between the beginning of line and the point."
(sbuf (marker-buffer start))
(ebuf (marker-buffer end)))
(when (and sbuf ebuf)
(set-buffer sbuf)
(goto-char start)
(org-back-to-heading)
(if (and (eq sbuf ebuf)
(equal
(point)
(save-excursion (goto-char end) (org-back-to-heading) (point))))
;; if the same line then promote/demote
(if (>= end start) (org-demote-subtree) (org-promote-subtree))
;; if different lines then move
(org-cut-subtree)
(when (and sbuf ebuf)
(set-buffer sbuf)
(goto-char start)
(org-back-to-heading)
(if (and (eq sbuf ebuf)
(equal
(point)
(save-excursion (goto-char end) (org-back-to-heading) (point))))
;; if the same line then promote/demote
(if (>= end start) (org-demote-subtree) (org-promote-subtree))
;; if different lines then move
(org-cut-subtree)
(set-buffer ebuf)
(goto-char end)
(org-back-to-heading)
(when (and (eq sbuf ebuf)
(equal
(point)
(save-excursion (goto-char start)
(org-back-to-heading) (point))))
(outline-end-of-subtree)
(end-of-line)
(if (eobp) (newline) (forward-char)))
(when (looking-at org-outline-regexp)
(let ((level (- (match-end 0) (match-beginning 0))))
(when (> end (match-end 0))
(set-buffer ebuf)
(goto-char end)
(org-back-to-heading)
(when (and (eq sbuf ebuf)
(equal
(point)
(save-excursion (goto-char start)
(org-back-to-heading) (point))))
(outline-end-of-subtree)
(end-of-line)
(if (eobp) (newline) (forward-char))
(setq level (1+ level)))
(org-paste-subtree level)
(save-excursion
(outline-end-of-subtree)
(when (bolp) (delete-char -1))))))))))
(if (eobp) (newline) (forward-char)))
(when (looking-at org-outline-regexp)
(let ((level (- (match-end 0) (match-beginning 0))))
(when (> end (match-end 0))
(outline-end-of-subtree)
(end-of-line)
(if (eobp) (newline) (forward-char))
(setq level (1+ level)))
(org-paste-subtree level)
(save-excursion
(outline-end-of-subtree)
(when (bolp) (delete-char -1))))))))))
(defun org-mouse-transform-to-outline ()
@ -994,7 +990,7 @@ This means, between the beginning of line and the point."
(defvar org-mouse-cmd) ;dynamically scoped from `org-with-remote-undo'.
(defun org-mouse-do-remotely (command)
; (org-agenda-check-no-diary)
; (org-agenda-check-no-diary)
(when (get-text-property (point) 'org-marker)
(let* ((anticol (- (point-at-eol) (point)))
(marker (get-text-property (point) 'org-marker))
@ -1091,20 +1087,20 @@ This means, between the beginning of line and the point."
(if (< (car startxy) (car endxy)) :right :left)))
; (setq org-agenda-mode-hook nil)
; (setq org-agenda-mode-hook nil)
(defvar org-agenda-mode-map)
(add-hook 'org-agenda-mode-hook
#'(lambda ()
(setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu)
(org-defkey org-agenda-mode-map [mouse-3] 'org-mouse-show-context-menu)
(org-defkey org-agenda-mode-map [down-mouse-3] 'org-mouse-move-tree-start)
(org-defkey org-agenda-mode-map [C-mouse-4] 'org-agenda-earlier)
(org-defkey org-agenda-mode-map [C-mouse-5] 'org-agenda-later)
(org-defkey org-agenda-mode-map [drag-mouse-3]
#'(lambda (event) (interactive "e")
(case (org-mouse-get-gesture event)
(:left (org-agenda-earlier 1))
(:right (org-agenda-later 1)))))))
#'(lambda ()
(setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu)
(org-defkey org-agenda-mode-map [mouse-3] 'org-mouse-show-context-menu)
(org-defkey org-agenda-mode-map [down-mouse-3] 'org-mouse-move-tree-start)
(org-defkey org-agenda-mode-map [C-mouse-4] 'org-agenda-earlier)
(org-defkey org-agenda-mode-map [C-mouse-5] 'org-agenda-later)
(org-defkey org-agenda-mode-map [drag-mouse-3]
#'(lambda (event) (interactive "e")
(case (org-mouse-get-gesture event)
(:left (org-agenda-earlier 1))
(:right (org-agenda-later 1)))))))
(provide 'org-mouse)

242
lisp/org/org-odt.el
View file

@ -100,9 +100,7 @@ Use this to infer values of `org-odt-styles-dir' and
(expand-file-name "./schema/" org-odt-data-dir)) ; bail out
(eval-when-compile
(and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install
(expand-file-name "./schema/" org-odt-data-dir)))
(expand-file-name "../contrib/odt/etc/schema/" org-odt-lib-dir) ; git
)
(expand-file-name "./schema/" org-odt-data-dir))))
"List of directories to search for OpenDocument schema files.
Use this list to set the default value of
`org-export-odt-schema-dir'. The entries in this list are
@ -213,7 +211,7 @@ heuristically based on the values of `org-odt-lib-dir' and
org-odt-styles-dir-list)
nil)))
(unless styles-dir
(error "Error (org-odt): Cannot find factory styles files. Aborting."))
(error "Error (org-odt): Cannot find factory styles files, aborting"))
styles-dir)
"Directory that holds auxiliary XML files used by the ODT exporter.
@ -245,9 +243,6 @@ standard Emacs.")
(mapc
(lambda (desc)
;; Let Org open all OpenDocument files using system-registered app
(add-to-list 'org-file-apps
(cons (concat "\\." (car desc) "\\'") 'system))
;; Let Emacs open all OpenDocument files in archive mode
(add-to-list 'auto-mode-alist
(cons (concat "\\." (car desc) "\\'") 'archive-mode)))
@ -285,7 +280,7 @@ Valid values are one of:
4. list of the form (ODT-OR-OTT-FILE (FILE-MEMBER-1 FILE-MEMBER-2
...))
In case of option 1, an in-built styles.xml is used. See
In case of option 1, an in-built styles.xml is used. See
`org-odt-styles-dir' for more information.
In case of option 3, the specified file is unzipped and the
@ -326,6 +321,8 @@ a per-file basis. For example,
(defconst org-export-odt-tmpdir-prefix "%s-")
(defconst org-export-odt-bookmark-prefix "OrgXref.")
(defvar org-odt-zip-dir nil
"Temporary directory that holds XML files during export.")
(defvar org-export-odt-embed-images t
"Should the images be copied in to the odt file or just linked?")
@ -382,7 +379,8 @@ This variable is effective only if
(table . "Table")
(definition-term . "Text_20_body_20_bold")
(horizontal-line . "Horizontal_20_Line")))
(character . ((bold . "Bold")
(character . ((default . "Default")
(bold . "Bold")
(emphasis . "Emphasis")
(code . "OrgCode")
(verbatim . "OrgCode")
@ -413,7 +411,10 @@ Interactive commands `org-export-as-odt' and
then use `org-export-odt-convert-process' to convert the
resulting document to this format. During customization of this
variable, the list of valid values are populated based on
`org-export-odt-convert-capabilities'."
`org-export-odt-convert-capabilities'.
You can set this option on per-file basis using file local
values. See Info node `(emacs) File Variables'."
:group 'org-export-odt
:version "24.1"
:type '(choice :convert-widget
@ -424,6 +425,35 @@ variable, the list of valid values are populated based on
,@(mapcar (lambda (c)
`(const :tag ,c ,c))
(org-lparse-reachable-formats "odt")))))
;;;###autoload
(put 'org-export-odt-preferred-output-format 'safe-local-variable 'stringp)
(defmacro org-odt-cleanup-xml-buffers (&rest body)
`(let ((org-odt-zip-dir
(make-temp-file
(format org-export-odt-tmpdir-prefix "odf") t))
(--cleanup-xml-buffers
(function
(lambda nil
(let ((xml-files '("mimetype" "META-INF/manifest.xml" "content.xml"
"meta.xml" "styles.xml")))
;; kill all xml buffers
(mapc (lambda (file)
(let ((buf (find-file-noselect
(expand-file-name file org-odt-zip-dir) t)))
(when (buffer-name buf)
(set-buffer-modified-p nil)
(kill-buffer buf))))
xml-files))
;; delete temporary directory.
(delete-directory org-odt-zip-dir t)))))
(org-condition-case-unless-debug err
(prog1 (progn ,@body)
(funcall --cleanup-xml-buffers))
((quit error)
(funcall --cleanup-xml-buffers)
(message "OpenDocument export failed: %s"
(error-message-string err))))))
;;;###autoload
(defun org-export-as-odt-and-open (arg)
@ -432,8 +462,9 @@ If there is an active region, export only the region.
The prefix ARG specifies how many levels of the outline should become
headlines. The default is 3. Lower levels will become bulleted lists."
(interactive "P")
(org-lparse-and-open
(or org-export-odt-preferred-output-format "odt") "odt" arg))
(org-odt-cleanup-xml-buffers
(org-lparse-and-open
(or org-export-odt-preferred-output-format "odt") "odt" arg)))
;;;###autoload
(defun org-export-as-odt-batch ()
@ -464,8 +495,9 @@ the file header and footer, simply return the content of
<body>...</body>, without even the body tags themselves. When
PUB-DIR is set, use this as the publishing directory."
(interactive "P")
(org-lparse (or org-export-odt-preferred-output-format "odt")
"odt" arg hidden ext-plist to-buffer body-only pub-dir))
(org-odt-cleanup-xml-buffers
(org-lparse (or org-export-odt-preferred-output-format "odt")
"odt" arg hidden ext-plist to-buffer body-only pub-dir)))
(defvar org-odt-entity-control-callbacks-alist
`((EXPORT
@ -539,7 +571,7 @@ PUB-DIR is set, use this as the publishing directory."
(delete-region (match-beginning 0) (point-max)))
;; Following variable is let bound when `org-do-lparse' is in
;; progress. See org-html.el.
;; progress. See org-html.el.
(defvar org-lparse-toc)
(defun org-odt-format-toc ()
(if (not org-lparse-toc) "" (concat "\n" org-lparse-toc "\n")))
@ -810,7 +842,7 @@ PUB-DIR is set, use this as the publishing directory."
(org-lparse-begin-list-item list-type)))
;; Following variables are let bound when table emission is in
;; progress. See org-lparse.el.
;; progress. See org-lparse.el.
(defvar org-lparse-table-begin-marker)
(defvar org-lparse-table-ncols)
(defvar org-lparse-table-rowgrp-open)
@ -944,7 +976,7 @@ Use `org-odt-add-automatic-style' to add update this variable.'")
(defvar org-odt-object-counters nil
"Running counters for various OBJECT-TYPEs.
Use this to generate automatic names and style-names. See
Use this to generate automatic names and style-names. See
`org-odt-add-automatic-style'.")
(defun org-odt-write-automatic-styles ()
@ -987,7 +1019,7 @@ new entry in `org-odt-automatic-styles'. Return (OBJECT-NAME
(cons object-name style-name)))
(defvar org-odt-table-indentedp nil)
(defun org-odt-begin-table (caption label attributes)
(defun org-odt-begin-table (caption label attributes short-caption)
(setq org-odt-table-indentedp (not (null org-lparse-list-stack)))
(when org-odt-table-indentedp
;; Within the Org file, the table is appearing within a list item.
@ -1006,11 +1038,12 @@ new entry in `org-odt-automatic-styles'. Return (OBJECT-NAME
(insert
(org-odt-format-stylized-paragraph
'table (org-odt-format-entity-caption label caption "__Table__"))))
(let ((name-and-style (org-odt-add-automatic-style "Table" attributes)))
(let ((automatic-name (org-odt-add-automatic-style "Table" attributes)))
(org-lparse-insert-tag
"<table:table table:name=\"%s\" table:style-name=\"%s\">"
(car name-and-style) (or (nth 1 org-odt-table-style-spec)
(cdr name-and-style) "OrgTable")))
(or short-caption (car automatic-name))
(or (nth 1 org-odt-table-style-spec)
(cdr automatic-name) "OrgTable")))
(setq org-lparse-table-begin-marker (point)))
(defvar org-lparse-table-colalign-info)
@ -1097,7 +1130,7 @@ styles congruent with the ODF-1.2 specification."
;; Additional Note: LibreOffice's AutoFormat facility for tables -
;; which recognizes as many as 16 different cell types - is much
;; richer. Unfortunately it is NOT amenable to easy configuration
;; richer. Unfortunately it is NOT amenable to easy configuration
;; by hand.
(let* ((template-name (nth 1 style-spec))
@ -1247,7 +1280,7 @@ styles congruent with the ODF-1.2 specification."
(+ level (or (org-lparse-get 'TOPLEVEL-HLEVEL) 1) -1))))
(insert "\n" (org-odt-format-stylized-paragraph style toc-entry) "\n")))
;; Following variable is let bound during 'ORG-LINK callback. See
;; Following variable is let bound during 'ORG-LINK callback. See
;; org-html.el
(defvar org-lparse-link-description-is-image nil)
(defun org-odt-format-link (desc href &optional attr)
@ -1443,7 +1476,7 @@ is turned on."
(" " "<text:s/>")
(" " "<text:tab/>")))
(hfy-face-to-css 'org-odt-hfy-face-to-css)
(hfy-optimisations-1 (copy-seq hfy-optimisations))
(hfy-optimisations-1 (copy-sequence hfy-optimisations))
(hfy-optimisations (add-to-list 'hfy-optimisations-1
'body-text-only))
(hfy-begin-span-handler
@ -1552,7 +1585,12 @@ See `org-odt-add-label-definition' and
(defun org-export-odt-format-formula (src href)
(save-match-data
(let* ((caption (org-find-text-property-in-string 'org-caption src))
(short-caption
(or (org-find-text-property-in-string 'org-caption-shortn src)
caption))
(caption (and caption (org-xml-format-desc caption)))
(short-caption (and short-caption
(org-xml-encode-plain-text short-caption)))
(label (org-find-text-property-in-string 'org-label src))
(latex-frag (org-find-text-property-in-string 'org-latex-src src))
(embed-as (or (and latex-frag
@ -1572,7 +1610,8 @@ See `org-odt-add-label-definition' and
`((,(org-odt-format-entity
(if (not (or caption label)) "DisplayFormula"
"CaptionedDisplayFormula")
href width height :caption caption :label label)
href width height :caption caption :label label
:short-caption short-caption)
,(if (not (or caption label)) ""
(let* ((label-props (car org-odt-entity-labels-alist)))
(setcar (last label-props) "math-label")
@ -1732,7 +1771,7 @@ ATTR is a string of other attributes of the a element."
(concat
(org-lparse-format 'EXTRA-TARGETS extra-targets)
;; No need to generate section numbers. They are auto-generated by
;; No need to generate section numbers. They are auto-generated by
;; the application
;; (concat (org-lparse-format 'SECTION-NUMBER snumber level) " ")
@ -1799,7 +1838,12 @@ ATTR is a string of other attributes of the a element."
"Create image tag with source and attributes."
(save-match-data
(let* ((caption (org-find-text-property-in-string 'org-caption src))
(short-caption
(or (org-find-text-property-in-string 'org-caption-shortn src)
caption))
(caption (and caption (org-xml-format-desc caption)))
(short-caption (and short-caption
(org-xml-encode-plain-text short-caption)))
(attr (org-find-text-property-in-string 'org-attributes src))
(label (org-find-text-property-in-string 'org-label src))
(latex-frag (org-find-text-property-in-string
@ -1837,6 +1881,7 @@ ATTR is a string of other attributes of the a element."
(org-odt-format-entity
frame-style-handle href width height
:caption caption :label label :category category
:short-caption short-caption
:user-frame-params user-frame-params)))))
(defun org-odt-format-object-description (title description)
@ -1915,7 +1960,7 @@ ATTR is a string of other attributes of the a element."
(defun* org-odt-format-entity (entity href width height
&key caption label category
user-frame-params)
user-frame-params short-caption)
(let* ((entity-style (assoc-string entity org-odt-entity-frame-styles t))
default-frame-params frame-params)
(cond
@ -1933,7 +1978,16 @@ ATTR is a string of other attributes of the a element."
'illustration
(concat
(apply 'org-odt-format-frame href width height
(nth 2 entity-style))
(let ((entity-style-1 (copy-sequence
(nth 2 entity-style))))
(setcar (cdr entity-style-1)
(concat
(cadr entity-style-1)
(and short-caption
(format " draw:name=\"%s\" "
short-caption))))
entity-style-1))
(org-odt-format-entity-caption
label caption (or category (nth 1 entity-style)))))
width height frame-params)))))
@ -1973,37 +2027,43 @@ ATTR is a string of other attributes of the a element."
methods.")
;; A4 page size is 21.0 by 29.7 cms
;; The default page settings has 2cm margin on each of the sides. So
;; The default page settings has 2cm margin on each of the sides. So
;; the effective text area is 17.0 by 25.7 cm
(defvar org-export-odt-max-image-size '(17.0 . 20.0)
"Limiting dimensions for an embedded image.")
(defun org-odt-do-image-size (probe-method file &optional dpi anchor-type)
(setq dpi (or dpi org-export-odt-pixels-per-inch))
(setq anchor-type (or anchor-type "paragraph"))
(flet ((size-in-cms (size-in-pixels)
(flet ((pixels-to-cms (pixels)
(let* ((cms-per-inch 2.54)
(inches (/ pixels dpi)))
(* cms-per-inch inches))))
(and size-in-pixels
(cons (pixels-to-cms (car size-in-pixels))
(pixels-to-cms (cdr size-in-pixels)))))))
(let* ((dpi (or dpi org-export-odt-pixels-per-inch))
(anchor-type (or anchor-type "paragraph"))
(--pixels-to-cms
(function
(lambda (pixels dpi)
(let* ((cms-per-inch 2.54)
(inches (/ pixels dpi)))
(* cms-per-inch inches)))))
(--size-in-cms
(function
(lambda (size-in-pixels dpi)
(and size-in-pixels
(cons (funcall --pixels-to-cms (car size-in-pixels) dpi)
(funcall --pixels-to-cms (cdr size-in-pixels) dpi)))))))
(case probe-method
(emacs
(size-in-cms (ignore-errors ; Emacs could be in batch mode
(clear-image-cache)
(image-size (create-image file) 'pixels))))
(let ((size-in-pixels
(ignore-errors ; Emacs could be in batch mode
(clear-image-cache)
(image-size (create-image file) 'pixels))))
(funcall --size-in-cms size-in-pixels dpi)))
(imagemagick
(size-in-cms
(let ((dim (shell-command-to-string
(format "identify -format \"%%w:%%h\" \"%s\"" file))))
(when (string-match "\\([0-9]+\\):\\([0-9]+\\)" dim)
(cons (string-to-number (match-string 1 dim))
(string-to-number (match-string 2 dim)))))))
(t
(cdr (assoc-string anchor-type
org-export-odt-default-image-sizes-alist))))))
(let ((size-in-pixels
(let ((dim (shell-command-to-string
(format "identify -format \"%%w:%%h\" \"%s\"" file))))
(when (string-match "\\([0-9]+\\):\\([0-9]+\\)" dim)
(cons (string-to-number (match-string 1 dim))
(string-to-number (match-string 2 dim)))))))
(funcall --size-in-cms size-in-pixels dpi)))
(t (cdr (assoc-string anchor-type
org-export-odt-default-image-sizes-alist))))))
(defun org-odt-image-size-from-file (file &optional user-width
user-height scale dpi embed-as)
@ -2016,7 +2076,7 @@ ATTR is a string of other attributes of the a element."
until size
do (setq size (org-odt-do-image-size
probe-method file dpi embed-as)))
(or size (error "Cannot determine Image size. Aborting ..."))
(or size (error "Cannot determine image size, aborting"))
(setq width (car size) height (cdr size)))
(cond
(scale
@ -2206,10 +2266,7 @@ captions on export.")
;; Not at all OSes ship with zip by default
(error "Executable \"zip\" needed for creating OpenDocument files"))
(let* ((outdir (make-temp-file
(format org-export-odt-tmpdir-prefix org-lparse-backend) t))
(content-file (expand-file-name "content.xml" outdir)))
(let* ((content-file (expand-file-name "content.xml" org-odt-zip-dir)))
;; init conten.xml
(require 'nxml-mode)
(let ((nxml-auto-insert-xml-declaration-flag nil))
@ -2259,11 +2316,9 @@ visually."
(org-odt-write-manifest-file)
(let ((xml-files '("mimetype" "META-INF/manifest.xml" "content.xml"
"meta.xml"))
(zipdir default-directory))
"meta.xml")))
(when (equal org-lparse-backend 'odt)
(push "styles.xml" xml-files))
(message "Switching to directory %s" (expand-file-name zipdir))
;; save all xml files
(mapc (lambda (file)
@ -2299,15 +2354,8 @@ visually."
cmds))
;; move the file from outdir to target-dir
(rename-file target-name target-dir)
(rename-file target-name target-dir)))
;; kill all xml buffers
(mapc (lambda (file)
(kill-buffer
(find-file-noselect (expand-file-name file zipdir) t)))
xml-files)
(delete-directory zipdir)))
(message "Created %s" target)
(set-buffer (find-file-noselect target t)))
@ -2366,7 +2414,8 @@ visually."
(org-odt-format-tags '("\n<meta:generator>" . "</meta:generator>")
(when org-export-creator-info
(format "Org-%s/Emacs-%s"
org-version emacs-version)))
(org-version)
emacs-version)))
(org-odt-format-tags '("\n<meta:keyword>" . "</meta:keyword>") keywords)
(org-odt-format-tags '("\n<dc:subject>" . "</dc:subject>") description)
(org-odt-format-tags '("\n<dc:title>" . "</dc:title>") title)
@ -2386,12 +2435,12 @@ visually."
;; Update styles.xml - take care of outline numbering
(with-current-buffer
(find-file-noselect (expand-file-name "styles.xml") t)
;; Don't make automatic backup of styles.xml file. This setting
;; Don't make automatic backup of styles.xml file. This setting
;; prevents the backed-up styles.xml file from being zipped in to
;; odt file. This is more of a hackish fix. Better alternative
;; odt file. This is more of a hackish fix. Better alternative
;; would be to fix the zip command so that the output odt file
;; includes only the needed files and excludes any auto-generated
;; extra files like backups and auto-saves etc etc. Note that
;; extra files like backups and auto-saves etc etc. Note that
;; currently the zip command zips up the entire temp directory so
;; that any auto-generated files created under the hood ends up in
;; the resulting odt file.
@ -2609,7 +2658,7 @@ using `org-open-file'."
cache-dir display-msg)
(cond
((eq latex-frag-opt 'dvipng)
(setq cache-dir "ltxpng/")
(setq cache-dir org-latex-preview-ltxpng-directory)
(setq display-msg "Creating LaTeX image %s"))
((member latex-frag-opt '(mathjax t))
(setq latex-frag-opt 'mathml)
@ -2657,7 +2706,7 @@ Do this when translation to MathML fails."
"" (org-add-props label '(org-protected t)))) t t)))))
;; process latex fragments as part of
;; `org-export-preprocess-after-blockquote-hook'. Note that this hook
;; `org-export-preprocess-after-blockquote-hook'. Note that this hook
;; is the one that is closest and well before the call to
;; `org-export-attach-captions-and-attributes' in
;; `org-export-preprocess-string'. The above arrangement permits
@ -2692,7 +2741,7 @@ Do this when translation to MathML fails."
members))
(defun org-odt-copy-styles-file (&optional styles-file)
;; Non-availability of styles.xml is not a critical error. For now
;; Non-availability of styles.xml is not a critical error. For now
;; throw an error purely for aesthetic reasons.
(setq styles-file (or styles-file
org-export-odt-styles-file
@ -2749,7 +2798,7 @@ MathML source to kill ring, if `org-export-copy-to-kill-ring' is
non-nil."
(interactive
`(,(let (frag)
(setq frag (and (setq frag (and (region-active-p)
(setq frag (and (setq frag (and (org-region-active-p)
(buffer-substring (region-beginning)
(region-end))))
(loop for e in org-latex-regexps
@ -2764,27 +2813,28 @@ non-nil."
(file-name-directory buffer-file-name))))
(read-file-name "ODF filename: " nil odf-filename nil
(file-name-nondirectory odf-filename)))))
(let* ((org-lparse-backend 'odf)
org-lparse-opt-plist
(filename (or odf-file
(expand-file-name
(concat
(file-name-sans-extension
(or (file-name-nondirectory buffer-file-name)))
"." "odf")
(file-name-directory buffer-file-name))))
(buffer (find-file-noselect (org-odt-init-outfile filename)))
(coding-system-for-write 'utf-8)
(save-buffer-coding-system 'utf-8))
(set-buffer buffer)
(set-buffer-file-coding-system coding-system-for-write)
(let ((mathml (org-create-math-formula latex-frag)))
(unless mathml (error "No Math formula created"))
(insert mathml)
(or (org-export-push-to-kill-ring
(upcase (symbol-name org-lparse-backend)))
(message "Exporting... done")))
(org-odt-save-as-outfile filename nil)))
(org-odt-cleanup-xml-buffers
(let* ((org-lparse-backend 'odf)
org-lparse-opt-plist
(filename (or odf-file
(expand-file-name
(concat
(file-name-sans-extension
(or (file-name-nondirectory buffer-file-name)))
"." "odf")
(file-name-directory buffer-file-name))))
(buffer (find-file-noselect (org-odt-init-outfile filename)))
(coding-system-for-write 'utf-8)
(save-buffer-coding-system 'utf-8))
(set-buffer buffer)
(set-buffer-file-coding-system coding-system-for-write)
(let ((mathml (org-create-math-formula latex-frag)))
(unless mathml (error "No Math formula created"))
(insert mathml)
(or (org-export-push-to-kill-ring
(upcase (symbol-name org-lparse-backend)))
(message "Exporting... done")))
(org-odt-save-as-outfile filename nil))))
;;;###autoload
(defun org-export-as-odf-and-open ()

109
lisp/org/org-pcomplete.el
View file

@ -31,6 +31,7 @@
(require 'cl))
(require 'org-macs)
(require 'org-compat)
(require 'pcomplete)
(declare-function org-split-string "org" (string &optional separators))
@ -50,14 +51,17 @@
:tag "Org"
:group 'org)
(defvar org-drawer-regexp)
(defvar org-property-re)
(defun org-thing-at-point ()
"Examine the thing at point and let the caller know what it is.
The return value is a string naming the thing at point."
(let ((beg1 (save-excursion
(skip-chars-backward (org-re "[:alnum:]_@"))
(skip-chars-backward (org-re "[:alnum:]-_@"))
(point)))
(beg (save-excursion
(skip-chars-backward "a-zA-Z0-9_:$")
(skip-chars-backward "a-zA-Z0-9-_:$")
(point)))
(line-to-here (buffer-substring (point-at-bol) (point))))
(cond
@ -84,8 +88,18 @@ The return value is a string naming the thing at point."
(equal (char-after (point-at-bol)) ?*))
(cons "tag" nil))
((and (equal (char-before beg1) ?:)
(not (equal (char-after (point-at-bol)) ?*)))
(not (equal (char-after (point-at-bol)) ?*))
(save-excursion
(move-beginning-of-line 1)
(skip-chars-backward "[ \t\n]")
;; org-drawer-regexp matches a whole line but while
;; looking-back, we just ignore trailing whitespaces
(or (org-looking-back (substring org-drawer-regexp 0 -1))
(org-looking-back org-property-re))))
(cons "prop" nil))
((and (equal (char-before beg1) ?:)
(not (equal (char-after (point-at-bol)) ?*)))
(cons "drawer" nil))
(t nil))))
(defun org-command-at-point ()
@ -119,7 +133,6 @@ When completing for #+STARTUP, for example, this function returns
args)))
(cons (reverse args) (reverse begins))))))
(defun org-pcomplete-initial ()
"Calls the right completion function for first argument completions."
(ignore
@ -127,7 +140,8 @@ When completing for #+STARTUP, for example, this function returns
(car (org-thing-at-point)))
pcomplete-default-completion-function))))
(defvar org-additional-option-like-keywords)
(defvar org-options-keywords) ; From org.el
(defvar org-additional-option-like-keywords) ; From org.el
(defun pcomplete/org-mode/file-option ()
"Complete against all valid file options."
(require 'org-exp)
@ -137,14 +151,8 @@ When completing for #+STARTUP, for example, this function returns
(if (= ?: (aref x (1- (length x))))
(concat x " ")
x))
(delq nil
(pcomplete-uniqify-list
(append
(mapcar (lambda (x)
(if (string-match "^#\\+\\([A-Z_]+:?\\)" x)
(match-string 1 x)))
(org-split-string (org-get-current-options) "\n"))
(copy-sequence org-additional-option-like-keywords))))))
(append org-options-keywords
org-additional-option-like-keywords)))
(substring pcomplete-stub 2)))
(defvar org-startup-options)
@ -161,8 +169,40 @@ When completing for #+STARTUP, for example, this function returns
(setq opts (delete "showstars" opts)))))
opts))))
(defmacro pcomplete/org-mode/file-option/x (option)
"Complete arguments for OPTION."
`(while
(pcomplete-here
(pcomplete-uniqify-list
(delq nil
(mapcar (lambda(o)
(when (string-match (concat "^[ \t]*#\\+"
,option ":[ \t]+\\(.*\\)[ \t]*$") o)
(match-string 1 o)))
(split-string (org-get-current-options) "\n")))))))
(defun pcomplete/org-mode/file-option/options ()
"Complete arguments for the #+OPTIONS file option."
(pcomplete/org-mode/file-option/x "OPTIONS"))
(defun pcomplete/org-mode/file-option/title ()
"Complete arguments for the #+TITLE file option."
(pcomplete/org-mode/file-option/x "TITLE"))
(defun pcomplete/org-mode/file-option/author ()
"Complete arguments for the #+AUTHOR file option."
(pcomplete/org-mode/file-option/x "AUTHOR"))
(defun pcomplete/org-mode/file-option/email ()
"Complete arguments for the #+EMAIL file option."
(pcomplete/org-mode/file-option/x "EMAIL"))
(defun pcomplete/org-mode/file-option/date ()
"Complete arguments for the #+DATE file option."
(pcomplete/org-mode/file-option/x "DATE"))
(defun pcomplete/org-mode/file-option/bind ()
"Complete arguments for the #+BIND file option, which are variable names"
"Complete arguments for the #+BIND file option, which are variable names."
(let (vars)
(mapatoms
(lambda (a) (if (boundp a) (setq vars (cons (symbol-name a) vars)))))
@ -196,16 +236,16 @@ When completing for #+STARTUP, for example, this function returns
"Complete against all headings.
This needs more work, to handle headings with lots of spaces in them."
(while
(pcomplete-here
(save-excursion
(goto-char (point-min))
(let (tbl)
(while (re-search-forward org-todo-line-regexp nil t)
(push (org-make-org-heading-search-string
(match-string-no-properties 3) t)
tbl))
(pcomplete-uniqify-list tbl)))
(substring pcomplete-stub 1))))
(pcomplete-here
(save-excursion
(goto-char (point-min))
(let (tbl)
(while (re-search-forward org-todo-line-regexp nil t)
(push (org-make-org-heading-search-string
(match-string-no-properties 3) t)
tbl))
(pcomplete-uniqify-list tbl)))
(substring pcomplete-stub 1))))
(defvar org-tag-alist)
(defun pcomplete/org-mode/tag ()
@ -239,6 +279,25 @@ This needs more work, to handle headings with lots of spaces in them."
lst))
(substring pcomplete-stub 1)))
(defvar org-drawers)
(defun pcomplete/org-mode/drawer ()
"Complete a drawer name."
(let ((spc (save-excursion
(move-beginning-of-line 1)
(looking-at "^\\([ \t]*\\):")
(match-string 1)))
(cpllist (mapcar (lambda (x) (concat x ": ")) org-drawers)))
(pcomplete-here cpllist
(substring pcomplete-stub 1)
(unless (or (not (delete
nil
(mapcar (lambda(x)
(string-match (substring pcomplete-stub 1) x))
cpllist)))
(looking-at "[ \t]*\n.*:END:"))
(save-excursion (insert "\n" spc ":END:"))))))
(defun pcomplete/org-mode/block-option/src ()
"Complete the arguments of a begin_src block.
Complete a language in the first field, the header arguments and switches."
@ -256,7 +315,7 @@ Complete a language in the first field, the header arguments and switches."
":session" ":shebang" ":tangle" ":var"))))
(defun pcomplete/org-mode/block-option/clocktable ()
"Complete keywords in a clocktable line"
"Complete keywords in a clocktable line."
(while (pcomplete-here '(":maxlevel" ":scope"
":tstart" ":tend" ":block" ":step"
":stepskip0" ":fileskip0"

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

@ -144,7 +144,8 @@ and dependant variables."
(dotimes (col (length (first table)))
(setf collector (cons col collector)))
collector)))
row-vals (counter 0))
(counter 0)
row-vals)
(when (>= ind 0) ;; collect values of ind col
(setf row-vals (mapcar (lambda (row) (setf counter (+ 1 counter))
(cons counter (nth ind row))) table)))
@ -159,26 +160,26 @@ and dependant variables."
;; write table to gnuplot grid datafile format
(with-temp-file data-file
(let ((num-rows (length table)) (num-cols (length (first table)))
(gnuplot-row (lambda (col row value)
(setf col (+ 1 col)) (setf row (+ 1 row))
(format "%f %f %f\n%f %f %f\n"
col (- row 0.5) value ;; lower edge
col (+ row 0.5) value))) ;; upper edge
front-edge back-edge)
(flet ((gnuplot-row (col row value)
(setf col (+ 1 col)) (setf row (+ 1 row))
(format "%f %f %f\n%f %f %f\n"
col (- row 0.5) value ;; lower edge
col (+ row 0.5) value))) ;; upper edge
(dotimes (col num-cols)
(dotimes (row num-rows)
(setf back-edge
(concat back-edge
(gnuplot-row (- col 1) row (string-to-number
(nth col (nth row table))))))
(setf front-edge
(concat front-edge
(gnuplot-row col row (string-to-number
(nth col (nth row table)))))))
;; only insert once per row
(insert back-edge) (insert "\n") ;; back edge
(insert front-edge) (insert "\n") ;; front edge
(setf back-edge "") (setf front-edge "")))))
(dotimes (col num-cols)
(dotimes (row num-rows)
(setf back-edge
(concat back-edge
(funcall gnuplot-row (- col 1) row
(string-to-number (nth col (nth row table))))))
(setf front-edge
(concat front-edge
(funcall gnuplot-row col row
(string-to-number (nth col (nth row table)))))))
;; only insert once per row
(insert back-edge) (insert "\n") ;; back edge
(insert front-edge) (insert "\n") ;; front edge
(setf back-edge "") (setf front-edge ""))))
row-vals))
(defun org-plot/gnuplot-script (data-file num-cols params &optional preface)
@ -208,40 +209,41 @@ manner suitable for prepending to a user-specified script."
('2d "plot")
('3d "splot")
('grid "splot")))
(script "reset") plot-lines)
(flet ((add-to-script (line) (setf script (format "%s\n%s" script line))))
(when file ;; output file
(add-to-script (format "set term %s" (file-name-extension file)))
(add-to-script (format "set output '%s'" file)))
(case type ;; type
('2d ())
('3d (if map (add-to-script "set map")))
('grid (if map
(add-to-script "set pm3d map")
(add-to-script "set pm3d"))))
(when title (add-to-script (format "set title '%s'" title))) ;; title
(when lines (mapc (lambda (el) (add-to-script el)) lines)) ;; line
(when sets ;; set
(mapc (lambda (el) (add-to-script (format "set %s" el))) sets))
(when x-labels ;; x labels (xtics)
(add-to-script
(format "set xtics (%s)"
(mapconcat (lambda (pair)
(format "\"%s\" %d" (cdr pair) (car pair)))
x-labels ", "))))
(when y-labels ;; y labels (ytics)
(add-to-script
(format "set ytics (%s)"
(mapconcat (lambda (pair)
(format "\"%s\" %d" (cdr pair) (car pair)))
y-labels ", "))))
(when time-ind ;; timestamp index
(add-to-script "set xdata time")
(add-to-script (concat "set timefmt \""
(or timefmt ;; timefmt passed to gnuplot
"%Y-%m-%d-%H:%M:%S") "\"")))
(unless preface
(case type ;; plot command
(script "reset")
; ats = add-to-script
(ats (lambda (line) (setf script (format "%s\n%s" script line))))
plot-lines)
(when file ;; output file
(funcall ats (format "set term %s" (file-name-extension file)))
(funcall ats (format "set output '%s'" file)))
(case type ;; type
('2d ())
('3d (if map (funcall ats "set map")))
('grid (if map (funcall ats "set pm3d map")
(funcall ats "set pm3d"))))
(when title (funcall ats (format "set title '%s'" title))) ;; title
(when lines (mapc (lambda (el) (funcall ats el)) lines)) ;; line
(when sets ;; set
(mapc (lambda (el) (funcall ats (format "set %s" el))) sets))
(when x-labels ;; x labels (xtics)
(funcall ats
(format "set xtics (%s)"
(mapconcat (lambda (pair)
(format "\"%s\" %d" (cdr pair) (car pair)))
x-labels ", "))))
(when y-labels ;; y labels (ytics)
(funcall ats
(format "set ytics (%s)"
(mapconcat (lambda (pair)
(format "\"%s\" %d" (cdr pair) (car pair)))
y-labels ", "))))
(when time-ind ;; timestamp index
(funcall ats "set xdata time")
(funcall ats (concat "set timefmt \""
(or timefmt ;; timefmt passed to gnuplot
"%Y-%m-%d-%H:%M:%S") "\"")))
(unless preface
(case type ;; plot command
('2d (dotimes (col num-cols)
(unless (and (equal type '2d)
(or (and ind (equal (+ 1 col) ind))
@ -263,9 +265,9 @@ manner suitable for prepending to a user-specified script."
('grid
(setq plot-lines (list (format "'%s' with %s title ''"
data-file with)))))
(add-to-script
(concat plot-cmd " " (mapconcat 'identity (reverse plot-lines) ",\\\n "))))
script)))
(funcall ats
(concat plot-cmd " " (mapconcat 'identity (reverse plot-lines) ",\\\n "))))
script))
;;-----------------------------------------------------------------------------
;; facade functions

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

@ -187,7 +187,7 @@ Each element of this list must be of the form:
(module-name :property value property: value ...)
where module-name is an arbitrary name. All the values are strings.
where module-name is an arbitrary name. All the values are strings.
Possible properties are:
@ -195,7 +195,7 @@ Possible properties are:
:working-suffix - the replacement for online-suffix
:base-url - the base URL, e.g. http://www.example.com/project/
Last slash required.
:working-directory - the local working directory. This is, what base-url will
:working-directory - the local working directory. This is, what base-url will
be replaced with.
:redirects - A list of cons cells, each of which maps a regular
expression to match to a path relative to :working-directory.
@ -236,21 +236,21 @@ protocol - protocol to detect in a filename without trailing colon and slashes.
If you define a protocol \"my-protocol\", `org-protocol-check-filename-for-protocol'
will search filenames for \"org-protocol:/my-protocol:/\"
and trigger your action for every match. `org-protocol' is defined in
`org-protocol-the-protocol'. Double and triple slashes are compressed
`org-protocol-the-protocol'. Double and triple slashes are compressed
to one by emacsclient.
function - function that handles requests with protocol and takes exactly one
argument: the filename with all protocols stripped. If the function
returns nil, emacsclient and -server do nothing. Any non-nil return
argument: the filename with all protocols stripped. If the function
returns nil, emacsclient and -server do nothing. Any non-nil return
value is considered a valid filename and thus passed to the server.
`org-protocol.el provides some support for handling those filenames,
if you stay with the conventions used for the standard handlers in
`org-protocol-protocol-alist-default'. See `org-protocol-split-data'.
`org-protocol-protocol-alist-default'. See `org-protocol-split-data'.
kill-client - If t, kill the client immediately, once the sub-protocol is
detected. This is necessary for actions that can be interrupted by
`C-g' to avoid dangling emacsclients. Note, that all other command
detected. This is necessary for actions that can be interrupted by
`C-g' to avoid dangling emacsclients. Note, that all other command
line arguments but the this one will be discarded, greedy handlers
still receive the whole list of arguments though.
@ -273,6 +273,12 @@ string with two characters."
:group 'org-protocol
:type 'string)
(defcustom org-protocol-data-separator "/+"
"The default data separator to use.
This should be a single regexp string."
:group 'org-protocol
:type 'string)
;;; Helper functions:
(defun org-protocol-sanitize-uri (uri)
@ -316,32 +322,32 @@ Everything up to the end of the protocols is stripped.
Note, that this function will always behave as if
`org-protocol-reverse-list-of-files' was set to t and the returned list will
reflect that. I.e. emacsclients first parameter will be the first one in the
reflect that. I.e. emacsclients first parameter will be the first one in the
returned list."
(let* ((l (org-protocol-flatten (if org-protocol-reverse-list-of-files
param-list
(reverse param-list))))
(trigger (car l))
(len 0)
dir
ret)
(when (string-match "^\\(.*\\)\\(org-protocol:/+[a-zA-z0-9][-_a-zA-z0-9]*:/+\\)\\(.*\\)" trigger)
(setq dir (match-string 1 trigger))
(setq len (length dir))
(setcar l (concat dir (match-string 3 trigger))))
(if strip-path
(progn
(dolist (e l ret)
(setq ret
(append ret
(list
(if (stringp e)
(if (stringp replacement)
(setq e (concat replacement (substring e len)))
(setq e (substring e len)))
e)))))
ret)
l)))
(let* ((l (org-protocol-flatten (if org-protocol-reverse-list-of-files
param-list
(reverse param-list))))
(trigger (car l))
(len 0)
dir
ret)
(when (string-match "^\\(.*\\)\\(org-protocol:/+[a-zA-z0-9][-_a-zA-z0-9]*:/+\\)\\(.*\\)" trigger)
(setq dir (match-string 1 trigger))
(setq len (length dir))
(setcar l (concat dir (match-string 3 trigger))))
(if strip-path
(progn
(dolist (e l ret)
(setq ret
(append ret
(list
(if (stringp e)
(if (stringp replacement)
(setq e (concat replacement (substring e len)))
(setq e (substring e len)))
e)))))
ret)
l)))
(defun org-protocol-flatten (l)
"Greedy handlers might receive a list like this from emacsclient:
@ -350,7 +356,7 @@ where \"/dir/\" is the absolute path to emacsclients working directory.
This function transforms it into a flat list."
(if (null l) ()
(if (listp l)
(append (org-protocol-flatten (car l)) (org-protocol-flatten (cdr l)))
(append (org-protocol-flatten (car l)) (org-protocol-flatten (cdr l)))
(list l))))
@ -358,7 +364,7 @@ This function transforms it into a flat list."
(defun org-protocol-store-link (fname)
"Process an org-protocol://store-link:// style url.
Additionally store a browser URL as an org link. Also pushes the
Additionally store a browser URL as an org link. Also pushes the
link's URL to the `kill-ring'.
The location for a browser's bookmark has to look like this:
@ -367,17 +373,17 @@ The location for a browser's bookmark has to look like this:
encodeURIComponent(location.href)
encodeURIComponent(document.title)+'/'+ \\
Don't use `escape()'! Use `encodeURIComponent()' instead. The title of the page
Don't use `escape()'! Use `encodeURIComponent()' instead. The title of the page
could contain slashes and the location definitely will.
The sub-protocol used to reach this function is set in
`org-protocol-protocol-alist'."
(let* ((splitparts (org-protocol-split-data fname t))
(let* ((splitparts (org-protocol-split-data fname t org-protocol-data-separator))
(uri (org-protocol-sanitize-uri (car splitparts)))
(title (cadr splitparts))
orglink)
(if (boundp 'org-stored-links)
(setq org-stored-links (cons (list uri title) org-stored-links)))
(setq org-stored-links (cons (list uri title) org-stored-links)))
(kill-new uri)
(message "`%s' to insert new org-link, `%s' to insert `%s'"
(substitute-command-keys"\\[org-insert-link]")
@ -433,7 +439,7 @@ Now template ?b will be used."
(defun org-protocol-do-capture (info capture-func)
"Support `org-capture' and `org-remember' alike.
CAPTURE-FUNC is either the symbol `org-remember' or `org-capture'."
(let* ((parts (org-protocol-split-data info t))
(let* ((parts (org-protocol-split-data info t org-protocol-data-separator))
(template (or (and (>= 2 (length (car parts))) (pop parts))
org-protocol-default-template-key))
(url (org-protocol-sanitize-uri (car parts)))
@ -529,7 +535,7 @@ This is, how the matching is done:
protocol and sub-protocol are regexp-quoted.
If a matching protocol is found, the protocol is stripped from fname and the
result is passed to the protocols function as the only parameter. If the
result is passed to the protocols function as the only parameter. If the
function returns nil, the filename is removed from the list of filenames
passed from emacsclient to the server.
If the function returns a non nil value, that value is passed to the server
@ -548,7 +554,7 @@ as filename."
(split (split-string fname proto))
(result (if greedy restoffiles (cadr split))))
(when (plist-get (cdr prolist) :kill-client)
(message "Greedy org-protocol handler. Killing client.")
(message "Greedy org-protocol handler. Killing client.")
(server-edit))
(when (fboundp func)
(unless greedy
@ -566,7 +572,7 @@ as filename."
(client (ad-get-arg 1)))
(catch 'greedy
(dolist (var flist)
;; `\' to `/' on windows. FIXME: could this be done any better?
;; `\' to `/' on windows. FIXME: could this be done any better?
(let ((fname (expand-file-name (car var))))
(setq fname (org-protocol-check-filename-for-protocol
fname (member var flist) client))
@ -589,14 +595,14 @@ most of the work."
(require 'org-publish)
(let ((all (or (org-publish-get-project-from-filename buffer-file-name))))
(if all (org-protocol-create (cdr all))
(message "Not in an org-project. Did mean %s?"
(message "Not in an org-project. Did mean %s?"
(substitute-command-keys"\\[org-protocol-create]")))))
(defun org-protocol-create (&optional project-plist)
"Create a new org-protocol project interactively.
An org-protocol project is an entry in `org-protocol-project-alist'
which is used by `org-protocol-open-source'.
Optionally use project-plist to initialize the defaults for this project. If
Optionally use project-plist to initialize the defaults for this project. If
project-plist is the CDR of an element in `org-publish-project-alist', reuse
:base-directory, :html-extension and :base-extension."
(interactive)
@ -625,19 +631,19 @@ project-plist is the CDR of an element in `org-publish-project-alist', reuse
(setq strip-suffix
(read-string
(concat "Extension to strip from published URLs (" strip-suffix "): ")
strip-suffix nil strip-suffix t))
strip-suffix nil strip-suffix t))
(setq working-suffix
(read-string
(concat "Extension of editable files (" working-suffix "): ")
working-suffix nil working-suffix t))
working-suffix nil working-suffix t))
(when (yes-or-no-p "Save the new org-protocol-project to your init file? ")
(setq org-protocol-project-alist
(cons `(,base-url . (:base-url ,base-url
:working-directory ,working-dir
:online-suffix ,strip-suffix
:working-suffix ,working-suffix))
:working-directory ,working-dir
:online-suffix ,strip-suffix
:working-suffix ,working-suffix))
org-protocol-project-alist))
(customize-save-variable 'org-protocol-project-alist org-protocol-project-alist))))

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

@ -105,7 +105,7 @@ being published. Its value may be a string or regexp matching
file names you don't want to be published.
The :include property may be used to include extra files. Its
value may be a list of filenames to include. The filenames are
value may be a list of filenames to include. The filenames are
considered relative to the base directory.
When both :include and :exclude properties are given values, the
@ -315,7 +315,7 @@ You could use brackets to delimit on what part the link will be.
(format "%s" (or pub-func ""))))
(concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename))))
(defun org-publish-needed-p (filename &optional pub-dir pub-func true-pub-dir)
(defun org-publish-needed-p (filename &optional pub-dir pub-func true-pub-dir base-dir)
"Return t if FILENAME should be published in PUB-DIR using PUB-FUNC.
TRUE-PUB-DIR is where the file will truly end up. Currently we are not using
this - maybe it can eventually be used to check if the file is present at
@ -325,7 +325,7 @@ function can still decide about that independently."
(let ((rtn
(if org-publish-use-timestamps-flag
(org-publish-cache-file-needs-publishing
filename pub-dir pub-func)
filename pub-dir pub-func base-dir)
;; don't use timestamps, always return t
t)))
(if rtn
@ -334,7 +334,7 @@ function can still decide about that independently."
(message "Skipping unmodified file %s" filename)))
rtn))
(defun org-publish-update-timestamp (filename &optional pub-dir pub-func)
(defun org-publish-update-timestamp (filename &optional pub-dir pub-func base-dir)
"Update publishing timestamp for file FILENAME.
If there is no timestamp, create one."
(let ((key (org-publish-timestamp-filename filename pub-dir pub-func))
@ -418,22 +418,22 @@ This splices all the components into the list."
(setq retval (if org-sitemap-ignore-case
(not (string-lessp (upcase B) (upcase A)))
(not (string-lessp B A))))))
((or (equal org-sitemap-sort-files 'chronologically)
(equal org-sitemap-sort-files 'anti-chronologically))
(let* ((adate (org-publish-find-date a))
(bdate (org-publish-find-date b))
(A (+ (lsh (car adate) 16) (cadr adate)))
(B (+ (lsh (car bdate) 16) (cadr bdate))))
(setq retval (if (equal org-sitemap-sort-files 'chronologically)
(<= A B)
(>= A B)))))))
((or (equal org-sitemap-sort-files 'chronologically)
(equal org-sitemap-sort-files 'anti-chronologically))
(let* ((adate (org-publish-find-date a))
(bdate (org-publish-find-date b))
(A (+ (lsh (car adate) 16) (cadr adate)))
(B (+ (lsh (car bdate) 16) (cadr bdate))))
(setq retval (if (equal org-sitemap-sort-files 'chronologically)
(<= A B)
(>= A B)))))))
;; Directory-wise wins:
(when org-sitemap-sort-folders
;; a is directory, b not:
(cond
((and (file-directory-p a) (not (file-directory-p b)))
(setq retval (equal org-sitemap-sort-folders 'first)))
;; a is not a directory, but b is:
;; a is not a directory, but b is:
((and (not (file-directory-p a)) (file-directory-p b))
(setq retval (equal org-sitemap-sort-folders 'last))))))
retval))
@ -506,7 +506,7 @@ matching filenames."
(setq org-publish-temp-files nil)
(if org-sitemap-requested
(pushnew (expand-file-name (concat base-dir sitemap-filename))
org-publish-temp-files))
org-publish-temp-files))
(org-publish-get-base-files-1 base-dir recurse match
;; FIXME distinguish exclude regexp
;; for skip-file and skip-dir?
@ -536,14 +536,14 @@ matching filenames."
(xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$")))
(when
(or
(and
(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)))
(and
(not (and e (string-match e filename)))
(string-match xm filename)))
(setq project-name (car prj))
(throw 'p-found project-name))))))
(when up
@ -600,10 +600,10 @@ PUB-DIR is the publishing directory."
(defmacro org-publish-with-aux-preprocess-maybe (&rest body)
"Execute BODY with a modified hook to preprocess for index."
`(let ((org-export-preprocess-after-headline-targets-hook
(if (plist-get project-plist :makeindex)
(cons 'org-publish-aux-preprocess
org-export-preprocess-after-headline-targets-hook)
org-export-preprocess-after-headline-targets-hook)))
(if (plist-get project-plist :makeindex)
(cons 'org-publish-aux-preprocess
org-export-preprocess-after-headline-targets-hook)
org-export-preprocess-after-headline-targets-hook)))
,@body))
(def-edebug-spec org-publish-with-aux-preprocess-maybe (body))
@ -624,7 +624,7 @@ See `org-publish-org-to' to the list of arguments."
"Publish an org file to HTML.
See `org-publish-org-to' to the list of arguments."
(org-publish-with-aux-preprocess-maybe
(org-publish-org-to "html" plist filename pub-dir)))
(org-publish-org-to "html" plist filename pub-dir)))
(defun org-publish-org-to-org (plist filename pub-dir)
"Publish an org file to HTML.
@ -635,19 +635,19 @@ See `org-publish-org-to' to the list of arguments."
"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)))
(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)))
(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)))
(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.
@ -705,15 +705,14 @@ See `org-publish-projects'."
(if (listp publishing-function)
;; allow chain of publishing functions
(mapc (lambda (f)
(when (org-publish-needed-p filename pub-dir f tmp-pub-dir)
(when (org-publish-needed-p filename pub-dir f tmp-pub-dir base-dir)
(funcall f project-plist filename tmp-pub-dir)
(org-publish-update-timestamp filename pub-dir f)))
(org-publish-update-timestamp filename pub-dir f base-dir)))
publishing-function)
(when (org-publish-needed-p filename pub-dir publishing-function
tmp-pub-dir)
(when (org-publish-needed-p filename pub-dir publishing-function tmp-pub-dir base-dir)
(funcall publishing-function project-plist filename tmp-pub-dir)
(org-publish-update-timestamp
filename pub-dir publishing-function)))
filename pub-dir publishing-function base-dir)))
(unless no-cache (org-publish-write-cache-file))))
(defun org-publish-projects (projects)
@ -733,9 +732,9 @@ If :makeindex is set, also produce a file theindex.org."
(sitemap-function (or (plist-get project-plist :sitemap-function)
'org-publish-org-sitemap))
(org-sitemap-date-format (or (plist-get project-plist :sitemap-date-format)
org-publish-sitemap-date-format))
org-publish-sitemap-date-format))
(org-sitemap-file-entry-format (or (plist-get project-plist :sitemap-file-entry-format)
org-publish-sitemap-file-entry-format))
org-publish-sitemap-file-entry-format))
(preparation-function (plist-get project-plist :preparation-function))
(completion-function (plist-get project-plist :completion-function))
(files (org-publish-get-base-files project exclude-regexp)) file)
@ -751,7 +750,7 @@ If :makeindex is set, also produce a file theindex.org."
(plist-get project-plist :base-directory))
project t))
(when completion-function (run-hooks 'completion-function))
(org-publish-write-cache-file)))
(org-publish-write-cache-file)))
(org-publish-expand-projects projects)))
(defun org-publish-org-sitemap (project &optional sitemap-filename)
@ -767,9 +766,9 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
(files (nreverse (org-publish-get-base-files project exclude-regexp)))
(sitemap-filename (concat dir (or sitemap-filename "sitemap.org")))
(sitemap-title (or (plist-get project-plist :sitemap-title)
(concat "Sitemap for project " (car project))))
(concat "Sitemap for project " (car project))))
(sitemap-style (or (plist-get project-plist :sitemap-style)
'tree))
'tree))
(sitemap-sans-extension (plist-get project-plist :sitemap-sans-extension))
(visiting (find-buffer-visiting sitemap-filename))
(ifn (file-name-nondirectory sitemap-filename))
@ -833,10 +832,10 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
(defun org-publish-format-file-entry (fmt file project-plist)
(format-spec fmt
`((?t . ,(org-publish-find-title file t))
(?d . ,(format-time-string org-sitemap-date-format
(org-publish-find-date file)))
(?a . ,(or (plist-get project-plist :author) user-full-name)))))
`((?t . ,(org-publish-find-title file t))
(?d . ,(format-time-string org-sitemap-date-format
(org-publish-find-date file)))
(?a . ,(or (plist-get project-plist :author) user-full-name)))))
(defun org-publish-find-title (file &optional reset)
"Find the title of FILE in project."
@ -902,7 +901,7 @@ It returns time in `current-time' format."
;; If this function is called in batch mode,
;; project is still a string here.
(list (assoc project org-publish-project-alist))
(list project))))))
(list project))))))
;;;###autoload
(defun org-publish-all (&optional force)
@ -1033,25 +1032,24 @@ the project."
;; Create theindex.org if it doesn't exist already
(let ((index-file (expand-file-name "theindex.org" directory)))
(unless (file-exists-p index-file)
(setq ibuffer (find-file-noselect index-file))
(with-current-buffer ibuffer
(erase-buffer)
(insert "\n\n#+include: \"theindex.inc\"\n\n")
(save-buffer))
(kill-buffer ibuffer)))))
(setq ibuffer (find-file-noselect index-file))
(with-current-buffer ibuffer
(erase-buffer)
(insert "\n\n#+INCLUDE: \"theindex.inc\"\n\n")
(save-buffer))
(kill-buffer ibuffer)))))
;; Caching functions:
(defun org-publish-write-cache-file (&optional free-cache)
"Write `org-publish-cache' to file.
If FREE-CACHE, empty the cache."
(unless org-publish-cache
(error "%s" "`org-publish-write-cache-file' called, but no cache present"))
(or org-publish-cache
(error "`org-publish-write-cache-file' called, but no cache present"))
(let ((cache-file (org-publish-cache-get ":cache-file:")))
(unless cache-file
(error
"%s" "Cannot find cache-file name in `org-publish-write-cache-file'"))
(or cache-file
(error "Cannot find cache-file name in `org-publish-write-cache-file'"))
(with-temp-file cache-file
(let ((print-level nil)
(print-length nil))
@ -1068,9 +1066,8 @@ If FREE-CACHE, empty the cache."
(defun org-publish-initialize-cache (project-name)
"Initialize the projects cache if not initialized yet and return it."
(unless project-name
(error "%s%s" "Cannot initialize `org-publish-cache' without projects name"
" in `org-publish-initialize-cache'"))
(or project-name
(error "Cannot initialize `org-publish-cache' without projects name in `org-publish-initialize-cache'"))
(unless (file-exists-p org-publish-timestamp-directory)
(make-directory org-publish-timestamp-directory t))
@ -1105,23 +1102,24 @@ If FREE-CACHE, empty the cache."
(clrhash org-publish-cache))
(setq org-publish-cache nil))
(defun org-publish-cache-file-needs-publishing (filename &optional pub-dir pub-func)
(defun org-publish-cache-file-needs-publishing (filename &optional pub-dir pub-func base-dir)
"Check the timestamp of the last publishing of FILENAME.
Return `t', if the file needs publishing. The function also
checks if any included files have been more recently published,
so that the file including them will be republished as well."
(unless org-publish-cache
(error "%s" "`org-publish-cache-file-needs-publishing' called, but no cache present"))
(or org-publish-cache
(error "`org-publish-cache-file-needs-publishing' called, but no cache present"))
(let* ((key (org-publish-timestamp-filename filename pub-dir pub-func))
(pstamp (org-publish-cache-get key))
(visiting (find-buffer-visiting filename))
(case-fold-search t)
included-files-ctime buf)
(when (equal (file-name-extension filename) "org")
(setq buf (find-file (expand-file-name filename)))
(with-current-buffer buf
(goto-char (point-min))
(while (re-search-forward "^#\\+INCLUDE:[ \t]+\"?\\([^ \t\n\r\"]*\\)\"?[ \t]*.*$" nil t)
(while (re-search-forward "^#\\+include:[ \t]+\"\\([^\t\n\r\"]*\\)\"[ \t]*.*$" nil t)
(let* ((included-file (expand-file-name (match-string 1))))
(add-to-list 'included-files-ctime
(org-publish-cache-ctime-of-src included-file) t))))
@ -1173,28 +1171,24 @@ If the entry will be created, unless NO-CREATE is not nil."
"Return the value stored in `org-publish-cache' for key KEY.
Returns nil, if no value or nil is found, or the cache does not
exist."
(unless org-publish-cache
(error "%s" "`org-publish-cache-get' called, but no cache present"))
(or org-publish-cache
(error "`org-publish-cache-get' called, but no cache present"))
(gethash key org-publish-cache))
(defun org-publish-cache-set (key value)
"Store KEY VALUE pair in `org-publish-cache'.
Returns value on success, else nil."
(unless org-publish-cache
(error "%s" "`org-publish-cache-set' called, but no cache present"))
(or org-publish-cache
(error "`org-publish-cache-set' called, but no cache present"))
(puthash key value org-publish-cache))
(defun org-publish-cache-ctime-of-src (filename)
"Get the FILENAME ctime as an integer."
(let* ((symlink-maybe (or (file-symlink-p filename) filename))
(src-attr (file-attributes (if (file-name-absolute-p symlink-maybe)
symlink-maybe
(expand-file-name
symlink-maybe
(file-name-directory filename))))))
(+
(lsh (car (nth 5 src-attr)) 16)
(cadr (nth 5 src-attr)))))
(defun org-publish-cache-ctime-of-src (file)
"Get the ctime of filename F as an integer."
(let ((attr (file-attributes
(expand-file-name (or (file-symlink-p file) file)
(file-name-directory file)))))
(+ (lsh (car (nth 5 attr)) 16)
(cadr (nth 5 attr)))))
(provide 'org-publish)

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

@ -64,7 +64,7 @@ and `org-remember-default-headline'. To force prompting anyway, use
\\[universal-argument] \\[org-remember-finalize] to file the note.
When this variable is nil, \\[org-remember-finalize] gives you the prompts, and
\\[universal-argument] \\[org-remember-finalize] triggers the fast track."
\\[universal-argument] \\[org-remember-finalize] triggers the fasttrack."
:group 'org-remember
:type 'boolean)
@ -189,22 +189,22 @@ calendar | %:type %:date"
(character :tag "Selection Key")
(string :tag "Template")
(choice :tag "Destination file"
(file :tag "Specify")
(function :tag "Function")
(const :tag "Use `org-default-notes-file'" nil))
(file :tag "Specify")
(function :tag "Function")
(const :tag "Use `org-default-notes-file'" nil))
(choice :tag "Destin. headline"
(string :tag "Specify")
(function :tag "Function")
(const :tag "Use `org-remember-default-headline'" nil)
(const :tag "At beginning of file" top)
(const :tag "At end of file" bottom)
(const :tag "In a date tree" date-tree))
(string :tag "Specify")
(function :tag "Function")
(const :tag "Use `org-remember-default-headline'" nil)
(const :tag "At beginning of file" top)
(const :tag "At end of file" bottom)
(const :tag "In a date tree" date-tree))
(choice :tag "Context"
(const :tag "Use in all contexts" nil)
(const :tag "Use in all contexts" t)
(repeat :tag "Use only if in major mode"
(symbol :tag "Major mode"))
(function :tag "Perform a check against function")))))
(const :tag "Use in all contexts" nil)
(const :tag "Use in all contexts" t)
(repeat :tag "Use only if in major mode"
(symbol :tag "Major mode"))
(function :tag "Perform a check against function")))))
(defcustom org-remember-delete-empty-lines-at-end t
"Non-nil means clean up final empty lines in remember buffer."
@ -277,9 +277,6 @@ opposite case, the default, t, is more useful."
:group 'org-remember
:type 'boolean)
(defvar annotation) ; from remember.el, dynamically scoped in `remember-mode'
(defvar initial) ; from remember.el, dynamically scoped in `remember-mode'
;;;###autoload
(defun org-remember-insinuate ()
"Setup remember.el for use with Org-mode."
@ -297,7 +294,7 @@ conventions in Org-mode. This function returns such a link."
(org-store-link nil))
(defconst org-remember-help
"Select a destination location for the note.
"Select a destination location for the note.
UP/DOWN=headline TAB=cycle visibility [Q]uit RET/<left>/<right>=Store
RET on headline -> Store as sublevel entry to current headline
RET at beg-of-buf -> Append to file as level 2 headline
@ -401,8 +398,7 @@ RET at beg-of-buf -> Append to file as level 2 headline
This function should be placed into `remember-mode-hook' and in fact requires
to be run from that hook to function properly."
(when (and (boundp 'initial) (stringp initial))
(setq initial (org-no-properties initial))
(remove-text-properties 0 (length initial) '(read-only t) initial))
(setq initial (org-no-properties initial)))
(if org-remember-templates
(let* ((entry (org-select-remember-template use-char))
(ct (or org-overriding-default-time (org-current-time)))
@ -431,10 +427,10 @@ to be run from that hook to function properly."
;; `initial' and `annotation' are bound in `remember'.
;; But if the property list has them, we prefer those values
(v-i (or (plist-get org-store-link-plist :initial)
(and (boundp 'initial) initial)
(and (boundp 'initial) (symbol-value 'initial))
""))
(v-a (or (plist-get org-store-link-plist :annotation)
(and (boundp 'annotation) annotation)
(and (boundp 'annotation) (symbol-value 'annotation))
""))
;; Is the link empty? Then we do not want it...
(v-a (if (equal v-a "[[]]") "" v-a))
@ -449,7 +445,7 @@ to be run from that hook to function properly."
v-a))
(v-n user-full-name)
(v-k (if (marker-buffer org-clock-marker)
(org-substring-no-properties org-clock-heading)))
(org-no-properties org-clock-heading)))
(v-K (if (marker-buffer org-clock-marker)
(org-make-link-string
(buffer-file-name (marker-buffer org-clock-marker))
@ -476,7 +472,7 @@ to be run from that hook to function properly."
(erase-buffer)
(insert (substitute-command-keys
(format
"## %s \"%s\" -> \"* %s\"
"## %s \"%s\" -> \"* %s\"
## C-u C-c C-c like C-c C-c, and immediately visit note at target location
## C-0 C-c C-c \"%s\" -> \"* %s\"
## %s to select file and header location interactively.
@ -505,18 +501,20 @@ to be run from that hook to function properly."
filename error)))))))
;; Simple %-escapes
(goto-char (point-min))
(while (re-search-forward "%\\([tTuUaiAcxkKI]\\)" nil t)
(unless (org-remember-escaped-%)
(when (and initial (equal (match-string 0) "%i"))
(save-match-data
(let* ((lead (buffer-substring
(point-at-bol) (match-beginning 0))))
(setq v-i (mapconcat 'identity
(org-split-string initial "\n")
(concat "\n" lead))))))
(replace-match
(or (eval (intern (concat "v-" (match-string 1)))) "")
t t)))
(let ((init (and (boundp 'initial)
(symbol-value 'initial))))
(while (re-search-forward "%\\([tTuUaiAcxkKI]\\)" nil t)
(unless (org-remember-escaped-%)
(when (and init (equal (match-string 0) "%i"))
(save-match-data
(let* ((lead (buffer-substring
(point-at-bol) (match-beginning 0))))
(setq v-i (mapconcat 'identity
(org-split-string init "\n")
(concat "\n" lead))))))
(replace-match
(or (eval (intern (concat "v-" (match-string 1)))) "")
t t))))
;; %() embedded elisp
(goto-char (point-min))
@ -536,10 +534,10 @@ to be run from that hook to function properly."
(when plist-p
(goto-char (point-min))
(while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t)
(unless (org-remember-escaped-%)
(and (setq x (or (plist-get org-store-link-plist
(intern (match-string 1))) ""))
(replace-match x t t)))))
(unless (org-remember-escaped-%)
(and (setq x (or (plist-get org-store-link-plist
(intern (match-string 1))) ""))
(replace-match x t t)))))
;; Turn on org-mode in the remember buffer, set local variables
(let ((org-inhibit-startup t)) (org-mode) (org-remember-mode 1))
@ -599,7 +597,7 @@ to be run from that hook to function properly."
(car clipboards))))))
((equal char "p")
(let*
((prop (org-substring-no-properties prompt))
((prop (org-no-properties prompt))
(pall (concat prop "_ALL"))
(allowed
(with-current-buffer
@ -943,7 +941,7 @@ See also the variable `org-reverse-note-order'."
(throw 'quit t))
;; Find the file
(with-current-buffer (or visiting (find-file-noselect file))
(unless (or (eq major-mode 'org-mode) (member heading '(top bottom)))
(unless (or (derived-mode-p 'org-mode) (member heading '(top bottom)))
(error "Target files for notes must be in Org-mode if not filing to top/bottom"))
(save-excursion
(save-restriction
@ -953,7 +951,7 @@ See also the variable `org-reverse-note-order'."
;; Find the default location
(when heading
(cond
((not (eq major-mode 'org-mode))
((not (derived-mode-p 'org-mode))
(if (eq heading 'top)
(goto-char (point-min))
(goto-char (point-max))
@ -995,7 +993,7 @@ See also the variable `org-reverse-note-order'."
(cond
((and fastp (memq heading '(top bottom)))
(setq spos org-goto-start-pos
exitcmd (if (eq heading 'top) 'left nil)))
exitcmd (if (eq heading 'top) 'left nil)))
(fastp (setq spos org-goto-start-pos
exitcmd 'return))
((eq org-remember-interactive-interface 'outline)

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

@ -33,9 +33,12 @@
(require 'org)
;; Declare external functions and variables
(declare-function rmail-show-message "rmail" (&optional n no-summary))
(declare-function rmail-what-message "rmail" ())
(defvar rmail-current-message)
(declare-function rmail-show-message "rmail" (&optional n no-summary))
(declare-function rmail-what-message "rmail" (&optional pos))
(declare-function rmail-toggle-header "rmail" (&optional arg))
(declare-function rmail-widen "rmail" ())
(defvar rmail-current-message) ; From rmail.el
(defvar rmail-header-style) ; From rmail.el
;; Install the link type
(org-add-link-type "rmail" 'org-rmail-open)
@ -52,6 +55,8 @@
(rmail-show-message rmail-current-message))
(when (fboundp 'rmail-narrow-to-non-pruned-header)
(rmail-narrow-to-non-pruned-header))
(when (eq rmail-header-style 'normal)
(rmail-toggle-header -1))
(let* ((folder buffer-file-name)
(message-id (mail-fetch-field "message-id"))
(from (mail-fetch-field "from"))
@ -73,7 +78,7 @@
: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))
(setq link (concat "rmail:" folder "#" message-id))
(org-add-link-props :link link :description desc)
(rmail-show-message rmail-current-message)
link)))))
@ -97,7 +102,7 @@
(rmail (if (string= folder "RMAIL") rmail-file-name folder))
(setq message-number
(save-restriction
(widen)
(rmail-widen)
(goto-char (point-max))
(if (re-search-backward
(concat "^Message-ID:\\s-+" (regexp-quote

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