mirrors
/
org-mode
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git
0
0
Fork 1
Code Releases Activity

Merge branch 'master' into maint

This commit is contained in:
emacs 2011-07-28 10:33:15 +00:00
parent c51dca7852 1fa0f027cd
commit b93e56aa80
72 changed files with 3308 additions and 1389 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

246
EXPERIMENTAL/org-mm.el Normal file
View File

@ -0,0 +1,246 @@
;;; org-mm.el --- MoinMoin backend for org-export.el
;;
;; Copyright 2010, 2011 Puneeth Chaganti
;;
;; Emacs Lisp Archive Entry
;; Filename: org-mm.el
;; Version: 0.2
;; Author: Puneeth Chaganti <punchagan [at] gmail [dot] com>
;; Keywords: MoinMoin Org export
;; Description: MoinMoin exporter for Org
;;
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;;
;; A portion of this code is based on org-mw.el by Bastien Guerry.
;;
;;; Commentary:
;;
;; org-mm.el lets you convert Org files to MoinMoin files using
;; the org-export.el experimental engine.
;;
;; Put this file into your load-path and the following into your ~/.emacs:
;; (require 'org-mm)
;;
;; You also need to fetch Org's git repository and add the EXPERIMENTAL/
;; directory in your load path.
;;
;; Fetch Org's git repository:
;;
;; ~$ cd ~/install/git/
;; ~$ git clone git://repo.or.cz/org-mode.git
;;
;; Put this in your .emacs.el:
;;
;; (add-to-list 'load-path "~/install/git/org-mode/EXPERIMENTAL/")
;;
;; Export Org files to MoinMoin: M-x org-mm-export RET
;;
;;; Todo:
;;
;; - handle radio links
;; - support caption and attributes in tables
;; - better handline of source code and examples
;; - handle inline HTML
;;
;;; Code:
(require 'org-export)
(defvar org-mm-emphasis-alist
'(("*" "'''%s'''" nil)
("/" "''%s''" nil)
("_" "__%s__" nil)
("+" "--%s--" nil)
("=" "`%s`" nil))
"The list of fontification expressions for MoinMoin.")
(defvar org-mm-export-table-table-style "")
(defvar org-mm-export-table-header-style "")
(defvar org-mm-export-table-cell-style "")
(defun org-mm-export ()
"Export the current buffer to MoinMoin."
(interactive)
(setq org-export-current-backend 'mm)
(org-export-set-backend "mm")
;; FIXME see the problem `org-mm-export-footnotes'
;; (add-hook 'org-export-preprocess-final-hook 'org-mm-export-footnotes)
(add-hook 'org-export-preprocess-before-backend-specifics-hook
'org-mm-export-src-example)
(org-export-render)
;; (remove-hook 'org-export-preprocess-final-hook 'org-mm-export-footnotes)
(remove-hook 'org-export-preprocess-before-backend-specifics-hook
'org-mm-export-src-example))
(defun org-mm-export-header ()
"Export the header part."
(let* ((p (org-combine-plists (org-infile-export-plist)
org-export-properties))
(title (plist-get p :title))
(author (plist-get p :author))
(date (plist-get p :date))
(level (plist-get p :headline-levels)))
(insert (format "= %s by %s =\n\n" title author))
(if (plist-get p :table-of-contents)
(insert (format "<<TableOfContents(%s)>>\n" level)))))
(defun org-mm-export-first-lines (first-lines)
"Export first lines."
(insert (org-export-render-content first-lines) "\n")
(goto-char (point-max)))
(defun org-mm-export-heading (section-properties)
"Export MoinMoin heading"
(let* ((p section-properties)
(h (plist-get p :heading))
(s (make-string (1+ (plist-get p :level)) ?=)))
(insert (format "%s %s %s\n" s h s))))
(defun org-mm-export-quote-verse-center ()
"Export #+BEGIN_QUOTE/VERSE/CENTER environments."
(let (rpl e)
(while (re-search-forward "^[ \t]*ORG-\\([A-Z]+\\)-\\(START\\|END\\).*$" nil t)
(setq e (if (equal (match-string 2) "END") "/" ""))
(setq rpl
(cond ((equal (match-string 1) "BLOCKQUOTE") "blockquote>")
((equal (match-string 1) "VERSE") "pre>")
((equal (match-string 1) "CENTER") "center>")))
(replace-match (concat "<" e rpl) t))))
(defun org-mm-export-fonts ()
"Export fontification."
(while (re-search-forward org-emph-re nil t)
(let* ((emph (assoc (match-string 3) org-mm-emphasis-alist))
(beg (match-beginning 0))
(begs (match-string 1))
(end (match-end 0))
(ends (match-string 5))
(rpl (format (cadr emph) (match-string 4))))
(delete-region beg end)
(insert begs rpl ends))))
(defun org-mm-export-links ()
"Replace Org links with MoinMoin links."
;; FIXME: This function could be more clever, of course.
(while (re-search-forward org-bracket-link-analytic-regexp nil t)
(cond ((and (equal (match-string 1) "file:")
(save-match-data
(string-match (org-image-file-name-regexp) (match-string 3))))
(replace-match
(concat "{{" (file-name-nondirectory (match-string 3)) "}}")))
(t
(replace-match
(concat "[[\\1\\3|" (if (match-string 5) "\\5]]" "]]")))))))
;; FIXME this function should test whether [1] is really a footnote.
;; `org-footnote-normalize' should add properties to the normalized
;; footnotes so that we can recognize them.
(defun org-mm-export-footnotes ()
"Export footnotes."
(goto-char (point-min))
(let (refpos rpl begnote begfullnote endnote)
(while (re-search-forward "\[[0-9]+\]" nil t)
(save-excursion
(save-match-data
(goto-char (point-max))
(search-backward (concat (match-string 0) " ") nil t)
(setq begfullnote (match-beginning 0))
(setq begnote (match-end 0))
(goto-char (match-end 0))
(re-search-forward "^\[[0-9]+\]\\|\\'" nil t)
(setq endnote (match-beginning 0))
(setq rpl (replace-regexp-in-string
"\n" " " (buffer-substring endnote begnote)))
(setq rpl (replace-regexp-in-string "[ \t]+$" "" rpl))
(delete-region begfullnote endnote)))
(replace-match (concat "<ref>" rpl "</ref>")))))
(defun org-mm-export-src-example ()
"Export #+BEGIN_EXAMPLE and #+BEGIN_SRC."
(goto-char (point-min))
(let (start env)
(while (re-search-forward "^[ \t]*#\\+BEGIN_\\(EXAMPLE\\|SRC\\).*\n" nil t)
(setq env (match-string 1))
(replace-match "{{{\n")
(setq start (point))
(re-search-forward (concat "^[ \t]*#\\+END_" env ".*\n") nil t)
(replace-match "}}}\n"))))
(defun org-mm-export-lists ()
"Export lists to MoinMoin syntax."
(while (re-search-forward (org-item-beginning-re) nil t)
(move-beginning-of-line 1)
(insert (org-list-to-generic
(org-list-parse-list t)
(org-combine-plists
'(:splice nil
:ostart "" :oend ""
:ustart "" :uend ""
:dstart "" :dend ""
:dtstart "" :dtend " "
:istart (concat (make-string (* 2 (1+ depth)) ? )
(if (eq type 'unordered)
"* " "# "))
:iend "\n"
:icount nil
:csep "\n"
:cbon "[X]" :cboff "[ ]"
:cbtrans "[-]"))))))
(defun org-mm-export-tables ()
"Convert tables in the current buffer to MoinMoin tables."
(while (re-search-forward "^\\([ \t]*\\)|" nil t)
(org-if-unprotected-at (1- (point))
(org-table-align)
(let* ((beg (org-table-begin))
(end (org-table-end))
(raw-table (buffer-substring beg end)) lines)
(setq lines (org-split-string raw-table "\n"))
(apply 'delete-region (list beg end))
(when org-export-table-remove-special-lines
(setq lines (org-table-clean-before-export lines 'maybe-quoted)))
(setq lines
(mapcar
(lambda(elem)
(or (and (string-match "[ \t]*|-+" elem) 'hline)
(org-split-string (org-trim elem) "|")))
lines))
(insert (orgtbl-to-mm lines nil))))))
(defun orgtbl-to-mm (table params)
"Convert TABLE into a MoinMoin table."
(let ((params2 (list
:tstart (concat ""
org-mm-export-table-table-style)
:tend "\n"
:lstart "||"
:lend "||"
:sep "||"
:fmt (concat org-mm-export-table-cell-style " %s ")
:hfmt (concat org-mm-export-table-cell-style "''' %s '''")
:hlsep "||"
)))
(orgtbl-to-generic table (org-combine-plists params2 params))))
;; Various empty function for org-export.el to work:
(defun org-mm-export-footer () "")
(defun org-mm-export-section-beginning (section-properties) "")
(defun org-mm-export-section-end (section-properties) "")
(defun org-export-mm-preprocess (parameters)
"Do extra work for MoinMoin export."
nil)
(provide 'org-mm)

23
Makefile
View File

@ -156,7 +156,9 @@ LISPF = org.el \
ob-plantuml.el \
ob-org.el \
ob-js.el \
ob-scheme.el
ob-scheme.el \
ob-lilypond.el \
ob-java.el
LISPFILES0 = $(LISPF:%=lisp/%)
LISPFILES = $(LISPFILES0) lisp/org-install.el
@ -221,21 +223,17 @@ install-lisp: $(LISPFILES) $(ELCFILES)
install-info: $(INFOFILES)
if [ ! -d $(infodir) ]; then $(MKDIR) $(infodir); else true; fi ;
$(CP) $(INFOFILES) $(infodir)
$(INSTALL_INFO) --info-file=$(INFOFILES) --info-dir=$(infodir)
install-info-debian: $(INFOFILES)
$(INSTALL_INFO) --infodir=$(infodir) $(INFOFILES)
autoloads: lisp/org-install.el
lisp/org-install.el: $(LISPFILES0) Makefile
$(BATCH) --eval "(require 'autoload)" \
--eval '(find-file "org-install.el")' \
--eval '(find-file "lisp/org-install.el")' \
--eval '(erase-buffer)' \
--eval '(mapc (lambda (x) (generate-file-autoloads (symbol-name x))) (quote ($(LISPFILES0))))' \
--eval '(mapc (lambda (x) (generate-file-autoloads (symbol-name x))) (quote ($(LISPF))))' \
--eval '(insert "\n(provide (quote org-install))\n")' \
--eval '(save-buffer)'
mv org-install.el lisp
doc/org: doc/org.texi
(cd doc && $(MAKEINFO) --no-split org.texi -o org)
@ -443,15 +441,15 @@ cleanrel:
push:
git-push orgmode@orgmode.org:org-mode.git master
git push orgmode@orgmode.org:org-mode.git master
pushtag:
git-tag -m "Adding tag" -a $(TAG)
git-push orgmode@orgmode.org:org-mode.git $(TAG)
git tag -m "Adding tag" -a $(TAG)
git push orgmode@orgmode.org:org-mode.git $(TAG)
pushreleasetag:
git-tag -m "Adding release tag" -a release_$(TAG)
git-push orgmode@orgmode.org:org-mode.git release_$(TAG)
git tag -m "Adding release tag" -a release_$(TAG)
git push orgmode@orgmode.org:org-mode.git release_$(TAG)
# Dependencies
@ -529,4 +527,3 @@ targets help:
@echo "make install - install Org"
@echo "make install-lisp - install Org ELisp files"
@echo "make install-info - install Org Info file"
@echo "make install-info-debian - install info on old debian systems (newer use ginstall)"

28
README_GIT
View File

@ -9,28 +9,34 @@ development.
* Main rules
1. The git repository is hosted publicly at repo.or.cz. Anyone
can get a clone of the current repository state using the
command
1. The master git repository is hosted publicly at orgmode.org.
Anyone can get a clone of the current repository state using
the command
git clone git://repo.or.cz/org-mode.git
git clone git://orgmode.org/org-mode.git
Having a clone is sufficient to start hacking and to produce
patches that can easily and consistently be applied to the
main repository.
2. People who are interested to participate in the Org-mode
development can do so by sending patches to
emacs-orgmode@gnu.org.
2. There is a mirror hosted publicly at repo.or.cz. Anyone can
get a clone of the current repository state using the command
3. An interested developer can also request push access to the
central repository by sending his/her user-info at repo.or.cz
the maintainer of Org-mode.
git clone git://repo.or.cz/org-mode.git
3. People who are interested to participate in the Org-mode
development can to so by sending patches to this address:
emacs-orgmode@gnu.org
4. An interested developer can also request push access to the
central repository by sending her/his user-info to the
maintainer of Org-mode or the webmaster of orgmode.org.
After you have been added as a user with push privileges,
clone the repository through ssh using
git+ssh://repo.or.cz/srv/git/org-mode.git
git clone orgmode@orgmode.org:org-mode.git
By requesting push access, you acknowledge that you have read
and agreed with the following rules:

93
contrib/babel/langs/ob-fomus.el Normal file
View File

@ -0,0 +1,93 @@
;;; ob-fomus.el --- org-babel functions for fomus evaluation
;; Copyright (C) 2011 Torsten Anders
;; Author: Torsten Anders
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version:
;;; License:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Org-Babel support for evaluating Fomus source code.
;; For information on Fomus see http://fomus.sourceforge.net/
;;
;; This differs from most standard languages in that
;;
;; 1) there is no such thing as a "session" in fomus
;;
;; 2) we are generally only going to return results of type "file"
;;
;; 3) we are adding the "file" and "cmdline" header arguments
;;
;; 4) there are no variables (at least for now)
;;; Code:
(require 'ob)
(require 'ob-eval)
(defvar org-babel-default-header-args:fomus
'((:results . "file") (:exports . "results"))
"Default arguments to use when evaluating a fomus source block.")
(defun org-babel-expand-body:fomus (body params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
(mapc
(lambda (pair)
(let ((name (symbol-name (car pair)))
(value (cdr pair)))
(setq body
(replace-regexp-in-string
(concat "\$" (regexp-quote name))
(if (stringp value) value (format "%S" value))
body))))
vars)
body))
(defun org-babel-execute:fomus (body params)
"Execute a block of Fomus 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)))
(cmdline (cdr (assoc :cmdline params)))
(cmd (or (cdr (assoc :cmd params)) "fomus"))
(in-file (org-babel-temp-file "fomus-" ".fms")))
(with-temp-file in-file
(insert (org-babel-expand-body:fomus body params)))
;; TMP: testing
;; (message (concat cmd
;; " " (org-babel-process-file-name in-file)
;; " " cmdline
;; " -o " (org-babel-process-file-name out-file)))
(org-babel-eval
(concat cmd
" " (org-babel-process-file-name in-file)
" " cmdline
" -o " (org-babel-process-file-name out-file)) "")
nil)) ;; signal that output has already been written to file
(defun org-babel-prep-session:fomus (session params)
"Return an error because Fomus does not support sessions."
(error "Fomus does not support sessions"))
(provide 'ob-fomus)
;;; ob-fomus.el ends here

162
contrib/babel/langs/ob-fortran.el Normal file
View File

@ -0,0 +1,162 @@
;;; ob-fortran.el --- org-babel functions for fortran
;; Copyright (C) 2011 Sergey Litvinov, Eric Schulte
;; Authors: Sergey Litvinov (based on ob-C.el by Eric Schulte), Eric Schulte
;; Keywords: literate programming, reproducible research, fortran
;; Homepage: http://orgmode.org
;; Version: 7.6
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Org-Babel support for evaluating fortran code.
;;; Code:
(require 'ob)
(require 'ob-eval)
(require 'cc-mode)
(declare-function org-entry-get "org"
(pom property &optional inherit literal-nil))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("fortran" . "F90"))
(defvar org-babel-default-header-args:fortran '())
(defvar org-babel-fortran-compiler "gfortran"
"fortran command used to compile a fortran source code file into an
executable.")
(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-"))
(cmdline (cdr (assoc :cmdline params)))
(flags (cdr (assoc :flags params)))
(full-body (org-babel-expand-body:fortran body params))
(compile
(progn
(with-temp-file tmp-src-file (insert full-body))
(org-babel-eval
(format "%s -o %s %s %s"
org-babel-fortran-compiler
(org-babel-process-file-name tmp-bin-file)
(mapconcat 'identity
(if (listp flags) flags (list flags)) " ")
(org-babel-process-file-name tmp-src-file)) ""))))
((lambda (results)
(org-babel-reassemble-table
(if (member "vector" (cdr (assoc :result-params params)))
(let ((tmp-file (org-babel-temp-file "f-")))
(with-temp-file tmp-file (insert results))
(org-babel-import-elisp-from-file tmp-file))
(org-babel-read results))
(org-babel-pick-name
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))
(org-babel-trim
(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
it's header arguments."
(let ((vars (mapcar #'cdr (org-babel-get-header params :var)))
(main-p (not (string= (cdr (assoc :main params)) "no")))
(includes (or (cdr (assoc :includes params))
(org-babel-read (org-entry-get nil "includes" t))))
(defines (org-babel-read
(or (cdr (assoc :defines params))
(org-babel-read (org-entry-get nil "defines" t))))))
(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' statment 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"))
(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"))
;; helper functions
(defun org-babel-fortran-var-to-fortran (pair)
"fortranonvert an elisp val into a string of fortran code specifying a var
of the same value."
;; TODO list support
(let ((var (car pair))
(val (cdr pair)))
(when (symbolp val)
(setq val (symbol-name val))
(when (= (length val) 1)
(setq val (string-to-char val))))
(cond
((integerp val)
(format "integer, parameter :: %S = %S\n" var val))
((floatp val)
(format "real, parameter :: %S = %S\n" var val))
((or (characterp val))
(format "character, parameter :: %S = '%S'\n" var val))
((stringp val)
(format "character(len=%d), parameter :: %S = '%s'\n"
(length val) var val))
((listp val)
(format "real, parameter :: %S(%d) = %s\n"
var (length val) (ob-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)
"Return a fortran representation of enclose syntactic lists."
(if (listp val)
(concat "(/" (mapconcat #'ob-fortran-transform-list val ", ") "/)")
(format "%S" val)))
(provide 'ob-fortran)
;;; ob-fortran.el ends here

97
contrib/babel/library-of-babel.org
View File

@ -1,26 +1,26 @@
#+title: The Library of Babel
#+author: Org-mode People
#+STARTUP: odd hideblocks
#+STARTUP: oddeven hideblocks
* Introduction
The Library of Babel is an extensible collection of ready-made and
easily-shortcut-callable source-code blocks for handling common
tasks. Org-babel comes pre-populated with the source-code blocks
located in this file. It is possible to add source-code blocks from
any org-mode file to the library by calling =(org-babel-lob-ingest
"path/to/file.org")=.
easily-shortcut-callable source-code blocks for handling common tasks.
Org-babel comes pre-populated with the source-code blocks located in this
file. It is possible to add source-code blocks from any org-mode file to
the library by calling =(org-babel-lob-ingest "path/to/file.org")=.
This file is included in worg mainly less for viewing through the
web interface, and more for contribution through the worg git
repository. If you have code snippets that you think others may
find useful please add them to this file and [[file:~/src/worg/worg-git.org::contribute-to-worg][contribute them]] to
worg.
This file is included in worg mainly less for viewing through the web
interface, and more for contribution through the worg git repository. If
you have code snippets that you think others may find useful please add
them to this file and [[file:~/src/worg/worg-git.org::contribute-to-worg][contribute them]] to worg.
The raw Org-mode text of this file can be downloaded at
[[repofile:contrib/babel/library-of-babel.org][library-of-babel.org]]
* Simple
A collection of simple utility functions
A collection of simple utility functions:
#+srcname: echo
#+begin_src emacs-lisp :var input="echo'd"
@ -28,10 +28,13 @@ A collection of simple utility functions
#+end_src
* File I/O
** reading and writing files
** Reading and writing files
Read the contents of the file at =file=. The =:results vector= and
=:results scalar= header arguments can be used to read the contents of
file as either a table or a string.
#+srcname: read
#+begin_src emacs-lisp :var file="" :var format=""
(if (string= format "csv")
@ -45,6 +48,7 @@ file as either a table or a string.
Write =data= to a file at =file=. If =data= is a list, then write it
as a table in traditional Org-mode table syntax.
#+srcname: write
#+begin_src emacs-lisp :var data="" :var file="" :var ext='()
(flet ((echo (r) (if (stringp r) r (format "%S" r))))
@ -57,9 +61,12 @@ as a table in traditional Org-mode table syntax.
nil
#+end_src
** remote files
** Remote files
**** json
Read local or remote file in [[http://www.json.org/][json]] format into emacs-lisp objects.
#+srcname: json
#+begin_src emacs-lisp :var file='() :var url='()
(require 'json)
@ -77,15 +84,18 @@ Read local or remote file in [[http://www.json.org/][json]] format into emacs-li
#+end_src
**** Google docs
The following code blocks make use of the [[http://code.google.com/p/googlecl/][googlecl]] Google command line
tool. This tool provides functionality for accessing Google services
from the command line, and the following code blocks use /googlecl/
for reading from and writing to Google docs with Org-mode code blocks.
****** read a document from Google docs
****** Read a document from Google docs
The =google= command seems to be throwing "Moved Temporarily" errors
when trying to download textual documents, but this is working fine
for spreadsheets.
#+source: gdoc-read
#+begin_src emacs-lisp :var title="example" :var format="csv"
(let* ((file (concat title "." format))
@ -107,12 +117,15 @@ contents of a spreadsheet named =num-cells= into a table.
A line like the following can be used to read the contents of a
document as a string.
: #+call: gdoc-read(title="loremi", :format "txt")
****** write a document to a Google docs
****** Write a document to a Google docs
Write =data= to a google document named =title=. If =data= is tabular
it will be saved to a spreadsheet, otherwise it will be saved as a
normal document.
#+source: gdoc-write
#+begin_src emacs-lisp :var title="babel-upload" :var data=fibs(n=10) :results silent
(let* ((format (if (listp data) "csv" "txt"))
@ -140,7 +153,9 @@ example usage
* Plotting code
** R
Plot column 2 (y axis) against column 1 (x axis). Columns 3 and beyond, if present, are ignored.
Plot column 2 (y axis) against column 1 (x axis). Columns 3 and
beyond, if present, are ignored.
#+srcname: R-plot(data=R-plot-example-data)
#+begin_src R
@ -162,7 +177,9 @@ plot(data)
** Gnuplot
* Org reference
** headline references
** Headline references
#+source: headline
#+begin_src emacs-lisp :var headline=top :var file='()
(save-excursion
@ -176,11 +193,15 @@ plot(data)
#+call: headline(headline="headline references")
* Tables
** LaTeX Table export
*** booktabs
This block can be used to wrap a table in the latex =booktabs=
environment, it takes the following arguments -- all but the first two
are optional.
| arg | description |
|-------+--------------------------------------------|
| table | a reference to the table |
@ -220,10 +241,12 @@ are optional.
(to-tab table))))))
#+end_src
*** longtable
*** Longtable
This block can be used to wrap a table in the latex =longtable=
environment, it takes the following arguments -- all but the first two
are optional.
| arg | description |
|-----------+-------------------------------------------------------------|
| table | a reference to the table |
@ -287,7 +310,7 @@ are optional.
:PROPERTIES:
:AUTHOR: Luke Crook
:END:
This function will attempt to retrieve the entire commit log for the
file associated with the current buffer and insert this log into the
export. The function uses the Emacs VC commands to interface to the
@ -321,6 +344,7 @@ Git. 'limit' is currently unsupported.
#+end_src
** Trivial python code blocks
#+srcname: python-identity(a=1)
#+begin_src python
a
@ -332,6 +356,7 @@ a + b
#+end_src
** Arithmetic
#+source: lob-add
#+begin_src emacs-lisp :var a=0 :var b=0
(+ a b)
@ -430,3 +455,35 @@ Fraga. It was modified slightly by Tom Dye.
%s
\\end{tikzpicture}" projecttime ntasks tasks milestones dates))
#+end_src
* Available languages
:PROPERTIES:
:AUTHOR: Bastien
:END:
** From Org's core
| Language | Identifier | Language | Identifier |
|------------+------------+----------------+------------|
| Asymptote | asymptote | Awk | awk |
| Emacs Calc | calc | C | C |
| C++ | C++ | Clojure | clojure |
| CSS | css | ditaa | ditaa |
| Graphviz | dot | Emacs Lisp | emacs-lisp |
| gnuplot | gnuplot | Haskell | haskell |
| Javascript | js | LaTeX | latex |
| Ledger | ledger | Lisp | lisp |
| Lilypond | lilypond | MATLAB | matlab |
| Mscgen | mscgen | Objective Caml | ocaml |
| Octave | octave | Org-mode | org |
| | | Perl | perl |
| Plantuml | plantuml | Python | python |
| R | R | Ruby | ruby |
| Sass | sass | Scheme | scheme |
| GNU Screen | screen | shell | sh |
| SQL | sql | SQLite | sqlite |
** From Org's contrib/babel/langs
- ob-oz.el, by Torsten Anders and Eric Schulte
- ob-fomus.el, by Torsten Anders

2
contrib/doc/fr-orgcard.tex
View File

@ -71,7 +71,7 @@
\centerline{Copyright \copyright\ \year\ Free Software Foundation, Inc.}
\centerline{v\orgversionnumber{} for Org-Mode \orgversionnumber{}, \versionyear}
\centerline{Auteur de la version anglaise : Philip Rooke}
\centerline{Traduction en fran\c{c}ais : Thierry Stoehr, Vincent-Xavier Jumel}
\centerline{Traduction en fran\c{c}ais : Isabelle Ramade, Thierry Stoehr, Vincent-Xavier Jumel}
\centerline{bas\'e sur le format refcard de Stephen Gildea}
Permission est donnée de faire des copies de ce document et de les

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

@ -55,7 +55,43 @@
;; - The sibling also gets the same TRIGGER property
;; "chain-siblings-scheduled", so the chain can continue.
;;
;; 3) If the TRIGGER property contains any other words like
;; 3) If the TRIGGER property contains the string
;; "chain-find-next(KEYWORD[,OPTIONS])", then switching that entry
;; to DONE do the following:
;; - All siblings are of the entry are collected into a temporary
;; list and then filtered and sorted according to OPTIONS
;; - The first sibling on the list is changed into KEYWORD state
;; - The sibling also gets the same TRIGGER property
;; "chain-find-next", so the chain can continue.
;;
;; OPTIONS should be a comma separated string without spaces, and
;; can contain following options:
;;
;; - from-top the candidate list is all of the siblings in
;; the current subtree
;;
;; - from-bottom candidate list are all siblings from bottom up
;;
;; - from-current candidate list are all siblings from current item
;; until end of subtree, then wrapped around from
;; first sibling
;;
;; - no-wrap candidate list are siblings from current one down
;;
;; - todo-only Only consider siblings that have a todo keyword
;; -
;; - todo-and-done-only
;; Same as above but also include done items.
;;
;; - priority-up sort by highest priority
;; - priority-down sort by lowest priority
;; - effort-up sort by highest effort
;; - effort-down sort by lowest effort
;;
;; Default OPTIONS are from-top
;;
;;
;; 4) If the TRIGGER property contains any other words like
;; XYZ(KEYWORD), these are treated as entry id's with keywords. That
;; means Org-mode will search for an entry with the ID property XYZ
;; and switch that entry to KEYWORD as well.
@ -97,7 +133,7 @@
;; :PROPERTIES:
;; :TRIGGER: chain-siblings(NEXT)
;; :END:
;;
;;
;; ** This is the second in this chain
;;
;; ** This is the third in this chain
@ -112,7 +148,7 @@
;; :END:
;;
;; ** This is the fifth in this chain
;;
;;
;; * Start writing report
;; :PROPERTIES:
;; :ID: XYZ-is-my-id
@ -121,12 +157,20 @@
;;
(require 'org)
(eval-when-compile
(require 'cl))
(defcustom org-depend-tag-blocked t
"Whether to indicate blocked TODO items by a special tag."
:group 'org
:type 'boolean)
(defcustom org-depend-find-next-options
"from-current,todo-only,priority-up"
"Default options for chain-find-next trigger"
:group 'org
:type 'string)
(defmacro org-depend-act-on-sibling (trigger-val &rest rest)
"Perform a set of actions on the next sibling, if it exists,
copying the sibling spec TRIGGER-VAL to the next sibling."
@ -143,6 +187,8 @@ copying the sibling spec TRIGGER-VAL to the next sibling."
(org-entry-add-to-multivalued-property
nil "TRIGGER" ,trigger-val))))
(defvar org-depend-doing-chain-find-next nil)
(defun org-depend-trigger-todo (change-plist)
"Trigger new TODO entries after the current is switched to DONE.
This does two different kinds of triggers:
@ -184,12 +230,107 @@ This does two different kinds of triggers:
;; Go through all the triggers
(while (setq tr (pop triggers))
(cond
((and (not org-depend-doing-chain-find-next)
(string-match "\\`chain-find-next(\\b\\(.+?\\)\\b\\(.*\\))\\'" tr))
;; smarter sibling selection
(let* ((org-depend-doing-chain-find-next t)
(kwd (match-string 1 tr))
(options (match-string 2 tr))
(options (if (or (null options)
(equal options ""))
org-depend-find-next-options
options))
(todo-only (string-match "todo-only" options))
(todo-and-done-only (string-match "todo-and-done-only"
options))
(from-top (string-match "from-top" options))
(from-bottom (string-match "from-bottom" options))
(from-current (string-match "from-current" options))
(no-wrap (string-match "no-wrap" options))
(priority-up (string-match "priority-up" options))
(priority-down (string-match "priority-down" options))
(effort-up (string-match "effort-up" options))
(effort-down (string-match "effort-down" options)))
(save-excursion
(org-back-to-heading t)
(let ((this-item (point)))
;; go up to the parent headline, then advance to next child
(org-up-heading-safe)
(let ((end (save-excursion (org-end-of-subtree t)
(point)))
(done nil)
(items '()))
(outline-next-heading)
(while (not done)
(if (not (looking-at org-complex-heading-regexp))
(setq done t)
(let ((todo-kwd (match-string 2))
(tags (match-string 5))
(priority (org-get-priority (or (match-string 3) "")))
(effort (when (or effort-up effort-down)
(let ((effort (org-get-effort)))
(when effort
(org-duration-string-to-minutes effort))))))
(push (list (point) todo-kwd priority tags effort)
items))
(unless (org-goto-sibling)
(setq done t))))
;; massage the list according to options
(setq items
(cond (from-top (nreverse items))
(from-bottom items)
((or from-current no-wrap)
(let* ((items (nreverse items))
(pos (position this-item items :key #'first))
(items-before (subseq items 0 pos))
(items-after (subseq items pos)))
(if no-wrap items-after
(append items-after items-before))))
(t (nreverse items))))
(setq items (remove-if
(lambda (item)
(or (equal (first item) this-item)
(and (not todo-and-done-only)
(member (second item) org-done-keywords))
(and (or todo-only
todo-and-done-only)
(null (second item)))))
items))
(setq items
(sort
items
(lambda (item1 item2)
(let* ((p1 (third item1))
(p2 (third item2))
(e1 (fifth item1))
(e2 (fifth item2))
(p1-lt (< p1 p2))
(p1-gt (> p1 p2))
(e1-lt (and e1 (or (not e2) (< e1 e2))))
(e2-gt (and e2 (or (not e1) (> e1 e2)))))
(cond (priority-up
(or p1-gt
(and (equal p1 p2)
(or (and effort-up e1-gt)
(and effort-down e1-lt)))))
(priority-down
(or p1-lt
(and (equal p1 p2)
(or (and effort-up e1-gt)
(and effort-down e1-lt)))))
(effort-up
(or e1-gt (and (equal e1 e2) p1-gt)))
(effort-down
(or e1-lt (and (equal e1 e2) p1-gt))))))))
(when items
(goto-char (first (first items)))
(org-entry-add-to-multivalued-property nil "TRIGGER" tr)
(org-todo kwd)))))))
((string-match "\\`chain-siblings(\\(.*?\\))\\'" tr)
;; This is a TODO chain of siblings
(setq kwd (match-string 1 tr))
(org-depend-act-on-sibling (format "chain-siblings(%s)" kwd)
(org-todo kwd)))
((string-match "\\`\\(\\S-+\\)(\\(.*?\\))\\'" tr)
;; This seems to be ENTRY_ID(KEYWORD)
(setq id (match-string 1 tr)
@ -237,7 +378,7 @@ this ID property, that entry is also checked."
;; and split it on whitespace.
(setq blocker (org-entry-get pos "BLOCKER")
blockers (and blocker (org-split-string blocker "[ \t]+")))
;; go through all the blockers
(while (setq bl (pop blockers))
(cond
@ -268,7 +409,7 @@ this ID property, that entry is also checked."
)))
(when org-depend-tag-blocked
(org-toggle-tag "blocked" (if proceed-p 'off 'on)))
proceed-p))
(add-hook 'org-trigger-hook 'org-depend-trigger-todo)

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

@ -621,7 +621,7 @@ situation use `org-part-of-drill-entry-p'."
(defun org-drill-goto-entry (marker)
(switch-to-buffer (marker-buffer marker))
(org-pop-to-buffer-same-window (marker-buffer marker))
(goto-char marker))
@ -2602,7 +2602,7 @@ the tag 'imported'."
(unless path
(setq path (org-get-outline-path)))
(org-copy-subtree)
(switch-to-buffer dest)
(org-pop-to-buffer-same-window dest)
(setq m
(condition-case nil
(org-find-olp path t)
@ -2684,7 +2684,7 @@ copy them across."
scheduled-time (org-get-scheduled-time (point)))
(save-excursion
;; go to matching entry in destination buffer
(switch-to-buffer (marker-buffer marker))
(org-pop-to-buffer-same-window (marker-buffer marker))
(goto-char marker)
(org-drill-strip-entry-data)
(unless (zerop total-repeats)

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

@ -42,7 +42,7 @@
(eshell-buffer-name (car buffer-and-command))
(command (cadr buffer-and-command)))
(if (get-buffer eshell-buffer-name)
(switch-to-buffer eshell-buffer-name)
(org-pop-to-buffer-same-window eshell-buffer-name)
(eshell))
(end-of-buffer)
(eshell-kill-input)

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

@ -846,7 +846,7 @@ underlined headlines. The default is 3."
(org-init-section-numbers)
(org-export-generic-check-section "top")
(while (setq line (pop lines))
(when (and link-buffer (string-match "^\\*+ " line))
(when (and link-buffer (string-match org-outline-regexp-bol line))
(org-export-generic-push-links (nreverse link-buffer))
(setq link-buffer nil))
(setq wrap nil)

105
contrib/lisp/org-lparse.el
View File

@ -1,4 +1,4 @@
;;; org-lparse.el --- Line-oriented exporter for Org-mode
;;; org-lparse.el --- Line-oriented parser-exporter for Org-mode
;; Copyright (C) 2010, 2011
;; Jambunathan <kjambunathan at gmail dot com>
@ -27,28 +27,28 @@
;;
;;; Commentary:
;;; `org-lparse' is the entry point for the generic line-oriented
;;; exporter. `org-do-lparse' is the genericized version of the
;;; original `org-export-as-html' routine.
;; `org-lparse' is the entry point for the generic line-oriented
;; exporter. `org-do-lparse' is the genericized version of the
;; original `org-export-as-html' routine.
;;; `org-lparse-native-backends' is a good starting point for
;;; exploring the generic exporter.
;; `org-lparse-native-backends' is a good starting point for
;; exploring the generic exporter.
;;; Following new interactive commands are provided by this library.
;;; `org-lparse', `org-lparse-and-open', `org-lparse-to-buffer'
;;; `org-replace-region-by', `org-lparse-region'.
;; Following new interactive commands are provided by this library.
;; `org-lparse', `org-lparse-and-open', `org-lparse-to-buffer'
;; `org-replace-region-by', `org-lparse-region'.
;;; Note that the above routines correspond to the following routines
;;; in the html exporter `org-export-as-html',
;;; `org-export-as-html-and-open', `org-export-as-html-to-buffer',
;;; `org-replace-region-by-html' and `org-export-region-as-html'.
;; Note that the above routines correspond to the following routines
;; in the html exporter `org-export-as-html',
;; `org-export-as-html-and-open', `org-export-as-html-to-buffer',
;; `org-replace-region-by-html' and `org-export-region-as-html'.
;;; The all new interactive command `org-export-convert' can be used
;;; to convert documents between various formats. Use this to
;;; command, for example, to convert odt file to doc or pdf format.
;; The new interactive command `org-lparse-convert' can be used to
;; convert documents between various formats. Use this to command,
;; for example, to convert odt file to doc or pdf format.
;;; See README.org file that comes with this library for answers to
;;; FAQs and more information on using this library.
;; See README.org file that comes with this library for answers to
;; FAQs and more information on using this library.
;;; Code:
@ -337,9 +337,11 @@ OPT-PLIST is the export options list."
(when org-lparse-do-open-par
(org-lparse-begin-paragraph))))
(defvar org-lparse-native-backends
'("xhtml" "odt")
(defvar org-lparse-native-backends nil
"List of native backends registered with `org-lparse'.
A backend can use `org-lparse-register-backend' to add itself to
this list.
All native backends must implement a get routine and a mandatory
set of callback routines.
@ -354,6 +356,16 @@ For the sake of illustration, the html backend implements
`org-xhtml-entity-format-callbacks-alist' as the values of
ENTITY-CONTROL and ENTITY-FORMAT settings.")
(defun org-lparse-register-backend (backend)
"Make BACKEND known to org-lparse library.
Add BACKEND to `org-lparse-native-backends'."
(when backend
(setq backend (cond
((symbolp backend) (symbol-name backend))
((stringp backend) backend)
(t (error "Error while registering backend: %S" backend))))
(add-to-list 'org-lparse-native-backends backend)))
(defun org-lparse-get-other-backends (native-backend)
(org-lparse-backend-get native-backend 'OTHER-BACKENDS))
@ -428,7 +440,7 @@ PUB-DIR specifies the publishing directory."
(run-hooks 'org-export-first-hook)
(org-do-lparse arg hidden ext-plist to-buffer body-only pub-dir)))
(defcustom org-export-convert-process
(defcustom org-lparse-convert-process
'("soffice" "-norestore" "-invisible" "-headless" "\"macro:///BasicODConverter.Main.Convert(%I,%f,%O)\"")
"Command to covert a Org exported format to other formats.
The variable is an list of the form (PROCESS ARG1 ARG2 ARG3
@ -440,9 +452,14 @@ The variable is an list of the form (PROCESS ARG1 ARG2 ARG3
%O output file name as a URL
%d output dir in full
%D output dir as a URL"
:group 'org-lparse)
(defcustom org-lparse-use-flashy-warning nil
"Use flashy warnings when exporting to ODT."
:type 'boolean
:group 'org-export)
(defun org-export-convert (&optional in-file fmt)
(defun org-lparse-convert (&optional in-file fmt)
"Convert file from one format to another using a converter.
IN-FILE is the file to be converted. If unspecified, it defaults
to variable `buffer-file-name'. FMT is the desired output format. If the
@ -468,7 +485,7 @@ then that converter is used. Otherwise
(backend (when (boundp 'org-lparse-backend) org-lparse-backend))
(convert-process
(or (ignore-errors (org-lparse-backend-get backend 'CONVERT-METHOD))
org-export-convert-process))
org-lparse-convert-process))
program arglist)
(setq program (and convert-process (consp convert-process)
@ -774,7 +791,7 @@ version."
(while (setq line (pop lines) origline line)
(catch 'nextline
(when (and (org-lparse-current-environment-p 'quote)
(string-match "^\\*+ " line))
(string-match org-outline-regexp-bol line))
(org-lparse-end-environment 'quote))
(when (org-lparse-current-environment-p 'quote)
@ -1109,9 +1126,9 @@ version."
(or (when (and (boundp 'org-lparse-other-backend)
org-lparse-other-backend
(not (equal org-lparse-backend org-lparse-other-backend)))
(let ((org-export-convert-process (org-lparse-get 'CONVERT-METHOD)))
(when org-export-convert-process
(org-export-convert buffer-file-name
(let ((org-lparse-convert-process (org-lparse-get 'CONVERT-METHOD)))
(when org-lparse-convert-process
(org-lparse-convert buffer-file-name
(symbol-name org-lparse-other-backend)))))
(current-buffer)))
((eq to-buffer 'string)
@ -1321,7 +1338,7 @@ for further information."
(while (string-match org-maybe-keyword-time-regexp s)
(or b (setq b (substring s 0 (match-beginning 0))))
(setq r (concat
r (substring s 0 (match-beginning 0))
r (substring s 0 (match-beginning 0)) " "
(org-lparse-format
'FONTIFY
(concat
@ -1329,6 +1346,7 @@ for further information."
(org-lparse-format
'FONTIFY
(match-string 1 s) "timestamp-kwd"))
" "
(org-lparse-format
'FONTIFY
(substring (org-translate-time (match-string 3 s)) 1 -1)
@ -1513,9 +1531,9 @@ the alist of previous items."
((assq pos struct)
(string-match
(concat "[ \t]*\\(\\S-+[ \t]*\\)"
"\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\]\\)?"
"\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?"
"\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?"
"\\(?:\\(.*\\)[ \t]+::[ \t]+\\)?"
"\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?"
"\\(.*\\)") line)
(let* ((checkbox (match-string 3 line))
(desc-tag (or (match-string 4 line) "???"))
@ -1577,9 +1595,24 @@ the alist of previous items."
(defvar org-lparse-output-buffer)
(defcustom org-lparse-debug nil
"."
"Enable or Disable logging of `org-lparse' callbacks.
The parameters passed to the backend-registered ENTITY-CONTROL
and ENTITY-FORMAT callbacks are logged as comment strings in the
exported buffer. (org-lparse-format 'COMMENT fmt args) is used
for logging. Customize this variable only if you are an expert
user. Valid values of this variable are:
nil : Disable logging
control : Log all invocations of `org-lparse-begin' and
`org-lparse-end' callbacks.
format : Log invocations of `org-lparse-format' callbacks.
t : Log all invocations of `org-lparse-begin', `org-lparse-end'
and `org-lparse-format' callbacks,"
:group 'org-lparse
:type 'boolean)
:type '(choice
(const :tag "Disable" nil)
(const :tag "Format callbacks" format)
(const :tag "Control callbacks" control)
(const :tag "Format and Control callbacks" t)))
(defun org-lparse-begin (entity &rest args)
"Begin ENTITY in current buffer. ARGS is entity specific.
@ -1980,9 +2013,11 @@ Replaces invalid characters with \"_\"."
(org-lparse-format 'FONTIFY snumber (format "section-number-%d" level))))
(defun org-lparse-warn (msg)
(put-text-property 0 (length msg) 'face 'font-lock-warning-face msg)
(message msg)
(sleep-for 3))
(if (not org-lparse-use-flashy-warning)
(message msg)
(put-text-property 0 (length msg) 'face 'font-lock-warning-face msg)
(message msg)
(sleep-for 3)))
(defun org-xml-format-href (s)
"Make sure the S is valid as a href reference in an XHTML document."

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

@ -99,7 +99,7 @@ the the Emacs diary"
;; for each calendar, concatenate individual events into a single ics file
(with-temp-buffer
(shell-command "sw_vers" (current-buffer))
(when (re-search-backward "10\\.[56]" nil t)
(when (re-search-backward "10\\.[567]" nil t)
(omi-concat-leopard-ics all-calendars)))
;; move all caldav ics files to the same place as local ics files
@ -126,7 +126,7 @@ the the Emacs diary"
(setq usedCalendarsFiles (directory-files "~/Library/Calendars" 1 ".*ics$"))
(omi-delete-ics-file usedCalendarsFiles)
(switch-to-buffer currentBuffer))
(org-pop-to-buffer-same-window currentBuffer))
(defun omi-concat-leopard-ics (list)
"Leopard stores each iCal.app event in a separate ics file.

170
contrib/lisp/org-odt.el
View File

@ -1,6 +1,6 @@
;;; org-odt.el --- OpenDocumentText export for Org-mode
;; Copyright (C) 2010-2011
;; Copyright (C) 2010, 2011
;; Jambunathan <kjambunathan at gmail dot com>
;; Author: Jambunathan K <kjambunathan at gmail dot com>
@ -73,7 +73,16 @@
(cond
((file-directory-p dir1) dir1)
((file-directory-p dir2) dir2)
(t (error "Cannot find factory styles file. Check package dir layout")))))
(t (error "Cannot find factory styles file. Check package dir layout"))))
"Directory that holds auxiliary files used by the ODT exporter.
The 'styles' subdir contains the following xml files -
'OrgOdtStyles.xml' and 'OrgOdtAutomaticStyles.xml' - which are
used as factory settings of `org-export-odt-styles-file' and
`org-export-odt-automatic-styles-file'.
The 'etc/schema' subdir contains rnc files for validating of
OpenDocument xml files.")
(defvar org-odt-file-extensions
'(("odt" . "OpenDocument Text")
@ -128,37 +137,66 @@
(cons (concat "\\." (car desc) "\\'") 'system)))
org-odt-ms-file-extensions)
;; register the odt exporter
;; register the odt exporter with the pre-processor
(add-to-list 'org-export-backends 'odt)
(defcustom org-export-odt-automatic-styles-file nil
"Default style file for use with ODT exporter."
:group 'org-export-odt
:type 'file)
;; register the odt exporter with org-lparse library
(org-lparse-register-backend 'odt)
(defcustom org-export-odt-automatic-styles-file nil
"Automatic styles for use with ODT exporter.
If unspecified, the file under `org-odt-data-dir' is used."
:type 'file
:group 'org-export-odt)
;; TODO: Make configuration user-friendly.
(defcustom org-export-odt-styles-file nil
"Default style file for use with ODT exporter.
Valid values are path to an styles.xml file or a path to a valid
*.odt or a *.ott file or a list of the form (FILE (MEMBER1
MEMBER2 ...)). In the last case, the specified FILE is unzipped
and MEMBER1, MEMBER2 etc are copied in to the generated odt
file. The last form is particularly useful if the styles.xml has
reference to additional files like header and footer images.
"
"Default styles file for use with ODT export.
Valid values are one of:
1. nil
2. path to a styles.xml file
3. path to a *.odt or a *.ott file
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
`org-odt-data-dir' for more information.
In case of option 3, the specified file is unzipped and the
styles.xml embedded therein is used.
In case of option 4, the specified ODT-OR-OTT-FILE is unzipped
and FILE-MEMBER-1, FILE-MEMBER-2 etc are copied in to the
generated odt file. Use relative path for specifying the
FILE-MEMBERS. styles.xml must be specified as one of the
FILE-MEMBERS.
Use options 1, 2 or 3 only if styles.xml alone suffices for
achieving the desired formatting. Use option 4, if the styles.xml
references additional files like header and footer images for
achieving the desired formattting."
:group 'org-export-odt
:type 'file)
(defconst org-export-odt-tmpdir-prefix "odt-")
:type
'(choice
(const :tag "Factory settings" nil)
(file :must-match t :tag "styles.xml")
(file :must-match t :tag "ODT or OTT file")
(list :tag "ODT or OTT file + Members"
(file :must-match t :tag "ODF Text or Text Template file")
(cons :tag "Members"
(file :tag " Member" "styles.xml")
(repeat (file :tag "Member"))))))
(defconst org-export-odt-tmpdir-prefix "odt-")
(defconst org-export-odt-bookmark-prefix "OrgXref.")
(defcustom org-export-odt-use-bookmarks-for-internal-links t
"Export Internal links as bookmarks?."
:group 'org-export-odt
:type 'boolean)
:type 'boolean
:group 'org-export-odt)
(defcustom org-export-odt-embed-images t
"Should the images be copied in to the odt file or just linked?"
:group 'org-export-odt
:type 'boolean)
:type 'boolean
:group 'org-export-odt)
(defcustom org-odt-export-inline-images 'maybe
"Non-nil means inline images into exported HTML pages.
@ -174,13 +212,14 @@ be linked only."
(defcustom org-odt-export-inline-image-extensions
'("png" "jpeg" "jpg" "gif")
"Extensions of image files that can be inlined into HTML."
:group 'org-odt-export
:type '(repeat (string :tag "Extension")))
:type '(repeat (string :tag "Extension"))
:group 'org-odt-export)
(defcustom org-export-odt-pixels-per-inch display-pixels-per-inch
;; FIXME add docstring
""
:group 'org-export-odt
:type 'float)
:type 'float
:group 'org-export-odt)
(defvar org-export-odt-default-org-styles-alist
'((paragraph . ((default . "Text_20_body")
@ -686,14 +725,15 @@ PUB-DIR is set, use this as the publishing directory."
</text:table-of-content-entry-template>
" level level)))
(insert "
(insert
(format "
</text:table-of-content-source>
<text:index-body>
<text:index-title text:style-name=\"Sect1\" text:name=\"Table of Contents1_Head\">
<text:p text:style-name=\"Contents_20_Heading\">Table of Contents</text:p>
<text:p text:style-name=\"Contents_20_Heading\">%s</text:p>
</text:index-title>
"))
" lang-specific-heading)))
(defun org-odt-end-toc ()
(insert "
@ -766,9 +806,7 @@ PUB-DIR is set, use this as the publishing directory."
(format "\n<!-- %s -->\n" comment)))
(defun org-odt-format-org-entity (wd)
;; FIXME: Seems to work. But is this correct?
(let ((s (org-entity-get-representation wd 'utf8)))
(and s (format "&#x%x;" (string-to-char s)))))
(org-entity-get-representation wd 'utf8))
(defun org-odt-fill-tabs-and-spaces (line)
(replace-regexp-in-string
@ -1053,7 +1091,7 @@ MAY-INLINE-P allows inlining it as an image."
;; xml files generated on-the-fly
(defconst org-export-odt-save-list
'("META-INF/manifest.xml" "content.xml" "meta.xml" "styles.xml"))
'("mimetype" "META-INF/manifest.xml" "content.xml" "meta.xml" "styles.xml"))
;; xml files that are copied
(defconst org-export-odt-nosave-list '())
@ -1188,6 +1226,10 @@ MAY-INLINE-P allows inlining it as an image."
(apply 'org-lparse-format-tags tag text prefix suffix args)))
(defun org-odt-init-outfile (filename)
(unless (executable-find "zip")
;; Not at all OSes ship with zip by default
(error "Executable \"zip\" needed for creating OpenDocument files. Aborting."))
(let* ((outdir (make-temp-file org-export-odt-tmpdir-prefix t))
(mimetype-file (expand-file-name "mimetype" outdir))
(content-file (expand-file-name "content.xml" outdir))
@ -1220,6 +1262,10 @@ MAY-INLINE-P allows inlining it as an image."
(save-excursion
(insert (mapconcat 'identity (cdr org-export-odt-meta-lines) "\n"))))
;; mimetype
(with-current-buffer (find-file-noselect mimetype-file t)
(insert "application/vnd.oasis.opendocument.text"))
;; styles file
;; (copy-file org-export-odt-styles-file styles-file t)
@ -1231,9 +1277,6 @@ MAY-INLINE-P allows inlining it as an image."
(append org-export-odt-save-list org-export-odt-nosave-list)))
content-file))
(defconst org-export-odt-mimetype-lines
'("application/vnd.oasis.opendocument.text"))
(defconst org-odt-manifest-file-entry-tag
"<manifest:file-entry manifest:media-type=\"%s\" manifest:full-path=\"%s\"/>")
@ -1277,23 +1320,22 @@ MAY-INLINE-P allows inlining it as an image."
(let* ((target-name (file-name-nondirectory target))
(target-dir (file-name-directory target))
(cmd (format "zip -rmTq %s %s" target-name ".")))
(cmds `(("zip" "-mX0" ,target-name "mimetype")
("zip" "-rmTq" ,target-name "."))))
(when (file-exists-p target)
;; FIXME: If the file is locked this throws a cryptic error
(delete-file target))
(let ((coding-system-for-write 'no-conversion) exitcode)
(message "Creating odt file using \"%s\"" cmd)
(setq exitcode
(apply 'call-process
"zip"
nil
nil
nil
(append (list "-rmTq") (list target-name "."))))
(or (zerop exitcode)
(error "Unable to create odt file (%S)" exitcode)))
(message "Creating odt file...")
(mapc
(lambda (cmd)
(message "Running %s" (mapconcat 'identity cmd " "))
(setq exitcode
(apply 'call-process (car cmd) nil nil nil (cdr cmd)))
(or (zerop exitcode)
(error "Unable to create odt file (%S)" exitcode)))
cmds))
;; move the file from outdir to target-dir
(rename-file target-name target-dir)
@ -1309,10 +1351,36 @@ MAY-INLINE-P allows inlining it as an image."
(message "Created %s" target)
(set-buffer (find-file-noselect target t)))
(defun org-odt-format-date (date)
(let ((warning-msg
"OpenDocument files require that dates be in ISO-8601 format. Please review your DATE options for compatibility."))
;; If the user is not careful with the date specification, an
;; invalid meta.xml will be emitted.
;; For now honor user's diktat and let him off with a warning
;; message. This is OK as LibreOffice (and possibly other
;; apps) doesn't deem this deviation as critical and continue
;; to load the file.
;; FIXME: Surely there a better way to handle this. Revisit this
;; later.
(cond
((and date (string-match "%" date))
;; Honor user's diktat. See comments above
(org-lparse-warn warning-msg)
(format-time-string date))
(date
;; Honor user's diktat. See comments above
(org-lparse-warn warning-msg)
date)
(t
;; ISO 8601 format
(format-time-string "%Y-%m-%dT%T%:z")))))
(defun org-odt-update-meta-file (opt-plist)
(with-current-buffer
(find-file-noselect (expand-file-name "meta.xml") t)
(let ((date (or (plist-get opt-plist :effective-date) ""))
(let ((date (org-odt-format-date (plist-get opt-plist :date)))
(author (or (plist-get opt-plist :author) ""))
(email (plist-get opt-plist :email))
(keywords (plist-get opt-plist :keywords))
@ -1367,7 +1435,7 @@ MAY-INLINE-P allows inlining it as an image."
'("bib" "doc" "doc6" "doc95" "html" "xhtml" "latex" "odt" "ott" "pdf" "rtf"
"sdw" "sdw3" "sdw4" "stw " "sxw" "mediawiki" "text" "txt" "uot" "vor"
"vor3" "vor4" "docbook" "ooxml" "ppt" "odp"))
(CONVERT-METHOD org-export-convert-process)
(CONVERT-METHOD org-lparse-convert-process)
(TOPLEVEL-HLEVEL 1)
(SPECIAL-STRING-REGEXPS org-export-odt-special-string-regexps)
(INLINE-IMAGES 'maybe)
@ -1375,6 +1443,8 @@ MAY-INLINE-P allows inlining it as an image."
(PLAIN-TEXT-MAP '(("&" . "&amp;") ("<" . "&lt;") (">" . "&gt;")))
(TABLE-FIRST-COLUMN-AS-LABELS nil)
(FOOTNOTE-SEPARATOR (org-lparse-format 'FONTIFY "," 'superscript))
(CODING-SYSTEM-FOR-WRITE 'utf-8)
(CODING-SYSTEM-FOR-SAVE 'utf-8)
(t (error "Unknown property: %s" what))))
(defun org-odt-parse-label (label)

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

@ -96,8 +96,8 @@ is copied from ansi-term method."
(let ((screen-buffer-name (org-screen-buffer-name name)))
(if (member screen-buffer-name
(mapcar 'buffer-name (buffer-list)))
(switch-to-buffer screen-buffer-name)
(switch-to-buffer (org-screen-helper name "-dr")))))
(org-pop-to-buffer-same-window screen-buffer-name)
(org-pop-to-buffer-same-window (org-screen-helper name "-dr")))))
(if org-link-abbrev-alist
(add-to-list 'org-link-abbrev-alist

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

@ -210,7 +210,7 @@ specified, then make `org-toc-recenter' use this value."
(defun org-toc-before-first-heading-p ()
"Before first heading?"
(save-excursion
(null (re-search-backward "^\\*+ " nil t))))
(null (re-search-backward org-outline-regexp-bol nil t))))
;;;###autoload
(defun org-toc-show (&optional depth position)
@ -220,13 +220,13 @@ specified, then make `org-toc-recenter' use this value."
(progn (setq org-toc-base-buffer (current-buffer))
(setq org-toc-odd-levels-only org-odd-levels-only))
(if (eq major-mode 'org-toc-mode)
(switch-to-buffer org-toc-base-buffer)
(org-pop-to-buffer-same-window org-toc-base-buffer)
(error "Not in an Org buffer")))
;; create the new window display
(let ((pos (or position
(save-excursion
(if (org-toc-before-first-heading-p)
(progn (re-search-forward "^\\*+ " nil t)
(progn (re-search-forward org-outline-regexp-bol nil t)
(match-beginning 0))
(point))))))
(setq org-toc-cycle-global-status org-cycle-global-status)
@ -342,13 +342,13 @@ If DELETE is non-nil, delete other windows when in the Org buffer."
"Toggle columns view in the Org buffer from Org TOC."
(interactive)
(let ((indirect-buffer (current-buffer)))
(switch-to-buffer org-toc-base-buffer)
(org-pop-to-buffer-same-window org-toc-base-buffer)
(if (not org-toc-columns-shown)
(progn (org-columns)
(setq org-toc-columns-shown t))
(progn (org-columns-remove-overlays)
(setq org-toc-columns-shown nil)))
(switch-to-buffer indirect-buffer)))
(org-pop-to-buffer-same-window indirect-buffer)))
(defun org-toc-info ()
"Show properties of current subtree in the echo-area."
@ -356,7 +356,7 @@ If DELETE is non-nil, delete other windows when in the Org buffer."
(let ((pos (point))
(indirect-buffer (current-buffer))
props prop msg)
(switch-to-buffer org-toc-base-buffer)
(org-pop-to-buffer-same-window org-toc-base-buffer)
(goto-char pos)
(setq props (org-entry-properties))
(while (setq prop (pop props))
@ -369,7 +369,7 @@ If DELETE is non-nil, delete other windows when in the Org buffer."
(setq p (concat p ":"))
(add-text-properties 0 (length p) '(face org-special-keyword) p)
(setq msg (concat msg p " " v " ")))))
(switch-to-buffer indirect-buffer)
(org-pop-to-buffer-same-window indirect-buffer)
(message msg)))
;;; Store and restore TOC configuration:
@ -441,7 +441,7 @@ status."
(goto-char (point-min))
(while (and (not (eobp))
(goto-char (next-overlay-change (point))))
(when (looking-at "^\\*+ ")
(when (looking-at org-outline-regexp-bol)
(add-to-list
'output
(cons (buffer-substring-no-properties

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

@ -279,7 +279,7 @@ If there is no last heading, return nil."
(org-velocity-edit-entry ',heading)
(progn
(message "%s" ,(org-velocity-heading-name heading))
(switch-to-buffer (marker-buffer
(org-pop-to-buffer-same-window (marker-buffer
,(org-velocity-heading-marker heading)))
(goto-char (marker-position
,(org-velocity-heading-marker heading)))))))
@ -681,7 +681,7 @@ Use method specified by `org-velocity-search-method'."
(read-string prompt))))
(remove-hook 'post-command-hook
'org-velocity-display-for-incremental))))
(if (bufferp res) (switch-to-buffer res) res)))
(if (bufferp res) (org-pop-to-buffer-same-window res) res)))
(defun org-velocity-read (arg &optional search)
"Read a search string SEARCH for Org-Velocity interface.

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

@ -155,7 +155,7 @@ setting of `org-wikinodes-create-targets'."
((stringp create)
;; Make new node in another file
(org-mark-ring-push (point))
(switch-to-buffer (find-file-noselect create))
(org-pop-to-buffer-same-window (find-file-noselect create))
(goto-char (point-max))
(or (bolp) (newline))
(insert "\n* " target "\n")

9
contrib/lisp/org-xhtml.el
View File

@ -943,7 +943,7 @@ that uses these same face definitions."
(when (and (symbolp f) (or (not i) (not (listp i))))
(insert (org-add-props (copy-sequence "1") nil 'face f))))
(htmlize-region (point-min) (point-max))))
(switch-to-buffer "*html*")
(org-pop-to-buffer-same-window "*html*")
(goto-char (point-min))
(if (re-search-forward "<style" nil t)
(delete-region (point-min) (match-beginning 0)))
@ -1194,6 +1194,9 @@ make any modifications to the exporter file. For example,
`org-xhtml-format-table-row' encloses incoming entity in <tr>
</tr> tags and returns it. See also `org-lparse-format'.")
;; register the xhtml exporter with org-lparse library
(org-lparse-register-backend 'xhtml)
(defun org-xhtml-begin-document-body (opt-plist)
(let ((link-up (and (plist-get opt-plist :link-up)
(string-match "\\S-" (plist-get opt-plist :link-up))
@ -1652,9 +1655,9 @@ lang=\"%s\" xml:lang=\"%s\">
(SAVE-METHOD nil)
(CLEANUP-METHOD nil)
(OTHER-BACKENDS
'("etext" "html" "html10" "mediawiki" "pdf" "sdw" "sdw3" "sdw4"
'("xhtml" "etext" "html" "html10" "mediawiki" "pdf" "sdw" "sdw3" "sdw4"
"text" "text10" "odt" "vor" "vor4"))
(CONVERT-METHOD org-export-convert-process)
(CONVERT-METHOD org-lparse-convert-process)
(EXPORT-DIR (org-export-directory :html opt-plist))
(FILE-NAME-EXTENSION (plist-get opt-plist :html-extension))
(EXPORT-BUFFER-NAME "*Org HTML Export*")

2
contrib/lisp/test-org-export-preproc.el
View File

@ -33,7 +33,7 @@
(plist-get export-plist :archived-trees-export)
:add-text (plist-get opt-plist :text)))))
(save-excursion
(switch-to-buffer "*preproc-temp*")
(org-pop-to-buffer-same-window "*preproc-temp*")
(point-max)
(insert string))))

1
contrib/odt/README.org
View File

@ -14,7 +14,6 @@
#+LINK_HOME:
#+XSLT:
* Summary
This package adds support for exporting of Orgmode files to

254
doc/org.texi
View File

@ -34,7 +34,7 @@
@c Below we define the following macros for Org key tables:
@c orgkey{key} A key item
@c orgkey{key} A key item
@c orgcmd{key,cmd} Key with command name
@c xorgcmd{key,cmmand} Key with command name as @itemx
@c orgcmdnki{key,cmd} Like orgcmd, but do not index the key
@ -880,15 +880,21 @@ make install
@end example
Installing Info files is system dependent, because of differences in the
@file{install-info} program. In Debian it copies the info files into the
correct directory and modifies the info directory file. In many other
systems, the files need to be copied to the correct directory separately, and
@file{install-info} then only modifies the directory file. Check your system
documentation to find out which of the following commands you need:
@file{install-info} program. The following should correctly install the Info
files on most systems, please send a bug report if not@footnote{The output
from install-info (if any) is also system dependent. In particular Debian
and its derivatives use two different versions of install-info and you may
see the message:
@example
This is not dpkg install-info anymore, but GNU install-info
See the man page for ginstall-info for command line arguments
@end example
@noindent which can be safely ignored.}.
@example
make install-info
make install-info-debian
@end example
Then add the following line to @file{.emacs}. It is needed so that
@ -1210,6 +1216,8 @@ but without affecting visibility in that buffer.}. With a numeric
prefix argument N, go up to level N and then take that tree. If N is
negative then go up that many levels. With a @kbd{C-u} prefix, do not remove
the previously used indirect buffer.
@orgcmd{C-c C-x v,org-copy-visible}
Copy the @i{visible} text in the region into the kill ring.
@end table
@vindex org-startup-folded
@ -1574,9 +1582,12 @@ structure of these lists, many structural constructs like @code{#+BEGIN_...}
blocks can be indented to signal that they belong to a particular item.
@vindex org-list-demote-modify-bullet
@vindex org-list-indent-offset
If you find that using a different bullet for a sub-list (than that used for
the current list-level) improves readability, customize the variable
@code{org-list-demote-modify-bullet}.
@code{org-list-demote-modify-bullet}. To get a greater difference of
indentation between items and theirs sub-items, customize
@code{org-list-indent-offset}.
@vindex org-list-automatic-rules
The following commands act on items when the cursor is in the first line of
@ -1618,17 +1629,21 @@ position.
@itemx S-@key{down}
@cindex shift-selection-mode
@vindex org-support-shift-select
Jump to the previous/next item in the current list, but only if
@vindex org-list-use-circular-motion
Jump to the previous/next item in the current list@footnote{If you want to
cycle around items that way, you may customize
@code{org-list-use-circular-motion}.}, but only if
@code{org-support-shift-select} is off. If not, you can still use paragraph
jumping commands like @kbd{C-@key{up}} and @kbd{C-@key{down}} to quite
similar effect.
@kindex M-S-@key{up}
@kindex M-S-@key{down}
@item M-S-@key{up}
@itemx M-S-@key{down}
Move the item including subitems up/down (swap with previous/next item
of same indentation). If the list is ordered, renumbering is
automatic.
@kindex M-@key{up}
@kindex M-@key{down}
@item M-@key{up}
@itemx M-@key{down}
Move the item including subitems up/down@footnote{See
@code{org-liste-use-circular-motion} for a cyclic behavior.} (swap with
previous/next item of same indentation). If the list is ordered, renumbering
is automatic.
@kindex M-@key{left}
@kindex M-@key{right}
@item M-@key{left}
@ -2482,7 +2497,6 @@ n3 s3 e2 f4 @r{Normal, scientific, engineering, or fixed}
D R @r{angle modes: degrees, radians}
F S @r{fraction and symbolic modes}
N @r{interpret all fields as numbers, use 0 for non-numbers}
T @r{force text interpretation}
E @r{keep empty fields in ranges}
L @r{literal}
@end example
@ -2519,6 +2533,9 @@ Calc also contains a complete set of logical operations. For example
if($1<20,teen,string("")) @r{"teen" if age $1 less than 20, else empty}
@end example
Note that you can also use two org-specific flags @code{T} and @code{t} for
durations computations @ref{Durations and time values}.
@node Formula syntax for Lisp, Durations and time values, Formula syntax for Calc, The spreadsheet
@subsection Emacs Lisp forms as formulas
@cindex Lisp forms, as table formulas
@ -2554,20 +2571,31 @@ embed them in list or vector syntax. Here are a few examples---note how the
@subsection Durations and time values
@cindex Duration, computing
@cindex Time, computing
@vindex org-table-duration-custom-format
If you want to compute time values use the @code{T} flag, either in Calc
formulas or Elisp formulas:
@example
@group
| Task 1 | Task 2 | Total |
|--------+--------+---------|
| 35:00 | 35:00 | 1:10:00 |
#+TBLFM: @@2$3=$1+$2;T
| Task 1 | Task 2 | Total |
|---------+----------+----------|
| 2:12 | 1:47 | 03:59:00 |
| 3:02:20 | -2:07:00 | 0.92 |
#+TBLFM: @@2$3=$1+$2;T::@@3$3=$1+$2;t
@end group
@end example
Values must be of the form @code{[HH:]MM:SS}, where hours are optional.
Input duration values must be of the form @code{[HH:MM[:SS]}, where seconds
are optional. With the @code{T} flag, computed durations will be displayed
as @code{[HH:MM:SS} (see the first formula above). With the @code{t} flag,
computed durations will be displayed according to the value of the variable
@code{org-table-duration-custom-format}, which defaults to @code{'hours} and
will display the result as a fraction of hours (see the second formula in the
example above).
Negative duration values can be manipulated as well, and integers will be
considered as seconds in addition and subtraction.
@node Field and range formulas, Column formulas, Durations and time values, The spreadsheet
@subsection Field and range formulas
@ -3886,7 +3914,7 @@ example:
* Parent
:PROPERTIES:
:ORDERED: t
:ORDERED: t
:END:
** TODO a
** TODO b, needs to wait for (a)
@ -5636,14 +5664,13 @@ an item:
@c
@orgcmd{C-c C-d,org-deadline}
Insert @samp{DEADLINE} keyword along with a stamp. The insertion will happen
in the line directly following the headline. When called with a prefix arg,
an existing deadline will be removed from the entry. Depending on the
variable @code{org-log-redeadline}@footnote{with corresponding
in the line directly following the headline. Any CLOSED timestamp will be
removed. When called with a prefix arg, an existing deadline will be removed
from the entry. Depending on the variable @code{org-log-redeadline}@footnote{with corresponding
@code{#+STARTUP} keywords @code{logredeadline}, @code{lognoteredeadline},
and @code{nologredeadline}}, a note will be taken when changing an existing
deadline.
@c FIXME Any CLOSED timestamp will be removed.????????
@c
@orgcmd{C-c C-s,org-schedule}
Insert @samp{SCHEDULED} keyword along with a stamp. The insertion will
happen in the line directly following the headline. Any CLOSED timestamp
@ -5678,6 +5705,11 @@ Sparse tree for deadlines and scheduled items before a given date.
Sparse tree for deadlines and scheduled items after a given date.
@end table
Note that @code{org-schedule} and @code{org-deadline} supports
setting the date by indicating a relative time: e.g. +1d will set
the date to the next day after today, and --1w will set the date
to the previous week before any current timestamp.
@node Repeated tasks, , Inserting deadline/schedule, Deadlines and scheduling
@subsection Repeated tasks
@cindex tasks, repeated
@ -5846,6 +5878,9 @@ Update the effort estimate for the current clock task.
Recompute the time interval after changing one of the timestamps. This
is only necessary if you edit the timestamps directly. If you change
them with @kbd{S-@key{cursor}} keys, the update is automatic.
@orgcmd{C-S-@key{up/down},org-clock-timestamps-up/down}
On @code{CLOCK} log lines, increase/decrease both timestamps at the same
time so that duration keeps the same.
@orgcmd{C-c C-t,org-todo}
Changing the TODO state of an item to DONE automatically stops the clock
if it is running in this same item.
@ -6360,14 +6395,14 @@ like this:
@subsubsection Template elements
Now lets look at the elements of a template definition. Each entry in
@code{org-capture-templates} is a list with the following items:
@code{org-capture-templates} is a list with the following items:
@table @var
@item keys
The keys that will select the template, as a string, characters
only, for example @code{"a"} for a template to be selected with a
single key, or @code{"bt"} for selection with two keys. When using
several keys, keys using the same prefix key must be sequential
several keys, keys using the same prefix key must be sequential
in the list and preceded by a 2-element entry explaining the
prefix key, for example
@example
@ -6502,40 +6537,39 @@ buffer again after capture is completed.
In the template itself, special @kbd{%}-escapes@footnote{If you need one of
these sequences literally, escape the @kbd{%} with a backslash.} allow
dynamic insertion of content:
dynamic insertion of content. The templates are expanded in the order given here:
@comment SJE: should these sentences terminate in period?
@smallexample
%^@{@var{prompt}@} @r{prompt the user for a string and replace this sequence with it.}
@r{You may specify a default value and a completion table with}
@r{%^@{prompt|default|completion2|completion3...@}}
@r{The arrow keys access a prompt-specific history.}
%a @r{annotation, normally the link created with @code{org-store-link}}
%A @r{like @code{%a}, but prompt for the description part}
%[@var{file}] @r{insert the contents of the file given by @var{file}.}
%(@var{sexp}) @r{evaluate Elisp @var{sexp} and replace with the result.}
%<...> @r{the result of format-time-string on the ... format specification.}
%t @r{timestamp, date only.}
%T @r{timestamp with date and time.}
%u, %U @r{like the above, but inactive timestamps.}
%a @r{annotation, normally the link created with @code{org-store-link}.}
%i @r{initial content, the region when capture is called while the}
@r{region is active.}
@r{The entire text will be indented like @code{%i} itself.}
%t @r{timestamp, date only}
%T @r{timestamp with date and time}
%u, %U @r{like the above, but inactive timestamps}
%^t @r{like @code{%t}, but prompt for date. Similarly @code{%^T}, @code{%^u}, @code{%^U}}
@r{You may define a prompt like @code{%^@{Birthday@}t}}
%<...> @r{the result of format-time-string on the ... format specification}
%n @r{user name (taken from @code{user-full-name})}
%A @r{like @code{%a}, but prompt for the description part.}
%c @r{Current kill ring head.}
%x @r{Content of the X clipboard.}
%^C @r{Interactive selection of which kill or clip to use.}
%^L @r{Like @code{%^C}, but insert as link.}
%k @r{title of the currently clocked task}
%K @r{link to the currently clocked task}
%f @r{file visited by current buffer when org-capture was called}
%F @r{like @code{%f}, but include full path}
%k @r{title of the currently clocked task.}
%K @r{link to the currently clocked task.}
%n @r{user name (taken from @code{user-full-name}).}
%f @r{file visited by current buffer when org-capture was called.}
%F @r{full path of the file or directory visited by current buffer.}
%:keyword @r{specific information for certain link types, see below.}
%^g @r{prompt for tags, with completion on tags in target file.}
%^G @r{prompt for tags, with completion all tags in all agenda files.}
%^@{@var{prop}@}p @r{Prompt the user for a value for property @var{prop}}
%:keyword @r{specific information for certain link types, see below}
%[@var{file}] @r{insert the contents of the file given by @var{file}}
%(@var{sexp}) @r{evaluate Elisp @var{sexp} and replace with the result}
%^t @r{like @code{%t}, but prompt for date. Similarly @code{%^T}, @code{%^u}, @code{%^U}.}
@r{You may define a prompt like @code{%^@{Birthday@}t}.}
%^C @r{Interactive selection of which kill or clip to use.}
%^L @r{Like @code{%^C}, but insert as link.}
%^@{@var{prop}@}p @r{Prompt the user for a value for property @var{prop}.}
%^@{@var{prompt}@} @r{prompt the user for a string and replace this sequence with it.}
@r{You may specify a default value and a completion table with}
@r{%^@{prompt|default|completion2|completion3...@}.}
@r{The arrow keys access a prompt-specific history.}
@end smallexample
@noindent
@ -8947,7 +8981,7 @@ further details.}. This is done with the @samp{src} block, where you also
need to specify the name of the major mode that should be used to fontify the
example@footnote{Code in @samp{src} blocks may also be evaluated either
interactively or on export. See @pxref{Working With Source Code} for more
information on evaluating code blocks.}:
information on evaluating code blocks.}:
@cindex #+BEGIN_SRC
@example
@ -9426,7 +9460,7 @@ or to exclude parts from export. This behavior is governed by two variables:
@code{org-export-select-tags} and @code{org-export-exclude-tags}.
@enumerate
@item
@item
Org first checks if any of the @emph{select} tags is present in the
buffer. If yes, all trees that do not carry one of these tags will be
excluded. If a selected tree is a subtree, the heading hierarchy above it
@ -9751,10 +9785,14 @@ The HTML exporter lets you define a preamble and a postamble.
The default value for @code{org-export-html-preamble} is @code{t}, which
means that the preamble is inserted depending on the relevant formatting
string in @code{org-export-html-preamble-format}. Setting
@code{org-export-html-preamble} to a string will override the default
string in @code{org-export-html-preamble-format}.
Setting @code{org-export-html-preamble} to a string will override the default
formatting string. Setting it to a function, will insert the output of the
function. Setting to @code{nil} will not insert any preamble.
function, which must be a string; such a function takes no argument but you
can check against the value of @code{opt-plist}, which contains the list of
publishing properties for the current file. Setting to @code{nil} will not
insert any preamble.
The default value for @code{org-export-html-postamble} is @code{'auto}, which
means that the HTML exporter will look for the value of
@ -10120,7 +10158,7 @@ title. If the tree head entry has or inherits an @code{EXPORT_FILE_NAME}
property, that name will be used for the export.
@orgcmd{C-c C-e L,org-export-as-latex-to-buffer}
Export to a temporary buffer. Do not create a file.
@item C-c C-e v l/L
@item C-c C-e v l/L
Export only the visible part of the document.
@item M-x org-export-region-as-latex
Convert the region to @LaTeX{} under the assumption that it was Org-mode
@ -10721,12 +10759,12 @@ following methods:
Export the outline first to one of the native formats (like OpenDocumentText)
and immediately post-process it to other formats using an external converter.
@item M-x org-export-convert
@item M-x org-lparse-convert
Export an existing document to other formats using an external converter.
@end table
You can choose the converter used for conversion by customizing the variable
@code{org-export-convert-process}.
@code{org-lparse-convert-process}.
@node Links in OpenDocumentText export, Tables in OpenDocumentText export, Converting to Other formats, OpenDocumentText export
@subsection Links in OpenDocumentText export
@ -10760,16 +10798,15 @@ been standardized yet and is hence conveniently skipped in this document.
The exporter can also make an image the clickable part of a link. To create
clickable images, provide a link whose description is a link to an image
file. For example, the following link
@samp{[[http://Orgmode.org][./img.jpg]]}, will result in a clickable image
@samp{[[http://orgmode.org][./img.jpg]]}, will result in a clickable image
that links to @uref{http://Orgmode.org} website.
@node Additional Documentation, , Images in OpenDocumentText export, OpenDocumentText export
@subsection Additional Documentation
@subsection Additional documentation
OpenDocumentText exporter is a beta software and is quickly evolving. So the
documentation in this section of the manual should not be considered as
authoritative. For up to date information, you are requested to follow the
Org mailing list @email{emacs-orgmode@@gnu.org} closely.
The OpenDocumentText exporter is still in development. For up to date
information, please follow Org mailing list @email{emacs-orgmode@@gnu.org}
closely.
@c end opendocument
@ -10910,7 +10947,7 @@ The Freemind exporter was written by Lennart Borgman.
@table @kbd
@orgcmd{C-c C-e m,org-export-as-freemind}
Export as Freemind mind map. For an Org file @file{myfile.org}, the Freemind
Export as Freemind mind map. For an Org file @file{myfile.org}, the Freemind
file will be @file{myfile.mm}.
@end table
@ -10924,7 +10961,7 @@ does not interpret any additional Org-mode features.
@table @kbd
@orgcmd{C-c C-e x,org-export-as-xoxo}
Export as XOXO file. For an Org file @file{myfile.org}, the XOXO file will be
Export as XOXO file. For an Org file @file{myfile.org}, the XOXO file will be
@file{myfile.html}.
@orgkey{C-c C-e v x}
Export only the visible part of the document.
@ -11049,7 +11086,7 @@ variable, called @code{org-publish-project-alist}. Each element of the list
configures one project, and may be in one of the two following forms:
@lisp
("project-name" :property value :property value ...)
("project-name" :property value :property value ...)
@r{i.e.@: a well-formed property list with alternating keys and values}
@r{or}
("project-name" :components ("project-name" "project-name" ...))
@ -11376,7 +11413,7 @@ a sitemap entry's date is to be formated. This property bypasses
@code{org-publish-sitemap-date-format} which defaults to @code{%Y-%m-%d}.
@item @code{:sitemap-sans-extension}
@tab When non-nil, remove filenames' extensions from the generated sitemap.
@tab When non-nil, remove filenames' extensions from the generated sitemap.
Useful to have cool URIs (see @uref{http://www.w3.org/Provider/Style/URI}).
Defaults to @code{nil}.
@ -11558,7 +11595,7 @@ e.g.@:
Org-mode provides a number of features for working with live source code,
including editing of code blocks in their native major-mode, evaluation of
code blocks, converting code blocks into source files (known as @dfn{tangling}
code blocks, converting code blocks into source files (known as @dfn{tangling}
in literate programming), and exporting code blocks and their
results in several formats. This functionality was contributed by Eric
Schulte and Dan Davison, and was originally named Org-babel.
@ -11626,7 +11663,7 @@ Optional switches controlling exportation of the code block (see switches discus
@ref{Literal examples})
@item <header arguments>
Optional header arguments control many aspects of evaluation, export and
tangling of code blocks. See the @ref{Header arguments}.
tangling of code blocks. See the @ref{Header arguments}.
Header arguments can also be set on a per-buffer or per-subtree
basis using properties.
@item <body>
@ -11706,7 +11743,7 @@ Both the code block and its results will be exported.
Neither the code block nor its results will be exported.
@end table
It is possible to inhibit the evaluation of code blocks during export.
It is possible to inhibit the evaluation of code blocks during export.
Setting the @code{org-export-babel-evaluate} variable to @code{nil} will
ensure that no code blocks are evaluated as part of the export process. This
can be useful in situations where potentially untrusted Org-mode files are
@ -11742,7 +11779,7 @@ Include the code block in the tangled output to file @samp{filename}.
@kindex C-c C-v t
@subsubheading Functions
@table @code
@item org-babel-tangle
@item org-babel-tangle
Tangle the current file. Bound to @kbd{C-c C-v t}.
@item org-babel-tangle-file
Choose a file to tangle. Bound to @kbd{C-c C-v f}.
@ -11751,7 +11788,7 @@ Choose a file to tangle. Bound to @kbd{C-c C-v f}.
@subsubheading Hooks
@table @code
@item org-babel-post-tangle-hook
This hook is run from within code files tangled by @code{org-babel-tangle}.
This hook is run from within code files tangled by @code{org-babel-tangle}.
Example applications could include post-processing, compilation or evaluation
of tangled code files.
@end table
@ -11846,7 +11883,7 @@ For more examples of passing header arguments to @code{#+call:} lines see
The ``Library of Babel'' is a library of code blocks
that can be called from any Org-mode file. The library is housed in an
Org-mode file located in the @samp{contrib} directory of Org-mode.
Org-mode file located in the @samp{contrib} directory of Org-mode.
Org-mode users can deposit functions they believe to be generally
useful in the library.
@ -11869,14 +11906,16 @@ Code blocks in the following languages are supported.
@multitable @columnfractions 0.28 0.3 0.22 0.2
@item @b{Language} @tab @b{Identifier} @tab @b{Language} @tab @b{Identifier}
@item Asymptote @tab asymptote @tab Emacs Calc @tab calc
@item C @tab C @tab C++ @tab C++
@item Clojure @tab clojure @tab CSS @tab css
@item ditaa @tab ditaa @tab Graphviz @tab dot
@item Emacs Lisp @tab emacs-lisp @tab gnuplot @tab gnuplot
@item Haskell @tab haskell @tab Javascript @tab js
@item LaTeX @tab latex @tab Ledger @tab ledger
@item Lisp @tab lisp @tab MATLAB @tab matlab
@item Asymptote @tab asymptote @tab Awk @tab awk
@item Emacs Calc @tab calc @tab C @tab C
@item C++ @tab C++ @tab Clojure @tab clojure
@item CSS @tab css @tab ditaa @tab ditaa
@item Graphviz @tab dot @tab Emacs Lisp @tab emacs-lisp
@item gnuplot @tab gnuplot @tab Haskell @tab haskell
@item Java @tab java @tab @tab
@item Javascript @tab js @tab LaTeX @tab latex
@item Ledger @tab ledger @tab Lisp @tab lisp
@item Lilypond @tab lilypond @tab MATLAB @tab matlab
@item Mscgen @tab mscgen @tab Objective Caml @tab ocaml
@item Octave @tab octave @tab Org-mode @tab org
@item Oz @tab oz @tab Perl @tab perl
@ -12044,7 +12083,7 @@ in Org-mode documents.
The most common way to assign values to header arguments is at the
code block level. This can be done by listing a sequence of header
arguments and their values as part of the @code{#+begin_src} line.
arguments and their values as part of the @code{#+begin_src} line.
Properties set in this way override both the values of
@code{org-babel-default-header-args} and header arguments specified as
properties. In the following example, the @code{:results} header argument
@ -12152,7 +12191,7 @@ Additional header arguments are defined on a language-specific basis, see
@node var, results, Specific header arguments, Specific header arguments
@subsubsection @code{:var}
The @code{:var} header argument is used to pass arguments to code blocks.
The @code{:var} header argument is used to pass arguments to code blocks.
The specifics of how arguments are included in a code block vary by language;
these are addressed in the language-specific documentation. However, the
syntax used to specify arguments is the same across all languages. The
@ -12310,7 +12349,7 @@ column is referenced.
| 1 | 2 | 3 | 4 |
@end example
It is possible to index into the results of code blocks as well as tables.
It is possible to index into the results of code blocks as well as tables.
Any number of dimensions can be indexed. Dimensions are separated from one
another by commas, as shown in the following example.
@ -12408,7 +12447,7 @@ table or scalar depending on their value.
@itemize @bullet
@item @code{table}, @code{vector}
The results should be interpreted as an Org-mode table. If a single value is
returned, it will be converted into a table with one row and one column.
returned, it will be converted into a table with one row and one column.
E.g., @code{:results value table}.
@item @code{list}
The results should be interpreted as an Org-mode list. If a single scalar
@ -12428,10 +12467,10 @@ such by Org-mode. E.g., @code{:results value raw}.
Results are assumed to be HTML and will be enclosed in a @code{begin_html}
block. E.g., @code{:results value html}.
@item @code{latex}
Results assumed to be LaTeX and are enclosed in a @code{begin_latex} block.
Results assumed to be LaTeX and are enclosed in a @code{begin_latex} block.
E.g., @code{:results value latex}.
@item @code{code}
Result are assumed to be parseable code and are enclosed in a code block.
Result are assumed to be parseable code and are enclosed in a code block.
E.g., @code{:results value code}.
@item @code{pp}
The result is converted to pretty-printed code and is enclosed in a code
@ -12581,7 +12620,7 @@ The code block is exported to a source code file named after the full path
(including the directory) and file name (w/o extension) of the Org-mode file.
E.g., @code{:tangle yes}.
@item @code{no}
The default. The code block is not exported to a source code file.
The default. The code block is not exported to a source code file.
E.g., @code{:tangle no}.
@item other
Any other string passed to the @code{:tangle} header argument is interpreted
@ -12957,6 +12996,10 @@ dangerous code blocks. @code{:eval query} will require a query for every
execution of a code block regardless of the value of the
@code{org-confirm-babel-evaluate} variable.
If this header argument is not set then evaluation is determined by the value
of the @code{org-confirm-babel-evaluate} variable see @ref{Code evaluation
security}.
@node Results of evaluation, Noweb reference syntax, Header arguments, Working With Source Code
@section Results of evaluation
@cindex code block, results of evaluation
@ -14108,7 +14151,7 @@ To use org-crypt it is suggested that you have the following in your
(setq auto-save-default nil)
;; Auto-saving does not cooperate with org-crypt.el: so you need
;; to turn it off if you plan to use org-crypt.el quite often.
;; Otherwise, you'll get an (annoying) message each time you
;; Otherwise, you'll get an (annoying) message each time you
;; start Org.
;; To turn it off only locally, you can insert this:
@ -14765,25 +14808,25 @@ particular, you may use the functions @code{org-agenda-skip-entry-if}
and @code{org-agenda-skip-subtree-if} in this form, for example:
@table @code
@item '(org-agenda-skip-entry-if 'scheduled)
@item (org-agenda-skip-entry-if 'scheduled)
Skip current entry if it has been scheduled.
@item '(org-agenda-skip-entry-if 'notscheduled)
@item (org-agenda-skip-entry-if 'notscheduled)
Skip current entry if it has not been scheduled.
@item '(org-agenda-skip-entry-if 'deadline)
@item (org-agenda-skip-entry-if 'deadline)
Skip current entry if it has a deadline.
@item '(org-agenda-skip-entry-if 'scheduled 'deadline)
@item (org-agenda-skip-entry-if 'scheduled 'deadline)
Skip current entry if it has a deadline, or if it is scheduled.
@item '(org-agenda-skip-entry-if 'todo '("TODO" "WAITING"))
@item (org-agenda-skip-entry-if 'todo '("TODO" "WAITING"))
Skip current entry if the TODO keyword is TODO or WAITING.
@item '(org-agenda-skip-entry-if 'todo 'done)
@item (org-agenda-skip-entry-if 'todo 'done)
Skip current entry if the TODO keyword marks a DONE state.
@item '(org-agenda-skip-entry-if 'timestamp)
@item (org-agenda-skip-entry-if 'timestamp)
Skip current entry if it has any timestamp, may also be deadline or scheduled.
@item '(org-agenda-skip-entry 'regexp "regular expression")
@item (org-agenda-skip-entry 'regexp "regular expression")
Skip current entry if the regular expression matches in the entry.
@item '(org-agenda-skip-entry 'notregexp "regular expression")
@item (org-agenda-skip-entry 'notregexp "regular expression")
Skip current entry unless the regular expression matches.
@item '(org-agenda-skip-subtree-if 'regexp "regular expression")
@item (org-agenda-skip-subtree-if 'regexp "regular expression")
Same as above, but check and skip the entire subtree.
@end table
@ -15019,6 +15062,7 @@ SCOPE determines the scope of this command. It can be any of:
@example
nil @r{the current buffer, respecting the restriction if any}
tree @r{the subtree started with the entry at point}
region @r{The entries within the active region, if any}
file @r{the current buffer, without restriction}
file-with-archives
@r{the current buffer, and any archives associated with it}

2
doc/orgcard.tex
View File

@ -309,6 +309,7 @@ are preserved on all copies.
\metax{move subtree/list item up/down}{M-S-UP/DOWN}
\metax{sort subtree/region/plain-list}{C-c \^{}}
\metax{clone a subtree}{C-c C-x c}
\metax{copy visible text}{C-c C-x v}
\metax{kill/copy subtree}{C-c C-x C-w/M-w}
\metax{yank subtree}{C-c C-x C-y or C-y}
\metax{narrow buffer to subtree / widen}{C-x n s/w}
@ -445,6 +446,7 @@ formula, \kbd{:=} a field formula.
\key{open results of code block at point}{C-c C-o}
\key{check code block at point for errors}{C-c C-v c}
\key{view expanded body of code block at point}{C-c C-v v}
\key{view information about code block at point}{C-c C-v I}
\key{go to named code block}{C-c C-v g}
\key{go to named result}{C-c C-v r}
\key{go to the head of the current code block}{C-c C-v u}

7
lisp/ob-awk.el
View File

@ -26,8 +26,7 @@
;;; Commentary:
;; Babel's awk support relies on two special header argument one of
;; which is required to pass data to the awk process.
;; Babel's awk can use special header argument:
;;
;; - :in-file takes a path to a file of data to be processed by awk
;;
@ -82,17 +81,17 @@ called by `org-babel-execute-src-block'"
((lambda (results)
(when results
(if (or (member "scalar" result-params)
(member "verbatim" result-params)
(member "output" result-params))
results
(let ((tmp (org-babel-temp-file "awk-results-")))
(with-temp-file tmp (insert results))
(org-babel-import-elisp-from-file tmp)))))
(cond
(in-file (org-babel-eval cmd ""))
(stdin (with-temp-buffer
(call-process-shell-command cmd stdin (current-buffer))
(buffer-string)))
(t (error "ob-awk: must specify either :in-file or :stdin"))))
(t (org-babel-eval cmd ""))))
(org-babel-pick-name
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name

32
lisp/ob-clojure.el
View File

@ -62,28 +62,32 @@
vars "\n ")
"]\n" body ")")
body))))
(if (or (member "code" result-params)
(member "pp" result-params))
(format
(concat
"(let [org-mode-print-catcher (java.io.StringWriter.)] "
"(clojure.pprint/with-pprint-dispatch clojure.pprint/%s-dispatch "
"(clojure.pprint/pprint (do %s) org-mode-print-catcher) "
"(str org-mode-print-catcher)))")
(if (member "code" result-params) "code" "simple") body)
body)))
(cond ((or (member "code" result-params) (member "pp" result-params))
(format (concat "(let [org-mode-print-catcher (java.io.StringWriter.)] "
"(clojure.pprint/with-pprint-dispatch clojure.pprint/%s-dispatch "
"(clojure.pprint/pprint (do %s) org-mode-print-catcher) "
"(str org-mode-print-catcher)))")
(if (member "code" result-params) "code" "simple") body))
;; if (:results output), collect printed output
((member "output" result-params)
(format "(clojure.core/with-out-str %s)" body))
(t body))))
(defun org-babel-execute:clojure (body params)
"Execute a block of Clojure code with Babel."
(require 'slime) (require 'swank-clojure)
(with-temp-buffer
(insert (org-babel-expand-body:clojure body params))
((lambda (result) (condition-case nil
(read (org-babel-script-escape result 'force))
(error result)))
((lambda (result)
(let ((result-params (cdr (assoc :result-params params))))
(if (or (member "scalar" result-params)
(member "verbatim" result-params))
result
(condition-case nil (org-babel-script-escape result)
(error result)))))
(slime-eval
`(swank:interactive-eval-region
,(buffer-substring-no-properties (point-min) (point-max)))
,(buffer-substring-no-properties (point-min) (point-max)))
(cdr (assoc :package params))))))
(provide 'ob-clojure)

4
lisp/ob-exp.el
View File

@ -243,9 +243,7 @@ This function is called by `org-babel-exp-do-export'. The code
block will be evaluated. Optional argument SILENT can be used to
inhibit insertion of results into the buffer."
(when (and org-export-babel-evaluate
(not (and hash
(equal hash (org-babel-exp-in-export-file (nth 0 info)
(org-babel-result-hash info))))))
(not (and hash (equal hash (org-babel-current-result-hash)))))
(let ((lang (nth 0 info))
(body (nth 1 info)))
;; skip code blocks which we can't evaluate

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

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

2
lisp/ob-keys.el
View File

@ -79,6 +79,8 @@ functions which are assigned key bindings, and see
("l" . org-babel-load-in-session)
("\C-i" . org-babel-lob-ingest)
("i" . org-babel-lob-ingest)
("\C-I" . org-babel-view-src-block-info)
("I" . org-babel-view-src-block-info)
("\C-z" . org-babel-switch-to-session)
("z" . org-babel-switch-to-session-with-code)
("\C-a" . org-babel-sha1-hash)

15
lisp/ob-lilypond.el
View File

@ -30,9 +30,16 @@
;;; Code:
(require 'ob)
(require 'ob-eval)
(require 'ob-tangle)
(defalias 'lilypond-mode 'LilyPond-mode)
(declare-function show-all "outline" ())
(add-to-list 'org-babel-tangle-lang-exts '("LilyPond" . "ly"))
(defvar org-babel-default-header-args:lilypond '()
"Default header arguments for js code blocks.")
(defconst ly-version "0.3"
"The version number of the file ob-lilypond.el.")
@ -137,10 +144,10 @@ specific arguments to =org-babel-tangle="
(out-file (cdr (assoc :file params)))
(cmdline (or (cdr (assoc :cmdline params))
""))
(in-file (org-babel-temp-file "dot-")))
(in-file (org-babel-temp-file "lilypond-")))
(with-temp-file in-file
(insert (org-babel-expand-body:dot body params)))
(insert (org-babel-expand-body:generic body params)))
(org-babel-eval
(concat
@ -404,9 +411,9 @@ If TEST is non-nil, it contains a simulation of the OS for test purposes"
(defun ly-version (&optional insert-at-point)
(interactive)
(setq version (format "ob-lilypond version %s" ly-version))
(let ((version (format "ob-lilypond version %s" ly-version)))
(when insert-at-point (insert version))
(message version))
(message version)))
(defun ly-switch-extension (file-name ext)
"Utility command to swap current FILE-NAME extension with EXT"

4
lisp/ob-maxima.el
View File

@ -1,4 +1,4 @@
;;; org-babel-maxima.el --- org-babel functions for maxima evaluation
;;; ob-maxima.el --- org-babel functions for maxima evaluation
;; Copyright (c) 2009, 2010, 2011 Eric S Fraga, Eric Schulte
@ -77,4 +77,4 @@ called by `org-babel-execute-src-block'."
;; arch-tag: d86c97ac-7eab-4349-8d8b-302dd09779a8
;;; org-babel-maxima.el ends here
;;; ob-maxima.el ends here

4
lisp/ob-ref.el
View File

@ -60,6 +60,8 @@
(declare-function org-narrow-to-subtree "org" ())
(declare-function org-id-find-id-in-file "org-id" (id file &optional markerp))
(declare-function org-show-context "org" (&optional key))
(declare-function org-pop-to-buffer-same-window
"org-compat" (&optional buffer-or-name norecord label))
(defvar org-babel-ref-split-regexp
"[ \f\t\n\r\v]*\\(.+?\\)[ \f\t\n\r\v]*=[ \f\t\n\r\v]*\\(.+\\)[ \f\t\n\r\v]*")
@ -93,7 +95,7 @@ the variable."
(m (when file (org-id-find-id-in-file id file 'marker))))
(when (and file m)
(message "file:%S" file)
(switch-to-buffer (marker-buffer m))
(org-pop-to-buffer-same-window (marker-buffer m))
(goto-char m)
(move-marker m nil)
(org-show-context)

1
lisp/ob-sh.el
View File

@ -143,6 +143,7 @@ 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-")))

1
lisp/ob-sqlite.el
View File

@ -89,6 +89,7 @@ This function is called by `org-babel-execute-src-block'."
;; body of the code block
(org-babel-expand-body:sqlite body params)))
(if (or (member "scalar" result-params)
(member "verbatim" result-params)
(member "html" result-params)
(member "code" result-params)
(equal (point-min) (point-max)))

52
lisp/ob.el
View File

@ -250,6 +250,34 @@ then run `org-babel-execute-src-block'."
(progn (org-babel-eval-wipe-error-buffer)
(org-babel-execute-src-block current-prefix-arg info) t) nil)))
;;;###autoload
(defun org-babel-view-src-block-info ()
"Display information on the current source block.
This includes header arguments, language and name, and is largely
a window into the `org-babel-get-src-block-info' function."
(interactive)
(let ((info (org-babel-get-src-block-info 'light)))
(flet ((full (it) (> (length it) 0))
(printf (fmt &rest args) (princ (apply #'format fmt args))))
(when info
(with-help-window (help-buffer)
(let ((name (nth 4 info))
(lang (nth 0 info))
(switches (nth 3 info))
(header-args (nth 2 info)))
(when name (printf "Name: %s\n" name))
(when lang (printf "Lang: %s\n" lang))
(when (full switches) (printf "Switches: %s\n" switches))
(printf "Header Arguments:\n")
(dolist (pair (sort header-args
(lambda (a b) (string< (symbol-name (car a))
(symbol-name (car b))))))
(when (full (cdr pair))
(printf "\t%S%s\t%s\n"
(car pair)
(if (> (length (format "%S" (car pair))) 7) "" "\t")
(cdr pair))))))))))
;;;###autoload
(defun org-babel-expand-src-block-maybe ()
"Conditionally expand a source block.
@ -373,7 +401,7 @@ block."
(string= "yes" (cdr (assoc :cache params)))))
(result-params (cdr (assoc :result-params params)))
(new-hash (when cache? (org-babel-sha1-hash info)))
(old-hash (when cache? (org-babel-result-hash info)))
(old-hash (when cache? (org-babel-current-result-hash)))
(body (setf (nth 1 info)
(let ((noweb (cdr (assoc :noweb params))))
(if (and noweb
@ -754,7 +782,7 @@ the current subtree."
(setq lst (remove p lst)))
lst)
(norm (arg)
(let ((v (if (listp (cdr arg))
(let ((v (if (and (listp (cdr arg)) (null (cddr arg)))
(copy-seq (cdr arg))
(cdr arg))))
(when (and v (not (and (sequencep v)
@ -782,9 +810,9 @@ the current subtree."
(nth 1 info))))
(sha1 it))))))
(defun org-babel-result-hash (&optional info)
(defun org-babel-current-result-hash ()
"Return the in-buffer hash associated with INFO."
(org-babel-where-is-src-block-result nil info)
(org-babel-where-is-src-block-result)
(org-babel-clean-text-properties (match-string 3)))
(defun org-babel-hide-hash ()
@ -957,7 +985,12 @@ may be specified in the current buffer."
(lang (org-babel-clean-text-properties (match-string 2)))
(lang-headers (intern (concat "org-babel-default-header-args:" lang)))
(switches (match-string 3))
(body (org-babel-clean-text-properties (match-string 5)))
(body (org-babel-clean-text-properties
(let* ((body (match-string 5))
(sub-length (- (length body) 1)))
(if (string= "\n" (substring body sub-length))
(substring body 0 sub-length)
body))))
(preserve-indentation (or org-src-preserve-indentation
(string-match "-i\\>" switches))))
(list lang
@ -1723,7 +1756,7 @@ Later elements of PLISTS override the values of previous elements.
This takes into account some special considerations for certain
parameters when merging lists."
(let ((results-exclusive-groups
'(("file" "list" "vector" "table" "scalar" "raw" "org"
'(("file" "list" "vector" "table" "scalar" "verbatim" "raw" "org"
"html" "latex" "code" "pp" "wrap")
("replace" "silent" "append" "prepend")
("output" "value")))
@ -1943,7 +1976,8 @@ block but are passed literally to the \"example-block\"."
(defun org-babel-strip-protective-commas (body)
"Strip protective commas from bodies of source blocks."
(replace-regexp-in-string "^,#" "#" body))
(when body
(replace-regexp-in-string "^,#" "#" body)))
(defun org-babel-script-escape (str &optional force)
"Safely convert tables into elisp lists."
@ -1955,7 +1989,9 @@ block but are passed literally to the \"example-block\"."
(or (and (string-equal "[" (substring str 0 1))
(string-equal "]" (substring str -1)))
(and (string-equal "{" (substring str 0 1))
(string-equal "}" (substring str -1))))))
(string-equal "}" (substring str -1)))
(and (string-equal "(" (substring str 0 1))
(string-equal ")" (substring str -1))))))
(org-babel-read
(concat
"'"

129
lisp/org-agenda.el
View File

@ -61,6 +61,9 @@
(declare-function org-is-habit-p "org-habit" (&optional pom))
(declare-function org-habit-parse-todo "org-habit" (&optional pom))
(declare-function org-habit-get-priority "org-habit" (habit &optional moment))
(declare-function org-pop-to-buffer-same-window "org-compat"
(&optional buffer-or-name norecord label))
(defvar calendar-mode-map)
(defvar org-clock-current-task) ; defined in org-clock.el
(defvar org-mobile-force-id-on-agenda-items) ; defined in org-mobile.el
@ -1388,34 +1391,31 @@ When nil, such items are sorted as 0 minutes effort."
(tags . " %i %-12:c")
(search . " %i %-12:c"))
"Format specifications for the prefix of items in the agenda views.
An alist with four entries, for the different agenda types. The keys to the
sublists are `agenda', `timeline', `todo', `search' and `tags'. The values
are format strings.
An alist with five entries, each for the different agenda types. The
keys of the sublists are `agenda', `timeline', `todo', `search' and `tags'.
The values are format strings.
This format works similar to a printf format, with the following meaning:
%c the category of the item, \"Diary\" for entries from the diary, or
as given by the CATEGORY keyword or derived from the file name.
%i the icon category of the item, as give in
`org-agenda-category-icon-alist'.
%T the *last* tag of the item. Last because inherited tags come
first in the list.
%t the time-of-day specification if one applies to the entry, in the
format HH:MM
%c the category of the item, \"Diary\" for entries from the diary,
or as given by the CATEGORY keyword or derived from the file name
%i the icon category of the item, see `org-agenda-category-icon-alist'
%T the last tag of the item (ignore inherited tags, which come first)
%t the HH:MM time-of-day specification if one applies to the entry
%s Scheduling/Deadline information, a short string
%(expression) Eval EXPRESSION and replace the control string
by the result
All specifiers work basically like the standard `%s' of printf, but may
contain two additional characters: A question mark just after the `%' and
a whitespace/punctuation character just before the final letter.
contain two additional characters: a question mark just after the `%'
and a whitespace/punctuation character just before the final letter.
If the first character after `%' is a question mark, the entire field
will only be included if the corresponding value applies to the
current entry. This is useful for fields which should have fixed
width when present, but zero width when absent. For example,
\"%?-12t\" will result in a 12 character time field if a time of the
day is specified, but will completely disappear in entries which do
not contain a time.
will only be included if the corresponding value applies to the current
entry. This is useful for fields which should have fixed width when
present, but zero width when absent. For example, \"%?-12t\" will
result in a 12 character time field if a time of the day is specified,
but will completely disappear in entries which do not contain a time.
If there is punctuation or whitespace character just before the final
format letter, this character will be appended to the field value if
@ -1423,19 +1423,16 @@ the value is not empty. For example, the format \"%-12:c\" leads to
\"Diary: \" if the category is \"Diary\". If the category were be
empty, no additional colon would be inserted.
The default value of this option is \" %-12:c%?-12t% s\", meaning:
The default value for the agenda sublist is \" %-12:c%?-12t% s\",
which means:
- Indent the line with two space characters
- Give the category in a 12 chars wide field, padded with whitespace on
- Give the category a 12 chars wide field, padded with whitespace on
the right (because of `-'). Append a colon if there is a category
(because of `:').
- If there is a time-of-day, put it into a 12 chars wide field. If no
time, don't put in an empty field, just skip it (because of '?').
- Finally, put the scheduling information and append a whitespace.
As another example, if you don't want the time-of-day of entries in
the prefix, you could use:
(setq org-agenda-prefix-format \" %-11:c% s\")
- Finally, put the scheduling information.
See also the variables `org-agenda-remove-times-when-in-prefix' and
`org-agenda-remove-tags'.
@ -1695,6 +1692,19 @@ the lower-case version of all tags."
:group 'org-agenda
:type 'function)
(defcustom org-agenda-bulk-custom-functions nil
"Alist of characters and custom functions for bulk actions.
For example, this value makes those two functions available:
'((?R set-category)
(?C bulk-cut))
With selected entries in an agenda buffer, `B R' will call
the custom function `set-category' on the selected entries.
Note that functions in this alist don't need to be quoted."
:type 'alist
:group 'org-agenda)
(eval-when-compile
(require 'cl))
(require 'org)
@ -2250,7 +2260,7 @@ Pressing `<' twice means to restrict to the current subtree or region
((eq type 'todo-tree)
(org-check-for-org-mode)
(org-let lprops
'(org-occur (concat "^" outline-regexp "[ \t]*"
'(org-occur (concat "^" org-outline-regexp "[ \t]*"
(regexp-quote match) "\\>"))))
((eq type 'occur-tree)
(org-check-for-org-mode)
@ -3058,7 +3068,7 @@ the global options and expect it to be applied to the entire view.")
(awin (select-window awin))
((not (setq org-pre-agenda-window-conf (current-window-configuration))))
((equal org-agenda-window-setup 'current-window)
(switch-to-buffer abuf))
(org-pop-to-buffer-same-window abuf))
((equal org-agenda-window-setup 'other-window)
(org-switch-to-buffer-other-window abuf))
((equal org-agenda-window-setup 'other-frame)
@ -3069,7 +3079,7 @@ the global options and expect it to be applied to the entire view.")
;; additional test in case agenda is invoked from within agenda
;; buffer via elisp link
(unless (equal (current-buffer) abuf)
(switch-to-buffer abuf)))
(org-pop-to-buffer-same-window abuf)))
(setq buffer-read-only nil)
(let ((inhibit-read-only t)) (erase-buffer))
(org-agenda-mode)
@ -3860,7 +3870,7 @@ in `org-agenda-text-search-extra-files'."
regexps+))
(setq regexps+ (sort regexps+ (lambda (a b) (> (length a) (length b)))))
(if (not regexps+)
(setq regexp (concat "^" org-outline-regexp))
(setq regexp org-outline-regexp-bol)
(setq regexp (pop regexps+))
(if hdl-only (setq regexp (concat "^" org-outline-regexp ".*?"
regexp))))
@ -4298,9 +4308,11 @@ of what a project is and how to check if it stuck, customize the variable
"\\)\\>"))
(tags (nth 2 org-stuck-projects))
(tags-re (if (member "*" tags)
(org-re "^\\*+ .*:[[:alnum:]_@#%]+:[ \t]*$")
(org-re (concat org-outline-regexp-bol
".*:[[:alnum:]_@#%]+:[ \t]*$"))
(if tags
(concat "^\\*+ .*:\\("
(concat org-outline-regexp-bol
".*:\\("
(mapconcat 'identity tags "\\|")
(org-re "\\):[[:alnum:]_@#%:]*[ \t]*$")))))
(gen-re (nth 3 org-stuck-projects))
@ -4753,7 +4765,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(setq marker (org-agenda-new-marker b0)
category (org-get-category b0))
(save-excursion
(if (not (re-search-backward "^\\*+ " nil t))
(if (not (re-search-backward org-outline-regexp-bol nil t))
(setq txt org-agenda-no-heading-message)
(goto-char (match-beginning 0))
(setq hdmarker (org-agenda-new-marker)
@ -4954,7 +4966,7 @@ please use `org-class' instead."
(clockp
(and (looking-at ".*\n[ \t]*-[ \t]+\\([^-\n \t].*?\\)[ \t]*$")
(match-string 1)))))
(if (not (re-search-backward "^\\*+ " nil t))
(if (not (re-search-backward org-outline-regexp-bol nil t))
(setq txt org-agenda-no-heading-message)
(goto-char (match-beginning 0))
(setq hdmarker (org-agenda-new-marker)
@ -5353,7 +5365,7 @@ FRACTION is what fraction of the head-warning time has passed."
(throw :skip t))
(setq marker (org-agenda-new-marker (point)))
(setq category (org-get-category))
(if (not (re-search-backward "^\\*+ " nil t))
(if (not (re-search-backward org-outline-regexp-bol nil t))
(setq txt org-agenda-no-heading-message)
(goto-char (match-beginning 0))
(setq hdmarker (org-agenda-new-marker (point)))
@ -5512,7 +5524,9 @@ Any match of REMOVE-RE will be removed from TXT."
(error nil)))
(when effort
(setq neffort (org-duration-string-to-minutes effort)
effort (setq effort (concat "[" effort "]" )))))
effort (setq effort (concat "[" effort "]")))))
;; prevent erroring out with %e format when there is no effort
(or effort (setq effort ""))
(when remove-re
(while (string-match remove-re txt)
@ -5566,6 +5580,7 @@ Any match of REMOVE-RE will be removed from TXT."
'txt txt
'time time
'extra extra
'format org-prefix-format-compiled
'dotime dotime))))
(defun org-agenda-fix-displayed-tags (txt tags add-inherited hide-re)
@ -6187,8 +6202,8 @@ to switch to narrowing."
(org-agenda-filter-apply org-agenda-filter)
(setq maybe-refresh t))
(t (error "Invalid tag selection character %c" char)))
(when (and maybe-refresh
(eq org-agenda-clockreport-mode 'with-filter))
(when (or maybe-refresh
(eq org-agenda-clockreport-mode 'with-filter))
(org-agenda-redo))))
(defun org-agenda-get-represented-tags ()
@ -6958,7 +6973,7 @@ at the text of the entry itself."
(org-agenda-error)))
(buffer (marker-buffer marker))
(pos (marker-position marker)))
(switch-to-buffer buffer)
(org-pop-to-buffer-same-window buffer)
(and delete-other-windows (delete-other-windows))
(widen)
(goto-char pos)
@ -7240,8 +7255,16 @@ If FORCE-TAGS is non nil, the car of it returns the new tags."
dotime (org-get-at-bol 'dotime)
cat (org-get-at-bol 'org-category)
tags thetags
new (org-format-agenda-item (org-get-at-bol 'extra)
newhead cat tags dotime)
new
(let ((org-prefix-format-compiled
(or (get-text-property (point) 'format)
org-prefix-format-compiled)))
(with-current-buffer (marker-buffer hdmarker)
(save-excursion
(save-restriction
(widen)
(org-format-agenda-item (org-get-at-bol 'extra)
newhead cat tags dotime)))))
pl (text-property-any (point-at-bol) (point-at-eol) 'org-heading t)
undone-face (org-get-at-bol 'undone-face)
done-face (org-get-at-bol 'done-face))
@ -7403,10 +7426,12 @@ the same tree node, and the headline of the tree node in the Org-mode file."
(org-show-context 'agenda))
(save-excursion
(and (outline-next-heading)
(org-flag-heading nil))) ; show the next heading
(org-flag-heading nil))) ; show the next heading
(goto-char pos)
(call-interactively 'org-set-effort)
(end-of-line 1)))))
(end-of-line 1)
(setq newhead (org-get-heading)))
(org-agenda-change-all-lines newhead hdmarker))))
(defun org-agenda-toggle-archive-tag ()
"Toggle the archive tag for the current entry."
@ -7560,7 +7585,7 @@ be used to request time specification in the time stamp."
(defun org-agenda-schedule (arg &optional time)
"Schedule the item at point.
Arg is passed through to `org-schedule'."
ARG is passed through to `org-schedule'."
(interactive "P")
(org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search)
(org-agenda-check-no-diary)
@ -7582,7 +7607,7 @@ Arg is passed through to `org-schedule'."
(defun org-agenda-deadline (arg &optional time)
"Schedule the item at point.
Arg is passed through to `org-deadline'."
ARG is passed through to `org-deadline'."
(interactive "P")
(org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search)
(org-agenda-check-no-diary)
@ -8149,7 +8174,13 @@ The prefix arg is passed through to the command if possible."
org-agenda-bulk-marked-entries)
;; Prompt for the bulk command
(message "Bulk: [r]efile [$]arch [A]rch->sib [t]odo [+/-]tag [s]chd [S]catter [d]eadline [f]unction")
(message (concat "Bulk: [r]efile [$]arch [A]rch->sib [t]odo"
" [+/-]tag [s]chd [S]catter [d]eadline [f]unction"
(when org-agenda-bulk-custom-functions
(concat " Custom: ["
(mapconcat (lambda(f) (char-to-string (car f)))
org-agenda-bulk-custom-functions "")
"]"))))
(let* ((action (read-char-exclusive))
(org-log-refile (if org-log-refile 'time nil))
(entries (reverse org-agenda-bulk-marked-entries))
@ -8243,6 +8274,10 @@ The prefix arg is passed through to the command if possible."
(org-agenda-schedule nil time))
(error nil)))))))
((assoc action org-agenda-bulk-custom-functions)
(setq cmd (list (cadr (assoc action org-agenda-bulk-custom-functions)))
redo-at-end t))
((equal action ?f)
(setq cmd (list (intern
(org-icompleting-read "Function: "

23
lisp/org-archive.el
View File

@ -165,10 +165,11 @@ if LOCATION is not given, the value of `org-archive-location' is used."
(setq location (or location org-archive-location))
(if (string-match "\\(.*\\)::\\(.*\\)" location)
(if (= (match-beginning 1) (match-end 1))
(buffer-file-name)
(buffer-file-name (buffer-base-buffer))
(expand-file-name
(format (match-string 1 location)
(file-name-nondirectory buffer-file-name))))))
(file-name-nondirectory
(buffer-file-name (buffer-base-buffer))))))))
(defun org-extract-archive-heading (&optional location)
"Extract the heading from archive LOCATION.
@ -176,7 +177,8 @@ if LOCATION is not given, the value of `org-archive-location' is used."
(setq location (or location org-archive-location))
(if (string-match "\\(.*\\)::\\(.*\\)" location)
(format (match-string 2 location)
(file-name-nondirectory buffer-file-name))))
(file-name-nondirectory
(buffer-file-name (buffer-base-buffer))))))
(defun org-archive-subtree (&optional find-done)
"Move the current subtree to the archive.
@ -202,15 +204,17 @@ this heading."
(tr-org-todo-line-regexp org-todo-line-regexp)
(tr-org-odd-levels-only org-odd-levels-only)
(this-buffer (current-buffer))
;; start of variables that will be used for saving context
;; start of variables that will be used for saving context
;; The compiler complains about them - keep them anyway!
(file (abbreviate-file-name (buffer-file-name)))
(file (abbreviate-file-name
(or (buffer-file-name (buffer-base-buffer))
(error "No file associated to buffer"))))
(olpath (mapconcat 'identity (org-get-outline-path) "/"))
(time (format-time-string
(substring (cdr org-time-stamp-formats) 1 -1)
(current-time)))
category todo priority ltags itags atags
;; end of variables that will be used for saving context
;; end of variables that will be used for saving context
location afile heading buffer level newfile-p infile-p visiting)
;; Find the local archive location
@ -301,7 +305,7 @@ this heading."
(org-paste-subtree (org-get-valid-level level (and heading 1)))
;; Shall we append inherited tags?
(and itags
(or (and (eq org-archive-subtree-add-inherited-tags 'infile)
(or (and (eq org-archive-subtree-add-inherited-tags 'infile)
infile-p)
(eq org-archive-subtree-add-inherited-tags t))
(org-set-tags-to atags))
@ -326,8 +330,7 @@ this heading."
;; Save and kill the buffer, if it is not the same buffer.
(when (not (eq this-buffer buffer))
(save-buffer))
))
(save-buffer))))
;; Here we are back in the original buffer. Everything seems to have
;; worked. So now cut the tree and finish up.
(let (this-command) (org-cut-subtree))
@ -403,7 +406,7 @@ sibling does not exist, it will be created at the end of the subtree."
If the cursor is not on a headline, try all level 1 trees. If
it is on a headline, try all direct children.
When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag."
(let ((re (concat "^\\*+ +" org-not-done-regexp)) re1
(let ((re (concat org-outline-regexp-bol "+" org-not-done-regexp)) re1
(rea (concat ".*:" org-archive-tag ":"))
(begm (make-marker))
(endm (make-marker))

11
lisp/org-ascii.el
View File

@ -108,9 +108,10 @@ utf8 Use all UTF-8 characters")
;;;###autoload
(defun org-export-as-utf8 (&rest args)
"Like `org-export-as-ascii', use use encoding for special symbols."
"Like `org-export-as-ascii', use encoding for special symbols."
(interactive)
(org-export-as-encoding 'org-export-as-ascii (org-called-interactively-p)
(org-export-as-encoding 'org-export-as-ascii
(org-called-interactively-p 'any)
'utf8 args))
;;;###autoload
@ -427,7 +428,7 @@ publishing directory."
(org-init-section-numbers)
(while (setq line (pop lines))
(when (and link-buffer (string-match "^\\*+ " line))
(when (and link-buffer (string-match org-outline-regexp-bol line))
(org-export-ascii-push-links (nreverse link-buffer))
(setq link-buffer nil))
(setq wrap nil)
@ -628,7 +629,9 @@ publishing directory."
(save-match-data
(if (save-excursion
(re-search-backward
"^\\(\\([ \t]*\\)\\|\\(\\*+ \\)\\)[^ \t\n]" nil t))
(concat "^\\(\\([ \t]*\\)\\|\\("
org-outline-regexp
"\\)\\)[^ \t\n]") nil t))
(setq ind (or (match-string 2)
(make-string (length (match-string 3)) ?\ )))))
(mapc (lambda (x) (insert ind "[" (car x) "]: " (cdr x) "\n"))

10
lisp/org-bibtex.el
View File

@ -121,6 +121,7 @@
(declare-function bibtex-parse-entry "bibtex" (&optional content))
(declare-function bibtex-url "bibtex" (&optional pos no-browse))
(declare-function longlines-mode "longlines" (&optional arg))
(declare-function org-babel-trim "ob" (string &optional regexp))
;;; Bibtex data
@ -277,8 +278,9 @@ This variable is relevant only if `org-bibtex-export-tags-as-keywords` is t."
;;; Utility functions
(defun org-bibtex-get (property)
(or (org-entry-get (point) (upcase property))
(org-entry-get (point) (concat org-bibtex-prefix (upcase property)))))
((lambda (it) (when it (org-babel-trim it)))
(or (org-entry-get (point) (upcase property))
(org-entry-get (point) (concat org-bibtex-prefix (upcase property))))))
(defun org-bibtex-put (property value)
(let ((prop (upcase (if (keywordp property)
@ -553,7 +555,7 @@ If nonew is t, add data to the headline of the entry at point."
(org-bibtex-put "TITLE" title)))
(org-bibtex-put "TYPE" (substring (symbol-name type) 1))
(org-bibtex-fleshout type arg)
(mapc (lambda (tag) (org-toggle-tag tag t)) org-bibtex-tags)))
(mapc (lambda (tag) (org-toggle-tag tag 'on)) org-bibtex-tags)))
(defun org-bibtex-create-in-current-entry (&optional arg)
"Add bibliographical data to the current entry.
@ -592,7 +594,7 @@ This uses `bibtex-parse-entry'."
(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 t)))
(togtag (tag) (org-toggle-tag tag 'on)))
(org-insert-heading)
(insert (val :title))
(org-bibtex-put "TITLE" (val :title))

104
lisp/org-capture.el
View File

@ -57,9 +57,13 @@
(date &optional keep-restriction))
(declare-function org-table-get-specials "org-table" ())
(declare-function org-table-goto-line "org-table" (N))
(declare-function org-pop-to-buffer-same-window "org-compat"
(&optional buffer-or-name norecord label))
(defvar org-remember-default-headline)
(defvar org-remember-templates)
(defvar org-table-hlines)
(defvar dired-buffers)
(defvar org-capture-clock-was-started nil
"Internal flag, noting if the clock was started.")
@ -113,11 +117,11 @@ type The type of entry. Valid types are:
target Specification of where the captured item should be placed.
In Org-mode files, targets usually define a node. Entries will
become children of this node, other types will be added to the
table or list in the body of this node.
table or list in the body of this node.
Most target specifications contain a file name. If that file
name is the empty string, it defaults to `org-default-notes-file'.
A file can also be given as a variable, function, or Emacs Lisp
Most target specifications contain a file name. If that file
name is the empty string, it defaults to `org-default-notes-file'.
A file can also be given as a variable, function, or Emacs Lisp
form.
Valid values are:
@ -202,39 +206,40 @@ properties are:
capture was invoked, kill the buffer again after capture
is finalized.
The template defines the text to be inserted. Often this is an org-mode
entry (so the first line should start with a star) that will be filed as a
child of the target headline. It can also be freely formatted text.
Furthermore, the following %-escapes will be replaced with content:
The template defines the text to be inserted. Often this is an
org-mode entry (so the first line should start with a star) that
will be filed as a child of the target headline. It can also be
freely formatted text. Furthermore, the following %-escapes will
be replaced with content and expanded in this order:
%^{prompt} prompt the user for a string and replace this sequence with it.
A default value and a completion table ca be specified like this:
%^{prompt|default|completion2|completion3|...}
%t time stamp, date only
%T time stamp with date and time
%u, %U like the above, but inactive time stamps
%^t like %t, but prompt for date. Similarly %^T, %^u, %^U.
You may define a prompt like %^{Please specify birthday
%<...> the result of format-time-string on the ... format specification
%n user name (taken from `user-full-name')
%a annotation, normally the link created with `org-store-link'
%[pathname] insert the contents of the file given by `pathname'.
%(sexp) evaluate elisp `(sexp)' and replace with the result.
%<...> the result of format-time-string on the ... format specification.
%t time stamp, date only.
%T time stamp with date and time.
%u, %U like the above, but inactive time stamps.
%a annotation, normally the link created with `org-store-link'.
%i initial content, copied from the active region. If %i is
indented, the entire inserted text will be indented as well.
%c current kill ring head
%x content of the X clipboard
%^C interactive selection of which kill or clip to use
%^L like %^C, but insert as link
%k title of currently clocked task
%K link to currently clocked task
%f file visited by current buffer when org-capture was called
%F like @code{%f}, but include full path
%^g prompt for tags, with completion on tags in target file
%^G prompt for tags, with completion on all tags in all agenda files
%^{prop}p prompt the user for a value for property `prop'
%:keyword specific information for certain link types, see below
%[pathname] insert the contents of the file given by `pathname'
%(sexp) evaluate elisp `(sexp)' and replace with the result
%A like %a, but prompt for the description part.
%c current kill ring head.
%x content of the X clipboard.
%k title of currently clocked task.
%K link to currently clocked task.
%n user name (taken from `user-full-name').
%f file visited by current buffer when org-capture was called.
%F full path of the file or directory visited by current buffer.
%:keyword specific information for certain link types, see below.
%^g prompt for tags, with completion on tags in target file.
%^G prompt for tags, with completion on all tags in all agenda files.
%^t like %t, but prompt for date. Similarly %^T, %^u, %^U.
You may define a prompt like %^{Please specify birthday.
%^C interactive selection of which kill or clip to use.
%^L like %^C, but insert as link.
%^{prop}p prompt the user for a value for property `prop'.
%^{prompt} prompt the user for a string and replace this sequence with it.
A default value and a completion table ca be specified like this:
%^{prompt|default|completion2|completion3|...}.
%? After completing the template, position cursor here.
Apart from these general escapes, you can access information specific to the
@ -328,8 +333,8 @@ calendar | %:type %:date"
((const :format "%v " :kill-buffer) (const t))))))))
(defcustom org-capture-before-finalize-hook nil
"Hook that is run right before a remember process is finalized.
The remember buffer is still current when this hook runs."
"Hook that is run right before a capture process is finalized.
The capture buffer is still current when this hook runs."
:group 'org-capture
:type 'hook)
@ -380,13 +385,13 @@ to avoid conflicts with other active capture processes."
(defvar org-capture-mode-map (make-sparse-keymap)
"Keymap for `org-capture-mode', a minor mode.
Use this map to set additional keybindings for when Org-mode is used
for a Remember buffer.")
for a capture buffer.")
(defvar org-capture-mode-hook nil
"Hook for the minor `org-capture-mode'.")
(define-minor-mode org-capture-mode
"Minor mode for special key bindings in a remember buffer."
"Minor mode for special key bindings in a capture buffer."
nil " Rem" org-capture-mode-map
(org-set-local
'header-line-format
@ -447,7 +452,10 @@ bypassed."
(org-capture-set-plist entry)
(org-capture-get-template)
(org-capture-put :original-buffer orig-buf
:original-file (buffer-file-name orig-buf)
:original-file (or (buffer-file-name orig-buf)
(and (featurep 'dired)
(car (rassq orig-buf
dired-buffers))))
:original-file-nondirectory
(and (buffer-file-name orig-buf)
(file-name-nondirectory
@ -551,6 +559,9 @@ captured item after finalizing."
(m2 (org-capture-get :end-marker 'local)))
(if (and m1 m2 (= m1 beg) (= m2 end))
(progn
(setq m2 (if (cdr (assoc 'heading org-blank-before-new-entry))
m2 (1+ m2))
m2 (if (< (point-max) m2) (point-max) m2))
(setq abort-note 'clean)
(kill-region m1 m2))
(setq abort-note 'dirty)))
@ -576,16 +587,14 @@ captured item after finalizing."
(org-at-table-p))
(if (org-table-get-stored-formulas)
(org-table-recalculate 'all) ;; FIXME: Should we iterate???
(org-table-align)))
)
(org-table-align))))
;; Store this place as the last one where we stored something
;; Do the marking in the base buffer, so that it makes sense after
;; the indirect buffer has been killed.
(org-capture-bookmark-last-stored-position)
;; Run the hook
(run-hooks 'org-capture-before-finalize-hook)
)
(run-hooks 'org-capture-before-finalize-hook))
;; Kill the indirect buffer
(save-buffer)
@ -665,11 +674,12 @@ already gone. Any prefix argument will be passed to the refile command."
(interactive)
;; FIXME: This does not do the right thing, we need to remove the new stuff
;; By hand it is easy: undo, then kill the buffer
(let ((org-note-abort t) (org-capture-before-finalize-hook nil))
(let ((org-note-abort t)
(org-capture-before-finalize-hook nil))
(org-capture-finalize)))
(defun org-capture-goto-last-stored ()
"Go to the location where the last remember note was stored."
"Go to the location where the last capture note was stored."
(interactive)
(org-goto-marker-or-bmk org-capture-last-stored-marker
"org-capture-last-stored")
@ -1191,7 +1201,7 @@ The user is queried for the template."
(error "No capture template selected"))
(org-capture-set-plist entry)
(org-capture-set-target-location)
(switch-to-buffer (org-capture-get :buffer))
(org-pop-to-buffer-same-window (org-capture-get :buffer))
(goto-char (org-capture-get :pos))))
(defun org-capture-get-indirect-buffer (&optional buffer prefix)
@ -1301,7 +1311,7 @@ The template may still contain \"%?\" for cursor positioning."
(sit-for 1))
(save-window-excursion
(delete-other-windows)
(switch-to-buffer (get-buffer-create "*Capture*"))
(org-pop-to-buffer-same-window (get-buffer-create "*Capture*"))
(erase-buffer)
(insert template)
(goto-char (point-min))

94
lisp/org-clock.el
View File

@ -37,7 +37,9 @@
(declare-function calendar-absolute-from-iso "cal-iso" (&optional date))
(declare-function notifications-notify "notifications" (&rest params))
(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label))
(defvar org-time-stamp-formats)
(defvar org-ts-what)
(defgroup org-clock nil
"Options concerning clocking working time in Org-mode."
@ -478,7 +480,7 @@ pointing to it."
heading (org-get-heading 'notags)
prefix (save-excursion
(org-back-to-heading t)
(looking-at "\\*+ ")
(looking-at org-outline-regexp)
(match-string 0))
task (substring
(org-fontify-like-in-org-mode
@ -1091,7 +1093,7 @@ the clocking selection, associated with the letter `d'."
(match-string 2))))
(if newstate (org-todo newstate))))
((and org-clock-in-switch-to-state
(not (looking-at (concat outline-regexp "[ \t]*"
(not (looking-at (concat org-outline-regexp "[ \t]*"
org-clock-in-switch-to-state
"\\>"))))
(org-todo org-clock-in-switch-to-state)))
@ -1379,7 +1381,7 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set."
(match-string 2))))
(if newstate (org-todo newstate))))
((and org-clock-out-switch-to-state
(not (looking-at (concat outline-regexp "[ \t]*"
(not (looking-at (concat org-outline-regexp "[ \t]*"
org-clock-out-switch-to-state
"\\>"))))
(org-todo org-clock-out-switch-to-state))))))
@ -1389,6 +1391,76 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set."
(run-hooks 'org-clock-out-hook)
(org-clock-delete-current))))))
(add-hook 'org-clock-out-hook 'org-clock-remove-empty-clock-drawer)
(defun org-clock-remove-empty-clock-drawer nil
"Remove empty clock drawer in the current subtree."
(let* ((olid (or (org-entry-get (point) "LOG_INTO_DRAWER")
org-log-into-drawer))
(clock-drawer (if (eq t olid) "LOGBOOK" olid))
(end (save-excursion (org-end-of-subtree t t))))
(when clock-drawer
(save-excursion
(org-back-to-heading t)
(while (search-forward clock-drawer end t)
(goto-char (match-beginning 0))
(org-remove-empty-drawer-at clock-drawer (point))
(forward-line 1))))))
(defun org-at-clock-log-p nil
"Is the cursor on the clock log line?"
(save-excursion
(move-beginning-of-line 1)
(looking-at "^[ \t]*CLOCK:")))
(defun org-clock-timestamps-up nil
"Increase CLOCK timestamps at cursor."
(interactive)
(org-clock-timestamps-change 'up))
(defun org-clock-timestamps-down nil
"Increase CLOCK timestamps at cursor."
(interactive)
(org-clock-timestamps-change 'down))
(defun org-clock-timestamps-change (updown)
"Change CLOCK timestamps synchronously at cursor.
UPDOWN tells whether to change 'up or 'down."
(setq org-ts-what nil)
(when (org-at-timestamp-p t)
(let ((tschange (if (eq updown 'up) 'org-timestamp-up
'org-timestamp-down))
ts1 begts1 ts2 begts2 updatets1 tdiff)
(save-excursion
(move-beginning-of-line 1)
(re-search-forward org-ts-regexp3 nil t)
(setq ts1 (match-string 0) begts1 (match-beginning 0))
(when (re-search-forward org-ts-regexp3 nil t)
(setq ts2 (match-string 0) begts2 (match-beginning 0))))
;; Are we on the second timestamp?
(if (<= begts2 (point)) (setq updatets1 t))
(if (not ts2)
;; fall back on org-timestamp-up if there is only one
(funcall tschange)
;; setq this so that (boundp 'org-ts-what is non-nil)
(funcall tschange)
(let ((ts (if updatets1 ts2 ts1))
(begts (if updatets1 begts1 begts2)))
(setq tdiff
(subtract-time
(org-time-string-to-time org-last-changed-timestamp)
(org-time-string-to-time ts)))
(save-excursion
(goto-char begts)
(org-timestamp-change
(round (/ (org-float-time tdiff)
(cond ((eq org-ts-what 'minute) 60)
((eq org-ts-what 'hour) 3600)
((eq org-ts-what 'day) (* 24 3600))
((eq org-ts-what 'month) (* 24 3600 31))
((eq org-ts-what 'year) (* 24 3600 365.2)))))
org-ts-what 'updown)))))))
(defun org-clock-cancel ()
"Cancel the running clock by removing the start timestamp."
(interactive)
@ -1427,7 +1499,7 @@ With prefix arg SELECT, offer recently clocked tasks for selection."
(setq recent t)
(car org-clock-history))
(t (error "No active or recent clock task")))))
(switch-to-buffer (marker-buffer m))
(org-pop-to-buffer-same-window (marker-buffer m))
(if (or (< m (point-min)) (> m (point-max))) (widen))
(goto-char m)
(org-show-entry)
@ -1671,7 +1743,7 @@ fontified, and then returned."
"Create a table containing a report about clocked time.
If the cursor is inside an existing clocktable block, then the table
will be updated. If not, a new clocktable will be inserted. The scope
of the new clock will be subtree when called from within a subtree, and
of the new clock will be subtree when called from within a subtree, and
file elsewhere.
When called with a prefix argument, move to the first clock table in the
@ -1683,11 +1755,11 @@ buffer and update it."
(org-show-entry))
(if (org-in-clocktable-p)
(goto-char (org-in-clocktable-p))
(let ((props (if (ignore-errors
(let ((props (if (ignore-errors
(save-excursion (org-back-to-heading)))
(list :name "clocktable" :scope 'subtree)
(list :name "clocktable"))))
(org-create-dblock
(org-create-dblock
(org-combine-plists org-clock-clocktable-default-properties props))))
(org-update-dblock))
@ -2035,7 +2107,7 @@ the currently selected interval size."
(setq level (string-to-number (match-string 1 (symbol-name scope))))
(catch 'exit
(while (org-up-heading-safe)
(looking-at outline-regexp)
(looking-at org-outline-regexp)
(if (<= (org-reduced-level (funcall outline-level)) level)
(throw 'exit nil))))
(org-narrow-to-subtree)))
@ -2063,7 +2135,7 @@ from the dynamic block defintion."
;; much easier because there can be a fixed format with a
;; well-defined number of columns...
(let* ((hlchars '((1 . "*") (2 . "/")))
(lwords (assoc (or (plist-get params :lang)
(lwords (assoc (or (plist-get params :lang)
org-export-default-language)
org-clock-clocktable-language-setup))
(multifile (plist-get params :multifile))
@ -2151,14 +2223,14 @@ from the dynamic block defintion."
(if level-p (concat (nth 2 lwords) "|") "") ; level column, maybe
(if timestamp (concat (nth 3 lwords) "|") "") ; timestamp column, maybe
(if properties (concat (mapconcat 'identity properties "|") "|") "") ;properties columns, maybe
(concat (nth 4 lwords) "|"
(concat (nth 4 lwords) "|"
(nth 5 lwords) "|\n")) ; headline and time columns
;; Insert the total time in the table
(insert-before-markers
"|-\n" ; a hline
"|" ; table line starter
(if multifile (concat "| " (nth 6 lwords) " ") "")
(if multifile (concat "| " (nth 6 lwords) " ") "")
; file column, maybe
(if level-p "|" "") ; level column, maybe
(if timestamp "|" "") ; timestamp column, maybe

4
lisp/org-colview-xemacs.el
View File

@ -862,7 +862,7 @@ around it."
(save-restriction
(narrow-to-region beg end)
(org-clock-sum))))
(while (re-search-forward (concat "^" outline-regexp) end t)
(while (re-search-forward org-outline-regexp-bol end t)
(if (and org-columns-skip-archived-trees
(looking-at (concat ".*:" org-archive-tag ":")))
(org-end-of-subtree t)
@ -1097,7 +1097,7 @@ Don't set this, this is meant for dynamic scoping.")
(defun org-columns-compute (property)
"Sum the values of property PROPERTY hierarchically, for the entire buffer."
(interactive)
(let* ((re (concat "^" outline-regexp))
(let* ((re org-outline-regexp-bol)
(lmax 30) ; Does anyone use deeper levels???
(lvals (make-vector lmax nil))
(lflag (make-vector lmax nil))

4
lisp/org-colview.el
View File

@ -696,7 +696,7 @@ around it."
(save-restriction
(narrow-to-region beg end)
(org-clock-sum))))
(while (re-search-forward (concat "^" outline-regexp) end t)
(while (re-search-forward org-outline-regexp-bol end t)
(if (and org-columns-skip-archived-trees
(looking-at (concat ".*:" org-archive-tag ":")))
(org-end-of-subtree t)
@ -929,7 +929,7 @@ Don't set this, this is meant for dynamic scoping.")
(defun org-columns-compute (property)
"Sum the values of property PROPERTY hierarchically, for the entire buffer."
(interactive)
(let* ((re (concat "^" outline-regexp))
(let* ((re org-outline-regexp-bol)
(lmax 30) ; Does anyone use deeper levels???
(lvals (make-vector lmax nil))
(lflag (make-vector lmax nil))

9
lisp/org-compat.el
View File

@ -433,6 +433,15 @@ With two arguments, return floor and remainder of their quotient."
(let ((q (floor x y)))
(list q (- x (if y (* y q) q)))))
;; `pop-to-buffer-same-window' has been introduced with Emacs 24.1.
(defun org-pop-to-buffer-same-window
(&optional buffer-or-name norecord label)
"Pop to buffer specified by BUFFER-OR-NAME in the selected window."
(if (fboundp 'pop-to-buffer-same-window)
(funcall
'pop-to-buffer-same-window buffer-or-name norecord label)
(funcall 'switch-to-buffer buffer-or-name norecord)))
(provide 'org-compat)
;; arch-tag: a0a0579f-e68c-4bdf-9e55-93768b846bbe

4
lisp/org-ctags.el
View File

@ -140,6 +140,8 @@
(require 'org)
(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label))
(defgroup org-ctags nil
"Options concerning use of ctags within org mode."
:tag "Org-Ctags"
@ -385,7 +387,7 @@ the new file."
(cond
((get-buffer (concat name ".org"))
;; Buffer is already open
(switch-to-buffer (get-buffer (concat name ".org"))))
(org-pop-to-buffer-same-window (get-buffer (concat name ".org"))))
((file-exists-p filename)
;; File exists but is not open --> open it
(message "Opening existing org file `%S'..."

2
lisp/org-docbook.el
View File

@ -651,7 +651,7 @@ publishing directory."
(catch 'nextline
;; End of quote section?
(when (and inquote (string-match "^\\*+ " line))
(when (and inquote (string-match org-outline-regexp-bol line))
(insert "]]></programlisting>\n")
(org-export-docbook-open-para)
(setq inquote nil))

2
lisp/org-exp-blocks.el
View File

@ -359,7 +359,7 @@ other backends, it converts the comment into an EXAMPLE segment."
(if owner (format " id=\"org-comment-%s\" " owner))
">\n"
(if owner (concat "<b>" owner "</b> ") "")
(if (and title (> (length title) 0)) (concat " -- " title "</br>\n") "</br>\n")
(if (and title (> (length title) 0)) (concat " -- " title "<br/>\n") "<br/>\n")
"<p>\n"
"#+END_HTML\n"
body

76
lisp/org-exp.el
View File

@ -48,6 +48,9 @@
(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ())
(declare-function org-table-cookie-line-p "org-table" (line))
(declare-function org-table-colgroup-line-p "org-table" (line))
(declare-function org-pop-to-buffer-same-window "org-compat"
(&optional buffer-or-name norecord label))
(autoload 'org-export-generic "org-export-generic" "Export using the generic exporter" t)
(autoload 'org-export-as-odt "org-odt"
@ -743,7 +746,7 @@ modified) list.")
(case-fold-search t)
p key val text options mathjax a pr style
latex-header latex-class macros letbind
ext-setup-or-nil setup-contents (start 0))
ext-setup-or-nil setup-file setup-dir setup-contents (start 0))
(while (or (and ext-setup-or-nil
(string-match re ext-setup-or-nil start)
(setq start (match-end 0)))
@ -790,11 +793,14 @@ modified) list.")
((string-equal key "MACRO")
(push val macros))
((equal key "SETUPFILE")
(setq setup-contents (org-file-contents
(expand-file-name
(org-remove-double-quotes
(org-trim val)))
'noerror))
(setq setup-file (org-remove-double-quotes (org-trim val))
;; take care of recursive inclusion of setupfiles
setup-file (if (or (file-name-absolute-p val) (not setup-dir))
(expand-file-name setup-file)
(let ((default-directory setup-dir))
(expand-file-name setup-file))))
(setq setup-dir (file-name-directory setup-file))
(setq setup-contents (org-file-contents setup-file 'noerror))
(if (not ext-setup-or-nil)
(setq ext-setup-or-nil setup-contents start 0)
(setq ext-setup-or-nil
@ -1083,7 +1089,6 @@ on this string to produce the exported version."
(archived-trees (plist-get parameters :archived-trees))
(inhibit-read-only t)
(drawers org-drawers)
(outline-regexp "\\*+ ")
(source-buffer (current-buffer))
target-alist rtn)
@ -1092,7 +1097,7 @@ on this string to produce the exported version."
org-export-id-target-alist nil
org-export-code-refs nil)
(with-current-buffer (get-buffer-create " org-mode-tmp")
(with-temp-buffer
(erase-buffer)
(insert string)
(setq case-fold-search t)
@ -1120,14 +1125,6 @@ on this string to produce the exported version."
(org-export-handle-include-files-recurse)
(run-hooks 'org-export-preprocess-after-include-files-hook)
;; Change lists ending. Other parts of export may insert blank
;; lines and lists' structure could be altered.
(org-export-mark-list-end)
;; Process the macros
(org-export-preprocess-apply-macros)
(run-hooks 'org-export-preprocess-after-macros-hook)
;; Get rid of archived trees
(org-export-remove-archived-trees archived-trees)
@ -1142,9 +1139,35 @@ on this string to produce the exported version."
;; Get rid of tasks, depending on configuration
(org-export-remove-tasks (plist-get parameters :tasks))
;; Normalize footnotes
;; Prepare footnotes for export. During that process, footnotes
;; actually included in the exported part of the buffer go
;; though some transformations:
;; 1. They have their label normalized (like "[N]");
;; 2. They get moved at the same place in the buffer (usually at
;; its end, but backends may define another place via
;; `org-footnote-insert-pos-for-preprocessor');
;; 3. The are stored in `org-export-footnotes-seen', while
;; `org-export-preprocess-string' is applied to their
;; definition.
;; Line-wise exporters ignore `org-export-footnotes-seen', as
;; they interpret footnotes at the moment they see them in the
;; buffer. Context-wise exporters grab all the info needed in
;; that variable and delete moved definitions (as described in
;; 2nd step).
(when (plist-get parameters :footnotes)
(org-footnote-normalize nil 'pre-process-p))
(org-footnote-normalize nil parameters))
;; Change lists ending. Other parts of export may insert blank
;; lines and lists' structure could be altered.
(org-export-mark-list-end)
;; Process the macros
(org-export-preprocess-apply-macros)
(run-hooks 'org-export-preprocess-after-macros-hook)
;; Export code blocks
(org-export-blocks-preprocess)
@ -1261,7 +1284,6 @@ on this string to produce the exported version."
(run-hooks 'org-export-preprocess-final-hook)
(setq rtn (buffer-string)))
(kill-buffer " org-mode-tmp")
rtn))
(defun org-export-kill-licensed-text ()
@ -1617,9 +1639,9 @@ from the buffer."
(defun org-export-protect-quoted-subtrees ()
"Mark quoted subtrees with the protection property."
(let ((re-quote (concat "^\\*+[ \t]+" org-quote-string "\\>")))
(let ((org-re-quote (concat "^\\*+[ \t]+" org-quote-string "\\>")))
(goto-char (point-min))
(while (re-search-forward re-quote nil t)
(while (re-search-forward org-re-quote nil t)
(goto-char (match-beginning 0))
(end-of-line 1)
(add-text-properties (point) (org-end-of-subtree t)
@ -1767,6 +1789,7 @@ These special cookies will later be interpreted by the backend."
(top-ind (org-list-get-ind top struct)))
(goto-char bottom)
(when (and (not (eq org-list-ending-method 'indent))
(not (looking-at "[ \t]*$"))
(looking-at org-list-end-re))
(replace-match ""))
(unless (bolp) (insert "\n"))
@ -1825,6 +1848,7 @@ These special properties will later be interpreted by the backend."
(goto-char bottom)
(when (or (looking-at "^ORG-LIST-END-MARKER\n")
(and (not (eq org-list-ending-method 'indent))
(not (looking-at "[ \t]*$"))
(looking-at org-list-end-re)))
(replace-match ""))
(unless (bolp) (insert "\n"))
@ -1918,9 +1942,9 @@ table line. If it is a link, add it to the line containing the link."
(goto-char (match-beginning 0))
(delete-region (point) (org-end-of-subtree t)))))
(defun org-export-handle-comments (commentsp)
(defun org-export-handle-comments (org-commentsp)
"Remove comments, or convert to backend-specific format.
COMMENTSP can be a format string for publishing comments.
ORG-COMMENTSP can be a format string for publishing comments.
When it is nil, all comments will be removed."
(let ((re "^\\(#\\|[ \t]*#\\+ \\)\\(.*\n?\\)")
pos)
@ -1930,12 +1954,12 @@ When it is nil, all comments will be removed."
(setq pos (match-beginning 0))
(if (get-text-property pos 'org-protected)
(goto-char (1+ pos))
(if (and commentsp
(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 commentsp (match-string 2))
(format org-commentsp (match-string 2))
nil 'org-protected t)
t t))
(goto-char (1+ pos))
@ -2951,7 +2975,7 @@ directory."
(region (buffer-string))
str-ret)
(save-excursion
(switch-to-buffer buffer)
(org-pop-to-buffer-same-window buffer)
(erase-buffer)
(insert region)
(let ((org-inhibit-startup t)) (org-mode))

2
lisp/org-feed.el
View File

@ -436,7 +436,7 @@ it can be a list structured like an entry in `org-feed-alist'."
(if (stringp feed) (setq feed (assoc feed org-feed-alist)))
(unless feed
(error "No such feed in `org-feed-alist"))
(switch-to-buffer
(org-pop-to-buffer-same-window
(org-feed-update feed 'retrieve-only))
(goto-char (point-min)))

263
lisp/org-footnote.el
View File

@ -38,8 +38,11 @@
(require 'org-macs)
(require 'org-compat)
(declare-function org-combine-plists "org" (&rest plists))
(declare-function org-in-commented-line "org" ())
(declare-function org-in-indented-comment-line "org" ())
(declare-function org-in-regexp "org" (re &optional nlines visually))
(declare-function org-in-block-p "org" (names))
(declare-function org-mark-ring-push "org" (&optional pos buffer))
(declare-function outline-next-heading "outline")
(declare-function org-trim "org" (s))
@ -50,7 +53,12 @@
(declare-function org-inside-latex-macro-p "org" ())
(declare-function org-id-uuid "org" ())
(declare-function org-fill-paragraph "org" (&optional justify))
(declare-function org-export-preprocess-string "org-exp"
(string &rest parameters))
(defvar org-outline-regexp-bol) ; defined in org.el
(defvar org-odd-levels-only) ;; defined in org.el
(defvar org-bracket-link-regexp) ; defined in org.el
(defvar message-signature-separator) ;; defined in message.el
(defconst org-footnote-re
@ -72,6 +80,10 @@
(org-re "^\\(\\[\\([0-9]+\\|fn:[-_[:word:]]+\\)\\]\\)")
"Regular expression matching the definition of a footnote.")
(defvar org-footnote-forbidden-blocks '("example" "verse" "src" "ascii" "beamer"
"docbook" "html" "latex" "odt")
"Names of blocks where footnotes are not allowed.")
(defgroup org-footnote nil
"Footnotes in Org-mode."
:tag "Org Footnote"
@ -154,19 +166,37 @@ extracted will be filled again."
:group 'org-footnote
:type 'boolean)
(defvar org-bracket-link-regexp) ; silent compiler
(defun org-footnote-in-valid-context-p ()
"Is point in a context where footnotes are allowed?"
(save-match-data
(not (or (org-in-commented-line)
(org-in-indented-comment-line)
(org-in-verbatim-emphasis)
;; Avoid literal example.
(save-excursion
(beginning-of-line)
(looking-at "[ \t]*:[ \t]+"))
;; Avoid cited text and headers in message-mode.
(and (derived-mode-p 'message-mode)
(or (save-excursion
(beginning-of-line)
(looking-at message-cite-prefix-regexp))
(message-point-in-header-p)))
;; Avoid forbidden blocks.
(org-in-block-p org-footnote-forbidden-blocks)))))
(defun org-footnote-at-reference-p ()
"Is the cursor at a footnote reference?
If so, return an list containing its label, beginning and ending
positions, and the definition, if local."
(when (and (not (or (org-in-commented-line)
(org-in-verbatim-emphasis)))
If so, return a list containing its label, beginning and ending
positions, and the definition, when inlined."
(when (and (org-footnote-in-valid-context-p)
(or (looking-at org-footnote-re)
(org-in-regexp org-footnote-re)
(save-excursion (re-search-backward org-footnote-re nil t)))
;; A footnote reference cannot start at bol.
(/= (match-beginning 0) (point-at-bol)))
;; Only inline footnotes can start at bol.
(or (eq (char-before (match-end 0)) 58)
(/= (match-beginning 0) (point-at-bol))))
(let* ((beg (match-beginning 0))
(label (or (match-string 2) (match-string 3)
;; Anonymous footnotes don't have labels
@ -177,20 +207,21 @@ positions, and the definition, if local."
;; get fooled by unrelated closing square brackets.
(end (ignore-errors (scan-sexps beg 1))))
;; Point is really at a reference if it's located before true
;; ending of the footnote and isn't within a link or a LaTeX
;; macro. About that case, some special attention should be
;; paid. Indeed, when two footnotes are side by side, once the
;; first one is changed into LaTeX, the second one might then be
;; considered as an optional argument of the command. To
;; prevent that, we have a look at the `org-protected' property
;; of that LaTeX command.
;; ending of the footnote.
(when (and end (< (point) end)
;; Verify match isn't a part of a link.
(not (save-excursion
(goto-char beg)
(let ((linkp
(save-match-data
(org-in-regexp org-bracket-link-regexp))))
(and linkp (< (point) (cdr linkp))))))
;; Verify point doesn't belong to a LaTeX macro.
;; Beware though, when two footnotes are side by
;; side, once the first one is changed into LaTeX,
;; the second one might then be considered as an
;; optional argument of the command. Thus, check
;; the `org-protected' property of that command.
(or (not (org-inside-latex-macro-p))
(and (get-text-property (1- beg) 'org-protected)
(not (get-text-property beg 'org-protected)))))
@ -208,20 +239,33 @@ footnote text is included and defined locally.
The return value will be nil if not at a footnote definition, and a list with
label, start, end and definition of the footnote otherwise."
(save-excursion
(end-of-line)
(let ((lim (save-excursion (re-search-backward "^\\*+ \\|^[ \t]*$" nil t))))
(when (re-search-backward org-footnote-definition-re lim t)
(end-of-line)
(list (match-string 2)
(match-beginning 0)
(save-match-data
(or (and (re-search-forward
(org-re "^[ \t]*$\\|^\\*+ \\|^\\[\\([0-9]+\\|fn:[-_[:word:]]+\\)\\]")
nil t)
(progn (skip-chars-forward " \t\n") (point-at-bol)))
(point-max)))
(org-trim (buffer-substring (match-end 0) (point))))))))
(when (org-footnote-in-valid-context-p)
(save-excursion
(end-of-line)
(let ((lim (save-excursion (re-search-backward
(concat org-outline-regexp-bol
"\\|^[ \t]*$") nil t))))
(when (re-search-backward org-footnote-definition-re lim t)
(end-of-line)
(list (match-string 2)
(match-beginning 0)
(save-match-data
;; In a message, limit search to signature.
(let ((bound (and (derived-mode-p 'message-mode)
(save-excursion
(goto-char (point-max))
(re-search-backward
message-signature-separator nil t)))))
(or (and (re-search-forward
(org-re
(concat "^[ \t]*$" "\\|"
org-outline-regexp-bol
"\\|"
"^\\[\\([0-9]+\\|fn:[-_[:word:]]+\\)\\]"))
bound 'move)
(progn (skip-chars-forward " \t\n") (point-at-bol)))
(point))))
(org-trim (buffer-substring (match-end 0) (point)))))))))
(defun org-footnote-get-next-reference (&optional label backward limit)
"Return complete reference of the next footnote.
@ -380,6 +424,8 @@ This command prompts for a label. If this is a label referencing an
existing label, only insert the label. If the footnote label is empty
or new, let the user edit the definition of the footnote."
(interactive)
(unless (and (not (bolp)) (org-footnote-in-valid-context-p))
(error "Cannot insert a footnote here"))
(let* ((labels (and (not (equal org-footnote-auto-label 'random))
(org-footnote-all-labels)))
(propose (org-footnote-unique-label labels))
@ -433,21 +479,30 @@ or new, let the user edit the definition of the footnote."
(org-footnote-goto-local-insertion-point)
(org-show-context 'link-search))
(t
(let ((re (concat "^" org-footnote-tag-for-non-org-mode-files "[ \t]*$")))
(unless (re-search-forward re nil t)
(let ((max (if (and (derived-mode-p 'message-mode)
(re-search-forward message-signature-separator nil t))
(progn (beginning-of-line) (point))
(goto-char (point-max)))))
(skip-chars-backward " \t\r\n")
(delete-region (point) max)
(insert "\n\n")
(insert org-footnote-tag-for-non-org-mode-files "\n"))))
;; Skip existing footnotes
(while (re-search-forward "^[[:space:]]*\\[[^]]+\\] " nil t)
(forward-line))))
;; In a non-Org file. Search for footnote tag, or create it if
;; necessary (at the end of buffer, or before a signature if in
;; Message mode). Set point after any definition already there.
(let ((tag (concat "^" org-footnote-tag-for-non-org-mode-files "[ \t]*$"))
(max (save-excursion
(if (and (derived-mode-p 'message-mode)
(re-search-forward
message-signature-separator nil t))
(copy-marker (point-at-bol) t)
(copy-marker (point-max) t)))))
(goto-char max)
(unless (re-search-backward tag nil t)
(skip-chars-backward " \t\r\n")
(delete-region (point) max)
(insert "\n\n" org-footnote-tag-for-non-org-mode-files "\n"))
;; Skip existing footnotes.
(while (re-search-forward org-footnote-definition-re max t))
(let ((def (org-footnote-at-definition-p)))
(when def (goto-char (nth 2 def))))
(set-marker max nil))))
;; Insert footnote label, position point and notify user.
(unless (bolp) (insert "\n"))
(insert "\n[" label "] \n")
(goto-char (1- (point)))
(backward-char)
(message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'.")))
;;;###autoload
@ -501,7 +556,7 @@ With prefix arg SPECIAL, offer additional commands in a menu."
(defvar org-export-footnotes-data nil) ; silence byte-compiler
;;;###autoload
(defun org-footnote-normalize (&optional sort-only pre-process-p)
(defun org-footnote-normalize (&optional sort-only export-props)
"Collect the footnotes in various formats and normalize them.
This finds the different sorts of footnotes allowed in Org, and
@ -511,7 +566,10 @@ Org-mode exporters.
When SORT-ONLY is set, only sort the footnote definitions into the
referenced sequence.
When PRE-PROCESS-P is non-nil, the default action, is to insert
If Org is amidst an export process, EXPORT-PROPS will hold the
export properties of the buffer.
When EXPORT-PROPS is non-nil, the default action is to insert
normalized footnotes towards the end of the pre-processing buffer.
Some exporters like docbook, odt, etc. expect that footnote
definitions be available before any references to them. Such
@ -535,24 +593,24 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
(if org-odd-levels-only
(and limit-level (1- (* limit-level 2)))
limit-level)))
(outline-regexp
(org-outline-regexp
(concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ ")))
;; Determine the highest marker used so far.
(ref-table (when pre-process-p org-export-footnotes-seen))
(count (if (and pre-process-p ref-table)
(ref-table (when export-props org-export-footnotes-seen))
(count (if (and export-props ref-table)
(apply 'max (mapcar (lambda (e) (nth 1 e)) ref-table))
0))
ins-point ref)
(save-excursion
;; 1. Find every footnote reference, extract the definition, and
;; collect that data in REF-TABLE. If SORT-ONLY is nil, also
;; collect that data in REF-TABLE. If SORT-ONLY is nil, also
;; normalize references.
(goto-char (point-min))
(while (setq ref (org-footnote-get-next-reference))
(let* ((lbl (car ref))
;; When footnote isn't anonymous, check if it's label
;; (REF) is already stored in REF-TABLE. In that case,
;; extract number used to identify it (MARKER). If
;; (REF) is already stored in REF-TABLE. In that case,
;; extract number used to identify it (MARKER). If
;; footnote is unknown, increment the global counter
;; (COUNT) to create an unused identifier.
(a (and lbl (assoc lbl ref-table)))
@ -560,10 +618,10 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
;; Is the reference inline or pointing to an inline
;; footnote?
(inlinep (or (stringp (nth 3 ref)) (nth 3 a))))
;; Replace footnote reference with [MARKER]. Maybe fill
;; paragraph once done. If SORT-ONLY is non-nil, only move
;; Replace footnote reference with [MARKER]. Maybe fill
;; paragraph once done. If SORT-ONLY is non-nil, only move
;; to the end of reference found to avoid matching it twice.
;; If PRE-PROCESS-P isn't nil, also add `org-footnote'
;; If EXPORT-PROPS isn't nil, also add `org-footnote'
;; property to it, so it can be easily recognized by
;; exporters.
(if sort-only
@ -571,7 +629,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
(delete-region (nth 1 ref) (nth 2 ref))
(goto-char (nth 1 ref))
(let ((new-ref (format "[%d]" marker)))
(when pre-process-p (org-add-props new-ref '(org-footnote t)))
(when export-props (org-add-props new-ref '(org-footnote t)))
(insert new-ref))
(and inlinep
org-footnote-fill-after-inline-note-extraction
@ -579,17 +637,27 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
;; Add label (REF), identifier (MARKER) and definition (DEF)
;; to REF-TABLE if data was unknown.
(unless a
(let ((def (or (nth 3 ref) ; inline
(and pre-process-p
(let ((def (or (nth 3 ref) ; inline
(and export-props
(cdr (assoc lbl org-export-footnotes-data)))
(nth 3 (org-footnote-get-definition lbl)))))
(push (list lbl marker def inlinep) ref-table)))
(push (list lbl marker
;; When exporting, each definition goes
;; through `org-export-preprocess-string' so
;; it is ready to insert in the
;; backend-specific buffer.
(if export-props
(let ((parameters
(org-combine-plists
export-props
'(:todo-keywords t :tags t :priority t))))
(org-export-preprocess-string def parameters))
def)
inlinep) ref-table)))
;; Remove definition of non-inlined footnotes.
(unless inlinep (org-footnote-delete-definitions lbl))))
;; 2. Find and remove the footnote section, if any. If we are
;; exporting, insert it again at end of buffer. In a non
;; org-mode file, insert instead
;; `org-footnote-tag-for-non-org-mode-files'.
;; 2. Find and remove the footnote section, if any. Also
;; determine where footnotes shall be inserted (INS-POINT).
(goto-char (point-min))
(cond
((org-mode-p)
@ -598,29 +666,31 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
(concat "^\\*[ \t]+" (regexp-quote org-footnote-section)
"[ \t]*$")
nil t))
(if pre-process-p
(replace-match "")
(org-back-to-heading t)
(forward-line 1)
(setq ins-point (point))
(delete-region (point) (org-end-of-subtree t)))
(goto-char (point-max))
(unless pre-process-p
(when org-footnote-section
(or (bolp) (insert "\n"))
(insert "* " org-footnote-section "\n")
(setq ins-point (point))))))
(progn
(setq ins-point (match-beginning 0))
(delete-region (match-beginning 0) (org-end-of-subtree t)))
(setq ins-point (point-max))))
(t
(if (re-search-forward
(concat "^"
(regexp-quote org-footnote-tag-for-non-org-mode-files)
"[ \t]*$")
nil t)
(replace-match ""))
(goto-char (point-max))
(skip-chars-backward " \t\n\r")
(delete-region (point) (point-max))
(insert "\n\n" org-footnote-tag-for-non-org-mode-files "\n")
(when (re-search-forward
(concat "^"
(regexp-quote org-footnote-tag-for-non-org-mode-files)
"[ \t]*$")
nil t)
(replace-match ""))
;; In message-mode, ensure footnotes are inserted before the
;; signature.
(let ((pt-max
(or (and (derived-mode-p 'message-mode)
(save-excursion
(goto-char (point-max))
(re-search-backward
message-signature-separator nil t)
(1- (point))))
(point-max))))
(goto-char pt-max)
(skip-chars-backward " \t\n\r")
(forward-line)
(delete-region (point) pt-max))
(setq ins-point (point))))
;; 3. Clean-up REF-TABLE.
(setq ref-table
@ -641,30 +711,39 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
;; 4. Insert the footnotes again in the buffer, at the
;; appropriate spot.
(goto-char (or
(and pre-process-p
(and export-props
(eq org-footnote-insert-pos-for-preprocessor 'point-min)
(point-min))
ins-point
(point-max)))
(cond
((not ref-table)) ; no footnote: exit
;; Cases when footnotes should be inserted together in one place.
;; No footnote: exit.
((not ref-table))
;; Cases when footnotes should be inserted in one place.
((or (not (org-mode-p))
org-footnote-section
(not sort-only))
;; Insert again the section title.
(cond
((not (org-mode-p))
(insert "\n\n" org-footnote-tag-for-non-org-mode-files "\n"))
((and org-footnote-section (not export-props))
(or (bolp) (insert "\n"))
(insert "* " org-footnote-section "\n")))
;; Insert the footnotes.
(insert "\n"
(mapconcat (lambda (x) (format "[%s] %s"
(nth (if sort-only 0 1) x) (nth 2 x)))
ref-table "\n\n")
"\n\n")
;; When exporting, add newly insert markers along with their
;; associated definition to `org-export-footnotes-seen'.
(when pre-process-p
;; When exporting, add newly inserted markers along with their
;; associated definition to `org-export-footnotes-seen'.
(when export-props
(setq org-export-footnotes-seen ref-table)))
;; Else, insert each definition at the end of the section
;; containing their first reference. Happens only in Org
;; files with no special footnote section, and only when
;; doing sorting.
;; containing their first reference. Happens only in Org files
;; with no special footnote section, and only when doing
;; sorting.
(t (mapc 'org-insert-footnote-reference-near-definition
ref-table))))))

253
lisp/org-html.el
View File

@ -35,6 +35,8 @@
(declare-function org-id-find-id-file "org-id" (id))
(declare-function htmlize-region "ext:htmlize" (beg end))
(declare-function org-pop-to-buffer-same-window
"org-compat" (&optional buffer-or-name norecord label))
(defgroup org-export-html nil
"Options specific for HTML export of Org-mode files."
@ -367,11 +369,13 @@ precedence over this variable."
(string :tag "Custom formatting string")
(function :tag "Function (must return a string)")))
(defcustom org-export-html-preamble-format
'(("en" "<h1 class=\"title\">%t</h1>"))
(defcustom org-export-html-preamble-format '(("en" ""))
"The format for the HTML preamble.
%t stands for the title.
%a stands for the author's name.
%e stands for the author's email.
%d stands for the date.
If you need to use a \"%\" character, you need to escape it
like that: \"%%\"."
@ -407,10 +411,10 @@ precedence over this variable."
"))
"The format for the HTML postamble.
%a stands for the author.
%e stands for the email(s).
%a stands for the author's name.
%e stands for the author's email.
%d stands for the date.
%c will be replaced by information about Org/Emacs.
%c will be replaced by information about Org/Emacs versions.
%v will be replaced by `org-export-html-validation-link'.
If you need to use a \"%\" character, you need to escape it
@ -546,19 +550,15 @@ When nil, also column one will use data tags."
:group 'org-export-html
:type 'string)
(defcustom org-export-html-with-timestamp nil
"If non-nil, write timestamp into the exported HTML text.
If non-nil, write `org-export-html-html-helper-timestamp' into the
exported HTML text. Otherwise, the buffer will just be saved to
a file."
:group 'org-export-html
:type 'boolean)
;; FIXME Obsolete since Org 7.7
;; Use the :timestamp option or `org-export-time-stamp-file' instead
(defvar org-export-html-with-timestamp nil
"If non-nil, write container for HTML-helper-mode timestamp.")
(defcustom org-export-html-html-helper-timestamp
"<br/><br/><hr/><p><!-- hhmts start --> <!-- hhmts end --></p>\n"
"The HTML tag used as timestamp delimiter for HTML-helper-mode."
:group 'org-export-html
:type 'string)
;; FIXME Obsolete since Org 7.7
(defvar org-export-html-html-helper-timestamp
"\n<p><br/><br/>\n<!-- hhmts start --> <!-- hhmts end --></p>\n"
"The HTML tag used as timestamp delimiter for HTML-helper-mode.")
(defcustom org-export-html-protect-char-alist
'(("&" . "&amp;")
@ -612,10 +612,22 @@ with a link to this URL."
(const :tag "Keep internal css" nil)
(string :tag "URL or local href")))
(defcustom org-export-content-div "content"
"The name of the container DIV that holds all the page contents."
:group 'org-export-htmlize
:type 'string)
;; FIXME: The following variable is obsolete since Org 7.7 but is
;; still declared and checked within code for compatibility reasons.
;; Use the custom variables `org-export-html-divs' instead.
(defvar org-export-html-content-div "content"
"The name of the container DIV that holds all the page contents.
This variable is obsolete since Org version 7.7.
Please set `org-export-html-divs' instead.")
(defcustom org-export-html-divs '("preamble" "content" "postamble")
"The name of the main divs for HTML export."
:group 'org-export-html
:type '(list
(string :tag " Div for the preamble:")
(string :tag " Div for the content:")
(string :tag "Div for the postamble:")))
;;; Hooks
@ -1292,7 +1304,6 @@ lang=\"%s\" xml:lang=\"%s\">
%s
</head>
<body>
<div id=\"%s\">
%s
"
(format
@ -1309,7 +1320,6 @@ lang=\"%s\" xml:lang=\"%s\">
date author description keywords
style
mathjax
org-export-content-div
(if (or link-up link-home)
(concat
(format org-export-html-home/up-format
@ -1321,12 +1331,13 @@ lang=\"%s\" xml:lang=\"%s\">
;; insert html preamble
(when (plist-get opt-plist :html-preamble)
(let ((html-pre (plist-get opt-plist :html-preamble)))
(insert "<div id=\"" (nth 0 org-export-html-divs) "\">\n")
(cond ((stringp html-pre)
(insert
(format-spec html-pre `((?t . ,title) (?a . ,author)
(?d . ,date) (?e . ,email)))))
((functionp html-pre)
(funcall html-pre opt-plist))
(funcall html-pre))
(t
(insert
(format-spec
@ -1334,8 +1345,19 @@ lang=\"%s\" xml:lang=\"%s\">
org-export-html-preamble-format))
(cadr (assoc "en" org-export-html-preamble-format)))
`((?t . ,title) (?a . ,author)
(?d . ,date) (?e . ,email)))))))))
(?d . ,date) (?e . ,email))))))
(insert "\n</div>\n")))
;; begin wrap around body
(insert (format "\n<div id=\"%s\">"
;; FIXME org-export-html-content-div is obsolete since 7.7
(or org-export-html-content-div
(nth 1 org-export-html-divs)))
;; FIXME this should go in the preamble but is here so
;; that org-infojs can still find it
"\n<h1 class=\"title\">" title "</h1>\n"))
;; insert body
(if (and org-export-with-toc (not body-only))
(progn
(push (format "<h%d>%s</h%d>\n"
@ -1346,93 +1368,97 @@ lang=\"%s\" xml:lang=\"%s\">
(push "<div id=\"text-table-of-contents\">\n" thetoc)
(push "<ul>\n<li>" thetoc)
(setq lines
(mapcar #'(lambda (line)
(if (and (string-match org-todo-line-regexp line)
(not (get-text-property 0 'org-protected 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 (save-match-data
(org-html-expand
(org-export-cleanup-toc-line
(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)))
(mapcar
#'(lambda (line)
(if (and (string-match org-todo-line-regexp line)
(not (get-text-property 0 'org-protected 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 (save-match-data
(org-html-expand
(org-export-cleanup-toc-line
(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))))
(if (string-match
(org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt)
(setq txt (replace-match "&nbsp;&nbsp;&nbsp;<span class=\"tag\"> \\1</span>" t nil txt)))
(if (string-match quote-re0 txt)
(setq txt (replace-match "" t t txt)))
(setq snumber (org-section-number level))
(if (and num (if (integerp num)
(>= num level)
num))
(setq txt (concat snumber " " txt)))
(if (<= level (max umax umax-toc))
(setq head-count (+ head-count 1)))
(if (<= level umax-toc)
(and org-export-mark-todo-in-toc
(= level umax-toc)
(org-search-todo-below
line lines level))))
(if (string-match
(org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt)
(setq txt (replace-match
"&nbsp;&nbsp;&nbsp;<span class=\"tag\"> \\1</span>" t nil txt)))
(if (string-match quote-re0 txt)
(setq txt (replace-match "" t t txt)))
(setq snumber (org-section-number level))
(if (and num (if (integerp num)
(>= num level)
num))
(setq txt (concat snumber " " txt)))
(if (<= level (max umax umax-toc))
(setq head-count (+ head-count 1)))
(if (<= level umax-toc)
(progn
(if (> level org-last-level)
(progn
(if (> level org-last-level)
(progn
(setq cnt (- level org-last-level))
(while (>= (setq cnt (1- cnt)) 0)
(push "\n<ul>\n<li>" thetoc))
(push "\n" thetoc)))
(if (< level org-last-level)
(progn
(setq cnt (- org-last-level level))
(while (>= (setq cnt (1- cnt)) 0)
(push "</li>\n</ul>" thetoc))
(push "\n" thetoc)))
;; Check for targets
(while (string-match org-any-target-regexp line)
(setq line (replace-match
(concat "@<span class=\"target\">" (match-string 1 line) "@</span> ")
t t line)))
(while (string-match "&lt;\\(&lt;\\)+\\|&gt;\\(&gt;\\)+" txt)
(setq txt (replace-match "" t t txt)))
(setq href
(replace-regexp-in-string
"\\." "-" (format "sec-%s" snumber)))
(setq href (org-solidify-link-text (or (cdr (assoc href org-export-preferred-target-alist)) href)))
(push
(format
(if todo
"</li>\n<li><a href=\"#%s\"><span class=\"todo\">%s</span></a>"
"</li>\n<li><a href=\"#%s\">%s</a>")
href txt) thetoc)
(setq org-last-level level))
)))
line)
lines))
(setq cnt (- level org-last-level))
(while (>= (setq cnt (1- cnt)) 0)
(push "\n<ul>\n<li>" thetoc))
(push "\n" thetoc)))
(if (< level org-last-level)
(progn
(setq cnt (- org-last-level level))
(while (>= (setq cnt (1- cnt)) 0)
(push "</li>\n</ul>" thetoc))
(push "\n" thetoc)))
;; Check for targets
(while (string-match org-any-target-regexp line)
(setq line (replace-match
(concat "@<span class=\"target\">"
(match-string 1 line) "@</span> ")
t t line)))
(while (string-match "&lt;\\(&lt;\\)+\\|&gt;\\(&gt;\\)+" txt)
(setq txt (replace-match "" t t txt)))
(setq href
(replace-regexp-in-string
"\\." "-" (format "sec-%s" snumber)))
(setq href (org-solidify-link-text
(or (cdr (assoc href
org-export-preferred-target-alist)) href)))
(push
(format
(if todo
"</li>\n<li><a href=\"#%s\"><span class=\"todo\">%s</span></a>"
"</li>\n<li><a href=\"#%s\">%s</a>")
href txt) thetoc)
(setq org-last-level level)))))
line)
lines))
(while (> org-last-level (1- org-min-level))
(setq org-last-level (1- org-last-level))
(push "</li>\n</ul>\n" thetoc))
(push "</div>\n" thetoc)
(setq thetoc (if have-headings (nreverse thetoc) nil))))
(setq head-count 0)
(org-init-section-numbers)
(org-open-par)
(while (setq line (pop lines) origline line)
(catch 'nextline
;; end of quote section?
(when (and inquote (string-match "^\\*+ " line))
(when (and inquote (string-match org-outline-regexp-bol line))
(insert "</pre>\n")
(org-open-par)
(setq inquote nil))
@ -1739,8 +1765,11 @@ lang=\"%s\" xml:lang=\"%s\">
(when bib
(insert "\n" bib "\n")))
;; export html postamble
(unless body-only
;; end wrap around body
(insert "</div>\n")
;; export html postamble
(let ((html-post (plist-get opt-plist :html-postamble))
(email
(mapconcat (lambda(e)
@ -1750,19 +1779,18 @@ lang=\"%s\" xml:lang=\"%s\">
(creator-info
(concat "Org version " org-version " with Emacs version "
(number-to-string emacs-major-version))))
(when (plist-get opt-plist :html-postamble)
(insert "\n<div id=\"" (nth 2 org-export-html-divs) "\">\n")
(cond ((stringp html-post)
(insert "<div id=\"postamble\">\n")
(insert (format-spec html-post
`((?a . ,author) (?e . ,email)
(?d . ,date) (?c . ,creator-info)
(?v . ,html-validation-link))))
(insert "</div>"))
(?v . ,html-validation-link)))))
((functionp html-post)
(funcall html-post opt-plist))
(funcall html-post))
((eq html-post 'auto)
;; fall back on default postamble
(insert "<div id=\"postamble\">\n")
(when (plist-get opt-plist :time-stamp-file)
(insert "<p class=\"date\">" (nth 2 lang-words) ": " date "</p>\n"))
(when (and (plist-get opt-plist :author-info) author)
@ -1773,22 +1801,23 @@ lang=\"%s\" xml:lang=\"%s\">
(insert "<p class=\"creator\">"
(concat "Org version " org-version " with Emacs version "
(number-to-string emacs-major-version) "</p>\n")))
(insert html-validation-link "\n</div>"))
(insert html-validation-link "\n"))
(t
(insert "<div id=\"postamble\">\n")
(insert (format-spec
(or (cadr (assoc (nth 0 lang-words)
org-export-html-postamble-format))
(cadr (assoc "en" org-export-html-postamble-format)))
`((?a . ,author) (?e . ,email)
(?d . ,date) (?c . ,creator-info)
(?v . ,html-validation-link))))
(insert "</div>"))))))
(?v . ,html-validation-link))))))
(insert "\n</div>"))))
;; FIXME `org-export-html-with-timestamp' has been declared
;; obsolete since Org 7.7 -- don't forget to remove this.
(if org-export-html-with-timestamp
(insert org-export-html-html-helper-timestamp))
(unless body-only (insert "\n</div>\n</body>\n</html>\n"))
(unless body-only (insert "\n</body>\n</html>\n"))
(unless (plist-get opt-plist :buffer-will-be-killed)
(normal-mode)
@ -2237,7 +2266,7 @@ that uses these same face definitions."
(when (and (symbolp f) (or (not i) (not (listp i))))
(insert (org-add-props (copy-sequence "1") nil 'face f))))
(htmlize-region (point-min) (point-max))))
(switch-to-buffer "*html*")
(org-pop-to-buffer-same-window "*html*")
(goto-char (point-min))
(if (re-search-forward "<style" nil t)
(delete-region (point-min) (match-beginning 0)))

4
lisp/org-id.el
View File

@ -74,6 +74,8 @@
(require 'org)
(declare-function message-make-fqdn "message" ())
(declare-function org-pop-to-buffer-same-window
"org-compat" (&optional buffer-or-name norecord label))
;;; Customization
@ -253,7 +255,7 @@ Move the cursor to that entry in that buffer."
(let ((m (org-id-find id 'marker)))
(unless m
(error "Cannot find entry with ID \"%s\"" id))
(switch-to-buffer (marker-buffer m))
(org-pop-to-buffer-same-window (marker-buffer m))
(goto-char m)
(move-marker m nil)
(org-show-context)))

6
lisp/org-indent.el
View File

@ -217,7 +217,7 @@ useful to make it ever so slightly different."
'(line-prefix nil wrap-prefix nil) string)
string)
(defvar org-indent-outline-re (concat "^" org-outline-regexp)
(defvar org-indent-outline-re org-outline-regexp-bol
"Outline heading regexp.")
(defun org-indent-add-properties (beg end)
@ -273,7 +273,7 @@ Point is assumed to be at the beginning of a headline."
(when org-indent-mode
(let (beg end)
(save-excursion
(when (ignore-errors (let ((outline-regexp (format "\\*\\{1,%s\\}[ \t]+"
(when (ignore-errors (let ((org-outline-regexp (format "\\*\\{1,%s\\}[ \t]+"
(if (featurep 'org-inlinetask)
(1- org-inlinetask-min-level)
""))))
@ -290,7 +290,7 @@ Point is assumed to be at the beginning of a headline."
(when org-indent-mode
(let ((beg (point)) (end limit))
(save-excursion
(and (ignore-errors (let ((outline-regexp (format "\\*\\{1,%s\\}[ \t]+"
(and (ignore-errors (let ((org-outline-regexp (format "\\*\\{1,%s\\}[ \t]+"
(if (featurep 'org-inlinetask)
(1- org-inlinetask-min-level)
""))))

8
lisp/org-irc.el
View File

@ -60,6 +60,8 @@
(declare-function erc-server-buffer "erc" ())
(declare-function erc-get-server-nickname-list "erc" ())
(declare-function erc-cmd-JOIN "erc" (channel &optional key))
(declare-function org-pop-to-buffer-same-window
"org-compat" (&optional buffer-or-name norecord label))
(defvar org-irc-client 'erc
"The IRC client to act on.")
@ -232,7 +234,7 @@ default."
(throw 'found x))))))
(if chan-buf
(progn
(switch-to-buffer chan-buf)
(org-pop-to-buffer-same-window chan-buf)
;; if we got a nick, and they're in the chan,
;; then start a chat with them
(let ((nick (pop link)))
@ -243,9 +245,9 @@ default."
(insert (concat nick ": ")))
(error "%s not found in %s" nick chan-name)))))
(progn
(switch-to-buffer server-buffer)
(org-pop-to-buffer-same-window server-buffer)
(erc-cmd-JOIN chan-name))))
(switch-to-buffer server-buffer)))
(org-pop-to-buffer-same-window server-buffer)))
;; no server match, make new connection
(erc-select :server server :port port))))

260
lisp/org-latex.el
View File

@ -75,8 +75,8 @@
org-closed-string"\\)")
"Regexp matching special time planning keywords plus the time after it.")
(defvar re-quote) ; dynamically scoped from org.el
(defvar commentsp) ; dynamically scoped from org.el
(defvar org-re-quote) ; dynamically scoped from org.el
(defvar org-commentsp) ; dynamically scoped from org.el
;;; User variables:
@ -304,8 +304,10 @@ markup defined, the first one in the association list will be used."
(defcustom org-export-latex-href-format "\\href{%s}{%s}"
"A printf format string to be applied to href links.
The format must contain two %s instances. The first will be filled with
the link, the second with the link description."
The format must contain either two %s instances or just one.
If it contains two %s instances, the first will be filled with
the link, the second with the link description. If it contains
only one, the %s will be filled with the link."
:group 'org-export-latex
:type 'string)
@ -321,6 +323,32 @@ will be filled with the link, the second with its description."
:group 'org-export-latex
:type 'string)
(defcustom org-export-latex-quotes
'(("fr" ("\\(\\s-\\|[[(]\\)\"" . "«~") ("\\(\\S-\\)\"" . "~»") ("\\(\\s-\\|(\\)'" . "'"))
("en" ("\\(\\s-\\|[[(]\\)\"" . "``") ("\\(\\S-\\)\"" . "''") ("\\(\\s-\\|(\\)'" . "`")))
"Alist for quotes to use when converting english double-quotes.
The CAR of each item in this alist is the language code.
The CDR of each item in this alist is a list of three CONS:
- the first CONS defines the opening quote;
- the second CONS defines the closing quote;
- the last CONS defines single quotes.
For each item in a CONS, the first string is a regexp
for allowed characters before/after the quote, the second
string defines the replacement string for this quote."
:group 'org-export-latex
:type '(list
(cons :tag "Opening quote"
(string :tag "Regexp for char before")
(string :tag "Replacement quote "))
(cons :tag "Closing quote"
(string :tag "Regexp for char after ")
(string :tag "Replacement quote "))
(cons :tag "Single quote"
(string :tag "Regexp for char before")
(string :tag "Replacement quote "))))
(defcustom org-export-latex-tables-verbatim nil
"When non-nil, tables are exported verbatim."
:group 'org-export-latex
@ -365,7 +393,7 @@ string should be like \"\\end{itemize\"."
(string :tag "Use a section string" :value "\\subparagraph{%s}")))
(defcustom org-export-latex-list-parameters
'(:cbon "$\\boxtimes$" :cboff "$\\Box$")
'(:cbon "$\\boxtimes$" :cboff "$\\Box$" :cbtrans "$\\boxminus$")
"Parameters for the LaTeX list exporter.
These parameters will be passed on to `org-list-to-latex', which in turn
will pass them (combined with the LaTeX default list parameters) to
@ -546,7 +574,7 @@ and `org-export-with-tags' instead."
:type 'plist
:group 'org-export-latex)
(defcustom org-export-latex-image-default-option "width=10em"
(defcustom org-export-latex-image-default-option "width=.9\\linewidth"
"Default option for images."
:group 'org-export-latex
:type 'string)
@ -1017,26 +1045,28 @@ when PUB-DIR is set, use this as the publishing directory."
(with-current-buffer outbuf (erase-buffer))
(message (concat "Processing LaTeX file " file "..."))
(setq output-dir (file-name-directory file))
(if (and cmds (symbolp cmds))
(funcall cmds (shell-quote-argument file))
(while cmds
(setq cmd (pop cmds))
(while (string-match "%b" cmd)
(setq cmd (replace-match
(save-match-data
(shell-quote-argument base))
t t cmd)))
(while (string-match "%f" cmd)
(setq cmd (replace-match
(save-match-data
(shell-quote-argument file))
t t cmd)))
(while (string-match "%o" cmd)
(setq cmd (replace-match
(save-match-data
(shell-quote-argument output-dir))
t t cmd)))
(shell-command cmd outbuf)))
(with-current-buffer lbuf
(save-excursion
(if (and cmds (symbolp cmds))
(funcall cmds (shell-quote-argument file))
(while cmds
(setq cmd (pop cmds))
(while (string-match "%b" cmd)
(setq cmd (replace-match
(save-match-data
(shell-quote-argument base))
t t cmd)))
(while (string-match "%f" cmd)
(setq cmd (replace-match
(save-match-data
(shell-quote-argument file))
t t cmd)))
(while (string-match "%o" cmd)
(setq cmd (replace-match
(save-match-data
(shell-quote-argument output-dir))
t t cmd)))
(shell-command cmd outbuf)))))
(message (concat "Processing LaTeX file " file "...done"))
(setq errors (org-export-latex-get-error outbuf))
(if (not (file-exists-p pdffile))
@ -1461,8 +1491,6 @@ If END is non-nil, it is the end of the region."
(defvar org-export-latex-header-defs nil
"The header definitions that might be used in the LaTeX body.")
(defvar org-export-latex-header-defs-re nil
"The header definitions that might be used in the LaTeX body.")
(defun org-export-latex-content (content &optional exclude-list)
"Convert CONTENT string to LaTeX.
@ -1626,21 +1654,18 @@ links, keywords, lists, tables, fixed-width"
(defun org-export-latex-quotation-marks ()
"Export quotation marks depending on language conventions."
(let* ((lang (plist-get org-export-latex-options-plist :language))
(quote-rpl (if (equal lang "fr")
'(("\\(\\s-\\)\"" "«~")
("\\(\\S-\\)\"" "~»")
("\\(\\s-\\)'" "`"))
'(("\\(\\s-\\|[[(]\\)\"" "``")
("\\(\\S-\\)\"" "''")
("\\(\\s-\\|(\\)'" "`")))))
(mapc (lambda(l) (goto-char (point-min))
(while (re-search-forward (car l) nil t)
(let ((rpl (concat (match-string 1)
(org-export-latex-protect-string
(copy-sequence (cadr l))))))
(org-if-unprotected-1
(replace-match rpl t t))))) quote-rpl)))
(mapc (lambda(l)
(goto-char (point-min))
(while (re-search-forward (car l) nil t)
(let ((rpl (concat (match-string 1)
(org-export-latex-protect-string
(copy-sequence (cdr l))))))
(org-if-unprotected-1
(replace-match rpl t t)))))
(cdr (or (assoc (plist-get org-export-latex-options-plist :language)
org-export-latex-quotes)
;; falls back on english
(assoc "en" org-export-latex-quotes)))))
(defun org-export-latex-special-chars (sub-superscript)
"Export special characters to LaTeX.
@ -1930,7 +1955,9 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(mapcar
(lambda(elem)
(or (and (string-match "[ \t]*|-+" elem) 'hline)
(org-split-string (org-trim elem) "|")))
(org-split-string
(progn (set-text-properties 0 (length elem) nil elem)
(org-trim elem)) "|")))
lines))
(when insert
(insert (org-export-latex-protect-string
@ -2176,7 +2203,10 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
;; a LaTeX issue, but we here implement a work-around anyway.
(setq path (org-export-latex-protect-amp path)
desc (org-export-latex-protect-amp desc)))
(insert (format org-export-latex-href-format path desc)))
(insert
(if (string-match "%s.*%s" org-export-latex-href-format)
(format org-export-latex-href-format path desc)
(format org-export-latex-href-format path))))
((functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
;; The link protocol has a function for formatting the link
@ -2273,6 +2303,68 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(defun org-export-latex-preprocess (parameters)
"Clean stuff in the LaTeX export."
;; Replace footnotes.
(when (plist-get parameters :footnotes)
(goto-char (point-min))
(let (ref)
(while (setq ref (org-footnote-get-next-reference))
(let* ((beg (nth 1 ref))
(lbl (car ref))
(def (nth 1 (assoc (string-to-number lbl)
(mapcar (lambda (e) (cdr e))
org-export-footnotes-seen)))))
;; Fix body for footnotes ending on a link or a list and
;; remove definition from buffer.
(setq def
(concat def
(if (string-match "ORG-LIST-END-MARKER\\'" def)
"\n" " ")))
(org-footnote-delete-definitions lbl)
;; Compute string to insert (FNOTE), and protect the outside
;; macro from further transformation. When footnote at
;; point is referring to a previously defined footnote, use
;; \footnotemark. Otherwise, use \footnote.
(let ((fnote (if (member lbl org-export-latex-footmark-seen)
(org-export-latex-protect-string
(format "\\footnotemark[%s]" lbl))
(push lbl org-export-latex-footmark-seen)
(concat (org-export-latex-protect-string "\\footnote{")
def
(org-export-latex-protect-string "}"))))
;; Check if another footnote is immediately following.
;; If so, add a separator in-between.
(sep (org-export-latex-protect-string
(if (save-excursion (goto-char (1- (nth 2 ref)))
(let ((next (org-footnote-get-next-reference)))
(and next (= (nth 1 next) (nth 2 ref)))))
org-export-latex-footnote-separator ""))))
(when (org-on-heading-p)
(setq fnote (concat (org-export-latex-protect-string "\\protect")
fnote)))
;; Ensure a footnote at column 0 cannot end a list
;; containing it.
(put-text-property 0 (length fnote) 'original-indentation 1000 fnote)
;; Replace footnote reference with FNOTE and, maybe, SEP.
;; `save-excursion' is required if there are two footnotes
;; in a row. In that case, point would be left at the
;; beginning of the second one, and
;; `org-footnote-get-next-reference' would then skip it.
(goto-char beg)
(delete-region beg (nth 2 ref))
(save-excursion (insert fnote sep)))))))
;; Remove footnote section tag for LaTeX
(goto-char (point-min))
(while (re-search-forward
(concat "^" footnote-section-tag-regexp) nil t)
(org-if-unprotected
(replace-match "")))
;; Remove any left-over footnote definition.
(mapc (lambda (fn) (org-footnote-delete-definitions (car fn)))
org-export-footnotes-data)
(mapc (lambda (fn) (org-footnote-delete-definitions fn))
org-export-latex-footmark-seen)
;; Preserve line breaks
(goto-char (point-min))
(while (re-search-forward "\\\\\\\\" nil t)
@ -2294,7 +2386,6 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(goto-char (point-at-eol))))))
;; Preserve math snippets
(let* ((matchers (plist-get org-format-latex-options :matchers))
(re-list org-latex-regexps)
beg end re e m n block off)
@ -2354,7 +2445,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(while (re-search-forward
"^[ \t]*#\\+index:[ \t]*\\([^ \t\r\n].*?\\)[ \t]*$"
nil t)
(setq entry
(setq entry
(save-match-data
(org-export-latex-protect-string
(org-export-latex-fontify-headline (match-string 1)))))
@ -2386,12 +2477,17 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
"\\(" (org-create-multibrace-regexp "{" "}" 3) "\\)\\{1,3\\}")))
(while (re-search-forward re nil t)
(unless (or
;; check for comment line
;; Check for comment line.
(save-excursion (goto-char (match-beginning 0))
(org-in-indented-comment-line))
;; Check if this is a defined entity, so that is may need conversion
;; Check if this is a defined entity, so that is may
;; need conversion.
(org-entity-get (match-string 1))
)
;; Do not protect interior of footnotes. Those have
;; already been taken care of earlier in the function.
;; Yet, keep looking inside them for more commands.
(and (equal (match-string 1) "footnote")
(goto-char (match-end 1))))
(add-text-properties (match-beginning 0) (match-end 0)
'(org-protected t)))))
@ -2427,69 +2523,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(goto-char (point-min))
(while (re-search-forward "@<\\(?:[^\"\n]\\|\".*\"\\)*?>" nil t)
(org-if-unprotected
(replace-match "")))
;; When converting to LaTeX, replace footnotes.
(when (plist-get parameters :footnotes)
(goto-char (point-min))
(let (ref)
(while (setq ref (org-footnote-get-next-reference))
(let* ((beg (nth 1 ref))
(lbl (car ref))
(def (nth 1 (assoc (string-to-number lbl)
(mapcar (lambda (e) (cdr e))
org-export-footnotes-seen)))))
;; Fix body for footnotes ending on a link or a list and
;; remove definition from buffer.
(setq def
(concat def
(if (string-match "ORG-LIST-END-MARKER\\'" def)
"\n" " ")))
(org-footnote-delete-definitions lbl)
;; Compute string to insert (FNOTE), and protect the outside
;; macro from further transformation. When footnote at point
;; is referring to a previously defined footnote, use
;; \footnotemark. Otherwise, use \footnote.
(let ((fnote (if (member lbl org-export-latex-footmark-seen)
(org-export-latex-protect-string
(format "\\footnotemark[%s]" lbl))
(push lbl org-export-latex-footmark-seen)
(concat (org-export-latex-protect-string "\\footnote{")
def
(org-export-latex-protect-string "}"))))
;; Check if another footnote is immediately following.
;; If so, add a separator in-between.
(sep (org-export-latex-protect-string
(if (save-excursion (goto-char (1- (nth 2 ref)))
(let ((next (org-footnote-get-next-reference)))
(and next (= (nth 1 next) (nth 2 ref)))))
org-export-latex-footnote-separator ""))))
(when (org-on-heading-p)
(setq fnote (concat (org-export-latex-protect-string"\\protect")
fnote)))
;; Ensure a footnote at column 0 cannot end a list
;; containing it.
(put-text-property 0 (length fnote) 'original-indentation 1000 fnote)
;; Replace footnote reference with FNOTE and, maybe, SEP.
;; `save-excursion' is required if there are two footnotes
;; in a row. In that case, point would be left at the
;; beginning of the second one, and
;; `org-footnote-get-next-reference' would then skip it.
(goto-char beg)
(delete-region beg (nth 2 ref))
(save-excursion (insert fnote sep)))))))
;; Remove footnote section tag for LaTeX
(goto-char (point-min))
(while (re-search-forward
(concat "^" footnote-section-tag-regexp) nil t)
(org-if-unprotected
(replace-match "")))
;; Remove any left-over footnote definition.
(mapc (lambda (fn) (org-footnote-delete-definitions (car fn)))
org-export-footnotes-data)
(mapc (lambda (fn) (org-footnote-delete-definitions fn))
org-export-latex-footmark-seen))
(replace-match ""))))
(defun org-export-latex-fix-inputenc ()
"Set the coding system in inputenc to what the buffer is."

442
lisp/org-list.el
View File

@ -76,7 +76,7 @@
;;; Code:
(eval-when-compile
(eval-when-compile
(require 'cl))
(require 'org-macs)
(require 'org-compat)
@ -106,9 +106,8 @@
(declare-function org-fix-tags-on-the-fly "org" ())
(declare-function org-get-indentation "org" (&optional line))
(declare-function org-icompleting-read "org" (&rest args))
(declare-function org-in-block-p "org" (names))
(declare-function org-in-regexp "org" (re &optional nlines visually))
(declare-function org-in-regexps-block-p "org"
(start-re end-re &optional bound))
(declare-function org-inlinetask-goto-beginning "org-inlinetask" ())
(declare-function org-inlinetask-goto-end "org-inlinetask" ())
(declare-function org-inlinetask-in-task-p "org-inlinetask" ())
@ -203,10 +202,7 @@ into
(defcustom org-plain-list-ordered-item-terminator t
"The character that makes a line with leading number an ordered list item.
Valid values are ?. and ?\). To get both terminators, use t. While
?. may look nicer, it creates the danger that a line with leading
number may be incorrectly interpreted as an item. ?\) therefore is
the safe choice."
Valid values are ?. and ?\). To get both terminators, use t."
:group 'org-plain-lists
:type '(choice (const :tag "dot like in \"2.\"" ?.)
(const :tag "paren like in \"2)\"" ?\))
@ -300,6 +296,18 @@ indent when non-nil, indenting or outdenting list top-item
: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.
In that case, the item following the last item is the first one,
and the item preceding the first item is the last one.
This affects the behavior of \\[org-move-item-up],
\\[org-move-item-down], \\[org-next-item] and
\\[org-previous-item]."
:group 'org-plain-lists
:type 'boolean)
(defvar org-checkbox-statistics-hook nil
"Hook that is run whenever Org thinks checkbox statistics should be updated.
This hook runs even if checkbox rule in
@ -322,6 +330,13 @@ When the indentation would be larger than this, it will become
:group 'org-plain-lists
:type 'integer)
(defcustom org-list-indent-offset 0
"Additional indentation for sub-items in a list.
By setting this to a small number, usually 1 or 2, one can more
clearly distinguish sub-items in a list."
:group 'org-plain-lists
:type 'integer)
(defcustom org-list-radio-list-templates
'((latex-mode "% BEGIN RECEIVE ORGLST %n
% END RECEIVE ORGLST %n
@ -349,7 +364,8 @@ list, obtained by prompting the user."
(list (symbol :tag "Major mode")
(string :tag "Format"))))
(defvar org-list-forbidden-blocks '("example" "verse" "src" "latex" "html" "docbook")
(defvar org-list-forbidden-blocks '("example" "verse" "src" "ascii" "beamer"
"docbook" "html" "latex" "odt")
"Names of blocks where lists are not allowed.
Names must be in lower case.")
@ -410,15 +426,8 @@ group 4: description tag")
(looking-at regexp))))
(defun org-list-in-valid-context-p ()
"Non-nil if point is in a valid block.
Invalid blocks are referring to `org-list-forbidden-blocks'."
(save-match-data
(let ((case-fold-search t))
(not (org-in-regexps-block-p
(concat "^[ \t]*#\\+begin_\\("
(mapconcat 'regexp-quote org-list-forbidden-blocks "\\|")
"\\)")
'(concat "^[ \t]*#\\+end_" (match-string 1)))))))
"Is point in a context where lists are allowed?"
(not (org-in-block-p org-list-forbidden-blocks)))
(defun org-in-item-p ()
"Return item beginning position when in a plain list, nil otherwise.
@ -1091,6 +1100,61 @@ It determines the number of whitespaces to append by looking at
(string-match "\\S-+\\([ \t]*\\)" bullet)
(replace-match spaces nil nil bullet 1))))
(defun org-list-swap-items (beg-A beg-B struct)
"Swap item starting at BEG-A with item starting at BEG-B in STRUCT.
Blank lines at the end of items are left in place. Return the
new structure after the changes.
Assume BEG-A is lesser than BEG-B and that BEG-A and BEG-B belong
to the same sub-list.
This function modifies STRUCT."
(save-excursion
(let* ((end-A-no-blank (org-list-get-item-end-before-blank beg-A struct))
(end-B-no-blank (org-list-get-item-end-before-blank beg-B struct))
(end-A (org-list-get-item-end beg-A struct))
(end-B (org-list-get-item-end beg-B struct))
(size-A (- end-A-no-blank beg-A))
(size-B (- end-B-no-blank beg-B))
(body-A (buffer-substring beg-A end-A-no-blank))
(body-B (buffer-substring beg-B end-B-no-blank))
(between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B))
(sub-A (cons beg-A (org-list-get-subtree beg-A struct)))
(sub-B (cons beg-B (org-list-get-subtree beg-B struct))))
;; 1. Move effectively items in buffer.
(goto-char beg-A)
(delete-region beg-A end-B-no-blank)
(insert (concat body-B between-A-no-blank-and-B body-A))
;; 2. Now modify struct. No need to re-read the list, the
;; transformation is just a shift of positions. Some special
;; attention is required for items ending at END-A and END-B
;; as empty spaces are not moved there. In others words,
;; item BEG-A will end with whitespaces that were at the end
;; of BEG-B and the same applies to BEG-B.
(mapc (lambda (e)
(let ((pos (car e)))
(cond
((< pos beg-A))
((memq pos sub-A)
(let ((end-e (nth 6 e)))
(setcar e (+ pos (- end-B-no-blank end-A-no-blank)))
(setcar (nthcdr 6 e)
(+ end-e (- end-B-no-blank end-A-no-blank)))
(when (= end-e end-A) (setcar (nthcdr 6 e) end-B))))
((memq pos sub-B)
(let ((end-e (nth 6 e)))
(setcar e (- (+ pos beg-A) beg-B))
(setcar (nthcdr 6 e) (+ end-e (- beg-A beg-B)))
(when (= end-e end-B)
(setcar (nthcdr 6 e)
(+ beg-A size-B (- end-A end-A-no-blank))))))
((< pos beg-B)
(let ((end-e (nth 6 e)))
(setcar e (+ pos (- size-B size-A)))
(setcar (nthcdr 6 e) (+ end-e (- size-B size-A))))))))
struct)
(sort struct (lambda (e1 e2) (< (car e1) (car e2)))))))
(defun org-list-separating-blank-lines-number (pos struct prevs)
"Return number of blank lines that should separate items in list.
@ -1130,12 +1194,13 @@ some heuristics to guess the result."
(skip-chars-backward " \t")
(setq usr-blank (org-back-over-empty-lines))) 0))
usr-blank)
;; Are there blank lines inside the item?
;; Are there blank lines inside the list so far?
((save-excursion
(goto-char (org-list-get-top-point struct))
(org-list-search-forward
"^[ \t]*$" (org-list-get-item-end-before-blank item struct) t))
1)
;; No parent: no blank line.
;; Default choice: no blank line.
(t 0))))))))
(defun org-list-insert-item (pos struct prevs &optional checkbox after-bullet)
@ -1152,10 +1217,9 @@ function ends.
This function modifies STRUCT."
(let ((case-fold-search t))
;; 1. Get information about list: structure, usual helper
;; functions, position of point with regards to item start
;; (BEFOREP), blank lines number separating items (BLANK-NB),
;; position of split (POS) if we're allowed to (SPLIT-LINE-P).
;; 1. Get information about list: position of point with regards
;; to item start (BEFOREP), blank lines number separating items
;; (BLANK-NB), if we're allowed to (SPLIT-LINE-P).
(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))
@ -1181,15 +1245,20 @@ This function modifies STRUCT."
(and (not beforep) split-line-p
(progn
(goto-char pos)
;; If POS is greater than ITEM-END, then point is
;; in some white lines after the end of the list.
;; Those must be removed, or they will be left,
;; stacking up after the list.
(when (< item-end pos)
(delete-region (1- item-end) (point-at-eol)))
(skip-chars-backward " \r\t\n")
(setq pos (point))
(delete-and-extract-region pos item-end-no-blank))))
(body (concat bullet (when box (concat box " ")) after-bullet
(or (and text-cut
(if (string-match "\\`[ \t]+" text-cut)
(replace-match "" t t text-cut)
text-cut))
"")))
(and text-cut
(if (string-match "\\`[ \t]+" text-cut)
(replace-match "" t t text-cut)
text-cut))))
(item-sep (make-string (1+ blank-nb) ?\n))
(item-size (+ ind-size (length body) (length item-sep)))
(size-offset (- item-size (length text-cut))))
@ -1244,65 +1313,152 @@ This function modifies STRUCT."
;; after bullet, counter, checkbox, and label.
(if beforep
(goto-char item)
(setq struct (org-list-exchange-items item (+ item item-size) struct))
(setq struct (org-list-swap-items item (+ item item-size) struct))
(goto-char (org-list-get-next-item
item struct (org-list-prevs-alist struct))))
struct)))
(defun org-list-exchange-items (beg-A beg-B struct)
"Swap item starting at BEG-A with item starting at BEG-B in STRUCT.
Blank lines at the end of items are left in place. Return the
new structure after the changes.
(defun org-list-delete-item (item struct)
"Remove ITEM from the list and return the new structure.
Assume BEG-A is lesser than BEG-B and that BEG-A and BEG-B belong
to the same sub-list.
STRUCT is the list structure."
(let* ((end (org-list-get-item-end item struct))
(beg (if (= (org-list-get-bottom-point struct) end)
;; If ITEM ends with the list, delete blank lines
;; before it.
(save-excursion
(goto-char item)
(skip-chars-backward " \r\t\n")
(min (1+ (point-at-eol)) (point-max)))
item)))
;; Remove item from buffer.
(delete-region beg end)
;; Remove item from structure and shift others items accordingly.
;; Don't forget to shift also ending position when appropriate.
(let ((size (- end beg)))
(delq nil (mapcar (lambda (e)
(let ((pos (car e)))
(cond
((< pos item)
(let ((end-e (nth 6 e)))
(cond
((< end-e item) e)
((= end-e item)
(append (butlast e) (list beg)))
(t
(append (butlast e) (list (- end-e size)))))))
((< pos end) nil)
(t
(cons (- pos size)
(append (butlast (cdr e))
(list (- (nth 6 e) size))))))))
struct)))))
This function modifies STRUCT."
(save-excursion
(let* ((end-A-no-blank (org-list-get-item-end-before-blank beg-A struct))
(end-B-no-blank (org-list-get-item-end-before-blank beg-B struct))
(end-A (org-list-get-item-end beg-A struct))
(end-B (org-list-get-item-end beg-B struct))
(size-A (- end-A-no-blank beg-A))
(size-B (- end-B-no-blank beg-B))
(body-A (buffer-substring beg-A end-A-no-blank))
(body-B (buffer-substring beg-B end-B-no-blank))
(between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B))
(sub-A (cons beg-A (org-list-get-subtree beg-A struct)))
(sub-B (cons beg-B (org-list-get-subtree beg-B struct))))
;; 1. Move effectively items in buffer.
(goto-char beg-A)
(delete-region beg-A end-B-no-blank)
(insert (concat body-B between-A-no-blank-and-B body-A))
;; 2. Now modify struct. No need to re-read the list, the
;; transformation is just a shift of positions. Some special
;; attention is required for items ending at END-A and END-B
;; as empty spaces are not moved there. In others words,
;; item BEG-A will end with whitespaces that were at the end
;; of BEG-B and the same applies to BEG-B.
(mapc (lambda (e)
(let ((pos (car e)))
(cond
((< pos beg-A))
((memq pos sub-A)
(let ((end-e (nth 6 e)))
(setcar e (+ pos (- end-B-no-blank end-A-no-blank)))
(setcar (nthcdr 6 e)
(+ end-e (- end-B-no-blank end-A-no-blank)))
(when (= end-e end-A) (setcar (nthcdr 6 e) end-B))))
((memq pos sub-B)
(let ((end-e (nth 6 e)))
(setcar e (- (+ pos beg-A) beg-B))
(setcar (nthcdr 6 e) (+ end-e (- beg-A beg-B)))
(when (= end-e end-B)
(setcar (nthcdr 6 e)
(+ beg-A size-B (- end-A end-A-no-blank))))))
((< pos beg-B)
(let ((end-e (nth 6 e)))
(setcar e (+ pos (- size-B size-A)))
(setcar (nthcdr 6 e) (+ end-e (- size-B size-A))))))))
struct)
(sort struct (lambda (e1 e2) (< (car e1) (car e2)))))))
(defun org-list-send-item (item dest struct)
"Send ITEM to destination DEST.
STRUCT is the list structure.
DEST can have various values.
If DEST is a buffer position, the function will assume it points
to another item in the same list as ITEM, and will move the
latter just before the former.
If DEST is `begin' \(resp. `end'\), ITEM will be moved at the
beginning \(resp. end\) of the list it belongs to.
If DEST is a string like \"N\", where N is an integer, ITEM will
be moved at the Nth position in the list.
If DEST is `kill', ITEM will be deleted and its body will be
added to the kill-ring.
If DEST is `delete', ITEM will be deleted.
This function returns, destructively, the new list structure."
(let* ((prevs (org-list-prevs-alist struct))
(item-end (org-list-get-item-end item struct))
;; Grab full item body minus its bullet.
(body (org-trim
(buffer-substring
(save-excursion
(goto-char item)
(looking-at
(concat "[ \t]*"
(regexp-quote (org-list-get-bullet item struct))))
(match-end 0))
item-end)))
;; Change DEST into a buffer position. A trick is needed
;; when ITEM is meant to be sent at the end of the list.
;; Indeed, by setting locally `org-M-RET-may-split-line' to
;; nil and insertion point (INS-POINT) to the first line's
;; end of the last item, we ensure the new item will be
;; inserted after the last item, and not after any of its
;; hypothetical sub-items.
(ins-point (cond
((or (eq dest 'kill) (eq dest 'delete)))
((eq dest 'begin)
(setq dest (org-list-get-list-begin item struct prevs)))
((eq dest 'end)
(setq dest (org-list-get-list-end item struct prevs))
(save-excursion
(goto-char (org-list-get-last-item item struct prevs))
(point-at-eol)))
((string-match "\\`[0-9]+\\'" dest)
(let* ((all (org-list-get-all-items item struct prevs))
(len (length all))
(index (mod (string-to-number dest) len)))
(if (not (zerop index))
(setq dest (nth (1- index) all))
;; Send ITEM at the end of the list.
(setq dest (org-list-get-list-end item struct prevs))
(save-excursion
(goto-char
(org-list-get-last-item item struct prevs))
(point-at-eol)))))
(t dest)))
(org-M-RET-may-split-line nil))
(cond
((eq dest 'delete) (org-list-delete-item item struct))
((eq dest 'kill)
(kill-new body)
(org-list-delete-item item struct))
((and (integerp dest) (/= item ins-point))
(setq item (copy-marker item))
(setq struct (org-list-insert-item ins-point struct prevs nil body))
;; 1. Structure returned by `org-list-insert-item' may not be
;; accurate, as it cannot see sub-items included in BODY.
;; Thus, first compute the real structure so far.
(let ((moved-items
(cons (marker-position item)
(org-list-get-subtree (marker-position item) struct)))
(new-end (org-list-get-item-end (point) struct))
(old-end (org-list-get-item-end (marker-position item) struct))
(new-item (point))
(shift (- (point) item)))
;; 1.1. Remove the item just created in structure.
(setq struct (delete (assq new-item struct) struct))
;; 1.2. Copy ITEM and any of its sub-items at NEW-ITEM.
(setq struct (sort*
(append
struct
(mapcar (lambda (e)
(let* ((cell (assq e struct))
(pos (car cell))
(end (nth 6 cell)))
(cons (+ pos shift)
(append (butlast (cdr cell))
(list (if (= end old-end)
new-end
(+ end shift)))))))
moved-items))
(lambda (e1 e2) (< (car e1) (car e2))))))
;; 2. Eventually delete extra copy of the item and clean marker.
(prog1
(org-list-delete-item (marker-position item) struct)
(move-marker item nil)))
(t struct))))
(defun org-list-struct-outdent (start end struct parents)
"Outdent items between positions START and END.
@ -1517,12 +1673,14 @@ This function modifies STRUCT."
(lambda (item)
(let ((parent (org-list-get-parent item struct parents)))
(if parent
;; Indent like parent + length of parent's bullet.
;; Indent like parent + length of parent's bullet +
;; sub-list offset.
(org-list-set-ind
item struct (+ (or bullet-size
(length
(org-list-get-bullet parent struct)))
(org-list-get-ind parent struct)))
(org-list-get-ind parent struct)
org-list-indent-offset))
;; If no parent, indent like top-point.
(org-list-set-ind item struct top-ind))))))
(mapc new-ind (mapcar 'car (cdr struct)))))
@ -1597,7 +1755,7 @@ the structure to be applied. The function will only modify parts
of the list which have changed.
Initial position of cursor is restored after the changes."
(let* ((pos (copy-marker (point)))
(let* ((origin (copy-marker (point)))
(inlinetask-re (and (featurep 'org-inlinetask)
(org-inlinetask-outline-regexp)))
(item-re (org-item-re))
@ -1708,8 +1866,9 @@ Initial position of cursor is restored after the changes."
(unless (or (not cell) (equal cell (assq beg old-struct)))
(funcall modify-item beg))))
sliced-struct))
;; 4. Go back to initial position.
(goto-char pos)))
;; 4. Go back to initial position and clean marker.
(goto-char origin)
(move-marker origin nil)))
(defun org-list-write-struct (struct parents)
"Correct bullets, checkboxes and indentation in list at point.
@ -1783,6 +1942,7 @@ beginning of the item."
(setq value (apply function value args)))
(nreverse all))
(goto-char item)
(move-marker item nil)
value))
(defun org-list-set-item-visibility (item struct view)
@ -1872,86 +2032,79 @@ Throw an error when not in a list."
(defun org-previous-item ()
"Move to the beginning of the previous item.
Throw an error when not in a list, or at first item."
Throw an error when not in a list. Also throw an error when at
first item, unless `org-list-use-circular-motion' is non-nil."
(interactive)
(let ((begin (org-in-item-p)))
(if (not begin)
(let ((item (org-in-item-p)))
(if (not item)
(error "Not in an item")
(goto-char begin)
(goto-char item)
(let* ((struct (org-list-struct))
(prevs (org-list-prevs-alist struct))
(prevp (org-list-get-prev-item begin struct prevs)))
(if prevp (goto-char prevp) (error "On first item"))))))
(prevp (org-list-get-prev-item item struct prevs)))
(cond
(prevp (goto-char prevp))
(org-list-use-circular-motion
(goto-char (org-list-get-last-item item struct prevs)))
(t (error "On first item")))))))
(defun org-next-item ()
"Move to the beginning of the next item.
Throw an error when not in a plain list, or at last item."
Throw an error when not in a list. Also throw an error when at
last item, unless `org-list-use-circular-motion' is non-nil."
(interactive)
(let ((begin (org-in-item-p)))
(if (not begin)
(let ((item (org-in-item-p)))
(if (not item)
(error "Not in an item")
(goto-char begin)
(goto-char item)
(let* ((struct (org-list-struct))
(prevs (org-list-prevs-alist struct))
(prevp (org-list-get-next-item begin struct prevs)))
(if prevp (goto-char prevp) (error "On last item"))))))
(prevp (org-list-get-next-item item struct prevs)))
(cond
(prevp (goto-char prevp))
(org-list-use-circular-motion
(goto-char (org-list-get-first-item item struct prevs)))
(t (error "On last item")))))))
(defun org-move-item-down ()
"Move the item at point down, i.e. swap with following item.
Subitems (items with larger indentation) are considered part of
Sub-items (items with larger indentation) are considered part of
the item, so this really moves item trees."
(interactive)
(unless (org-at-item-p) (error "Not at an item"))
(let* ((pos (point))
(col (current-column))
(actual-item (point-at-bol))
(let* ((col (current-column))
(item (point-at-bol))
(struct (org-list-struct))
(prevs (org-list-prevs-alist struct))
(next-item (org-list-get-next-item (point-at-bol) struct prevs)))
(unless (or next-item org-list-use-circular-motion)
(error "Cannot move this item further down"))
(if (not next-item)
(progn
(goto-char pos)
(error "Cannot move this item further down"))
(setq struct
(org-list-exchange-items actual-item next-item struct))
;; Use a short variation of `org-list-write-struct' as there's
;; no need to go through all the steps.
(let ((old-struct (copy-tree struct))
(prevs (org-list-prevs-alist struct))
(parents (org-list-parents-alist struct)))
(org-list-struct-fix-bul struct prevs)
(org-list-struct-fix-ind struct parents)
(org-list-struct-apply-struct struct old-struct)
(goto-char (org-list-get-next-item (point-at-bol) struct prevs)))
(org-move-to-column col))))
(setq struct (org-list-send-item item 'begin struct))
(setq struct (org-list-swap-items item next-item struct))
(goto-char
(org-list-get-next-item item struct (org-list-prevs-alist struct))))
(org-list-write-struct struct (org-list-parents-alist struct))
(org-move-to-column col)))
(defun org-move-item-up ()
"Move the item at point up, i.e. swap with previous item.
Subitems (items with larger indentation) are considered part of
Sub-items (items with larger indentation) are considered part of
the item, so this really moves item trees."
(interactive)
(unless (org-at-item-p) (error "Not at an item"))
(let* ((pos (point))
(col (current-column))
(actual-item (point-at-bol))
(let* ((col (current-column))
(item (point-at-bol))
(struct (org-list-struct))
(prevs (org-list-prevs-alist struct))
(prev-item (org-list-get-prev-item (point-at-bol) struct prevs)))
(unless (or prev-item org-list-use-circular-motion)
(error "Cannot move this item further up"))
(if (not prev-item)
(progn
(goto-char pos)
(error "Cannot move this item further up"))
(setq struct
(org-list-exchange-items prev-item actual-item struct))
;; Use a short variation of `org-list-write-struct' as there's
;; no need to go through all the steps.
(let ((old-struct (copy-tree struct))
(prevs (org-list-prevs-alist struct))
(parents (org-list-parents-alist struct)))
(org-list-struct-fix-bul struct prevs)
(org-list-struct-fix-ind struct parents)
(org-list-struct-apply-struct struct old-struct))
(org-move-to-column col))))
(setq struct (org-list-send-item item 'end struct))
(setq struct (org-list-swap-items prev-item item struct)))
(org-list-write-struct struct (org-list-parents-alist struct))
(org-move-to-column col)))
(defun org-insert-item (&optional checkbox)
"Insert a new item at the current level.
@ -1974,8 +2127,8 @@ item is invisible."
(org-at-item-timer-p))
;; Timer list: delegate to `org-timer-item'.
(progn (org-timer-item) t)
(goto-char itemp)
(let* ((struct (org-list-struct))
(let* ((struct (save-excursion (goto-char itemp)
(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)
@ -2137,11 +2290,9 @@ in subtree, ignoring drawers."
((equal "[X]" cbox) "[ ]")
(t "[X]"))))))
;; When an item is found within bounds, grab the full list at
;; point structure, then:
;; 1. set check-box of all its items within bounds to
;; REF-CHECKBOX;
;; 2. fix check-boxes of the whole list; 3. move point after the
;; list.
;; point structure, then: (1) set check-box of all its items
;; within bounds to REF-CHECKBOX, (2) fix check-boxes of the
;; whole list, (3) move point after the list.
(goto-char lim-up)
(while (and (< (point) lim-down)
(org-list-search-forward (org-item-beginning-re)
@ -2178,6 +2329,8 @@ in subtree, ignoring drawers."
"Checkboxes were removed due to unchecked box at line %d"
(org-current-line block-item))))
(goto-char bottom)
(move-marker lim-down nil)
(move-marker bottom nil)
(org-list-struct-apply-struct struct struct-copy)))))
(org-update-checkbox-count-maybe))
@ -2745,8 +2898,9 @@ Point is left at list end."
(when delete
(delete-region top bottom)
(when (and (not (eq org-list-ending-method 'indent))
(not (looking-at "[ \t]*$"))
(looking-at org-list-end-re))
(replace-match "\n")))
(replace-match "")))
out))
(defun org-list-make-subtree ()
@ -2971,7 +3125,7 @@ with overruling parameters for `org-list-to-generic'."
"\\item "))
:csep "\n"
:cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}"
:cbtrans "$\\boxminus$")
:cbtrans "\\texttt{[-]}")
params)))
(defun org-list-to-html (list &optional params)

7
lisp/org-macs.el
View File

@ -347,16 +347,19 @@ point nowhere."
(defmacro org-with-limited-levels (&rest body)
"Execute BODY with limited number of outline levels."
`(let* ((outline-regexp (org-get-limited-outline-regexp)))
`(let* ((org-outline-regexp (org-get-limited-outline-regexp))
(outline-regexp org-outline-regexp)
(org-outline-regexp-at-bol (concat "^" org-outline-regexp)))
,@body))
(defvar org-outline-regexp) ; defined in org.el
(defvar org-odd-levels-only) ; defined in org.el
(defvar org-inlinetask-min-level) ; defined in org-inlinetask.el
(defun org-get-limited-outline-regexp ()
"Return outline-regexp with limited number of levels.
The number of levels is controlled by `org-inlinetask-min-level'"
(if (or (not (org-mode-p)) (not (featurep 'org-inlinetask)))
outline-regexp
org-outline-regexp
(let* ((limit-level (1- org-inlinetask-min-level))
(nstars (if org-odd-levels-only (1- (* limit-level 2)) limit-level)))
(format "\\*\\{1,%d\\} " nstars))))

10
lisp/org-mobile.el
View File

@ -38,6 +38,9 @@
(eval-when-compile (require 'cl))
(declare-function org-pop-to-buffer-same-window
"org-compat" (&optional buffer-or-name norecord label))
(defgroup org-mobile nil
"Options concerning support for a viewer/editor on a mobile device."
:tag "Org Mobile"
@ -575,8 +578,9 @@ The table of checksums is written to the file mobile-checksums."
" " match "</after>"))
settings))
(push (list type match settings) new))
((symbolp (nth 2 e))
;; A user-defined function, not sure how to handle that yet
((or (functionp (nth 2 e)) (symbolp (nth 2 e)))
;; A user-defined function, which can do anything, so simply
;; ignore it.
)
(t
;; a block agenda
@ -908,7 +912,7 @@ If BEG and END are given, only do this in that region."
(buffer-file-name (current-buffer))))))
(error (setq org-mobile-error msg))))
(when org-mobile-error
(switch-to-buffer (marker-buffer marker))
(org-pop-to-buffer-same-window (marker-buffer marker))
(goto-char marker)
(incf cnt-error)
(insert (if (stringp (nth 1 org-mobile-error))

10
lisp/org-mouse.el
View File

@ -635,7 +635,7 @@ This means, between the beginning of line and the point."
(defun org-mouse-match-todo-keyword ()
(save-excursion
(org-back-to-heading)
(if (looking-at outline-regexp) (goto-char (match-end 0)))
(if (looking-at org-outline-regexp) (goto-char (match-end 0)))
(or (looking-at (concat " +" org-todo-regexp " *"))
(looking-at " \\( *\\)"))))
@ -927,7 +927,7 @@ This means, between the beginning of line and the point."
(when (memq 'activate-stars org-mouse-features)
(font-lock-add-keywords
nil
`((,outline-regexp
`((,org-outline-regexp
0 `(face org-link mouse-face highlight keymap ,org-mouse-map)
'prepend))
t))
@ -999,7 +999,7 @@ This means, between the beginning of line and the point."
(end-of-line)
(if (eobp) (newline) (forward-char)))
(when (looking-at outline-regexp)
(when (looking-at org-outline-regexp)
(let ((level (- (match-end 0) (match-beginning 0))))
(when (> end (match-end 0))
(outline-end-of-subtree)
@ -1019,11 +1019,11 @@ This means, between the beginning of line and the point."
(replace-text (concat (match-string 0) "* ")))
(beginning-of-line 2)
(save-excursion
(while (not (or (eobp) (looking-at outline-regexp)))
(while (not (or (eobp) (looking-at org-outline-regexp)))
(when (looking-at org-mouse-plain-list-regexp)
(setq minlevel (min minlevel (- (match-end 1) (match-beginning 1)))))
(forward-line)))
(while (not (or (eobp) (looking-at outline-regexp)))
(while (not (or (eobp) (looking-at org-outline-regexp)))
(when (and (looking-at org-mouse-plain-list-regexp)
(eq minlevel (- (match-end 1) (match-beginning 1))))
(replace-match replace-text))

196
lisp/org-publish.el
View File

@ -41,16 +41,6 @@
;;; Code:
(defun org-publish-sanitize-plist (plist)
(mapcar (lambda (x)
(or (cdr (assq x '((:index-filename . :sitemap-filename)
(:index-title . :sitemap-title)
(:index-function . :sitemap-function)
(:index-style . :sitemap-style)
(:auto-index . :auto-sitemap))))
x))
plist))
(eval-when-compile
(require 'cl))
(require 'org)
@ -61,6 +51,17 @@
(unless (fboundp 'declare-function)
(defmacro declare-function (fn file &optional arglist fileonly))))
(defvar org-publish-initial-buffer nil
"The buffer `org-publish' has been called from.")
(defvar org-publish-temp-files nil
"Temporary list of files to be published.")
;; Here, so you find the variable right before it's used the first time:
(defvar org-publish-cache nil
"This will cache timestamps and titles for files in publishing projects.
Blocks could hash sha1 values here.")
(defgroup org-publish nil
"Options for publishing a set of Org-mode and related files."
:tag "Org Publishing"
@ -287,6 +288,21 @@ You could use brackets to delimit on what part the link will be.
:group 'org-publish
:type 'string)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Sanitize-plist (FIXME why?)
(defun org-publish-sanitize-plist (plist)
;; FIXME document
(mapcar (lambda (x)
(or (cdr (assq x '((:index-filename . :sitemap-filename)
(:index-title . :sitemap-title)
(:index-function . :sitemap-function)
(:index-style . :sitemap-style)
(:auto-index . :auto-sitemap))))
x))
plist))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Timestamp-related functions
@ -332,20 +348,6 @@ If there is no timestamp, create one."
(org-publish-reset-cache))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
(defvar org-publish-initial-buffer nil
"The buffer `org-publish' has been called from.")
(defvar org-publish-temp-files nil
"Temporary list of files to be published.")
;; Here, so you find the variable right before it's used the first time:
(defvar org-publish-cache nil
"This will cache timestamps and titles for files in publishing projects.
Blocks could hash sha1 values here.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Compatibility aliases
@ -368,6 +370,8 @@ This is a compatibility function for Emacsen without `delete-dups'."
(declare-function org-publish-delete-dups "org-publish" (list))
(declare-function find-lisp-find-files "find-lisp" (directory regexp))
(declare-function org-pop-to-buffer-same-window
"org-compat" (&optional buffer-or-name norecord label))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Getting project information out of org-publish-project-alist
@ -385,20 +389,19 @@ This splices all the components into the list."
(push p rtn)))
(nreverse (org-publish-delete-dups (delq nil rtn)))))
(defvar sitemap-sort-files)
(defvar sitemap-sort-folders)
(defvar sitemap-ignore-case)
(defvar sitemap-requested)
(defvar sitemap-date-format)
(defvar sitemap-file-entry-format)
(defvar org-sitemap-sort-files)
(defvar org-sitemap-sort-folders)
(defvar org-sitemap-ignore-case)
(defvar org-sitemap-requested)
(defvar org-sitemap-date-format)
(defvar org-sitemap-file-entry-format)
(defun org-publish-compare-directory-files (a b)
"Predicate for `sort', that sorts folders and files for sitemap."
(let ((retval t))
(when (or sitemap-sort-files sitemap-sort-folders)
(when (or org-sitemap-sort-files org-sitemap-sort-folders)
;; First we sort files:
(when sitemap-sort-files
(cond ((equal sitemap-sort-files 'alphabetically)
(when org-sitemap-sort-files
(cond ((equal org-sitemap-sort-files 'alphabetically)
(let* ((adir (file-directory-p a))
(aorg (and (string-match "\\.org$" a) (not adir)))
(bdir (file-directory-p b))
@ -409,27 +412,27 @@ This splices all the components into the list."
(B (if borg
(concat (file-name-directory b)
(org-publish-find-title b)) b)))
(setq retval (if sitemap-ignore-case
(setq retval (if org-sitemap-ignore-case
(not (string-lessp (upcase B) (upcase A)))
(not (string-lessp B A))))))
((or (equal sitemap-sort-files 'chronologically)
(equal sitemap-sort-files 'anti-chronologically))
((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 sitemap-sort-files 'chronologically)
(setq retval (if (equal org-sitemap-sort-files 'chronologically)
(<= A B)
(>= A B)))))))
;; Directory-wise wins:
(when sitemap-sort-folders
(when org-sitemap-sort-folders
;; a is directory, b not:
(cond
((and (file-directory-p a) (not (file-directory-p b)))
(setq retval (equal sitemap-sort-folders 'first)))
(setq retval (equal org-sitemap-sort-folders 'first)))
;; a is not a directory, but b is:
((and (not (file-directory-p a)) (file-directory-p b))
(setq retval (equal sitemap-sort-folders 'last))))))
(setq retval (equal org-sitemap-sort-folders 'last))))))
retval))
(defun org-publish-get-base-files-1 (base-dir &optional recurse match skip-file skip-dir)
@ -452,7 +455,7 @@ matching the regexp SKIP-DIR when recursing through BASE-DIR."
(not (string-match match fnd)))
(pushnew f org-publish-temp-files)))))
(if sitemap-requested
(if org-sitemap-requested
(sort (directory-files base-dir t (unless recurse match))
'org-publish-compare-directory-files)
(directory-files base-dir t (unless recurse match)))))
@ -469,16 +472,16 @@ matching filenames."
(extension (or (plist-get project-plist :base-extension) "org"))
;; sitemap-... variables are dynamically scoped for
;; org-publish-compare-directory-files:
(sitemap-requested
(org-sitemap-requested
(plist-get project-plist :auto-sitemap))
(sitemap-filename
(or (plist-get project-plist :sitemap-filename)
"sitemap.org"))
(sitemap-sort-folders
(org-sitemap-sort-folders
(if (plist-member project-plist :sitemap-sort-folders)
(plist-get project-plist :sitemap-sort-folders)
org-publish-sitemap-sort-folders))
(sitemap-sort-files
(org-sitemap-sort-files
(cond ((plist-member project-plist :sitemap-sort-files)
(plist-get project-plist :sitemap-sort-files))
;; For backward compatibility:
@ -486,19 +489,19 @@ matching filenames."
(if (plist-get project-plist :sitemap-alphabetically)
'alphabetically nil))
(t org-publish-sitemap-sort-files)))
(sitemap-ignore-case
(org-sitemap-ignore-case
(if (plist-member project-plist :sitemap-ignore-case)
(plist-get project-plist :sitemap-ignore-case)
org-publish-sitemap-sort-ignore-case))
(match (if (eq extension 'any)
"^[^\\.]"
(concat "^[^\\.].*\\.\\(" extension "\\)$"))))
;; Make sure sitemap-sort-folders' has an accepted value
(unless (memq sitemap-sort-folders '(first last))
(setq sitemap-sort-folders nil))
;; Make sure `org-sitemap-sort-folders' has an accepted value
(unless (memq org-sitemap-sort-folders '(first last))
(setq org-sitemap-sort-folders nil))
(setq org-publish-temp-files nil)
(if sitemap-requested
(if org-sitemap-requested
(pushnew (expand-file-name (concat base-dir sitemap-filename))
org-publish-temp-files))
(org-publish-get-base-files-1 base-dir recurse match
@ -559,7 +562,7 @@ PUB-DIR is the publishing directory."
(make-directory pub-dir t))
(let ((visiting (find-buffer-visiting filename)))
(save-excursion
(switch-to-buffer (or visiting (find-file filename)))
(org-pop-to-buffer-same-window (or visiting (find-file filename)))
(let* ((plist (cons :buffer-will-be-killed (cons t plist)))
(init-buf (current-buffer))
(init-point (point))
@ -646,10 +649,10 @@ See `org-publish-org-to' to the list of arguments."
"Publish a file with no transformation of any kind.
See `org-publish-org-to' to the list of arguments."
;; make sure eshell/cp code is loaded
(unless (file-directory-p pub-dir)
(make-directory pub-dir t))
(or (equal (expand-file-name (file-name-directory filename))
(file-name-as-directory (expand-file-name pub-dir)))
(unless (file-directory-p pub-dir)
(make-directory pub-dir t))
(or (equal (expand-file-name (file-name-directory filename))
(file-name-as-directory (expand-file-name pub-dir)))
(copy-file filename
(expand-file-name (file-name-nondirectory filename) pub-dir)
t)))
@ -725,9 +728,9 @@ If :makeindex is set, also produce a file theindex.org."
"sitemap.org"))
(sitemap-function (or (plist-get project-plist :sitemap-function)
'org-publish-org-sitemap))
(sitemap-date-format (or (plist-get project-plist :sitemap-date-format)
(org-sitemap-date-format (or (plist-get project-plist :sitemap-date-format)
org-publish-sitemap-date-format))
(sitemap-file-entry-format (or (plist-get project-plist :sitemap-file-entry-format)
(org-sitemap-file-entry-format (or (plist-get project-plist :sitemap-file-entry-format)
org-publish-sitemap-file-entry-format))
(preparation-function (plist-get project-plist :preparation-function))
(completion-function (plist-get project-plist :completion-function))
@ -737,7 +740,7 @@ If :makeindex is set, also produce a file theindex.org."
(while (setq file (pop files))
(org-publish-file file project t))
(when (plist-get project-plist :makeindex)
(org-publish-index-generate-theindex.inc
(org-publish-index-generate-theindex
(plist-get project-plist :base-directory))
(org-publish-file (expand-file-name
"theindex.org"
@ -808,7 +811,7 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
(+ (length indent-str) 2) ?\ )))))))
;; This is common to 'flat and 'tree
(let ((entry
(org-publish-format-file-entry sitemap-file-entry-format
(org-publish-format-file-entry org-sitemap-file-entry-format
file project-plist))
(regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)"))
(cond ((string-match-p regexp entry)
@ -827,7 +830,7 @@ 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 sitemap-date-format
(?d . ,(format-time-string org-sitemap-date-format
(org-publish-find-date file)))
(?a . ,(or (plist-get project-plist :author) user-full-name)))))
@ -836,21 +839,21 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
(or
(and (not reset) (org-publish-cache-get-file-property file :title nil t))
(let* ((visiting (find-buffer-visiting file))
(buffer (or visiting (find-file-noselect file)))
title)
(with-current-buffer buffer
(let* ((opt-plist (org-combine-plists (org-default-export-plist)
(org-infile-export-plist))))
(setq title
(or (plist-get opt-plist :title)
(and (not
(plist-get opt-plist :skip-before-1st-heading))
(org-export-grab-title-from-buffer))
(file-name-nondirectory (file-name-sans-extension file))))))
(unless visiting
(kill-buffer buffer))
(org-publish-cache-set-file-property file :title title)
title)))
(buffer (or visiting (find-file-noselect file)))
title)
(with-current-buffer buffer
(let* ((opt-plist (org-combine-plists (org-default-export-plist)
(org-infile-export-plist))))
(setq title
(or (plist-get opt-plist :title)
(and (not
(plist-get opt-plist :skip-before-1st-heading))
(org-export-grab-title-from-buffer))
(file-name-nondirectory (file-name-sans-extension file))))))
(unless visiting
(kill-buffer buffer))
(org-publish-cache-set-file-property file :title title)
title)))
(defun org-publish-find-date (file)
"Find the date of FILE in project.
@ -860,7 +863,7 @@ system's modification time.
It returns time in `current-time' format."
(let ((visiting (find-buffer-visiting file)))
(save-excursion
(switch-to-buffer (or visiting (find-file-noselect file nil t)))
(org-pop-to-buffer-same-window (or visiting (find-file-noselect file nil t)))
(let* ((plist (org-infile-export-plist))
(date (plist-get plist :date)))
(unless visiting
@ -959,12 +962,15 @@ the project."
target ""))
(push (cons entry target) index)))
(with-temp-file
(concat (file-name-sans-extension org-current-export-file) ".orgx")
(concat
(file-name-directory org-current-export-file) "."
(file-name-sans-extension
(file-name-nondirectory org-current-export-file)) ".orgx")
(dolist (entry (nreverse index))
(insert (format "INDEX: (%s) %s\n" (cdr entry) (car entry)))))))
(defun org-publish-index-generate-theindex.inc (directory)
"Generate the index from all .orgx files in the current directory and below."
(defun org-publish-index-generate-theindex (directory)
"Generate the index from all .orgx files in DIRECTORY."
(require 'find-lisp)
(let* ((fulldir (file-name-as-directory
(expand-file-name directory)))
@ -979,7 +985,7 @@ the project."
main last-main letter last-letter file sub link tgext)
;; `files' contains the list of relative file names
(dolist (file files)
(setq origfile (substring file 0 -1))
(setq origfile (substring file 1 -1))
(setq buf (find-file-noselect file))
(with-current-buffer buf
(goto-char (point-min))
@ -990,7 +996,7 @@ the project."
(kill-buffer buf))
(setq index (sort index (lambda (a b) (string< (downcase (car a))
(downcase (car b))))))
(setq ibuffer (find-file-noselect (expand-file-name "theindex.inc" directory)))
(setq ibuffer (find-file-noselect (expand-file-name "theindex.org" directory)))
(with-current-buffer ibuffer
(erase-buffer)
(insert "* Index\n")
@ -1017,17 +1023,7 @@ the project."
(insert " - " link "\n")
(insert " - " link "\n")))
(save-buffer))
(kill-buffer ibuffer)
(let ((index-file (expand-file-name "theindex.org" directory)))
(unless (file-exists-p index-file)
(setq ibuffer (find-file-noselect index-file))
(with-current-buffer ibuffer
(erase-buffer)
(insert "\n\n#+include: \"theindex.inc\"\n\n")
(save-buffer))
(kill-buffer ibuffer)))))
(kill-buffer ibuffer)))
;; Caching functions:
@ -1103,15 +1099,19 @@ so that the file including them will be republished as well."
(error "%s" "`org-publish-cache-file-needs-publishing' called, but no cache present"))
(let* ((key (org-publish-timestamp-filename filename pub-dir pub-func))
(pstamp (org-publish-cache-get key))
included-files-ctime)
(with-temp-buffer
(when (equal (file-name-extension filename) "org")
(find-file (expand-file-name filename))
(visiting (find-buffer-visiting filename))
included-files-ctime buf)
(when (equal (file-name-extension filename) "org")
(setq buf (find-file (expand-file-name filename)))
(with-current-buffer buf
(goto-char (point-min))
(while (re-search-forward "^#\\+INCLUDE: \\(.+\\)[ ^\t]*$" nil t)
(while (re-search-forward "^#\\+INCLUDE:[ \t]+\"?\\([^ \t\"]*\\)\"?[ \t]*.*$" nil t)
(let* ((included-file (expand-file-name (match-string 1))))
(add-to-list 'included-files-ctime
(org-publish-cache-ctime-of-src included-file) t)))))
(org-publish-cache-ctime-of-src included-file) t))))
;; FIXME don't kill current buffer
(unless visiting (kill-buffer buf)))
(if (null pstamp)
t
(let ((ctime (org-publish-cache-ctime-of-src filename)))

8
lisp/org-remember.el
View File

@ -34,12 +34,16 @@
(eval-when-compile
(require 'cl))
(require 'org)
(require 'org-compat)
(require 'org-datetree)
(declare-function remember-mode "remember" ())
(declare-function remember "remember" (&optional initial))
(declare-function remember-buffer-desc "remember" ())
(declare-function remember-finalize "remember" ())
(declare-function org-pop-to-buffer-same-window
"org-compat" (&optional buffer-or-name norecord label))
(defvar remember-save-after-remembering)
(defvar remember-register)
(defvar remember-buffer)
@ -785,7 +789,7 @@ The user is queried for the template."
(setq heading org-remember-default-headline))
(setq visiting (org-find-base-buffer-visiting file))
(if (not visiting) (find-file-noselect file))
(switch-to-buffer (or visiting (get-file-buffer file)))
(org-pop-to-buffer-same-window (or visiting (get-file-buffer file)))
(widen)
(goto-char (point-min))
(if (re-search-forward
@ -1072,7 +1076,7 @@ See also the variable `org-reverse-note-order'."
(save-restriction
(widen)
(goto-char (point-min))
(re-search-forward "^\\*+ " nil t)
(re-search-forward org-outline-regexp-bol nil t)
(beginning-of-line 1)
(org-paste-subtree 1 txt)
(and org-auto-align-tags (org-set-tags nil t))

12
lisp/org-src.el
View File

@ -43,6 +43,8 @@
(declare-function org-at-table.el-p "org" ())
(declare-function org-get-indentation "org" (&optional line))
(declare-function org-switch-to-buffer-other-window "org" (&rest args))
(declare-function org-pop-to-buffer-same-window
"org-compat" (&optional buffer-or-name norecord label))
(defcustom org-edit-src-region-extra nil
"Additional regexps to identify regions for editing with `org-edit-src-code'.
@ -340,7 +342,7 @@ buffer."
(defun org-src-switch-to-buffer (buffer context)
(case org-src-window-setup
('current-window
(switch-to-buffer buffer))
(org-pop-to-buffer-same-window buffer))
('other-window
(switch-to-buffer-other-window buffer))
('other-frame
@ -351,7 +353,7 @@ buffer."
(delete-frame frame)))
('save
(kill-buffer (current-buffer))
(switch-to-buffer buffer))
(org-pop-to-buffer-same-window buffer))
(t
(switch-to-buffer-other-frame buffer))))
('reorganize-frame
@ -363,7 +365,7 @@ buffer."
(t
(message "Invalid value %s for org-src-window-setup"
(symbol-name org-src-window-setup))
(switch-to-buffer buffer))))
(org-pop-to-buffer-same-window buffer))))
(defun org-src-construct-edit-buffer-name (org-buffer-name lang)
"Construct the buffer name for a source editing buffer."
@ -423,7 +425,7 @@ the fragment in the Org-mode buffer."
begline (save-excursion (goto-char beg) (org-current-line)))
(if (and (setq buffer (org-edit-src-find-buffer beg end))
(y-or-n-p "Return to existing edit buffer? [n] will revert changes: "))
(switch-to-buffer buffer)
(org-pop-to-buffer-same-window buffer)
(when buffer
(with-current-buffer buffer
(if (boundp 'org-edit-src-overlay)
@ -443,7 +445,7 @@ the fragment in the Org-mode buffer."
(define-key map [mouse-1] 'org-edit-src-continue)
map))
(overlay-put ovl :read-only "Leave me alone")
(switch-to-buffer buffer)
(org-pop-to-buffer-same-window buffer)
(insert code)
(remove-text-properties (point-min) (point-max)
'(display nil invisible nil intangible nil))

149
lisp/org-table.el
View File

@ -52,7 +52,7 @@
(defvar orgtbl-after-send-table-hook nil
"Hook for functions attaching to `C-c C-c', if the table is sent.
This can be used to add additional functionality after the table is sent
to the receiver position, othewise, if table is not sent, the functions
to the receiver position, othewise, if table is not sent, the functions
are not run.")
(defcustom orgtbl-optimized (eq org-enable-table-editor 'optimized)
@ -231,6 +231,18 @@ relies on the variables to be present in the list."
:group 'org-table-calculation
:type 'plist)
(defcustom org-table-duration-custom-format 'hours
"Format for the output of calc computations like $1+$2;t.
The default value is 'hours, and will output the results as a
number of hours. Other allowed values are 'seconds, 'minutes and
'days, and the output will be a fraction of seconds, minutes or
days."
:group 'org-table-calculation
:type '(choice (symbol :tag "Seconds" 'seconds)
(symbol :tag "Minutes" 'minutes)
(symbol :tag "Hours " 'hours)
(symbol :tag "Days " 'days)))
(defcustom org-table-formula-evaluate-inline t
"Non-nil means TAB and RET evaluate a formula in current table field.
If the current field starts with an equal sign, it is assumed to be a formula
@ -547,7 +559,7 @@ property, locally or anywhere up in the hierarchy."
(end (org-table-end))
(txt (buffer-substring-no-properties beg end))
(file (or file (org-entry-get beg "TABLE_EXPORT_FILE" t)))
(format (or format
(format (or format
(org-entry-get beg "TABLE_EXPORT_FORMAT" t)))
buf deffmt-readable)
(unless file
@ -1426,7 +1438,7 @@ first dline below it is used. When ABOVE is non-nil, the one above is used."
(org-move-to-column col)
(unless (or hline1p hline2p
(not (or (not org-table-fix-formulas-confirm)
(funcall org-table-fix-formulas-confirm
(funcall org-table-fix-formulas-confirm
"Fix formulas? "))))
(org-table-fix-formulas
"@" (list (cons (number-to-string dline1) (number-to-string dline2))
@ -1806,6 +1818,12 @@ it can be edited in place."
(font-lock-fontify-block))))
(t
(let ((pos (move-marker (make-marker) (point)))
(coord
(if (eq org-table-use-standard-references t)
(concat (org-number-to-letters (org-table-current-column))
(int-to-string (org-table-current-dline)))
(concat "@" (int-to-string (org-table-current-dline))
"$" (int-to-string (org-table-current-column)))))
(field (org-table-get-field))
(cw (current-window-configuration))
p)
@ -1815,7 +1833,7 @@ it can be edited in place."
(markerp org-field-marker))
(move-marker org-field-marker nil))
(erase-buffer)
(insert "#\n# Edit field and finish with C-c C-c\n#\n")
(insert "#\n# Edit field " coord " and finish with C-c C-c\n#\n")
(let ((org-inhibit-startup t)) (org-mode))
(auto-fill-mode -1)
(setq truncate-lines nil)
@ -2391,7 +2409,7 @@ not overwrite the stored one."
(modes (copy-sequence org-calc-default-modes))
(numbers nil) ; was a variable, now fixed default
(keep-empty nil)
n form form0 bw fmt x ev orig c lispp literal duration)
n form form0 formrpl formrg bw fmt x ev orig c lispp literal duration)
;; Parse the format string. Since we have a lot of modes, this is
;; a lot of work. However, I think calc still uses most of the time.
(if (string-match ";" formula)
@ -2412,6 +2430,12 @@ not overwrite the stored one."
(setq fmt (replace-match "" t t fmt)))
(if (string-match "T" fmt)
(setq duration t numbers t
duration-output-format nil
fmt (replace-match "" t t fmt)))
(if (string-match "t" fmt)
(setq duration t
duration-output-format org-table-duration-custom-format
numbers t
fmt (replace-match "" t t fmt)))
(if (string-match "N" fmt)
(setq numbers t
@ -2431,21 +2455,22 @@ not overwrite the stored one."
(setq formula (org-table-formula-substitute-names formula)))
(setq orig (or (get-text-property 1 :orig-formula formula) "?"))
(while (> ndown 0)
(setq fields
(mapcar (lambda (cell)
(let ((duration (org-table-time-string-to-seconds cell)))
(if duration (number-to-string duration) cell)))
(org-split-string
(org-no-properties
(buffer-substring (point-at-bol) (point-at-eol)))
" *| *")))
(setq fields (org-split-string
(org-no-properties
(buffer-substring (point-at-bol) (point-at-eol)))
" *| *"))
;; replace fields with duration values if relevant
(if duration
(setq fields
(mapcar (lambda (x) (org-table-time-string-to-seconds x))
fields)))
(if (eq numbers t)
(setq fields (mapcar
(lambda (x) (number-to-string (string-to-number x)))
fields)))
(setq ndown (1- ndown))
(setq form (copy-sequence formula)
lispp (and (> (length form) 2)(equal (substring form 0 2) "'(")))
lispp (and (> (length form) 2) (equal (substring form 0 2) "'(")))
(if (and lispp literal) (setq lispp 'literal))
;; Insert row and column number of formula result field
@ -2476,13 +2501,22 @@ not overwrite the stored one."
;; Insert complex ranges
(while (and (string-match org-table-range-regexp form)
(> (length (match-string 0 form)) 1))
(setq form
(replace-match
(save-match-data
(org-table-make-reference
(org-table-get-range (match-string 0 form) nil n0)
keep-empty numbers lispp))
t t form)))
(setq formrg (save-match-data
(org-table-get-range (match-string 0 form) nil n0)))
(setq formrpl
(save-match-data
(org-table-make-reference
;; possibly handle durations
(if duration
(if (listp formrg)
(mapcar (lambda(x) (org-table-time-string-to-seconds x)) formrg)
(org-table-time-string-to-seconds formrg))
formrg)
keep-empty numbers lispp)))
(if (not (save-match-data
(string-match (regexp-quote form) formrpl)))
(setq form (replace-match formrpl t t form))
(error "Spreadsheet error: invalid reference \"%s\"" form)))
;; Insert simple ranges
(while (string-match "\\$\\([0-9]+\\)\\.\\.\\$\\([0-9]+\\)" form)
(setq form
@ -2512,14 +2546,15 @@ not overwrite the stored one."
(eval (eval (read form)))
(error "#ERROR"))
ev (if (numberp ev) (number-to-string ev) ev)
ev (if duration (org-table-time-seconds-to-string
(string-to-number ev)) ev))
ev (if duration (org-table-time-seconds-to-string
(string-to-number ev)
duration-output-format) ev))
(or (fboundp 'calc-eval)
(error "Calc does not seem to be installed, and is needed to evaluate the formula"))
(setq ev (calc-eval (cons form modes)
(if numbers 'num))
ev (if duration (org-table-time-seconds-to-string
(string-to-number ev)) ev)))
(setq ev (calc-eval (cons form modes) (if numbers 'num))
ev (if duration (org-table-time-seconds-to-string
(string-to-number ev)
duration-output-format) ev)))
(when org-table-formula-debug
(with-output-to-temp-buffer "*Substitution History*"
@ -2777,7 +2812,7 @@ known that the table will be realigned a little later anyway."
(setq eqlnum (nreverse eqlnum) eqlname (nreverse eqlname))
;; Expand ranges in lhs of formulas
(setq eqlname (org-table-expand-lhs-ranges eqlname))
;; Get the correct line range to process
(if all
(progn
@ -2809,7 +2844,7 @@ known that the table will be realigned a little later anyway."
(when (member name1 seen-fields)
(error "Several field/range formulas try to set %s" name1))
(push name1 seen-fields)
(and (not a)
(string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" name)
(setq a (list name
@ -2826,7 +2861,7 @@ known that the table will be realigned a little later anyway."
(push (append a (list (cdr eq))) eqlname1)
(org-table-put-field-property :org-untouchable t)))
(setq eqlname1 (nreverse eqlname1))
;; Now evaluate the column formulas, but skip fields covered by
;; field formulas
(goto-char beg)
@ -3204,25 +3239,43 @@ For example: 28 -> AB."
s))
(defun org-table-time-string-to-seconds (s)
"Convert a time string into numerical duration in seconds."
(cond
((and (stringp s)
(string-match "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)" s))
(let ((hour (string-to-number (match-string 1 s)))
(min (string-to-number (match-string 2 s)))
(sec (string-to-number (match-string 3 s))))
(+ (* hour 3600) (* min 60) sec)))
((and (stringp s)
(string-match "\\([0-9]+\\):\\([0-9]+\\)" s))
(let ((min (string-to-number (match-string 1 s)))
(sec (string-to-number (match-string 2 s))))
(+ (* min 60) sec)))))
"Convert a time string into numerical duration in seconds.
S can be a string matching either -?HH:MM:SS or -?HH:MM.
If S is a string representing a number, keep this number."
(let (hour min sec res)
(cond
((and (string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)" s))
(setq minus (< 0 (length (match-string 1 s)))
hour (string-to-number (match-string 2 s))
min (string-to-number (match-string 3 s))
sec (string-to-number (match-string 4 s)))
(if minus
(setq res (- (+ (* hour 3600) (* min 60) sec)))
(setq res (+ (* hour 3600) (* min 60) sec))))
((and (not (string-match org-ts-regexp-both s))
(string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\)" s))
(setq minus (< 0 (length (match-string 1 s)))
hour (string-to-number (match-string 2 s))
min (string-to-number (match-string 3 s)))
(if minus
(setq res (- (+ (* hour 3600) (* min 60))))
(setq res (+ (* hour 3600) (* min 60)))))
(t (setq res (string-to-number s))))
(number-to-string res)))
(defun org-table-time-seconds-to-string (secs)
"Convert a number of seconds to a time string."
(cond ((>= secs 3600) (org-format-seconds "%h:%.2m:%.2s" secs))
((>= secs 60) (org-format-seconds "%m:%.2s" secs))
(t (org-format-seconds "%s" secs))))
(defun org-table-time-seconds-to-string (secs &optional output-format)
"Convert a number of seconds to a time string.
If OUTPUT-FORMAT is non-nil, return a number of days, hours,
minutes or seconds."
(cond ((eq output-format 'days)
(format "%.3f" (/ (float secs) 86400)))
((eq output-format 'hours)
(format "%.2f" (/ (float secs) 3600)))
((eq output-format 'minutes)
(format "%.1f" (/ (float secs) 60)))
((eq output-format 'seconds)
(format "%d" secs))
(t (org-format-seconds "%.2h:%.2m:%.2s" secs))))
(defun org-table-fedit-convert-buffer (function)
"Convert all references in this buffer, using FUNCTION."

56
lisp/org-taskjuggler.el
View File

@ -265,12 +265,12 @@ defined in `org-export-taskjuggler-default-reports'."
(org-taskjuggler-assign-task-ids
(org-taskjuggler-compute-task-leafiness
(org-map-entries
'(org-taskjuggler-components)
'org-taskjuggler-components
org-export-taskjuggler-project-tag nil 'archive 'comment)))))
(resources
(org-taskjuggler-assign-resource-ids
(org-map-entries
'(org-taskjuggler-components)
'org-taskjuggler-components
org-export-taskjuggler-resource-tag nil 'archive 'comment)))
(filename (expand-file-name
(concat
@ -555,10 +555,10 @@ attributes from the PROJECT alist are inserted. If no end date is
specified it is calculated
`org-export-taskjuggler-default-project-duration' days from now."
(let* ((unique-id (cdr (assoc "unique-id" project)))
(headline (cdr (assoc "headline" project)))
(version (cdr (assoc "version" project)))
(start (cdr (assoc "start" project)))
(end (cdr (assoc "end" project))))
(headline (cdr (assoc "headline" project)))
(version (cdr (assoc "version" project)))
(start (cdr (assoc "start" project)))
(end (cdr (assoc "end" project))))
(insert
(format "project %s \"%s\" \"%s\" %s +%sd {\n }\n"
unique-id headline version start
@ -629,28 +629,28 @@ org-mode priority string."
(defun org-taskjuggler-open-task (task)
(let* ((unique-id (cdr (assoc "unique-id" task)))
(headline (cdr (assoc "headline" task)))
(effort (org-taskjuggler-clean-effort (cdr (assoc org-effort-property task))))
(depends (cdr (assoc "depends" task)))
(allocate (cdr (assoc "allocate" task)))
(priority-raw (cdr (assoc "PRIORITY" task)))
(priority (and priority-raw (org-taskjuggler-get-priority priority-raw)))
(state (cdr (assoc "TODO" task)))
(complete (or (and (member state org-done-keywords) "100")
(cdr (assoc "complete" task))))
(parent-ordered (cdr (assoc "parent-ordered" task)))
(previous-sibling (cdr (assoc "previous-sibling" task)))
(milestone (or (cdr (assoc "milestone" task))
(and (assoc "leaf-node" task)
(not (or effort
(cdr (assoc "duration" task))
(cdr (assoc "end" task))
(cdr (assoc "period" task)))))))
(attributes
'(account start note duration endbuffer endcredit end
flags journalentry length maxend maxstart minend
minstart period reference responsible scheduling
startbuffer startcredit statusnote)))
(headline (cdr (assoc "headline" task)))
(effort (org-taskjuggler-clean-effort (cdr (assoc org-effort-property task))))
(depends (cdr (assoc "depends" task)))
(allocate (cdr (assoc "allocate" task)))
(priority-raw (cdr (assoc "PRIORITY" task)))
(priority (and priority-raw (org-taskjuggler-get-priority priority-raw)))
(state (cdr (assoc "TODO" task)))
(complete (or (and (member state org-done-keywords) "100")
(cdr (assoc "complete" task))))
(parent-ordered (cdr (assoc "parent-ordered" task)))
(previous-sibling (cdr (assoc "previous-sibling" task)))
(milestone (or (cdr (assoc "milestone" task))
(and (assoc "leaf-node" task)
(not (or effort
(cdr (assoc "duration" task))
(cdr (assoc "end" task))
(cdr (assoc "period" task)))))))
(attributes
'(account start note duration endbuffer endcredit end
flags journalentry length maxend maxstart minend
minstart period reference responsible scheduling
startbuffer startcredit statusnote)))
(insert
(concat
"task " unique-id " \"" headline "\" {\n"

715
lisp/org.el
View File

File diff suppressed because it is too large Load Diff

2
testing/README.org
View File

@ -78,6 +78,8 @@ First tangle this file out to your desktop.
(org-id-update-id-locations
(list (concat org-dir "/testing/examples/babel.org")
(concat org-dir "/testing/examples/normal.org")
(concat org-dir "/testing/examples/ob-awk-test.org")
(concat org-dir "/testing/examples/ob-fortran-test.org")
(concat org-dir "/testing/examples/link-in-heading.org")
(concat org-dir "/testing/examples/links.org")))

6
testing/examples/babel.org
View File

@ -227,17 +227,17 @@ an = sign.
** query all mounted disks
#+begin_src sh :noweb-ref fullest-disk
df \
df
#+end_src
** strip the header row
#+begin_src sh :noweb-ref fullest-disk
|sed '1d' \
|sed '1d'
#+end_src
** sort by the percent full
#+begin_src sh :noweb-ref fullest-disk
|awk '{print $5 " " $6}'|sort -n |tail -1 \
|awk '{print $5 " " $6}'|sort -n |tail -1
#+end_src
** extract the mount point

2
testing/examples/ob-awk-test.in Normal file
View File

@ -0,0 +1,2 @@
# an input file for awk test
15

39
testing/examples/ob-awk-test.org Normal file
View File

@ -0,0 +1,39 @@
#+Title: a collection of examples for ob-awk tests
#+OPTIONS: ^:nil
* Simple tests
:PROPERTIES:
:ID: 9e998b2a-3581-43fe-b26d-07d3c507b86a
:END:
Run without input stream
#+begin_src awk :ouput silent :results silent
BEGIN {
print 42
}
#+end_src
Use a code block ouput as an input
#+begin_src awk :stdin genseq :results silent
{
print 42+$1
}
#+end_src
Use input file
#+srcname: genfile
#+begin_src awk :in-file ob-awk-test.in :results silent
$0~/[\t]*#/{
# skip comments
next
}
{
print $1*10
}
#+end_src
* Input data generators
A code block to generate input stream
#+srcname: genseq
#+begin_src emacs-lisp :results silent
(print "1")
#+end_src

86
testing/examples/ob-fortran-test.org Normal file
View File

@ -0,0 +1,86 @@
#+Title: a collection of examples for ob-fortran tests
#+OPTIONS: ^:nil
* simple programs
:PROPERTIES:
:ID: 459384e8-1797-4f11-867e-dde0473ea7cc
:END:
#+source: hello
#+begin_src fortran :results silent
print *, 'Hello world'
#+end_src
#+source: fortran_parameter
#+begin_src fortran :results silent
integer, parameter :: i = 10
write (*, '(i2)') i
#+end_src
* variable resolution
:PROPERTIES:
:ID: d8d1dfd3-5f0c-48fe-b55d-777997e02242
:END:
#+begin_src fortran :var N = 15 :results silent
write (*, '(i2)') N
#+end_src
Define for preprocessed fortran
#+begin_src fortran :defines N 42 :results silent
implicit none
write (*, '(i2)') N
#+end_src
#+begin_src fortran :var s="word" :results silent
write (*, '(a4)') s
#+end_src
* arrays
:PROPERTIES:
:ID: c28569d9-04ce-4cad-ab81-1ea29f691465
:END:
Real array as input
#+begin_src fortran :var s='(1.0 2.0 3.0) :results silent
write (*, '(3f5.2)'), s
#+end_src
#+tblname: test_tbl
| 1.0 |
| 2.0 |
#+begin_src fortran :var s=test_tbl :results silent
write (*, '(2f5.2)'), s
#+end_src
* failing
:PROPERTIES:
:ID: 891ead4a-f87a-473c-9ae0-1cf348bcd04f
:END:
Should fail (TODO: add input variables for the case with explicit
program statement)
#+begin_src fortran :var s="word" :results silent
program ex
print *, "output of ex program"
end program ex
#+end_src
Fails to compile (TODO: error check in ob-fortran.el)
#+begin_src fortran :var s='(1 ()) :results silent
print *, s
#+end_src
Should fail to compile with gfortran
#+begin_src fortran :flags --std=f95 --pedantic-error :results silent
program ex
integer*8 :: i
end program ex
#+end_src
* programs input parameters
:PROPERTIES:
:ID: 2d5330ea-9934-4737-9ed6-e1d3dae2dfa4
:END:
Pass parameters to the program
#+begin_src fortran :cmdline "23" :results silent
character(len=255) :: cmd
call get_command_argument(1, cmd)
write (*,*) trim(cmd)
#+end_src

19
testing/lisp/test-ob-awk.el Normal file
View File

@ -0,0 +1,19 @@
(require 'ob-awk)
(ert-deftest ob-awk/input-none ()
"Test with no input file"
(org-test-at-id "9e998b2a-3581-43fe-b26d-07d3c507b86a"
(org-babel-next-src-block)
(should (= 42 (org-babel-execute-src-block)))))
(ert-deftest ob-awk/input-src-block ()
"Test a code block as an input"
(org-test-at-id "9e998b2a-3581-43fe-b26d-07d3c507b86a"
(org-babel-next-src-block 2)
(should (= 43 (org-babel-execute-src-block)))))
(ert-deftest ob-awk/input-src-block ()
"Test a code block as an input"
(org-test-at-id "9e998b2a-3581-43fe-b26d-07d3c507b86a"
(org-babel-next-src-block 3)
(should (= 150 (org-babel-execute-src-block)))))

80
testing/lisp/test-ob-fortran.el Normal file
View File

@ -0,0 +1,80 @@
(require 'ob-fortran)
(ert-deftest ob-fortran/assert ()
(should t))
(ert-deftest ob-fortran/simple-program ()
"Test of hello world program."
(org-test-at-id "459384e8-1797-4f11-867e-dde0473ea7cc"
(org-babel-next-src-block)
(should (equal "Hello world" (org-babel-execute-src-block))))
)
(ert-deftest ob-fortran/fortran-var-program ()
"Test a fortran variable"
(org-test-at-id "459384e8-1797-4f11-867e-dde0473ea7cc"
(org-babel-next-src-block 2)
(should (= 10 (org-babel-execute-src-block))))
)
(ert-deftest ob-fortran/input-var ()
"Test :var"
(org-test-at-id "d8d1dfd3-5f0c-48fe-b55d-777997e02242"
(org-babel-next-src-block)
(should (= 15 (org-babel-execute-src-block)))))
(ert-deftest ob-fortran/preprosessor-var ()
"Test preprocessed fortran"
(org-test-at-id "d8d1dfd3-5f0c-48fe-b55d-777997e02242"
(org-babel-next-src-block 2)
(should (= 42 (org-babel-execute-src-block)))))
(ert-deftest ob-fortran/character-var ()
"Test string input"
(org-test-at-id "d8d1dfd3-5f0c-48fe-b55d-777997e02242"
(org-babel-next-src-block 3)
(should (equal "word" (org-babel-execute-src-block)))))
(ert-deftest ob-fortran/list-var ()
"Test real array input"
(org-test-at-id "c28569d9-04ce-4cad-ab81-1ea29f691465"
(org-babel-next-src-block)
(should (equal "1.00 2.00 3.00" (org-babel-execute-src-block)))))
(ert-deftest ob-fortran/list-var-from-table ()
"Test real array from a table"
(org-test-at-id "c28569d9-04ce-4cad-ab81-1ea29f691465"
(org-babel-next-src-block 2)
(should (equal "1.00 2.00" (org-babel-execute-src-block)))))
(ert-deftest ob-fortran/no-variables-with-main ()
"Test :var with explicit 'program'"
(org-test-at-id "891ead4a-f87a-473c-9ae0-1cf348bcd04f"
(org-babel-next-src-block)
(should-error (org-babel-execute-src-block))
:type 'error))
;; (ert-deftest ob-fortran/wrong-list ()
;; "Test wrong input list"
;; (org-test-at-id "891ead4a-f87a-473c-9ae0-1cf348bcd04f"
;; (org-babel-next-src-block 2)
;; (should-error (org-babel-execute-src-block))
;; :type 'error))
;; (ert-deftest ob-fortran/compiler-flags ()
;; "Test compiler's flags"
;; (org-test-at-id "891ead4a-f87a-473c-9ae0-1cf348bcd04f"
;; (org-babel-next-src-block 3)
;; (should-error (org-babel-execute-src-block))
;; :type 'error))
(ert-deftest ob-fortran/command-arguments ()
"Test real array from a table"
(org-test-at-id "2d5330ea-9934-4737-9ed6-e1d3dae2dfa4"
(org-babel-next-src-block)
(should (= 23 (org-babel-execute-src-block)))))
(provide 'test-ob-fortran)
;;; test-ob-fortran.el ends here

7
testing/lisp/test-ob-tangle.el
View File

@ -56,11 +56,8 @@
(ert-deftest ob-tangle/continued-code-blocks-w-noweb-ref ()
"Test that the :noweb-ref header argument is used correctly."
(org-test-at-id "54d68d4b-1544-4745-85ab-4f03b3cbd8a0"
(let ((tangled "df \\
|sed '1d' \\
|awk '{print $5 \" \" $6}'|sort -n |tail -1 \\
|awk '{print $2}'
"))
(let ((tangled
"df|sed '1d'|awk '{print $5 \" \" $6}'|sort -n |tail -1|awk '{print $2}'"))
(org-narrow-to-subtree)
(org-babel-tangle)
(with-temp-buffer