ndwarshuis
/
org-mode
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'master' of git+ssh://repo.or.cz/srv/git/org-mode

This commit is contained in:
Carsten Dominik 2010-10-08 12:40:14 +02:00
parent 395098f6f1 3d13b8e687
commit 63e4b4528e
76 changed files with 3392 additions and 1577 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
.gitmodules vendored Normal file
View File

@ -0,0 +1,6 @@
[submodule "testing/jump"]
path = testing/jump
url = git://github.com/eschulte/jump.el.git
[submodule "testing/ert"]
path = testing/ert
url = http://github.com/ohler/ert.git

382
EXPERIMENTAL/org-export.el
View File

@ -1,14 +1,14 @@
;;; org-export.el --- Export engine for Org
;;
;; Copyright 2008 Bastien Guerry
;; Copyright 2008 2010 Bastien Guerry
;;
;; Emacs Lisp Archive Entry
;; Filename: org-export.el
;; Version: 0.1a
;; Version: 0.3
;; Author: Bastien <bzg AT altern DOT org>
;; Maintainer: Bastien <bzg AT altern DOT org>
;; Keywords:
;; Description:
;; Keywords:
;; Description:
;; URL: [Not distributed yet]
;;
;; This program is free software; you can redistribute it and/or modify
@ -27,23 +27,50 @@
;;
;;; Commentary:
;;
;; This is the export engine for Org.
;; org-export.el implements a new experimental export engine for Org.
;;
;; Put this file into your load-path and the following into your ~/.emacs:
;; (require 'org-export)
;;
;;; Todo:
;;
;; Rewrite `org-export-export-preprocess-string'.
;;
;;; Code:
(eval-when-compile
(require 'cl))
;;; Preparation functions:
(defvar org-export-structure nil)
(defvar org-export-content nil)
(defvar org-export-properties nil)
(defun org-export-set-backend (suffix)
"Set the backend functions names from SUFFIX."
(setq org-export-structure
`((header ,(intern (concat "org-" suffix "-export-header")))
(first-lines ,(intern (concat "org-" suffix "-export-first-lines")))
(section-beginning ,(intern (concat "org-" suffix "-export-section-beginning")))
(heading ,(intern (concat "org-" suffix "-export-heading")))
(section-end ,(intern (concat "org-" suffix "-export-section-end")))
(footer ,(intern (concat "org-" suffix "-export-footer")))))
(setq org-export-content
`((fonts ,(intern (concat "org-" suffix "-export-fonts")))
(links ,(intern (concat "org-" suffix "-export-links")))
(lists ,(intern (concat "org-" suffix "-export-lists")))
(envs ,(intern (concat "org-" suffix "-export-quote-verse-center")))
(tables ,(intern (concat "org-" suffix "-export-tables"))))))
;;; Parsing functions:
(defun org-export-parse (&optional level)
"Parse the current buffer.
Return a nested list reflecting the sectioning structure of the
file and containing all information about each section, including
its content."
"Recursively parse the current buffer.
If LEVEL is set, do the parsing at that level of sectioning.
Return a nested list containing the structure of the parsed
buffer and information about each section, including its
content."
(let (output eos)
(save-excursion
(goto-char (point-min))
@ -52,116 +79,101 @@ its content."
(properties (org-entry-properties)))
(save-restriction
(narrow-to-region (if (looking-at "\n") (1+ (point)) (point))
(save-excursion
(save-excursion
(setq eos (org-end-of-subtree t t))))
(setq output
(append output
(list
(list
(list :level (or level 1)
:heading heading
:properties properties
:content (org-export-parse-clean-content-string
(org-export-parse-content))
:subtree (org-export-parse
:content (org-export-get-entry-content)
:subtree (org-export-parse
(if level (1+ level) 2)))))))
(goto-char (1- eos)))))
output))
(defun org-export-parse-content ()
"Extract the content of a section.
The content of a section is the part before a subtree."
(defun org-export-get-entry-content ()
"Extract the content of an entry.
The content of a entry is the part before its first subtree or
the end of the entry."
(save-excursion
(goto-char (point-min))
;; FIXME The following shouldn't be necessary since we are cleaning
;; up the buffer ith org-export-preprocess-string
(while (or (looking-at org-property-drawer-re)
(looking-at org-clock-drawer-re)
(looking-at org-keyword-time-regexp))
(move-beginning-of-line 1))
(buffer-substring
(point)
(if (re-search-forward org-complex-heading-regexp nil t)
(match-beginning 0) (point-max)))))
(defun org-export-parse-clean-content-string (s)
"From the content string S, remove stuff also captured by get-properties.
So this will remove the clock drawer, the property drawer, and the lines
with planning info (DEADLINE, SCHEDULED, CLOSED)."
(if (string-match org-property-drawer-re s)
(setq s (replace-match "" t t s)))
(if (string-match org-clock-drawer-re s)
(setq s (replace-match "" t t s)))
(while (string-match (concat org-keyword-time-regexp ".*\n?") s)
(setq s (replace-match "" t t s)))
s)
;;; Rendering functions:
(defun org-export-buffer (filter struct-backend content-backend)
"Render the current buffer.
It first parses the current buffer into a list. Then it filters
this list with FILTER. Finally it uses STRUCT-BACKEND and
CONTENT-BACKEND to render the structure of the buffer and the
content of each section."
(save-excursion
(let* ((props (org-combine-plists
(org-default-export-plist)
(org-infile-export-plist)))
(first-lines (org-export-parse-content))
(parsed-buffer (org-export-parse)))
(switch-to-buffer (get-buffer-create "*Org export*"))
(erase-buffer)
(funcall (cdr (assoc 'header struct-backend)) props)
(funcall (cdr (assoc 'first-lines struct-backend))
first-lines props)
(org-export-render-structure parsed-buffer props filter
struct-backend content-backend)
(funcall (cdr (assoc 'footer struct-backend)) props))))
(defun org-export-render (&optional filter)
"Render the current Org buffer and export it.
First parse the buffer and return it as a nested list. If FILTER
is set, use it to filter this list (see `org-export-filter') then
export the (filtered) list with `org-export-render-structure'."
(setq org-export-properties
(org-combine-plists (org-default-export-plist)
(org-infile-export-plist)))
(let* (first-lines
(bstring (buffer-string))
(parsed-buffer
(with-temp-buffer
(org-mode)
(insert (apply 'org-export-export-preprocess-string
bstring org-export-properties))
(goto-char (point-min))
(setq first-lines (org-export-get-entry-content))
(org-export-parse))))
(switch-to-buffer (get-buffer-create "*Org export*"))
(erase-buffer)
(funcall (cadr (assoc 'header org-export-structure)))
(funcall (cadr (assoc 'first-lines org-export-structure)) first-lines)
(org-export-render-structure parsed-buffer filter)
(funcall (cadr (assoc 'footer org-export-structure)))))
(defun org-export-render-structure
(parsed-buffer props filter struct-backend content-backend)
(defun org-export-render-structure (parsed-buffer &optional filter)
"Render PARSED-BUFFER.
The optional argument FILTER specifies a filter to pass to the
An optional argument FILTER specifies a filter to pass to the
rendering engine."
(mapc (lambda(s)
(funcall (cdr (assoc 'section-beginning struct-backend)) s)
(funcall (cdr (assoc 'heading struct-backend)) s)
(insert (org-export-render-content s props content-backend) "\n\n")
(org-export-render-structure (plist-get s :subtree) props
filter struct-backend content-backend)
(funcall (cdr (assoc 'section-end struct-backend)) s))
(funcall (cadr (assoc 'section-beginning org-export-structure)) s)
(funcall (cadr (assoc 'heading org-export-structure)) s)
(insert (org-export-render-content s) "\n\n")
(org-export-render-structure (plist-get s :subtree) filter)
(funcall (cadr (assoc 'section-end org-export-structure)) s))
(org-export-filter parsed-buffer filter)))
(defun org-export-render-content (section props content-backend)
"Render SECTION with PROPS. SECTION is the property list
defining the information for the section. PROPS is the property
list defining information for the current export.
CONTENT-BACKEND is an association list defining possible
exporting directive the content of this section."
(defun org-export-render-content (section)
"Render SECTION.
SECTION is either a string or a property list containing
informations (including content) for a section."
(with-temp-buffer
(insert (plist-get section :content))
(if (not (plist-get props :with-comment))
(funcall (cdr (assoc 'comment content-backend))))
(insert (if (listp section) (plist-get section :content) section))
(mapc (lambda(e)
(goto-char (point-min))
(funcall (cadr (assoc e org-export-content))))
'(fonts tables lists envs links))
(buffer-string)))
(defun org-export-strip-drawer ()
"Strip DRAWERS in the current buffer.
Stripped drawers are those matched by `org-drawer-regexp'."
(save-excursion
(while (re-search-forward org-drawer-regexp nil t)
(let ((beg (match-beginning 0))
(end (and (search-forward ":END:" nil t)
(match-end 0))))
(delete-region beg end)))))
;;; Filtering functions:
(defun org-export-filter (parsed-buffer filter)
"Filter out PARSED-BUFFER with FILTER.
PARSED-BUFFER is a nested list a sections and subsections, as
PARSED-BUFFER is a nested list of sections and subsections, as
produced by `org-export-parse'. FILTER is an alist of rules to
apply to PARSED-BUFFER. For the syntax of a filter, please check
the docstring of `org-export-latex-filter'."
(delete
nil
(mapcar
;; FIXME where is org-export-latex-filter
(delete
nil
(mapcar
(lambda(s)
(if (delete
nil
nil
(mapcar
(lambda(f)
(let ((cnd (car f)) (re (cadr f)) prop-cnd)
@ -169,16 +181,214 @@ the docstring of `org-export-latex-filter'."
(string-match re (plist-get s :heading)))
(and (eq cnd 'content)
(string-match re (plist-get s :content)))
(and (setq prop-cnd
(and (setq prop-cnd
(assoc cnd (plist-get s :properties)))
(string-match re (cadr prop-cnd))))))
filter))
nil ;; return nil if the section is filtered out
(progn (plist-put s :subtree
(progn (plist-put s :subtree
(org-export-filter (plist-get s :subtree) filter))
s))) ;; return the section if it isn't filtered out
parsed-buffer)))
;; FIXME This function is a copy of `org-export-preprocess-string' which
;; should be rewritten for this export engine to work okay.
(defun org-export-export-preprocess-string (string &rest parameters)
"Cleanup STRING so that that the true exported has a more consistent source.
This function takes STRING, which should be a buffer-string of an org-file
to export. It then creates a temporary buffer where it does its job.
The result is then again returned as a string, and the exporter works
on this string to produce the exported version."
(interactive)
(let* ((htmlp (plist-get parameters :for-html))
(asciip (plist-get parameters :for-ascii))
(latexp (plist-get parameters :for-LaTeX))
(docbookp (plist-get parameters :for-docbook))
(backend (cond (htmlp 'html)
(latexp 'latex)
(asciip 'ascii)
(docbookp 'docbook)))
(archived-trees (plist-get parameters :archived-trees))
(inhibit-read-only t)
(drawers org-drawers)
(outline-regexp "\\*+ ")
target-alist rtn)
(setq org-export-target-aliases nil
org-export-preferred-target-alist nil
org-export-id-target-alist nil
org-export-code-refs nil)
(with-current-buffer (get-buffer-create " org-mode-tmp")
(erase-buffer)
(insert string)
(setq case-fold-search t)
(let ((inhibit-read-only t))
(remove-text-properties (point-min) (point-max)
'(read-only t)))
;; Remove license-to-kill stuff
;; The caller marks some stuff for killing, stuff that has been
;; used to create the page title, for example.
(org-export-kill-licensed-text)
(let ((org-inhibit-startup t)) (org-mode))
(setq case-fold-search t)
(org-install-letbind)
;; Call the hook
(run-hooks 'org-export-preprocess-hook)
;; Process the macros
(org-export-preprocess-apply-macros)
(run-hooks 'org-export-preprocess-after-macros-hook)
(untabify (point-min) (point-max))
;; Handle include files, and call a hook
(org-export-handle-include-files-recurse)
(run-hooks 'org-export-preprocess-after-include-files-hook)
;; Get rid of archived trees
(org-export-remove-archived-trees archived-trees)
;; Remove comment environment and comment subtrees
(org-export-remove-comment-blocks-and-subtrees)
;; Get rid of excluded trees, and call a hook
(org-export-handle-export-tags (plist-get parameters :select-tags)
(plist-get parameters :exclude-tags))
(run-hooks 'org-export-preprocess-after-tree-selection-hook)
;; Mark end of lists
(org-export-mark-list-ending backend)
;; Handle source code snippets
;; (org-export-export-replace-src-segments-and-examples backend)
;; Protect short examples marked by a leading colon
(org-export-protect-colon-examples)
;; Normalize footnotes
(when (plist-get parameters :footnotes)
(org-footnote-normalize nil t))
;; Find all headings and compute the targets for them
(setq target-alist (org-export-define-heading-targets target-alist))
(run-hooks 'org-export-preprocess-after-headline-targets-hook)
;; Find HTML special classes for headlines
(org-export-remember-html-container-classes)
;; Get rid of drawers
(org-export-remove-or-extract-drawers
drawers (plist-get parameters :drawers) backend)
;; Get the correct stuff before the first headline
(when (plist-get parameters :skip-before-1st-heading)
(goto-char (point-min))
(when (re-search-forward "^\\(#.*\n\\)?\\*+[ \t]" nil t)
(delete-region (point-min) (match-beginning 0))
(goto-char (point-min))
(insert "\n")))
(when (plist-get parameters :text)
(goto-char (point-min))
(insert (plist-get parameters :text) "\n"))
;; Remove todo-keywords before exporting, if the user has requested so
(org-export-remove-headline-metadata parameters)
;; Find targets in comments and move them out of comments,
;; but mark them as targets that should be invisible
(setq target-alist (org-export-handle-invisible-targets target-alist))
;; Select and protect backend specific stuff, throw away stuff
;; that is specific for other backends
(run-hooks 'org-export-preprocess-before-selecting-backend-code-hook)
(org-export-select-backend-specific-text backend)
;; Protect quoted subtrees
(org-export-protect-quoted-subtrees)
;; Remove clock lines
(org-export-remove-clock-lines)
;; Protect verbatim elements
(org-export-protect-verbatim)
;; Blockquotes, verse, and center
(org-export-mark-blockquote-verse-center)
(run-hooks 'org-export-preprocess-after-blockquote-hook)
;; Remove timestamps, if the user has requested so
(unless (plist-get parameters :timestamps)
(org-export-remove-timestamps))
;; Attach captions to the correct object
;; (setq target-alist (org-export-attach-captions-and-attributes
;; backend target-alist))
;; Find matches for radio targets and turn them into internal links
(org-export-mark-radio-links)
(run-hooks 'org-export-preprocess-after-radio-targets-hook)
;; Find all links that contain a newline and put them into a single line
(org-export-concatenate-multiline-links)
;; Normalize links: Convert angle and plain links into bracket links
;; and expand link abbreviations
(run-hooks 'org-export-preprocess-before-normalizing-links-hook)
(org-export-normalize-links)
;; Find all internal links. If they have a fuzzy match (i.e. not
;; a *dedicated* target match, let the link point to the
;; corresponding section.
(org-export-target-internal-links target-alist)
;; Find multiline emphasis and put them into single line
(when (plist-get parameters :emph-multiline)
(org-export-concatenate-multiline-emphasis))
;; Remove special table lines
(when org-export-table-remove-special-lines
(org-export-remove-special-table-lines))
;; Another hook
(run-hooks 'org-export-preprocess-before-backend-specifics-hook)
;; LaTeX-specific preprocessing
(when latexp
(require 'org-latex nil)
(org-export-latex-preprocess parameters))
;; ASCII-specific preprocessing
(when asciip
(org-export-ascii-preprocess parameters))
;; HTML-specific preprocessing
(when htmlp
(org-export-html-preprocess parameters))
;; DocBook-specific preprocessing
(when docbookp
(require 'org-docbook nil)
(org-export-docbook-preprocess parameters))
;; Remove or replace comments
(org-export-handle-comments (plist-get parameters :comments))
;; Remove #+TBLFM and #+TBLNAME lines
(org-export-handle-table-metalines)
;; Run the final hook
(run-hooks 'org-export-preprocess-final-hook)
(setq rtn (buffer-string))
(kill-buffer " org-mode-tmp"))
rtn))
(provide 'org-export)
;;; User Options, Variables

9
ORGWEBPAGE/Changes_old.org
View File

@ -31,9 +31,9 @@ Currently I do not recommend to turn it on globally using
the variable =org-startup-indented=. But you can turn it on
for a particular buffer using
#+begin_src org
#+begin_example
,#+STARTUP: indent
#+end_src
#+end_example
Turning on this minor mode automatically turns on
=org-hide-leading-stars=, and it turns off
@ -7369,8 +7369,9 @@ list of small improvements and some new significant features.
- Export content specified via the #+TEXT construct is now
fully processed, i.e. links, emphasis etc. are all
interpreted. #+TEXT lines may include
#+BEGIN_HTML...#+END_HTML sections to embed literal HTML.
interpreted. #+TEXT lines may
include #+BEGIN_HTML... #+END_HTML sections to embed literal
HTML.
- During HTML export, you can request to have a_{b}
interpreted as a subscript, but to leave a_b as it is. This

6
ORGWEBPAGE/index.org
View File

@ -117,11 +117,11 @@ a look at our [[http://orgmode.org/worg/org-quotes.php][collected quotes about O
#+ATTR_HTML: style="float:right;"
[[http://mobileorg.ncogni.to/][http://mobileorg.ncogni.to/images/screenshot-browse.png]]
- <2010-09-24 Fri>: FLOSS Weekly [[http://twit.tv/floss136][interview]] with Carsten available
- <2010-04-06 Tue>: Release 7.01
- <2010-06-06 Sun>: iPhone App [[http://mobileorg.ncogni.to/][MobileOrg]] version 1.3 introduces
DropBox support, for vastly easier setup.
- <2010-04-06 Tue>: Release 6.35
- <2010-01-10 Sun>: Release 6.34
* Current Version (7.01h)
@ -200,7 +200,9 @@ and corresponding to the latest git version.
** Talks about Org-mode
Check out the [[file:talks/index.html#sec-1][Google Tech Talk]] about Org-mode, or another talk
given at the [[file:talks/index.html#sec-2][Max Planck Institute for Neurological Research]]
given at the [[file:talks/index.html#sec-2][Max Planck Institute for Neurological Research]]. On
FLOSS Weekly [[http://twit.tv/floss136][show number 136]] Randal Schwartz interviews Carsten
about Org mode.
** Mailing list
:PROPERTIES:
:ID: 0B280B26-A3AB-4E5C-B4EE-B7FFC52C4D26

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

@ -161,6 +161,20 @@ plot(data)
** Gnuplot
* Org reference
** headline references
#+source: headline
#+begin_src emacs-lisp :var headline=top :var file='()
(save-excursion
(when file (get-file-buffer file))
(org-open-link-from-string (org-make-link-string headline))
(save-restriction
(org-narrow-to-subtree)
(buffer-string)))
#+end_src
#+call: headline(headline="headline references")
* Tables
** LaTeX Table export
*** booktabs

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

@ -1,7 +1,7 @@
;;; org-drill.el - Self-testing with org-learn
;;;
;;; Author: Paul Sexton <eeeickythump@gmail.com>
;;; Version: 1.0
;;; Version: 1.4
;;; Repository at http://bitbucket.org/eeeickythump/org-drill/
;;;
;;;
@ -96,6 +96,12 @@ Possible values:
(defface org-drill-visible-cloze-face
'((t (:foreground "darkseagreen")))
"The face used to hide the contents of cloze phrases."
:group 'org-drill)
(defface org-drill-visible-cloze-hint-face
'((t (:foreground "dark slate blue")))
"The face used to hide the contents of cloze phrases."
:group 'org-drill)
@ -115,6 +121,35 @@ buffers?"
:group 'org-drill)
(defcustom org-drill-new-count-color
"royal blue"
"Foreground colour used to display the count of remaining new items
during a drill session."
:group 'org-drill
:type 'color)
(defcustom org-drill-mature-count-color
"green"
"Foreground colour used to display the count of remaining mature items
during a drill session. Mature items are due for review, but are not new."
:group 'org-drill
:type 'color)
(defcustom org-drill-failed-count-color
"red"
"Foreground colour used to display the count of remaining failed items
during a drill session."
:group 'org-drill
:type 'color)
(defcustom org-drill-done-count-color
"sienna"
"Foreground colour used to display the count of reviewed items
during a drill session."
:group 'org-drill
:type 'color)
(setplist 'org-drill-cloze-overlay-defaults
'(display "[...]"
face org-drill-hidden-cloze-face
@ -124,7 +159,15 @@ buffers?"
(defvar org-drill-cloze-regexp
;; ver 1 "[^][]\\(\\[[^][][^]]*\\]\\)"
;; ver 2 "\\(\\[.*?\\]\\|^[^[[:cntrl:]]*?\\]\\|\\[.*?$\\)"
"\\(\\[.*?\\]\\|\\[.*?[[:cntrl:]]+.*?\\]\\)")
;; ver 3! "\\(\\[.*?\\]\\|\\[.*?[[:cntrl:]]+.*?\\]\\)"
"\\(\\[[[:cntrl:][:graph:][:space:]]*?\\)\\(\\||.+?\\)\\(\\]\\)")
(defvar org-drill-cloze-keywords
`((,org-drill-cloze-regexp
(1 'org-drill-visible-cloze-face nil)
(2 'org-drill-visible-cloze-hint-face t)
(3 'org-drill-visible-cloze-face nil)
)))
(defcustom org-drill-card-type-alist
@ -132,6 +175,7 @@ buffers?"
("simple" . org-drill-present-simple-card)
("twosided" . org-drill-present-two-sided-card)
("multisided" . org-drill-present-multi-sided-card)
("multicloze" . org-drill-present-multicloze)
("spanish_verb" . org-drill-present-spanish-verb))
"Alist associating card types with presentation functions. Each entry in the
alist takes the form (CARDTYPE . FUNCTION), where CARDTYPE is a string
@ -158,11 +202,41 @@ random noise is adapted from Mnemosyne."
:group 'org-drill
:type 'boolean)
(defcustom org-drill-cram-hours
12
"When in cram mode, items are considered due for review if
they were reviewed at least this many hours ago."
:group 'org-drill
:type 'integer)
(defvar *org-drill-done-entry-count* 0)
(defvar *org-drill-pending-entry-count* 0)
(defvar *org-drill-session-qualities* nil)
(defvar *org-drill-start-time* 0)
(defvar *org-drill-new-entries* nil)
(defvar *org-drill-mature-entries* nil)
(defvar *org-drill-failed-entries* nil)
(defvar *org-drill-again-entries* nil)
(defvar *org-drill-done-entries* nil)
(defvar *org-drill-cram-mode* nil
"Are we in 'cram mode', where all items are considered due
for review unless they were already reviewed in the recent past?")
;;;; Utilities ================================================================
(defun free-marker (m)
(set-marker m nil))
(defmacro pop-random (place)
(let ((elt (gensym)))
`(if (null ,place)
nil
(let ((,elt (nth (random (length ,place)) ,place)))
(setq ,place (remove ,elt ,place))
,elt))))
(defun shuffle-list (list)
@ -181,10 +255,52 @@ random noise is adapted from Mnemosyne."
list)
(defun time-to-inactive-org-timestamp (time)
(format-time-string
(concat "[" (substring (cdr org-time-stamp-formats) 1 -1) "]")
time))
(defmacro with-hidden-cloze-text (&rest body)
`(progn
(org-drill-hide-clozed-text)
(unwind-protect
(progn
,@body)
(org-drill-unhide-clozed-text))))
(defun org-drill-days-since-last-review ()
"Nil means a last review date has not yet been stored for
the item.
Zero means it was reviewed today.
A positive number means it was reviewed that many days ago.
A negative number means the date of last review is in the future --
this should never happen."
(let ((datestr (org-entry-get (point) "DRILL_LAST_REVIEWED")))
(when datestr
(- (time-to-days (current-time))
(time-to-days (apply 'encode-time
(org-parse-time-string datestr)))))))
(defun org-drill-hours-since-last-review ()
"Like `org-drill-days-since-last-review', but return value is
in hours rather than days."
(let ((datestr (org-entry-get (point) "DRILL_LAST_REVIEWED")))
(when datestr
(floor
(/ (- (time-to-seconds (current-time))
(time-to-seconds (apply 'encode-time
(org-parse-time-string datestr))))
(* 60 60))))))
(defun org-drill-entry-p ()
"Is the current entry a 'drill item'?"
(or (assoc "LEARN_DATA" (org-entry-properties nil))
(or (org-entry-get (point) "LEARN_DATA")
;;(assoc "LEARN_DATA" (org-entry-properties nil))
(member org-drill-question-tag (org-get-local-tags))))
@ -196,6 +312,19 @@ or a subheading within a drill item?"
(member org-drill-question-tag (org-get-tags-at))))
(defun org-drill-goto-drill-entry-heading ()
"Move the point to the heading which hold the :drill: tag for this
drill entry."
(unless (org-at-heading-p)
(org-back-to-heading))
(unless (org-part-of-drill-entry-p)
(error "Point is not inside a drill entry"))
(while (not (org-drill-entry-p))
(unless (org-up-heading-safe)
(error "Cannot find a parent heading that is marked as a drill entry"))))
(defun org-drill-entry-leech-p ()
"Is the current entry a 'leech item'?"
(and (org-drill-entry-p)
@ -203,25 +332,32 @@ or a subheading within a drill item?"
(defun org-drill-entry-due-p ()
(let ((item-time (org-get-scheduled-time (point))))
(and (org-drill-entry-p)
(or (not (eql 'skip org-drill-leech-method))
(not (org-drill-entry-leech-p)))
(or (null item-time)
(not (minusp ; scheduled for today/in future
(- (time-to-days (current-time))
(time-to-days item-time))))))))
(cond
(*org-drill-cram-mode*
(let ((hours (org-drill-hours-since-last-review)))
(and (org-drill-entry-p)
(or (null hours)
(>= hours org-drill-cram-hours)))))
(t
(let ((item-time (org-get-scheduled-time (point))))
(and (org-drill-entry-p)
(or (not (eql 'skip org-drill-leech-method))
(not (org-drill-entry-leech-p)))
(or (null item-time)
(not (minusp ; scheduled for today/in future
(- (time-to-days (current-time))
(time-to-days item-time))))))))))
(defun org-drill-entry-new-p ()
(let ((item-time (org-get-scheduled-time (point))))
(and (org-drill-entry-p)
(and (org-drill-entry-p)
(let ((item-time (org-get-scheduled-time (point))))
(null item-time))))
(defun org-drill-entry-last-quality ()
(let ((quality (cdr (assoc "DRILL_LAST_QUALITY" (org-entry-properties nil)))))
(let ((quality (org-entry-get (point) "DRILL_LAST_QUALITY")))
(if quality
(string-to-number quality)
nil)))
@ -351,6 +487,8 @@ Returns a list: (INTERVAL N EF OFMATRIX), where:
(cond
((= 0 (nth 0 learn-data))
(org-schedule t))
((minusp (first learn-data))
(org-schedule nil (current-time)))
(t
(org-schedule nil (time-add (current-time)
(days-to-time (nth 0 learn-data))))))))
@ -359,8 +497,8 @@ Returns a list: (INTERVAL N EF OFMATRIX), where:
(defun org-drill-reschedule ()
"Returns quality rating (0-5), or nil if the user quit."
(let ((ch nil))
(while (not (memq ch '(?q ?0 ?1 ?2 ?3 ?4 ?5)))
(setq ch (read-char
(while (not (memq ch '(?q ?e ?0 ?1 ?2 ?3 ?4 ?5)))
(setq ch (read-char-exclusive
(if (eq ch ??)
"0-2 Means you have forgotten the item.
3-5 Means you have remembered the item.
@ -372,12 +510,14 @@ Returns a list: (INTERVAL N EF OFMATRIX), where:
4 - After a little bit of thought you remembered.
5 - You remembered the item really easily.
How well did you do? (0-5, ?=help, q=quit)"
"How well did you do? (0-5, ?=help, q=quit)"))))
How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)"
"How well did you do? (0-5, ?=help, e=edit, q=quit)")))
(if (eql ch ?t)
(org-set-tags-command)))
(cond
((and (>= ch ?0) (<= ch ?5))
(let ((quality (- ch ?0))
(failures (cdr (assoc "DRILL_FAILURE_COUNT" (org-entry-properties nil)))))
(failures (org-entry-get (point) "DRILL_FAILURE_COUNT")))
(save-excursion
(org-drill-smart-reschedule quality))
(push quality *org-drill-session-qualities*)
@ -388,9 +528,20 @@ How well did you do? (0-5, ?=help, q=quit)"
(org-set-property "DRILL_FAILURE_COUNT"
(format "%d" (1+ failures)))
(if (> (1+ failures) org-drill-leech-failure-threshold)
(org-toggle-tag "leech" 'on)))))
(org-toggle-tag "leech" 'on))))
(t
(let ((scheduled-time (org-get-scheduled-time (point))))
(when scheduled-time
(message "Next review in %d days"
(- (time-to-days scheduled-time)
(time-to-days (current-time))))
(sit-for 0.5)))))
(org-set-property "DRILL_LAST_QUALITY" (format "%d" quality))
(org-set-property "DRILL_LAST_REVIEWED"
(time-to-inactive-org-timestamp (current-time)))
quality))
((= ch ?e)
'edit)
(t
nil))))
@ -416,42 +567,92 @@ the current topic."
(defun org-drill-presentation-prompt (&rest fmt-and-args)
(let ((ch nil)
(prompt
(if fmt-and-args
(apply 'format
(first fmt-and-args)
(rest fmt-and-args))
"Press any key to see the answer, 'e' to edit, 'q' to quit.")))
(let* ((item-start-time (current-time))
(ch nil)
(last-second 0)
(prompt
(if fmt-and-args
(apply 'format
(first fmt-and-args)
(rest fmt-and-args))
(concat "Press key for answer, "
"e=edit, t=tags, s=skip, q=quit."))))
(setq prompt
(format "(%d) %s" *org-drill-pending-entry-count* prompt))
(format "%s %s %s %s %s"
(propertize
(number-to-string (length *org-drill-done-entries*))
'face `(:foreground ,org-drill-done-count-color)
'help-echo "The number of items you have reviewed this session.")
(propertize
(number-to-string (+ (length *org-drill-again-entries*)
(length *org-drill-failed-entries*)))
'face `(:foreground ,org-drill-failed-count-color)
'help-echo (concat "The number of items that you failed, "
"and need to review again."))
(propertize
(number-to-string (length *org-drill-mature-entries*))
'face `(:foreground ,org-drill-mature-count-color)
'help-echo "The number of old items due for review.")
(propertize
(number-to-string (length *org-drill-new-entries*))
'face `(:foreground ,org-drill-new-count-color)
'help-echo (concat "The number of new items that you "
"have never reviewed."))
prompt))
(if (and (eql 'warn org-drill-leech-method)
(org-drill-entry-leech-p))
(setq prompt (concat "!!! LEECH ITEM !!!
(setq prompt (concat
(propertize "!!! LEECH ITEM !!!
You seem to be having a lot of trouble memorising this item.
Consider reformulating the item to make it easier to remember.\n" prompt)))
(setq ch (read-char prompt))
Consider reformulating the item to make it easier to remember.\n"
'face '(:foreground "red"))
prompt)))
(while (memq ch '(nil ?t))
(while (not (input-pending-p))
(message (concat (format-time-string
"%M:%S " (time-subtract
(current-time) item-start-time))
prompt))
(sit-for 1))
(setq ch (read-char-exclusive))
(if (eql ch ?t)
(org-set-tags-command)))
(case ch
(?q nil)
(?e 'edit)
(?s 'skip)
(otherwise t))))
(defun org-pos-in-regexp (pos regexp &optional nlines)
(save-excursion
(goto-char pos)
(org-in-regexp regexp nlines)))
(defun org-drill-hide-clozed-text ()
(let ((ovl nil))
(save-excursion
(while (re-search-forward org-drill-cloze-regexp nil t)
(setf ovl (make-overlay (match-beginning 0) (match-end 0)))
(overlay-put ovl 'category
'org-drill-cloze-overlay-defaults)
(when (find ?| (match-string 0))
(overlay-put ovl
'display
(format "[...%s]"
(substring-no-properties
(match-string 0)
(1+ (position ?| (match-string 0)))
(1- (length (match-string 0)))))))))))
(save-excursion
(while (re-search-forward org-drill-cloze-regexp nil t)
;; Don't hide org links, partly because they might contain inline
;; images which we want to keep visible
(unless (org-pos-in-regexp (match-beginning 0)
org-bracket-link-regexp 1)
(org-drill-hide-matched-cloze-text)))))
(defun org-drill-hide-matched-cloze-text ()
"Hide the current match with a 'cloze' visual overlay."
(let ((ovl (make-overlay (match-beginning 0) (match-end 0))))
(overlay-put ovl 'category
'org-drill-cloze-overlay-defaults)
(when (find ?| (match-string 0))
(overlay-put ovl
'display
(format "[...%s]"
(substring-no-properties
(match-string 0)
(1+ (position ?| (match-string 0)))
(1- (length (match-string 0)))))))))
(defun org-drill-unhide-clozed-text ()
@ -472,80 +673,110 @@ Consider reformulating the item to make it easier to remember.\n" prompt)))
;; recall, nil if they chose to quit.
(defun org-drill-present-simple-card ()
(org-drill-hide-all-subheadings-except nil)
(prog1 (org-drill-presentation-prompt)
(org-show-subtree)))
(with-hidden-cloze-text
(org-drill-hide-all-subheadings-except nil)
(org-display-inline-images t)
(org-cycle-hide-drawers 'all)
(prog1 (org-drill-presentation-prompt)
(org-show-subtree))))
(defun org-drill-present-two-sided-card ()
(let ((drill-sections (org-drill-hide-all-subheadings-except nil)))
(when drill-sections
(save-excursion
(goto-char (nth (random (min 2 (length drill-sections))) drill-sections))
(org-show-subtree)))
(prog1
(org-drill-presentation-prompt)
(org-show-subtree))))
(with-hidden-cloze-text
(let ((drill-sections (org-drill-hide-all-subheadings-except nil)))
(when drill-sections
(save-excursion
(goto-char (nth (random (min 2 (length drill-sections)))
drill-sections))
(org-show-subtree)))
(org-display-inline-images t)
(org-cycle-hide-drawers 'all)
(prog1
(org-drill-presentation-prompt)
(org-show-subtree)))))
(defun org-drill-present-multi-sided-card ()
(let ((drill-sections (org-drill-hide-all-subheadings-except nil)))
(when drill-sections
(with-hidden-cloze-text
(let ((drill-sections (org-drill-hide-all-subheadings-except nil)))
(when drill-sections
(save-excursion
(goto-char (nth (random (length drill-sections)) drill-sections))
(org-show-subtree)))
(org-display-inline-images t)
(org-cycle-hide-drawers 'all)
(prog1
(org-drill-presentation-prompt)
(org-show-subtree)))))
(defun org-drill-present-multicloze ()
(let ((item-end nil)
(match-count 0)
(body-start (or (cdr (org-get-property-block))
(point))))
(org-drill-hide-all-subheadings-except nil)
(save-excursion
(outline-next-heading)
(setq item-end (point)))
(save-excursion
(goto-char body-start)
(while (re-search-forward org-drill-cloze-regexp item-end t)
(incf match-count)))
(when (plusp match-count)
(save-excursion
(goto-char (nth (random (length drill-sections)) drill-sections))
(org-show-subtree)))
(prog1
(org-drill-presentation-prompt)
(org-show-subtree))))
(goto-char body-start)
(re-search-forward org-drill-cloze-regexp
item-end t (1+ (random match-count)))
(org-drill-hide-matched-cloze-text)))
(org-display-inline-images t)
(org-cycle-hide-drawers 'all)
(prog1 (org-drill-presentation-prompt)
(org-show-subtree)
(org-drill-unhide-clozed-text))))
(defun org-drill-present-spanish-verb ()
(case (random 6)
(0
(org-drill-hide-all-subheadings-except '("Infinitive"))
(let ((prompt nil)
(reveal-headings nil))
(with-hidden-cloze-text
(case (random 6)
(0
(org-drill-hide-all-subheadings-except '("Infinitive"))
(setq prompt
(concat "Translate this Spanish verb, and conjugate it "
"for the *present* tense.")
reveal-headings '("English" "Present Tense" "Notes")))
(1
(org-drill-hide-all-subheadings-except '("English"))
(setq prompt (concat "For the *present* tense, conjugate the "
"Spanish translation of this English verb.")
reveal-headings '("Infinitive" "Present Tense" "Notes")))
(2
(org-drill-hide-all-subheadings-except '("Infinitive"))
(setq prompt (concat "Translate this Spanish verb, and "
"conjugate it for the *past* tense.")
reveal-headings '("English" "Past Tense" "Notes")))
(3
(org-drill-hide-all-subheadings-except '("English"))
(setq prompt (concat "For the *past* tense, conjugate the "
"Spanish translation of this English verb.")
reveal-headings '("Infinitive" "Past Tense" "Notes")))
(4
(org-drill-hide-all-subheadings-except '("Infinitive"))
(setq prompt (concat "Translate this Spanish verb, and "
"conjugate it for the *future perfect* tense.")
reveal-headings '("English" "Future Perfect Tense" "Notes")))
(5
(org-drill-hide-all-subheadings-except '("English"))
(setq prompt (concat "For the *future perfect* tense, conjugate the "
"Spanish translation of this English verb.")
reveal-headings '("Infinitive" "Future Perfect Tense" "Notes"))))
(org-cycle-hide-drawers 'all)
(prog1
(org-drill-presentation-prompt
"Translate this Spanish verb, and conjugate it for the *present* tense.")
(org-drill-hide-all-subheadings-except '("English" "Present Tense"
"Notes"))))
(1
(org-drill-hide-all-subheadings-except '("English"))
(prog1
(org-drill-presentation-prompt
"For the *present* tense, conjugate the Spanish translation of this English verb.")
(org-drill-hide-all-subheadings-except '("Infinitive" "Present Tense"
"Notes"))))
(2
(org-drill-hide-all-subheadings-except '("Infinitive"))
(prog1
(org-drill-presentation-prompt
"Translate this Spanish verb, and conjugate it for the *past* tense.")
(org-drill-hide-all-subheadings-except '("English" "Past Tense"
"Notes"))))
(3
(org-drill-hide-all-subheadings-except '("English"))
(prog1
(org-drill-presentation-prompt
"For the *past* tense, conjugate the Spanish translation of this English verb.")
(org-drill-hide-all-subheadings-except '("Infinitive" "Past Tense"
"Notes"))))
(4
(org-drill-hide-all-subheadings-except '("Infinitive"))
(prog1
(org-drill-presentation-prompt
"Translate this Spanish verb, and conjugate it for the *future perfect* tense.")
(org-drill-hide-all-subheadings-except '("English" "Future Perfect Tense"
"Notes"))))
(5
(org-drill-hide-all-subheadings-except '("English"))
(prog1
(org-drill-presentation-prompt
"For the *future perfect* tense, conjugate the Spanish translation of this English verb.")
(org-drill-hide-all-subheadings-except '("Infinitive" "Future Perfect Tense"
"Notes"))))))
(org-drill-presentation-prompt prompt)
(org-drill-hide-all-subheadings-except reveal-headings)))))
@ -559,9 +790,12 @@ EDIT if the user chose to exit the drill and edit the current item.
See `org-drill' for more details."
(interactive)
(unless (org-at-heading-p)
(org-back-to-heading))
(let ((card-type (cdr (assoc "DRILL_CARD_TYPE" (org-entry-properties nil))))
(org-drill-goto-drill-entry-heading)
;;(unless (org-part-of-drill-entry-p)
;; (error "Point is not inside a drill entry"))
;;(unless (org-at-heading-p)
;; (org-back-to-heading))
(let ((card-type (org-entry-get (point) "DRILL_CARD_TYPE"))
(cont nil))
(save-restriction
(org-narrow-to-subtree)
@ -571,15 +805,7 @@ See `org-drill' for more details."
(let ((presentation-fn (cdr (assoc card-type org-drill-card-type-alist))))
(cond
(presentation-fn
(org-drill-hide-clozed-text)
;;(highlight-regexp org-drill-cloze-regexp
;; 'org-drill-hidden-cloze-face)
(unwind-protect
(progn
(setq cont (funcall presentation-fn)))
(org-drill-unhide-clozed-text))
;;(unhighlight-regexp org-drill-cloze-regexp)
)
(setq cont (funcall presentation-fn)))
(t
(error "Unknown card type: '%s'" card-type))))
@ -589,83 +815,188 @@ See `org-drill' for more details."
nil)
((eql cont 'edit)
'edit)
((eql cont 'skip)
'skip)
(t
(save-excursion
(org-drill-reschedule)))))))
(defun org-drill-entries (entries)
;; (defun org-drill-entries (entries)
;; "Returns nil, t, or a list of markers representing entries that were
;; 'failed' and need to be presented again before the session ends."
;; (let ((again-entries nil))
;; (setq *org-drill-done-entry-count* 0
;; *org-drill-pending-entry-count* (length entries))
;; (if (and org-drill-maximum-items-per-session
;; (> (length entries)
;; org-drill-maximum-items-per-session))
;; (setq entries (subseq entries 0
;; org-drill-maximum-items-per-session)))
;; (block org-drill-entries
;; (dolist (m entries)
;; (save-restriction
;; (switch-to-buffer (marker-buffer m))
;; (goto-char (marker-position m))
;; (setq result (org-drill-entry))
;; (cond
;; ((null result)
;; (message "Quit")
;; (return-from org-drill-entries nil))
;; ((eql result 'edit)
;; (setq end-pos (point-marker))
;; (return-from org-drill-entries nil))
;; (t
;; (cond
;; ((< result 3)
;; (push m again-entries))
;; (t
;; (decf *org-drill-pending-entry-count*)
;; (incf *org-drill-done-entry-count*)))
;; (when (and org-drill-maximum-duration
;; (> (- (float-time (current-time)) *org-drill-start-time*)
;; (* org-drill-maximum-duration 60)))
;; (message "This drill session has reached its maximum duration.")
;; (return-from org-drill-entries nil))))))
;; (or again-entries
;; t))))
(defun org-drill-entries-pending-p ()
(or *org-drill-again-entries*
(and (not (org-drill-maximum-item-count-reached-p))
(not (org-drill-maximum-duration-reached-p))
(or *org-drill-new-entries*
*org-drill-failed-entries*
*org-drill-mature-entries*
*org-drill-again-entries*))))
(defun org-drill-pending-entry-count ()
(+ (length *org-drill-new-entries*)
(length *org-drill-failed-entries*)
(length *org-drill-mature-entries*)
(length *org-drill-again-entries*)))
(defun org-drill-maximum-duration-reached-p ()
"Returns true if the current drill session has continued past its
maximum duration."
(and org-drill-maximum-duration
*org-drill-start-time*
(> (- (float-time (current-time)) *org-drill-start-time*)
(* org-drill-maximum-duration 60))))
(defun org-drill-maximum-item-count-reached-p ()
"Returns true if the current drill session has reached the
maximum number of items."
(and org-drill-maximum-items-per-session
(>= (length *org-drill-done-entries*)
org-drill-maximum-items-per-session)))
(defun org-drill-pop-next-pending-entry ()
(cond
;; First priority is items we failed in a prior session.
((and *org-drill-failed-entries*
(not (org-drill-maximum-item-count-reached-p))
(not (org-drill-maximum-duration-reached-p)))
(pop-random *org-drill-failed-entries*))
;; Next priority is newly added items, and items which
;; are not new and were not failed when they were last
;; reviewed.
((and (or *org-drill-new-entries*
*org-drill-mature-entries*)
(not (org-drill-maximum-item-count-reached-p))
(not (org-drill-maximum-duration-reached-p)))
(if (< (random (+ (length *org-drill-new-entries*)
(length *org-drill-mature-entries*)))
(length *org-drill-new-entries*))
(pop-random *org-drill-new-entries*)
;; else
(pop-random *org-drill-mature-entries*)))
;; After all the above are done, last priority is items
;; that were failed earlier THIS SESSION.
(*org-drill-again-entries*
(pop-random *org-drill-again-entries*))
(t
nil)))
(defun org-drill-entries ()
"Returns nil, t, or a list of markers representing entries that were
'failed' and need to be presented again before the session ends."
(let ((again-entries nil)
(*org-drill-done-entry-count* 0)
(*org-drill-pending-entry-count* (length entries)))
(if (and org-drill-maximum-items-per-session
(> (length entries)
org-drill-maximum-items-per-session))
(setq entries (subseq entries 0
org-drill-maximum-items-per-session)))
(block org-drill-entries
(dolist (m entries)
(save-restriction
(switch-to-buffer (marker-buffer m))
(goto-char (marker-position m))
(setq result (org-drill-entry))
(block org-drill-entries
(while (org-drill-entries-pending-p)
(setq m (org-drill-pop-next-pending-entry))
(unless m
(error "Unexpectedly ran out of pending drill items"))
(save-excursion
(set-buffer (marker-buffer m))
(goto-char m)
(setq result (org-drill-entry))
(cond
((null result)
(message "Quit")
(return-from org-drill-entries nil))
((eql result 'edit)
(setq end-pos (point-marker))
(return-from org-drill-entries nil))
((eql result 'skip)
nil) ; skip this item
(t
(cond
((null result)
(message "Quit")
(return-from org-drill-entries nil))
((eql result 'edit)
(setq end-pos (point-marker))
(return-from org-drill-entries nil))
((<= result org-drill-failure-quality)
(push m *org-drill-again-entries*))
(t
(cond
((< result 3)
(push m again-entries))
(t
(decf *org-drill-pending-entry-count*)
(incf *org-drill-done-entry-count*)))
(when (and org-drill-maximum-duration
(> (- (float-time (current-time)) *org-drill-start-time*)
(* org-drill-maximum-duration 60)))
(message "This drill session has reached its maximum duration.")
(return-from org-drill-entries nil))))))
(or again-entries
t))))
(push m *org-drill-done-entries*)))))))))
(defun org-drill-final-report ()
(read-char
(format
"%d items reviewed, %d items awaiting review
(read-char-exclusive
(format
"%d items reviewed
%d items awaiting review (%s, %s, %s)
Session duration %s
Recall of reviewed items:
Excellent (5): %3d%%
Good (4): %3d%%
Hard (3): %3d%%
Near miss (2): %3d%%
Failure (1): %3d%%
Total failure (0): %3d%%
Excellent (5): %3d%% | Near miss (2): %3d%%
Good (4): %3d%% | Failure (1): %3d%%
Hard (3): %3d%% | Total failure (0): %3d%%
Session finished. Press a key to continue..."
*org-drill-done-entry-count*
*org-drill-pending-entry-count*
(format-seconds "%h:%.2m:%.2s"
(- (float-time (current-time)) *org-drill-start-time*))
(round (* 100 (count 5 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
(round (* 100 (count 4 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
(round (* 100 (count 3 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
(round (* 100 (count 2 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
(round (* 100 (count 1 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
(round (* 100 (count 0 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
)))
(length *org-drill-done-entries*)
(org-drill-pending-entry-count)
(propertize
(format "%d failed"
(+ (length *org-drill-failed-entries*)
(length *org-drill-again-entries*)))
'face `(:foreground ,org-drill-failed-count-color))
(propertize
(format "%d old"
(length *org-drill-mature-entries*))
'face `(:foreground ,org-drill-mature-count-color))
(propertize
(format "%d new"
(length *org-drill-new-entries*))
'face `(:foreground ,org-drill-new-count-color))
(format-seconds "%h:%.2m:%.2s"
(- (float-time (current-time)) *org-drill-start-time*))
(round (* 100 (count 5 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
(round (* 100 (count 2 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
(round (* 100 (count 4 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
(round (* 100 (count 1 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
(round (* 100 (count 3 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
(round (* 100 (count 0 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
)))
@ -712,46 +1043,74 @@ agenda-with-archives
(interactive)
(let ((entries nil)
(failed-entries nil)
(new-entries nil)
(old-entries nil)
(result nil)
(results nil)
(end-pos nil))
(end-pos nil)
(cnt 0))
(block org-drill
(setq *org-drill-done-entries* nil
*org-drill-new-entries* nil
*org-drill-mature-entries* nil
*org-drill-failed-entries* nil
*org-drill-again-entries* nil)
(setq *org-drill-session-qualities* nil)
(setq *org-drill-start-time* (float-time (current-time)))
(save-excursion
(org-map-entries
(lambda () (when (org-drill-entry-due-p)
(cond
((org-drill-entry-new-p)
(push (point-marker) new-entries))
((<= (org-drill-entry-last-quality)
org-drill-failure-quality)
(push (point-marker) failed-entries))
(t
(push (point-marker) old-entries)))))
"" scope)
;; Failed first, then random mix of old + new
(setq entries (append (shuffle-list failed-entries)
(shuffle-list (append old-entries
new-entries))))
(cond
((null entries)
(message "I did not find any pending drill items."))
(t
(let ((again t))
(while again
(when (listp again)
(setq entries (shuffle-list again)))
(setq again (org-drill-entries entries))
(cond
((null again)
(return-from org-drill nil))
((eql t again)
(setq again nil))))
(message "Drill session finished!")
)))))
(unwind-protect
(save-excursion
(let ((org-trust-scanner-tags t))
(org-map-entries
(lambda ()
(when (zerop (% (incf cnt) 50))
(message "Processing drill items: %4d%s"
(+ (length *org-drill-new-entries*)
(length *org-drill-mature-entries*)
(length *org-drill-failed-entries*))
(make-string (ceiling cnt 50) ?.)))
(when (org-drill-entry-due-p)
(cond
((org-drill-entry-new-p)
(push (point-marker) *org-drill-new-entries*))
((and (org-drill-entry-last-quality)
(<= (org-drill-entry-last-quality)
org-drill-failure-quality))
(push (point-marker) *org-drill-failed-entries*))
(t
(push (point-marker) *org-drill-mature-entries*)))))
(concat "+" org-drill-question-tag) scope))
;; Failed first, then random mix of old + new
(setq entries (append (shuffle-list *org-drill-failed-entries*)
(shuffle-list (append *org-drill-mature-entries*
*org-drill-new-entries*))))
(cond
((and (null *org-drill-new-entries*)
(null *org-drill-failed-entries*)
(null *org-drill-mature-entries*))
(message "I did not find any pending drill items."))
(t
(org-drill-entries)
(message "Drill session finished!"))))
;; (cond
;; ((null entries)
;; (message "I did not find any pending drill items."))
;; (t
;; (let ((again t))
;; (while again
;; (when (listp again)
;; (setq entries (shuffle-list again)))
;; (setq again (org-drill-entries entries))
;; (cond
;; ((null again)
;; (return-from org-drill nil))
;; ((eql t again)
;; (setq again nil))))
;; (message "Drill session finished!")
;; ))))
(progn
(dolist (m (append *org-drill-new-entries*
*org-drill-failed-entries*
*org-drill-again-entries*
*org-drill-mature-entries*))
(free-marker m)))))
(cond
(end-pos
(switch-to-buffer (marker-buffer end-pos))
@ -761,15 +1120,25 @@ agenda-with-archives
(org-drill-final-report)))))
(defun org-drill-cram (&optional scope)
"Run an interactive drill session in 'cram mode'. In cram mode,
all drill items are considered to be due for review, unless they
have been reviewed within the last `org-drill-cram-hours'
hours."
(interactive)
(let ((*org-drill-cram-mode* t))
(org-drill scope)))
(add-hook 'org-mode-hook
(lambda ()
(if org-drill-use-visible-cloze-face-p
(font-lock-add-keywords
'org-mode
`((,org-drill-cloze-regexp
(0 'org-drill-visible-cloze-face nil)))
t))))
org-drill-cloze-keywords
t))))
(provide 'org-drill)

1167
doc/org.texi
View File

File diff suppressed because it is too large Load Diff

3
doc/orgcard.tex
View File

@ -480,8 +480,11 @@ formula, \kbd{:=} a field formula.
\key{view expanded body of code block at point}{C-c C-v v}
\key{go to named code block}{C-c C-v g}
\key{go to named result}{C-c C-v r}
\key{go to the head of the current code block}{C-c C-v u}
\key{go to the next code block}{C-c C-v n}
\key{go to the previous code block}{C-c C-v p}
\key{demarcate a code block}{C-c C-v d}
\key{execute the next key sequence in the code edit buffer}{C-c C-v x}
\key{execute all code blocks in current buffer}{C-c C-v b}
\key{execute all code blocks in current subtree}{C-c C-v s}
\key{tangle code blocks in current file}{C-c C-v t}

6
lisp/ob-C.el
View File

@ -33,7 +33,6 @@
;;; Code:
(require 'ob)
(require 'ob-eval)
(require 'org)
(require 'cc-mode)
(declare-function org-entry-get "org"
@ -90,7 +89,6 @@ or `org-babel-execute:c++'."
((equal org-babel-c-variant 'c) ".c")
((equal org-babel-c-variant 'cpp) ".cpp"))))
(tmp-bin-file (org-babel-temp-file "C-bin-"))
(tmp-out-file (org-babel-temp-file "C-out-"))
(cmdline (cdr (assoc :cmdline params)))
(flags (cdr (assoc :flags params)))
(full-body (org-babel-C-expand body params))
@ -102,10 +100,10 @@ or `org-babel-execute:c++'."
(cond
((equal org-babel-c-variant 'c) org-babel-C-compiler)
((equal org-babel-c-variant 'cpp) org-babel-c++-compiler))
tmp-bin-file
(org-babel-process-file-name tmp-bin-file)
(mapconcat 'identity
(if (listp flags) flags (list flags)) " ")
tmp-src-file) ""))))
(org-babel-process-file-name tmp-src-file)) ""))))
((lambda (results)
(org-babel-reassemble-table
(if (member "vector" (nth 2 processed-params))

12
lisp/ob-R.el
View File

@ -144,16 +144,16 @@ This function is called by `org-babel-execute-src-block'."
(let ((transition-file (org-babel-temp-file "R-import-")))
;; ensure VALUE has an orgtbl structure (depth of at least 2)
(unless (listp (car value)) (setq value (list value)))
(with-temp-file (org-babel-maybe-remote-file transition-file)
(with-temp-file transition-file
(insert (orgtbl-to-tsv value '(:fmt org-babel-R-quote-tsv-field)))
(insert "\n"))
(format "%s <- read.table(\"%s\", header=%s, row.names=%s, sep=\"\\t\", as.is=TRUE)"
name transition-file
name (org-babel-process-file-name transition-file 'noquote)
(if (or (eq (nth 1 value) 'hline) colnames-p) "TRUE" "FALSE")
(if rownames-p "1" "NULL")))
(format "%s <- %s" name (org-babel-R-quote-tsv-field value))))
(defvar ess-ask-for-ess-directory)
(defvar ess-ask-for-ess-directory nil)
(defun org-babel-R-initiate-session (session params)
"If there is not a current R process then create one."
(unless (string= session "none")
@ -172,7 +172,7 @@ This function is called by `org-babel-execute-src-block'."
(buffer-name))))
(current-buffer))))))
(defvar ess-local-process-name)
(defvar ess-local-process-name nil)
(defun org-babel-R-associate-session (session)
"Associate R code buffer with an R session.
Make SESSION be the inferior ESS process associated with the
@ -245,7 +245,7 @@ last statement in BODY, as elisp."
(if row-names-p "NA" "TRUE")
"FALSE")
(format "{function ()\n{\n%s\n}}()" body)
(org-babel-tramp-localname tmp-file)))
(org-babel-process-file-name tmp-file 'noquote)))
(org-babel-R-process-value-result
(org-babel-import-elisp-from-file tmp-file '(16)) column-names-p)))
(output (org-babel-eval org-babel-R-command body))))
@ -271,7 +271,7 @@ last statement in BODY, as elisp."
(if column-names-p
(if row-names-p "NA" "TRUE")
"FALSE")
".Last.value" (org-babel-tramp-localname tmp-file)))
".Last.value" (org-babel-process-file-name tmp-file 'noquote)))
(org-babel-R-process-value-result
(org-babel-import-elisp-from-file tmp-file '(16)) column-names-p)))
(output

14
lisp/ob-asymptote.el
View File

@ -74,11 +74,15 @@ This function is called by `org-babel-execute-src-block'."
"pdf"))
(cmdline (cdr (assoc :cmdline params)))
(in-file (org-babel-temp-file "asymptote-"))
(cmd (concat "asy "
(if out-file
(concat "-globalwrite -f " format " -o " out-file)
"-V")
" " cmdline " " in-file)))
(cmd
(concat "asy "
(if out-file
(concat
"-globalwrite -f " format
" -o " (org-babel-process-file-name out-file))
"-V")
" " cmdline
" " (org-babel-process-file-name in-file))))
(with-temp-file in-file
(insert (org-babel-expand-body:asymptote body params processed-params)))
(message cmd) (shell-command cmd)

10
lisp/ob-clojure.el
View File

@ -261,9 +261,13 @@ repl buffer."
" "))))
(case result-type
(output (org-babel-eval cmd body))
(value (let* ((tmp-file (org-babel-temp-file "clojure-results-")))
(org-babel-eval cmd (format org-babel-clojure-wrapper-method
body tmp-file tmp-file))
(value (let* ((tmp-file (org-babel-temp-file "clojure-")))
(org-babel-eval
cmd
(format
org-babel-clojure-wrapper-method
body
(org-babel-process-file-name tmp-file 'noquote)))
(org-babel-clojure-table-or-string
(org-babel-eval-read-file tmp-file)))))))

2
lisp/ob-comint.el
View File

@ -45,7 +45,7 @@
(defmacro org-babel-comint-in-buffer (buffer &rest body)
"Check BUFFER and execute BODY.
BUFFER is checked with `org-babel-comint-buffer-livep'. BODY is
executed inside the protection of `save-window-excursion' and
executed inside the protection of `save-excursion' and
`save-match-data'."
(declare (indent 1))
`(save-excursion

4
lisp/ob-ditaa.el
View File

@ -57,7 +57,9 @@ This function is called by `org-babel-execute-src-block'."
(cmd (concat "java -jar "
(shell-quote-argument
(expand-file-name org-ditaa-jar-path))
" " cmdline " " in-file " " out-file)))
" " cmdline
" " (org-babel-process-file-name in-file)
" " (org-babel-process-file-name out-file))))
(unless (file-exists-p org-ditaa-jar-path)
(error "Could not find ditaa.jar at %s" org-ditaa-jar-path))
(with-temp-file in-file (insert body))

19
lisp/ob-dot.el
View File

@ -65,15 +65,20 @@
(defun org-babel-execute:dot (body params)
"Execute a block of Dot code with org-babel.
This function is called by `org-babel-execute-src-block'."
(let ((processed-params (org-babel-process-params params))
(result-params (split-string (or (cdr (assoc :results params)) "")))
(out-file (cdr (assoc :file params)))
(cmdline (cdr (assoc :cmdline params)))
(cmd (or (cdr (assoc :cmd params)) "dot"))
(in-file (org-babel-temp-file "dot-")))
(let* ((processed-params (org-babel-process-params params))
(result-params (split-string (or (cdr (assoc :results params)) "")))
(out-file (cdr (assoc :file params)))
(cmdline (or (cdr (assoc :cmdline params))
(format "-T%s" (file-name-extension out-file))))
(cmd (or (cdr (assoc :cmd params)) "dot"))
(in-file (org-babel-temp-file "dot-")))
(with-temp-file in-file
(insert (org-babel-expand-body:dot body params processed-params)))
(org-babel-eval (concat cmd " " in-file " " cmdline " -o " out-file) "")
(org-babel-eval
(concat cmd
" " (org-babel-process-file-name in-file)
" " cmdline
" -o " (org-babel-process-file-name out-file)) "")
out-file))
(defun org-babel-prep-session:dot (session params)

9
lisp/ob-eval.el
View File

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

45
lisp/ob-exp.el
View File

@ -49,7 +49,7 @@
(defcustom org-export-babel-evaluate t
"Switch controlling code evaluation during export.
When set to nil no code will be exported as part of the export
When set to nil no code will be evaluated as part of the export
process."
:group 'org-babel
:type 'boolean)
@ -95,14 +95,47 @@ none ----- do not display either code or results upon export"
(message "org-babel-exp processing...")
(save-excursion
(goto-char (match-beginning 0))
(let* ((info (org-babel-get-src-block-info))
(params (nth 2 info)))
(let* ((raw-header (match-string 3))
(info (org-babel-get-src-block-info))
(lang (nth 0 info))
(lang-headers
(intern (concat "org-babel-default-header-args:" lang)))
(raw-params
(org-babel-parse-header-arguments
(org-babel-clean-text-properties
(mapconcat #'identity (cdr (split-string raw-header)) " "))))
(heading (nth 4 (ignore-errors (org-heading-components))))
(link (when org-current-export-file
(org-make-link-string
(if heading
(concat org-current-export-file "::" heading)
org-current-export-file))))
(export-buffer (current-buffer)))
;; bail if we couldn't get any info from the block
(when info
(when link
;; resolve parameters in the original file so that headline
;; and file-wide parameters are included
;; attempt to go to the same heading in the original file
(set-buffer (get-file-buffer org-current-export-file))
(save-restriction
(condition-case nil
(org-open-link-from-string link)
(error (when heading
(goto-char (point-min))
(re-search-forward (regexp-quote heading) nil t))))
(setf (nth 2 info)
(org-babel-merge-params
org-babel-default-header-args
(org-babel-params-from-buffer)
(org-babel-params-from-properties lang)
(if (boundp lang-headers) (eval lang-headers) nil)
raw-params)))
(set-buffer export-buffer))
;; expand noweb references in the original file
(setf (nth 1 info)
(if (and (cdr (assoc :noweb params))
(string= "yes" (cdr (assoc :noweb params))))
(if (and (cdr (assoc :noweb (nth 2 info)))
(string= "yes" (cdr (assoc :noweb (nth 2 info)))))
(org-babel-expand-noweb-references
info (get-file-buffer org-current-export-file))
(nth 1 info))))
@ -209,7 +242,7 @@ The function respects the value of the :exports header argument."
(defvar backend)
(defun org-babel-exp-code (info type)
"Prepare and return code in the current code block for export.
Code is prepared in a manner suitable for exportat by
Code is prepared in a manner suitable for export by
org-mode. This function is called by `org-babel-exp-do-export'.
The code block is not evaluated."
(let ((lang (nth 0 info))

9
lisp/ob-gnuplot.el
View File

@ -68,7 +68,7 @@ code."
(car pair) ;; variable name
(if (listp (cdr pair)) ;; variable value
(org-babel-gnuplot-table-to-data
(cdr pair) (org-babel-temp-file "gnuplot") params)
(cdr pair) (org-babel-temp-file "gnuplot-") params)
(cdr pair))))
(org-babel-ref-variables params)))
@ -141,12 +141,15 @@ This function is called by `org-babel-execute-src-block'."
(save-window-excursion
;; evaluate the code body with gnuplot
(if (string= session "none")
(let ((script-file (org-babel-temp-file "gnuplot-script")))
(let ((script-file (org-babel-temp-file "gnuplot-script-")))
(with-temp-file script-file
(insert (concat body "\n")))
(message "gnuplot \"%s\"" script-file)
(setq output
(shell-command-to-string (format "gnuplot \"%s\"" script-file)))
(shell-command-to-string
(format
"gnuplot \"%s\""
(org-babel-process-file-name script-file))))
(message output))
(with-temp-buffer
(insert (concat body "\n"))

4
lisp/ob-haskell.el
View File

@ -182,7 +182,9 @@ constructs (header arguments, no-web syntax etc...) are ignored."
(tmp-tex-file (concat tmp-file ".tex"))
(lhs-file (concat base-name ".lhs"))
(tex-file (concat base-name ".tex"))
(command (concat org-babel-haskell-lhs2tex-command " " lhs-file " > " tex-file))
(command (concat org-babel-haskell-lhs2tex-command
" " (org-babel-process-file-name lhs-file)
" > " (org-babel-process-file-name tex-file)))
(preserve-indentp org-src-preserve-indentation)
indentation)
;; escape haskell source-code blocks

4
lisp/ob-js.el
View File

@ -100,7 +100,9 @@ This function is called by `org-babel-execute-src-block'"
(if (string= result-type "value")
(format org-babel-js-function-wrapper full-body)
full-body)))
(org-babel-eval (format "%s %s" org-babel-js-cmd script-file) ""))))))
(org-babel-eval
(format "%s %s" org-babel-js-cmd
(org-babel-process-file-name script-file)) ""))))))
(defun org-babel-js-read (results)
"Convert RESULTS into an appropriate elisp value.

4
lisp/ob-keys.el
View File

@ -58,6 +58,8 @@ functions which are assigned key bindings, and see
("\C-o" . org-babel-open-src-block-result)
("\C-v" . org-babel-expand-src-block)
("v" . org-babel-expand-src-block)
("u" . org-babel-goto-src-block-head)
("\C-u" . org-babel-goto-src-block-head)
("g" . org-babel-goto-named-src-block)
("r" . org-babel-goto-named-result)
("\C-r" . org-babel-goto-named-result)
@ -65,6 +67,8 @@ functions which are assigned key bindings, and see
("b" . org-babel-execute-buffer)
("\C-s" . org-babel-execute-subtree)
("s" . org-babel-execute-subtree)
("\C-d" . org-babel-demarcate-block)
("d" . org-babel-demarcate-block)
("\C-t" . org-babel-tangle)
("t" . org-babel-tangle)
("\C-f" . org-babel-tangle-file)

13
lisp/ob-ledger.el
View File

@ -38,7 +38,6 @@
;;; Code:
(require 'ob)
(require 'org)
(defvar org-babel-default-header-args:ledger
'((:results . "output") (:cmdline . "bal"))
@ -51,12 +50,16 @@ called by `org-babel-execute-src-block'."
(let ((result-params (split-string (or (cdr (assoc :results params)) "")))
(cmdline (cdr (assoc :cmdline params)))
(in-file (org-babel-temp-file "ledger-"))
(out-file (org-babel-temp-file "ledger-output-"))
)
(out-file (org-babel-temp-file "ledger-output-")))
(with-temp-file in-file (insert body))
(message (concat "ledger -f " in-file " " cmdline))
(message (concat "ledger"
" -f " (org-babel-process-file-name in-file)
" " cmdline))
(with-output-to-string
(shell-command (concat "ledger -f " in-file " " cmdline " > " out-file)))
(shell-command (concat "ledger"
" -f " (org-babel-process-file-name in-file)
" " cmdline
" > " (org-babel-process-file-name out-file))))
(with-temp-buffer (insert-file-contents out-file) (buffer-string))))
(defun org-babel-prep-session:ledger (session params)

4
lisp/ob-lisp.el
View File

@ -81,7 +81,9 @@ This function is called by `org-babel-execute-src-block'"
(if (string= result-type "value")
(format "(print %s)" full-body)
full-body)))
(org-babel-eval (format "%s %s" org-babel-lisp-cmd script-file) ""))))))
(org-babel-eval
(format "%s %s" org-babel-lisp-cmd
(org-babel-process-file-name script-file)) ""))))))
;; This function should be used to assign any variables in params in
;; the context of the session environment.

24
lisp/ob-octave.el
View File

@ -178,17 +178,18 @@ value of the last statement in BODY, as elisp."
org-babel-octave-shell-command)))
(case result-type
(output (org-babel-eval cmd body))
(value (let ((tmp-file (org-babel-temp-file "results-")))
(value (let ((tmp-file (org-babel-temp-file "octave-")))
(org-babel-eval
cmd
(format org-babel-octave-wrapper-method body tmp-file tmp-file))
(org-babel-octave-import-elisp-from-file
(org-babel-maybe-remote-file tmp-file)))))))
(format org-babel-octave-wrapper-method body
(org-babel-process-file-name tmp-file 'noquote)
(org-babel-process-file-name tmp-file 'noquote)))
(org-babel-octave-import-elisp-from-file tmp-file))))))
(defun org-babel-octave-evaluate-session
(session body result-type &optional matlabp)
"Evaluate BODY in SESSION."
(let* ((tmp-file (org-babel-temp-file "results-"))
(let* ((tmp-file (org-babel-temp-file (if matlabp "matlab-" "octave-")))
(wait-file (org-babel-temp-file "matlab-emacs-link-wait-signal-"))
(full-body
(case result-type
@ -200,11 +201,15 @@ value of the last statement in BODY, as elisp."
(if (and matlabp org-babel-matlab-with-emacs-link)
(concat
(format org-babel-matlab-emacs-link-wrapper-method
body tmp-file tmp-file wait-file) "\n")
body
(org-babel-process-file-name tmp-file 'noquote)
(org-babel-process-file-name tmp-file 'noquote) wait-file) "\n")
(mapconcat
#'org-babel-chomp
(list (format org-babel-octave-wrapper-method
body tmp-file tmp-file)
body
(org-babel-process-file-name tmp-file 'noquote)
(org-babel-process-file-name tmp-file 'noquote))
org-babel-octave-eoe-indicator) "\n")))))
(raw (if (and matlabp org-babel-matlab-with-emacs-link)
(save-window-excursion
@ -227,8 +232,7 @@ value of the last statement in BODY, as elisp."
(insert full-body) (comint-send-input nil t)))) results)
(case result-type
(value
(org-babel-octave-import-elisp-from-file
(org-babel-maybe-remote-file tmp-file)))
(org-babel-octave-import-elisp-from-file tmp-file))
(output
(progn
(setq results
@ -246,7 +250,7 @@ value of the last statement in BODY, as elisp."
"Import data from FILE-NAME.
This removes initial blank and comment lines and then calls
`org-babel-import-elisp-from-file'."
(let ((temp-file (org-babel-temp-file "results-")) beg end)
(let ((temp-file (org-babel-temp-file "octave-matlab-")) beg end)
(with-temp-file temp-file
(insert-file-contents file-name)
(re-search-forward "^[ \t]*[^# \t]" nil t)

32
lisp/ob-org.el
View File

@ -30,17 +30,47 @@
;;; Code:
(require 'ob)
(declare-function org-load-modules-maybe "org" (&optional force))
(declare-function org-get-local-variables "org" ())
(defvar org-babel-default-header-args:org
'((:results . "raw silent") (:exports . "results"))
"Default arguments for evaluating a org source block.")
(defvar org-babel-org-default-header
"#+TITLE: default empty header\n"
"Default header inserted during export of org blocks.")
(defun org-babel-expand-body:org (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body." body)
(defun org-babel-execute:org (body params)
"Execute a block of Org code with.
This function is called by `org-babel-execute-src-block'."
body)
(let ((result-params (split-string (or (cdr (assoc :results params)) ""))))
(cond
((member "latex" result-params) (org-babel-org-export body "latex"))
((member "html" result-params) (org-babel-org-export body "html"))
((member "ascii" result-params) (org-babel-org-export body "ascii"))
(t body))))
(defvar org-local-vars)
(defun org-babel-org-export (body fmt)
"Export BODY to FMT using Org-mode's export facilities. "
(when (get-buffer " org-mode-tmp")
(error "Nested call to org-export: from org code block exporting results"))
(let ((tmp-file (org-babel-temp-file "org-")))
(with-temp-buffer
(insert org-babel-org-default-header)
(insert body)
(write-file tmp-file)
(org-load-modules-maybe)
(unless org-local-vars
(setq org-local-vars (org-get-local-variables)))
(eval ;; convert to fmt -- mimicking `org-run-like-in-org-mode'
(list 'let org-local-vars
(list (intern (concat "org-export-as-" fmt))
nil nil nil ''string t))))))
(defun org-babel-prep-session:org (session params)
"Return an error because org does not support sessions."

5
lisp/ob-perl.el
View File

@ -107,10 +107,11 @@ return the value of the last statement in BODY, as elisp."
(when session (error "Sessions are not supported for Perl."))
(case result-type
(output (org-babel-eval org-babel-perl-command body))
(value (let ((tmp-file (org-babel-temp-file "perl-results-")))
(value (let ((tmp-file (org-babel-temp-file "perl-")))
(org-babel-eval
org-babel-perl-command
(format org-babel-perl-wrapper-method body tmp-file))
(format org-babel-perl-wrapper-method body
(org-babel-process-file-name tmp-file 'noquote)))
(org-babel-eval-read-file tmp-file)))))
(provide 'ob-perl)

11
lisp/ob-plantuml.el
View File

@ -54,7 +54,8 @@
"Execute a block of plantuml code with org-babel.
This function is called by `org-babel-execute-src-block'."
(let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
(out-file (cdr (assoc :file params)))
(out-file (or (cdr (assoc :file params))
(error "plantuml requires a \":file\" header argument")))
(cmdline (cdr (assoc :cmdline params)))
(in-file (org-babel-temp-file "plantuml-"))
(cmd (if (not org-plantuml-jar-path)
@ -62,12 +63,12 @@ This function is called by `org-babel-execute-src-block'."
(concat "java -jar "
(shell-quote-argument
(expand-file-name org-plantuml-jar-path))
(if (string= (file-name-extension out-file) "svg")
" -tsvg" "")
" -p " cmdline " < "
(shell-quote-argument
(expand-file-name in-file))
(org-babel-process-file-name in-file)
" > "
(shell-quote-argument
(expand-file-name out-file))))))
(org-babel-process-file-name out-file)))))
(unless (file-exists-p org-plantuml-jar-path)
(error "Could not find plantuml.jar at %s" org-plantuml-jar-path))
(with-temp-file in-file (insert (concat "@startuml\n" body "\n@enduml")))

150
lisp/ob-python.el
View File

@ -194,73 +194,89 @@ def main():
open('%s', 'w').write( pprint.pformat(main()) )")
(defun org-babel-python-evaluate
(buffer body &optional result-type result-params)
"Pass BODY to the Python process in BUFFER.
If RESULT-TYPE equals 'output then return a list of the outputs
of the statements in BODY, if RESULT-TYPE equals 'value then
return the value of the last statement in BODY, as elisp."
(if (not buffer)
;; external process evaluation
(case result-type
(output (org-babel-eval org-babel-python-command body))
(value (let ((tmp-file (org-babel-temp-file "python-results-")))
(org-babel-eval org-babel-python-command
(format
(if (member "pp" result-params)
org-babel-python-pp-wrapper-method
org-babel-python-wrapper-method)
(mapconcat
(lambda (line) (format "\t%s" line))
(split-string
(org-remove-indentation
(org-babel-trim body))
"[\r\n]") "\n")
tmp-file))
((lambda (raw)
(if (or (member "code" result-params)
(member "pp" result-params))
raw
(org-babel-python-table-or-string raw)))
(org-babel-eval-read-file tmp-file)))))
;; comint session evaluation
(flet ((dump-last-value (tmp-file pp)
(mapc
(lambda (statement) (insert statement) (comint-send-input))
(if pp
(list
"import pp"
(format "open('%s', 'w').write(pprint.pformat(_))" tmp-file))
(list (format "open('%s', 'w').write(str(_))" tmp-file)))))
(input-body (body)
(mapc (lambda (statement) (insert statement) (comint-send-input))
(split-string (org-babel-trim body) "[\r\n]+"))
(comint-send-input) (comint-send-input)))
(case result-type
(output
(mapconcat
#'org-babel-trim
(butlast
(org-babel-comint-with-output
(buffer org-babel-python-eoe-indicator t body)
(let ((comint-process-echoes nil))
(input-body body)
(insert org-babel-python-eoe-indicator)
(comint-send-input))) 2) "\n"))
(value
((lambda (results)
(if (or (member "code" result-params) (member "pp" result-params))
results
(org-babel-python-table-or-string results)))
(let ((tmp-file (org-babel-temp-file "python-results-")))
(org-babel-comint-with-output
(buffer org-babel-python-eoe-indicator t body)
(let ((comint-process-echoes nil))
(input-body body)
(dump-last-value tmp-file (member "pp" result-params))
(comint-send-input) (comint-send-input)
(insert org-babel-python-eoe-indicator)
(comint-send-input)))
(org-babel-eval-read-file tmp-file))))))))
(session body &optional result-type result-params)
"Evaluate BODY as python code."
(if session
(org-babel-python-evaluate-session
session body result-type result-params)
(org-babel-python-evaluate-external-process
body result-type result-params)))
(defun org-babel-python-evaluate-external-process
(body &optional result-type result-params)
"Evaluate BODY in external python process.
If RESULT-TYPE equals 'output then return standard output as a
string. If RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp."
(case result-type
(output (org-babel-eval org-babel-python-command body))
(value (let ((tmp-file (org-babel-temp-file "python-")))
(org-babel-eval org-babel-python-command
(format
(if (member "pp" result-params)
org-babel-python-pp-wrapper-method
org-babel-python-wrapper-method)
(mapconcat
(lambda (line) (format "\t%s" line))
(split-string
(org-remove-indentation
(org-babel-trim body))
"[\r\n]") "\n")
(org-babel-process-file-name tmp-file 'noquote)))
((lambda (raw)
(if (or (member "code" result-params)
(member "pp" result-params))
raw
(org-babel-python-table-or-string raw)))
(org-babel-eval-read-file tmp-file))))))
(defun org-babel-python-evaluate-session
(session body &optional result-type result-params)
"Pass BODY to the Python process in SESSION.
If RESULT-TYPE equals 'output then return standard output as a
string. If RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp."
(flet ((dump-last-value
(tmp-file pp)
(mapc
(lambda (statement) (insert statement) (comint-send-input))
(if pp
(list
"import pp"
(format "open('%s', 'w').write(pprint.pformat(_))"
(org-babel-process-file-name tmp-file 'noquote)))
(list (format "open('%s', 'w').write(str(_))"
(org-babel-process-file-name tmp-file 'noquote))))))
(input-body (body)
(mapc (lambda (statement) (insert statement) (comint-send-input))
(split-string (org-babel-trim body) "[\r\n]+"))
(comint-send-input) (comint-send-input)))
(case result-type
(output
(mapconcat
#'org-babel-trim
(butlast
(org-babel-comint-with-output
(session org-babel-python-eoe-indicator t body)
(let ((comint-process-echoes nil))
(input-body body)
(insert org-babel-python-eoe-indicator)
(comint-send-input))) 2) "\n"))
(value
((lambda (results)
(if (or (member "code" result-params) (member "pp" result-params))
results
(org-babel-python-table-or-string results)))
(let ((tmp-file (org-babel-temp-file "python-")))
(org-babel-comint-with-output
(session org-babel-python-eoe-indicator t body)
(let ((comint-process-echoes nil))
(input-body body)
(dump-last-value tmp-file (member "pp" result-params))
(comint-send-input) (comint-send-input)
(insert org-babel-python-eoe-indicator)
(comint-send-input)))
(org-babel-eval-read-file tmp-file)))))))
(defun org-babel-python-read-string (string)
"Strip 's from around python string"

21
lisp/ob-ruby.el
View File

@ -185,12 +185,13 @@ return the value of the last statement in BODY, as elisp."
;; external process evaluation
(case result-type
(output (org-babel-eval org-babel-ruby-command body))
(value (let ((tmp-file (org-babel-temp-file "ruby-results-")))
(org-babel-eval org-babel-ruby-command
(format (if (member "pp" result-params)
org-babel-ruby-pp-wrapper-method
org-babel-ruby-wrapper-method)
body tmp-file))
(value (let ((tmp-file (org-babel-temp-file "ruby-")))
(org-babel-eval
org-babel-ruby-command
(format (if (member "pp" result-params)
org-babel-ruby-pp-wrapper-method
org-babel-ruby-wrapper-method)
body (org-babel-process-file-name tmp-file 'noquote)))
((lambda (raw)
(if (or (member "code" result-params)
(member "pp" result-params))
@ -220,7 +221,7 @@ return the value of the last statement in BODY, as elisp."
(if (or (member "code" result-params) (member "pp" result-params))
results
(org-babel-ruby-table-or-string results)))
(let* ((tmp-file (org-babel-temp-file "ruby-results-"))
(let* ((tmp-file (org-babel-temp-file "ruby-"))
(ppp (or (member "code" result-params)
(member "pp" result-params))))
(org-babel-comint-with-output
@ -232,10 +233,12 @@ return the value of the last statement in BODY, as elisp."
(append
(list body)
(if (not ppp)
(list (format org-babel-ruby-f-write tmp-file))
(list (format org-babel-ruby-f-write
(org-babel-process-file-name tmp-file 'noquote)))
(list
"results=_" "require 'pp'" "orig_out = $stdout"
(format org-babel-ruby-pp-f-write tmp-file)))
(format org-babel-ruby-pp-f-write
(org-babel-process-file-name tmp-file 'noquote))))
(list org-babel-ruby-eoe-indicator)))
(comint-send-input nil t))
(org-babel-eval-read-file tmp-file)))))))

4
lisp/ob-sass.el
View File

@ -54,7 +54,9 @@ This function is called by `org-babel-execute-src-block'."
(out-file (or file (org-babel-temp-file "sass-out-")))
(cmdline (cdr (assoc :cmdline params)))
(in-file (org-babel-temp-file "sass-in-"))
(cmd (concat "sass " (or cmdline "") in-file " " out-file)))
(cmd (concat "sass " (or cmdline "")
" " (org-babel-process-file-name in-file)
" " (org-babel-process-file-name out-file))))
(with-temp-file in-file
(insert (org-babel-expand-body:sass body params))) (shell-command cmd)
(or file (with-temp-buffer (insert-file-contents out-file) (buffer-string)))))

5
lisp/ob-scheme.el
View File

@ -90,7 +90,7 @@ This function is called by `org-babel-execute-src-block'"
(insert (org-babel-chomp line)) (comint-send-input nil t))
(list body (format "%S" org-babel-scheme-eoe)))))
;; external evaluation
(let ((script-file (org-babel-temp-file "lisp-script-")))
(let ((script-file (org-babel-temp-file "scheme-script-")))
(with-temp-file script-file
(insert
;; return the value or the output
@ -98,7 +98,8 @@ This function is called by `org-babel-execute-src-block'"
(format "(display %s)" full-body)
full-body)))
(org-babel-eval
(format "%s %s" org-babel-scheme-cmd script-file) ""))))))
(format "%s %s" org-babel-scheme-cmd
(org-babel-process-file-name script-file)) ""))))))
(defun org-babel-prep-session:scheme (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."

2
lisp/ob-screen.el
View File

@ -50,7 +50,7 @@ In case you want to use a different screen than one selected by your $PATH")
(defun org-babel-execute:screen (body params)
"Send a block of code via screen to a terminal using Babel.
\"default\" session is be used when none is specified."
\"default\" session is used when none is specified."
(message "Sending source code block to interactive terminal session...")
(save-window-excursion
(let* ((processed-params (org-babel-process-params params))

29
lisp/ob-sh.el
View File

@ -160,21 +160,20 @@ return the value of the last statement in BODY."
(org-babel-import-elisp-from-file tmp-file))))
(if (not session)
(org-babel-eval org-babel-sh-command (org-babel-trim body))
(let ((tmp-file (org-babel-temp-file "sh-")))
(mapconcat
#'org-babel-sh-strip-weird-long-prompt
(mapcar
#'org-babel-trim
(butlast
(org-babel-comint-with-output
(session org-babel-sh-eoe-output t body)
(mapc
(lambda (line)
(insert line) (comint-send-input nil t) (sleep-for 0.25))
(append
(split-string (org-babel-trim body) "\n")
(list org-babel-sh-eoe-indicator))))
2)) "\n")))))
(mapconcat
#'org-babel-sh-strip-weird-long-prompt
(mapcar
#'org-babel-trim
(butlast
(org-babel-comint-with-output
(session org-babel-sh-eoe-output t body)
(mapc
(lambda (line)
(insert line) (comint-send-input nil t) (sleep-for 0.25))
(append
(split-string (org-babel-trim body) "\n")
(list org-babel-sh-eoe-indicator))))
2)) "\n"))))
(defun org-babel-sh-strip-weird-long-prompt (string)
"Remove prompt cruft from a string of shell output."

8
lisp/ob-sql.el
View File

@ -65,7 +65,13 @@ This function is called by `org-babel-execute-src-block'."
(org-babel-temp-file "sql-out-")))
(command (case (intern engine)
('mysql (format "mysql %s -e \"source %s\" > %s"
(or cmdline "") in-file out-file))
(or cmdline "")
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)))
('postgresql (format "psql -A -P footer=off -F \"\t\" -f %s -o %s %s"
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)
(or cmdline "")))
(t (error "no support for the %s sql engine" engine)))))
(with-temp-file in-file
(insert (org-babel-expand-body:sql body params)))

158
lisp/ob-tangle.el
View File

@ -34,7 +34,10 @@
(declare-function org-link-escape "org" (text &optional table))
(declare-function org-heading-components "org" ())
(declare-function org-back-to-heading "org" (invisible-ok))
(declare-function org-fill-template "org" (template alist))
;;;###autoload
(defcustom org-babel-tangle-lang-exts
'(("emacs-lisp" . "el"))
"Alist mapping languages to their file extensions.
@ -53,6 +56,38 @@ then the name of the language is used."
:group 'org-babel
:type 'hook)
(defcustom org-babel-pre-tangle-hook '(save-buffer)
"Hook run at the beginning of `org-babel-tangle'."
:group 'org-babel
:type 'hook)
(defcustom org-babel-tangle-pad-newline t
"Switch indicating whether to pad tangled code with newlines."
:group 'org-babel
:type 'boolean)
(defcustom org-babel-tangle-comment-format-beg "[[%link][%sourcename]]"
"Format of inserted comments in tangled code files.
The following format strings can be used to insert special
information into the output using `org-fill-template'.
%start-line --- the line number at the start of the code block
%file --------- the file from which the code block was tangled
%link --------- Org-mode style link to the code block
%source-name -- name of the code block"
:group 'org-babel
:type 'string)
(defcustom org-babel-tangle-comment-format-end "%sourcename ends here"
"Format of inserted comments in tangled code files.
The following format strings can be used to insert special
information into the output using `org-fill-template'.
%start-line --- the line number at the start of the code block
%file --------- the file from which the code block was tangled
%link --------- Org-mode style link to the code block
%source-name -- name of the code block"
:group 'org-babel
:type 'string)
(defun org-babel-find-file-noselect-refresh (file)
"Find file ensuring that the latest changes on disk are
represented in the file."
@ -127,7 +162,7 @@ TARGET-FILE can be used to specify a default export file for all
source blocks. Optional argument LANG can be used to limit the
exported source code blocks by language."
(interactive)
(save-buffer)
(run-hooks 'org-babel-pre-tangle-hook)
(save-excursion
(let ((block-counter 0)
(org-babel-default-header-args
@ -152,7 +187,7 @@ exported source code blocks by language."
(mapc
(lambda (spec)
(flet ((get-spec (name)
(cdr (assoc name (nth 2 spec)))))
(cdr (assoc name (nth 4 spec)))))
(let* ((tangle (get-spec :tangle))
(she-bang ((lambda (sheb) (when (> (length sheb) 0) sheb))
(get-spec :shebang)))
@ -193,8 +228,9 @@ exported source code blocks by language."
(add-to-list 'path-collector file-name)))))
specs)))
(org-babel-tangle-collect-blocks lang))
(message "tangled %d code block%s" block-counter
(if (= block-counter 1) "" "s"))
(message "tangled %d code block%s from %s" block-counter
(if (= block-counter 1) "" "s")
(file-name-nondirectory (buffer-file-name (current-buffer))))
;; run `org-babel-post-tangle-hook' in all tangled files
(when org-babel-post-tangle-hook
(mapc
@ -219,7 +255,7 @@ references."
(save-excursion (end-of-line 1) (forward-char 1) (point)))))
(defvar org-stored-links)
(defun org-babel-tangle-collect-blocks (&optional lang)
(defun org-babel-tangle-collect-blocks (&optional language)
"Collect source blocks in the current Org-mode file.
Return an association list of source-code block specifications of
the form used by `org-babel-spec-to-string' grouped by language.
@ -237,43 +273,56 @@ code blocks by language."
(condition-case nil
(nth 4 (org-heading-components))
(error (buffer-file-name)))))
(let* ((link (progn (call-interactively 'org-store-link)
(let* ((start-line (save-restriction (widen)
(+ 1 (line-number-at-pos (point)))))
(file (buffer-file-name))
(link (progn (call-interactively 'org-store-link)
(org-babel-clean-text-properties
(car (pop org-stored-links)))))
(info (org-babel-get-src-block-info))
(params (nth 2 info))
(source-name (intern (or (nth 4 info)
(format "%s:%d"
current-heading block-counter))))
(src-lang (nth 0 info))
(src-lang (nth 0 info))
(expand-cmd (intern (concat "org-babel-expand-body:" src-lang)))
(params (nth 2 info))
(body ((lambda (body)
(if (assoc :no-expand params)
body
(funcall (if (fboundp expand-cmd)
expand-cmd
'org-babel-expand-body:generic)
body params)))
(if (and (cdr (assoc :noweb params))
(let ((nowebs (split-string
(cdr (assoc :noweb params)))))
(or (member "yes" nowebs)
(member "tangle" nowebs))))
(org-babel-expand-noweb-references info)
(nth 1 info))))
(comment (when (or (string= "both" (cdr (assoc :comments params)))
(string= "org" (cdr (assoc :comments params))))
;; from the previous heading or code-block end
(buffer-substring
(max (condition-case nil
(save-excursion
(org-back-to-heading t) (point))
(error 0))
(save-excursion (re-search-backward
org-babel-src-block-regexp nil t)
(match-end 0)))
(point))))
by-lang)
(unless (string= (cdr (assoc :tangle params)) "no") ;; skip
(unless (and lang (not (string= lang src-lang))) ;; limit by language
(unless (string= (cdr (assoc :tangle params)) "no")
(unless (and language (not (string= language src-lang)))
;; add the spec for this block to blocks under it's language
(setq by-lang (cdr (assoc src-lang blocks)))
(setq blocks (delq (assoc src-lang blocks) blocks))
(setq blocks
(cons
(cons src-lang
(cons (list link source-name params
((lambda (body)
(if (assoc :no-expand params)
body
(funcall
(if (fboundp expand-cmd)
expand-cmd
'org-babel-expand-body:generic)
body
params)))
(if (and (cdr (assoc :noweb params))
(string=
"yes"
(cdr (assoc :noweb params))))
(org-babel-expand-noweb-references
info)
(nth 1 info))))
by-lang)) blocks))))))
(setq blocks (cons
(cons src-lang
(cons (list start-line file link
source-name params body comment)
by-lang)) blocks))))))
;; ensure blocks in the correct order
(setq blocks
(mapcar
@ -288,22 +337,39 @@ source code file. This function uses `comment-region' which
assumes that the appropriate major-mode is set. SPEC has the
form
(link source-name params body)"
(let ((link (nth 0 spec))
(source-name (nth 1 spec))
(body (nth 3 spec))
(commentable (string= (cdr (assoc :comments (nth 2 spec))) "yes")))
(start-line file link source-name params body comment)"
(let* ((start-line (nth 0 spec))
(file (nth 1 spec))
(link (org-link-escape (nth 2 spec)))
(source-name (nth 3 spec))
(body (nth 5 spec))
(comment (nth 6 spec))
(comments (cdr (assoc :comments (nth 4 spec))))
(link-p (or (string= comments "both") (string= comments "link")
(string= comments "yes")))
(link-data (mapcar (lambda (el)
(cons (symbol-name el)
((lambda (le)
(if (stringp le) le (format "%S" le)))
(eval el))))
'(start-line file link source-name))))
(flet ((insert-comment (text)
(when commentable
(insert "\n")
(comment-region (point)
(progn (insert text) (point)))
(end-of-line nil)
(insert "\n"))))
(insert-comment (format "[[%s][%s]]" (org-link-escape link) source-name))
(insert (format "\n%s\n" (replace-regexp-in-string
"^," "" (org-babel-chomp body))))
(insert-comment (format "%s ends here" source-name)))))
(let ((text (org-babel-trim text)))
(when (and comments (not (string= comments "no"))
(> (length text) 0))
(when org-babel-tangle-pad-newline (insert "\n"))
(comment-region (point) (progn (insert text) (point)))
(end-of-line nil) (insert "\n")))))
(when comment (insert-comment comment))
(when link-p
(insert-comment
(org-fill-template org-babel-tangle-comment-format-beg link-data)))
(when org-babel-tangle-pad-newline (insert "\n"))
(insert (format "%s\n" (replace-regexp-in-string
"^," "" (org-babel-trim body))))
(when link-p
(insert-comment
(org-fill-template org-babel-tangle-comment-format-end link-data))))))
(provide 'ob-tangle)

379
lisp/ob.el
View File

@ -57,6 +57,7 @@
(declare-function org-at-table-p "org" (&optional table-type))
(declare-function org-cycle "org" (&optional arg))
(declare-function org-uniquify "org" (list))
(declare-function org-current-level "org" ())
(declare-function org-table-import "org-table" (file arg))
(declare-function org-add-hook "org-compat" (hook function &optional append local))
(declare-function org-table-align "org-table" ())
@ -133,16 +134,12 @@ remove code block execution from the C-c C-c keybinding."
"{\\([^\f\n\r\v]+?\\)}\\)")
"Regexp used to identify inline src-blocks.")
(defun org-babel-get-src-block-info (&optional header-vars-only)
(defun org-babel-get-src-block-info ()
"Get information on the current source block.
Returns a list
(language body header-arguments-alist switches name function-args indent).
Unless HEADER-VARS-ONLY is non-nil, any variable
references provided in 'function call style' (i.e. in a
parenthesised argument list following the src block name) are
added to the header-arguments-alist."
(let ((case-fold-search t) head info args indent)
(language body header-arguments-alist switches name function-args indent)."
(let ((case-fold-search t) head info name args indent)
(if (setq head (org-babel-where-is-src-block-head))
(save-excursion
(goto-char head)
@ -150,29 +147,16 @@ added to the header-arguments-alist."
(setq indent (car (last info)))
(setq info (butlast info))
(forward-line -1)
(if (and (looking-at org-babel-src-name-w-name-regexp)
(match-string 2))
(progn
(setq info (append info (list (org-babel-clean-text-properties
(match-string 2)))))
;; Note that e.g. "name()" and "name( )" result in
;; ((:var . "")). We maintain that behaviour, and the
;; resulting non-nil sixth element is relied upon in
;; org-babel-exp-code to detect a functional-style
;; block in those cases. However, "name" without any
;; parentheses would result in the same thing, so we
;; explicitly avoid that.
(if (setq args (match-string 4))
(setq info
(append info (list
(mapcar
(lambda (ref) (cons :var ref))
(org-babel-ref-split-args args))))))
(unless header-vars-only
(setf (nth 2 info)
(org-babel-merge-params (nth 5 info) (nth 2 info)))))
(setq info (append info (list nil nil))))
(append info (list indent)))
(when (and (looking-at org-babel-src-name-w-name-regexp)
(setq name (match-string 2)))
(setq name (org-babel-clean-text-properties name))
(when (setq args (match-string 4))
(setq args (mapcar
(lambda (ref) (cons :var ref))
(org-babel-ref-split-args args)))
(setf (nth 2 info)
(org-babel-merge-params args (nth 2 info)))))
(append info (list name args indent)))
(if (save-excursion ;; inline source block
(re-search-backward "[ \f\t\n\r\v]" nil t)
(looking-at org-babel-inline-src-block-regexp))
@ -191,10 +175,10 @@ of potentially harmful code."
(let* ((eval (or (cdr (assoc :eval (nth 2 info)))
(when (assoc :noeval (nth 2 info)) "no")))
(query (or (equal eval "query")
(and (functionp org-confirm-babel-evaluate)
(funcall org-confirm-babel-evaluate
(nth 0 info) (nth 1 info)))
org-confirm-babel-evaluate)))
(if (functionp org-confirm-babel-evaluate)
(funcall org-confirm-babel-evaluate
(nth 0 info) (nth 1 info))
org-confirm-babel-evaluate))))
(if (or (equal eval "never") (equal eval "no")
(and query
(not (yes-or-no-p
@ -510,10 +494,11 @@ with a prefix argument then this is passed on to
"Evaluate BODY in edit buffer if there is a code block at point.
Return t if a code block was found at point, nil otherwise."
`(let ((org-src-window-setup 'switch-invisibly))
(when (org-edit-src-code nil nil nil 'quietly)
,@body
(if (org-bound-and-true-p org-edit-src-from-org-mode)
(org-edit-src-exit))
(when (and (org-babel-where-is-src-block-head)
(org-edit-src-code nil nil nil 'quietly))
(unwind-protect (progn ,@body)
(if (org-bound-and-true-p org-edit-src-from-org-mode)
(org-edit-src-exit)))
t)))
(defun org-babel-do-key-sequence-in-edit-buffer (key)
@ -568,15 +553,9 @@ results already exist."
Call `org-babel-execute-src-block' on every source block in
the current buffer."
(interactive "P")
(save-excursion
(org-save-outline-visibility t
(goto-char (point-min))
(show-all)
(while (re-search-forward org-babel-src-block-regexp nil t)
(let ((pos-end (match-end 0)))
(goto-char (match-beginning 0))
(org-babel-execute-src-block arg)
(goto-char pos-end))))))
(org-save-outline-visibility t
(org-babel-map-src-blocks nil
(org-babel-execute-src-block arg))))
;;;###autoload
(defun org-babel-execute-subtree (&optional arg)
@ -595,9 +574,17 @@ the current subtree."
"Generate an sha1 hash based on the value of info."
(interactive)
(let* ((info (or info (org-babel-get-src-block-info)))
(hash (sha1 (format "%s-%s" (mapconcat (lambda (arg) (format "%S" arg))
(nth 2 info) ":")
(nth 1 info)))))
(hash (sha1
(format "%s-%s"
(mapconcat
(lambda (arg)
(if (stringp (cdr arg))
(mapconcat
#'identity
(sort (split-string (cdr arg)) #'string<) " ")
(cdr arg)))
(nth 2 info) ":")
(nth 1 info)))))
(when (interactive-p) (message hash))
hash))
@ -728,8 +715,26 @@ portions of results lines."
'org-babel-show-result-all 'append 'local)))
(defmacro org-babel-map-src-blocks (file &rest body)
"Evaluate BODY forms on each source-block in FILE. If FILE is
nil evaluate BODY forms on source blocks in current buffer."
"Evaluate BODY forms on each source-block in FILE.
If FILE is nil evaluate BODY forms on source blocks in current
buffer. During evaluation of BODY the following local variables
are set relative to the currently matched code block.
full-block ------- string holding the entirety of the code block
beg-block -------- point at the beginning of the code block
end-block -------- point at the end of the matched code block
lang ------------- string holding the language of the code block
beg-lang --------- point at the beginning of the lang
end-lang --------- point at the end of the lang
switches --------- string holding the switches
beg-switches ----- point at the beginning of the switches
end-switches ----- point at the end of the switches
header-args ------ string holding the header-args
beg-header-args -- point at the beginning of the header-args
end-header-args -- point at the end of the header-args
body ------------- string holding the body of the code block
beg-body --------- point at the beginning of the body
end-body --------- point at the end of the body"
(declare (indent 1))
`(let ((visited-p (or (null ,file)
(get-file-buffer (expand-file-name ,file))))
@ -740,7 +745,22 @@ nil evaluate BODY forms on source blocks in current buffer."
(goto-char (point-min))
(while (re-search-forward org-babel-src-block-regexp nil t)
(goto-char (match-beginning 0))
(save-match-data ,@body)
(let ((full-block (match-string 0))
(beg-block (match-beginning 0))
(end-block (match-beginning 0))
(lang (match-string 2))
(beg-lang (match-beginning 2))
(end-lang (match-end 2))
(switches (match-string 3))
(beg-switches (match-beginning 3))
(end-switches (match-end 3))
(header-args (match-string 4))
(beg-header-args (match-beginning 4))
(end-header-args (match-end 4))
(body (match-string 5))
(beg-body (match-beginning 5))
(end-body (match-end 5)))
(save-match-data ,@body))
(goto-char (match-end 0))))
(unless visited-p
(kill-buffer to-be-removed))
@ -988,6 +1008,14 @@ If the point is not on a source block then return nil."
(looking-at org-babel-src-block-regexp))
(point))))))
;;;###autoload
(defun org-babel-goto-src-block-head ()
"Go to the beginning of the current code block."
(interactive)
((lambda (head)
(if head (goto-char head) (error "not currently in a code block")))
(org-babel-where-is-src-block-head)))
;;;###autoload
(defun org-babel-goto-named-src-block (name)
"Go to a named source-code block."
@ -1064,7 +1092,9 @@ buffer or nil if no such result exists."
With optional prefix argument ARG, jump forward ARG many source blocks."
(interactive "P")
(when (looking-at org-babel-src-block-regexp) (forward-char 1))
(re-search-forward org-babel-src-block-regexp nil nil (or arg 1))
(condition-case nil
(re-search-forward org-babel-src-block-regexp nil nil (or arg 1))
(error (error "No further code blocks")))
(goto-char (match-beginning 0)) (org-show-context))
;;;###autoload
@ -1072,9 +1102,56 @@ With optional prefix argument ARG, jump forward ARG many source blocks."
"Jump to the previous source block.
With optional prefix argument ARG, jump backward ARG many source blocks."
(interactive "P")
(re-search-backward org-babel-src-block-regexp nil nil (or arg 1))
(condition-case nil
(re-search-backward org-babel-src-block-regexp nil nil (or arg 1))
(error (error "No previous code blocks")))
(goto-char (match-beginning 0)) (org-show-context))
(defvar org-babel-load-languages)
;;;###autoload
(defun org-babel-demarcate-block (&optional arg)
"Wrap or split the code in the region or on the point.
When called from inside of a code block the current block is
split. When called from outside of a code block a new code block
is created. In both cases if the region is demarcated and if the
region is not active then the point is demarcated."
(interactive "P")
(let ((info (org-babel-get-src-block-info))
(stars (concat (make-string (or (org-current-level) 1) ?*) " ")))
(if info
(mapc
(lambda (place)
(save-excursion
(goto-char place)
(let ((lang (nth 0 info))
(indent (make-string (nth 6 info) ? )))
(when (string-match "^[[:space:]]*$"
(buffer-substring (point-at-bol)
(point-at-eol)))
(delete-region (point-at-bol) (point-at-eol)))
(insert (concat (if (looking-at "^") "" "\n")
indent "#+end_src\n"
(if arg stars indent) "\n"
indent "#+begin_src " lang
(if (looking-at "[\n\r]") "" "\n")))))
(move-end-of-line 2))
(sort (if (region-active-p) (list (mark) (point)) (list (point))) #'>))
(let ((start (point))
(lang (org-icompleting-read "Lang: "
(mapcar (lambda (el) (symbol-name (car el)))
org-babel-load-languages)))
(body (delete-and-extract-region
(if (region-active-p) (mark) (point)) (point))))
(insert (concat (if (looking-at "^") "" "\n")
(if arg (concat stars "\n") "")
"#+begin_src " lang "\n"
body
(if (or (= (length body) 0)
(string-match "[\r\n]$" body)) "" "\n")
"#+end_src\n"))
(goto-char start) (move-end-of-line 1)))))
(defvar org-babel-lob-one-liner-regexp)
(defun org-babel-where-is-src-block-result (&optional insert info hash indent)
"Find where the current source block results begin.
@ -1242,76 +1319,79 @@ code ---- the results are extracted in the syntax of the source
(when (member "file" result-params)
(setq result (org-babel-result-to-file result))))
(unless (listp result) (setq result (format "%S" result))))
(if (= (length result) 0)
(if (member "value" result-params)
(message "No result returned by source block")
(message "Source block produced no output"))
(if (and result-params (member "silent" result-params))
(progn
(message (replace-regexp-in-string "%" "%%" (format "%S" result)))
result)
(when (and (stringp result) ;; ensure results end in a newline
(not (or (string-equal (substring result -1) "\n")
(string-equal (substring result -1) "\r"))))
(setq result (concat result "\n")))
(save-excursion
(let ((existing-result (org-babel-where-is-src-block-result
t info hash indent))
(results-switches
(cdr (assoc :results_switches (nth 2 info))))
beg end)
(if (not existing-result)
(setq beg (point))
(goto-char existing-result)
(save-excursion
(re-search-forward "#" nil t)
(setq indent (- (current-column) 1)))
(forward-line 1)
(if (and result-params (member "silent" result-params))
(progn
(message (replace-regexp-in-string "%" "%%" (format "%S" result)))
result)
(when (and (stringp result) ;; ensure results end in a newline
(> (length result) 0)
(not (or (string-equal (substring result -1) "\n")
(string-equal (substring result -1) "\r"))))
(setq result (concat result "\n")))
(save-excursion
(let ((existing-result (org-babel-where-is-src-block-result
t info hash indent))
(results-switches
(cdr (assoc :results_switches (nth 2 info))))
beg end)
(if (not existing-result)
(setq beg (point))
(cond
((member "replace" result-params)
(delete-region (point) (org-babel-result-end)))
((member "append" result-params)
(goto-char (org-babel-result-end)) (setq beg (point)))
((member "prepend" result-params) ;; already there
)))
(setq results-switches
(if results-switches (concat " " results-switches) ""))
(goto-char existing-result)
(save-excursion
(re-search-forward "#" nil t)
(setq indent (- (current-column) 1)))
(forward-line 1)
(setq beg (point))
(cond
;; assume the result is a table if it's not a string
((not (stringp result))
(insert (concat (orgtbl-to-orgtbl
(if (or (eq 'hline (car result))
(and (listp (car result))
(listp (cdr (car result)))))
result (list result))
'(:fmt (lambda (cell) (format "%s" cell)))) "\n"))
(goto-char beg) (when (org-at-table-p) (org-table-align)))
((member "file" result-params)
(insert result))
((member "html" result-params)
(insert (format "#+BEGIN_HTML%s\n%s#+END_HTML\n"
results-switches result)))
((member "latex" result-params)
(insert (format "#+BEGIN_LaTeX%s\n%s#+END_LaTeX\n"
results-switches result)))
((member "code" result-params)
(insert (format "#+BEGIN_SRC %s%s\n%s#+END_SRC\n"
(or lang "none") results-switches result)))
((member "org" result-params)
(insert (format "#+BEGIN_SRC org\n%s#+END_SRC\n" result)))
((member "raw" result-params)
(save-excursion (insert result)) (if (org-at-table-p) (org-cycle)))
(t
(org-babel-examplize-region
(point) (progn (insert result) (point)) results-switches)))
;; possibly indent the results to match the #+results line
(setq end (if (listp result) (org-table-end) (point)))
(when (and indent (> indent 0)
;; in this case `table-align' does the work for us
(not (and (listp result)
(member "append" result-params))))
(indent-rigidly beg end indent))))
((member "replace" result-params)
(delete-region (point) (org-babel-result-end)))
((member "append" result-params)
(goto-char (org-babel-result-end)) (setq beg (point)))
((member "prepend" result-params) ;; already there
)))
(setq results-switches
(if results-switches (concat " " results-switches) ""))
(cond
;; do nothing for an empty result
((= (length result) 0))
;; assume the result is a table if it's not a string
((not (stringp result))
(insert (concat (orgtbl-to-orgtbl
(if (or (eq 'hline (car result))
(and (listp (car result))
(listp (cdr (car result)))))
result (list result))
'(:fmt (lambda (cell) (format "%s" cell)))) "\n"))
(goto-char beg) (when (org-at-table-p) (org-table-align)))
((member "file" result-params)
(insert result))
((member "html" result-params)
(insert (format "#+BEGIN_HTML%s\n%s#+END_HTML\n"
results-switches result)))
((member "latex" result-params)
(insert (format "#+BEGIN_LaTeX%s\n%s#+END_LaTeX\n"
results-switches result)))
((member "code" result-params)
(insert (format "#+BEGIN_SRC %s%s\n%s#+END_SRC\n"
(or lang "none") results-switches result)))
((member "org" result-params)
(insert (format "#+BEGIN_SRC org\n%s#+END_SRC\n" result)))
((member "raw" result-params)
(save-excursion (insert result)) (if (org-at-table-p) (org-cycle)))
(t
(org-babel-examplize-region
(point) (progn (insert result) (point)) results-switches)))
;; possibly indent the results to match the #+results line
(setq end (if (listp result) (org-table-end) (point)))
(when (and indent (> indent 0)
;; in this case `table-align' does the work for us
(not (and (listp result)
(member "append" result-params))))
(indent-rigidly beg end indent))))
(if (= (length result) 0)
(if (member "value" result-params)
(message "No result returned by source block")
(message "Source block produced no output"))
(message "finished"))))
(defun org-babel-remove-result (&optional info)
@ -1366,7 +1446,7 @@ file's directory then expand relative links."
(let ((size (count-lines beg end)))
(save-excursion
(cond ((= size 0)
(error (concat "This should be impossible:"
(error (concat "This should not be impossible:"
"a newline was appended to result if missing")))
((< size org-babel-min-lines-for-block-output)
(goto-char beg)
@ -1591,7 +1671,7 @@ This is taken almost directly from `org-read-prop'."
cell))
(defun org-babel-number-p (string)
"Return t if STRING represents a number."
"If STRING represents a number return it's value."
(if (and (string-match "^-?[0-9]*\\.?[0-9]*$" string)
(= (length (substring string (match-beginning 0)
(match-end 0)))
@ -1668,18 +1748,7 @@ Fixes a bug in `tramp-handle-call-process-region'."
(apply org-babel-call-process-region-original
start end program delete buffer display args)))
(defun org-babel-maybe-remote-file (file)
"Conditionally parse information on a remote connnection.
If FILE specifies a remove file, then parse the information on
the remote connection."
(if (file-remote-p default-directory)
(let* ((vec (tramp-dissect-file-name default-directory))
(user (tramp-file-name-user vec))
(host (tramp-file-name-host vec)))
(concat "/" user (when user "@") host ":" file))
file))
(defun org-babel-tramp-localname (file)
(defun org-babel-local-file-name (file)
"Return the local name component of FILE."
(if (file-remote-p file)
(let (localname)
@ -1687,13 +1756,27 @@ the remote connection."
localname))
file))
(defvar org-babel-temporary-directory
(or (and (boundp 'org-babel-temporary-directory)
org-babel-temporary-directory)
(make-temp-file "babel-" t))
"Directory to hold temporary files created to execute code blocks.
(defun org-babel-process-file-name (name &optional no-quote-p)
"Prepare NAME to be used in an external process.
If NAME specifies a remote location, the remote portion of the
name is removed, since in that case the process will be executing
remotely. The file name is then processed by
`expand-file-name'. Unless second argument NO-QUOTE-P is non-nil,
the file name is additionally processed by
`shell-quote-argument'"
((lambda (f) (if no-quote-p f (shell-quote-argument f)))
(expand-file-name (org-babel-local-file-name name))))
(defvar org-babel-temporary-directory)
(unless (or noninteractive (boundp 'org-babel-temporary-directory))
(defvar org-babel-temporary-directory
(or (and (boundp 'org-babel-temporary-directory)
(file-exists-p org-babel-temporary-directory)
org-babel-temporary-directory)
(make-temp-file "babel-" t))
"Directory to hold temporary files created to execute code blocks.
Used by `org-babel-temp-file'. This directory will be removed on
Emacs shutdown.")
Emacs shutdown."))
(defun org-babel-temp-file (prefix &optional suffix)
"Create a temporary file in the `org-babel-temporary-directory'.
@ -1706,14 +1789,16 @@ of `org-babel-temporary-directory'."
(expand-file-name
prefix temporary-file-directory)
nil suffix))
(let ((temporary-file-directory (expand-file-name
org-babel-temporary-directory
temporary-file-directory)))
(let ((temporary-file-directory
(or (and (file-exists-p org-babel-temporary-directory)
org-babel-temporary-directory)
temporary-file-directory)))
(make-temp-file prefix nil suffix))))
(defun org-babel-remove-temporary-directory ()
"Remove `org-babel-temporary-directory' on Emacs shutdown."
(when (boundp 'org-babel-temporary-directory)
(when (and (boundp 'org-babel-temporary-directory)
(file-exists-p org-babel-temporary-directory))
;; taken from `delete-directory' in files.el
(mapc (lambda (file)
;; This test is equivalent to

34
lisp/org-agenda.el
View File

@ -2829,7 +2829,11 @@ the global options and expect it to be applied to the entire view.")
(switch-to-buffer-other-frame abuf))
((equal org-agenda-window-setup 'reorganize-frame)
(delete-other-windows)
(org-switch-to-buffer-other-window abuf))))
(org-switch-to-buffer-other-window abuf)))
;; additional test in case agenda is invoked from within agenda
;; buffer via elisp link
(unless (equal (current-buffer) abuf)
(switch-to-buffer abuf)))
(setq buffer-read-only nil)
(let ((inhibit-read-only t)) (erase-buffer))
(org-agenda-mode)
@ -3552,6 +3556,20 @@ in `org-agenda-text-search-extra-files'."
(member (string-to-char words) '(?- ?+ ?\{)))
(setq boolean t))
(setq words (org-split-string words))
(let (www w)
(while (setq w (pop words))
(while (and (string-match "\\\\\\'" w) words)
(setq w (concat (substring w 0 -1) " " (pop words))))
(push w www))
(setq words (nreverse www) www nil)
(while (setq w (pop words))
(when (and (string-match "\\`[-+]?{" w)
(not (string-match "}\\'" w)))
(while (and words (not (string-match "}\\'" (car words))))
(setq w (concat w " " (pop words))))
(setq w (concat w " " (pop words))))
(push w www))
(setq words (nreverse www)))
(setq org-agenda-last-search-view-search-was-boolean boolean)
(when boolean
(let (wds w)
@ -5117,13 +5135,13 @@ The modified list may contain inherited tags, and tags matched by
(throw 'exit list))
(while (setq time (pop gridtimes))
(unless (and remove (member time have))
(setq time (format "%4d" time))
(setq time (replace-regexp-in-string " " "0" (format "%04s" time)))
(push (org-format-agenda-item
nil string "" nil
(concat (substring time 0 -2) ":" (substring time -2)))
new)
(put-text-property
1 (length (car new)) 'face 'org-time-grid (car new))))
2 (length (car new)) 'face 'org-time-grid (car new))))
(if (member 'time-up org-agenda-sorting-strategy-selected)
(append new list)
(append list new)))))
@ -5726,7 +5744,9 @@ If the line does not have an effort defined, return nil."
(if (not (eval org-agenda-filter-form))
(org-agenda-filter-by-tag-hide-line))
(beginning-of-line 2))
(beginning-of-line 2))))))
(beginning-of-line 2))))
(if (get-char-property (point) 'invisible)
(org-agenda-previous-line))))
(defun org-agenda-filter-by-tag-hide-line ()
(let (ov)
@ -5803,7 +5823,8 @@ Negative selection means regexp must not match for selection of an entry."
(defun org-agenda-goto-date (date)
"Jump to DATE in agenda."
(interactive (list (org-read-date)))
(interactive (list (let ((org-read-date-prefer-future nil))
(org-read-date))))
(org-agenda-list nil date))
(defun org-agenda-goto-today ()
@ -7279,7 +7300,8 @@ the resulting entry will not be shown. When TEXT is empty, switch to
(let ((calendar-date-display-form
(if (if (boundp 'calendar-date-style)
(eq calendar-date-style 'european)
(org-bound-and-true-p european-calendar-style)) ; Emacs 22
(with-no-warnings ;; european-calendar-style is obsolete as of version 23.1
(org-bound-and-true-p european-calendar-style))) ; Emacs 22
'(day " " month " " year)
'(month " " day " " year))))

2
lisp/org-archive.el
View File

@ -115,7 +115,7 @@ information."
((or (re-search-backward re nil t)
(re-search-forward re nil t))
(match-string 1))
(t org-archive-location (match-string 1)))))))
(t org-archive-location))))))
(defun org-add-archive-files (files)
"Splice the archive files into the list of files.

38
lisp/org-ascii.el
View File

@ -311,7 +311,7 @@ publishing directory."
:add-text (plist-get opt-plist :text))
"\n"))
thetoc have-headings first-heading-pos
table-open table-buffer link-buffer link desc desc0 rpl wrap)
table-open table-buffer link-buffer link type path desc desc0 rpl wrap fnc)
(let ((inhibit-read-only t))
(org-unmodified
(remove-text-properties (point-min) (point-max)
@ -347,7 +347,7 @@ publishing directory."
(if (and (or author email)
org-export-author-info)
(insert(concat (nth 1 lang-words) ": " (or author "")
(insert (concat (nth 1 lang-words) ": " (or author "")
(if (and org-export-email-info
email (string-match "\\S-" email))
(concat " <" email ">") "")
@ -431,10 +431,12 @@ publishing directory."
;; Remove the quoted HTML tags.
(setq line (org-html-expand-for-ascii line))
;; Replace links with the description when possible
(while (string-match org-bracket-link-regexp line)
(setq link (match-string 1 line)
desc0 (match-string 3 line)
desc (or desc0 (match-string 1 line)))
(while (string-match org-bracket-link-analytic-regexp++ line)
(setq path (match-string 3 line)
link (concat (match-string 1 line) path)
type (match-string 2 line)
desc0 (match-string 5 line)
desc (or desc0 link))
(if (and (> (length link) 8)
(equal (substring link 0 8) "coderef:"))
(setq line (replace-match
@ -443,15 +445,18 @@ publishing directory."
(substring link 8)
org-export-code-refs)))
t t line))
(setq rpl (concat "["
(or (match-string 3 line) (match-string 1 line))
"]"))
(when (and desc0 (not (equal desc0 link)))
(if org-export-ascii-links-to-notes
(push (cons desc0 link) link-buffer)
(setq rpl (concat rpl " (" link ")")
wrap (+ (length line) (- (length (match-string 0 line)))
(length desc)))))
(setq rpl (concat "[" desc "]"))
(if (functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
(setq rpl (or (save-match-data
(funcall fnc (org-link-unescape path)
desc0 'ascii))
rpl))
(when (and desc0 (not (equal desc0 link)))
(if org-export-ascii-links-to-notes
(push (cons desc0 link) link-buffer)
(setq rpl (concat rpl " (" link ")")
wrap (+ (length line) (- (length (match-string 0 line)))
(length desc))))))
(setq line (replace-match rpl t t line))))
(when custom-times
(setq line (org-translate-time line)))
@ -482,7 +487,8 @@ publishing directory."
(org-format-table-ascii table-buffer)
"\n") "\n")))
(t
(if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)" line)
(if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)"
line)
(setq line (replace-match "\\1\\3:" t nil line)))
(setq line (org-fix-indentation line org-ascii-current-indentation))
;; Remove forced line breaks

29
lisp/org-capture.el
View File

@ -221,20 +221,23 @@ Furthermore, the following %-escapes will be replaced with content:
Apart from these general escapes, you can access information specific to the
link type that is created. For example, calling `org-capture' in emails
or gnus will record the author and the subject of the message, which you
can access with \"%:author\" and \"%:subject\", respectively. Here is a
can access with \"%:from\" and \"%:subject\", respectively. Here is a
complete list of what is recorded for each link type.
Link type | Available information
-------------------+------------------------------------------------------
bbdb | %:type %:name %:company
vm, wl, mh, rmail | %:type %:subject %:message-id
| %:from %:fromname %:fromaddress
| %:to %:toname %:toaddress
| %:fromto (either \"to NAME\" or \"from NAME\")
gnus | %:group, for messages also all email fields
w3, w3m | %:type %:url
info | %:type %:file %:node
calendar | %:type %:date"
Link type | Available information
------------------------+------------------------------------------------------
bbdb | %:type %:name %:company
vm, wl, mh, mew, rmail | %:type %:subject %:message-id
| %:from %:fromname %:fromaddress
| %:to %:toname %:toaddress
| %:fromto (either \"to NAME\" or \"from NAME\")
| %:date
| %:date-timestamp (as active timestamp)
| %:date-timestamp-inactive (as inactive timestamp)
gnus | %:group, for messages also all email fields
w3, w3m | %:type %:url
info | %:type %:file %:node
calendar | %:type %:date"
:group 'org-capture
:type
'(repeat
@ -678,6 +681,7 @@ already gone."
(delete-other-windows)
(org-switch-to-buffer-other-window
(org-capture-get-indirect-buffer (org-capture-get :buffer) "CAPTURE"))
(widen)
(show-all)
(goto-char (org-capture-get :pos))
(org-set-local 'org-capture-target-marker
@ -1198,6 +1202,7 @@ The template may still contain \"%?\" for cursor positioning."
"org-capture-template-prompt-history::"
(or prompt "")))
completions (mapcar 'list completions)))
(unless (boundp histvar) (set histvar nil))
(cond
((member char '("G" "g"))
(let* ((org-last-tags-completion-table

18
lisp/org-clock.el
View File

@ -35,6 +35,7 @@
(require 'cl))
(declare-function calendar-absolute-from-iso "cal-iso" (&optional date))
(declare-function notifications-notify "notifications" (&rest params))
(defvar org-time-stamp-formats)
(defgroup org-clock nil
@ -558,6 +559,7 @@ use libnotify if available, or fall back on a message."
(start-process "emacs-timer-notification" nil
org-show-notification-handler notification))
((featurep 'notifications)
(require 'notifications)
(notifications-notify
:title "Org-mode message"
:body notification
@ -957,7 +959,7 @@ the clocking selection, associated with the letter `d'."
;; We are interrupting the clocking of a different task.
;; Save a marker to this task, so that we can go back.
;; First check if we are trying to clock into the same task!
(if (save-excursion
(when (save-excursion
(unless selected-task
(org-back-to-heading t))
(and (equal (marker-buffer org-clock-hd-marker)
@ -968,13 +970,13 @@ the clocking selection, associated with the letter `d'."
(if selected-task
(marker-position selected-task)
(point)))))
(message "Clock continues in \"%s\"" org-clock-heading)
(progn
(move-marker org-clock-interrupted-task
(marker-position org-clock-marker)
(org-clocking-buffer))
(let ((org-clock-clocking-in t))
(org-clock-out t)))))
(message "Clock continues in \"%s\"" org-clock-heading)
(throw 'abort nil))
(move-marker org-clock-interrupted-task
(marker-position org-clock-marker)
(marker-buffer org-clock-marker))
(let ((org-clock-clocking-in t))
(org-clock-out t)))
(when (equal select '(16))
;; Mark as default clocking task

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

@ -201,7 +201,8 @@ which defaults to the value of `org-export-blocks-witheld'."
(interblock start (point-max))
(run-hooks 'org-export-blocks-postblock-hook)))))
(add-hook 'org-export-preprocess-hook 'org-export-blocks-preprocess)
(add-hook 'org-export-preprocess-after-include-files-hook
'org-export-blocks-preprocess)
;;================================================================================
;; type specific functions

3
lisp/org-exp.el
View File

@ -181,7 +181,7 @@ This option can also be set with the +OPTIONS line, e.g. \"-:nil\"."
("no" "Forfatter" "Dato" "Innhold" "Fotnoter")
("nb" "Forfatter" "Dato" "Innhold" "Fotnoter") ;; nb = Norsk (bokm.l)
("nn" "Forfattar" "Dato" "Innhald" "Fotnotar") ;; nn = Norsk (nynorsk)
("pl" "Autor" "Data" "Spis tre&sacute;ci" "Przypis")
("pl" "Autor" "Data" "Spis tre&#x015b;ci" "Przypis")
("sv" "F&ouml;rfattare" "Datum" "Inneh&aring;ll" "Fotnoter"))
"Terms used in export text, translated to different languages.
Use the variable `org-export-default-language' to set the language,
@ -771,6 +771,7 @@ modified) list.")
;; Add macro definitions
(setq p (plist-put p :macro-date "(eval (format-time-string \"$1\"))"))
(setq p (plist-put p :macro-time "(eval (format-time-string \"$1\"))"))
(setq p (plist-put p :macro-property "(eval (org-entry-get nil \"$1\" 'selective))"))
(setq p (plist-put
p :macro-modification-time
(and (buffer-file-name)

2
lisp/org-feed.el
View File

@ -103,7 +103,7 @@
(defgroup org-feed nil
"Options concerning RSS feeds as inputs for Org files."
:tag "Org ID"
:tag "Org Feed"
:group 'org)
(defcustom org-feed-alist nil

59
lisp/org-gnus.el
View File

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

6
lisp/org-html.el
View File

@ -387,7 +387,7 @@ be linked only."
(const :tag "When there is no description" maybe)))
(defcustom org-export-html-inline-image-extensions
'("png" "jpeg" "jpg" "gif")
'("png" "jpeg" "jpg" "gif" "svg")
"Extensions of image files that can be inlined into HTML."
:group 'org-export-html
:type '(repeat (string :tag "Extension")))
@ -519,7 +519,7 @@ with a link to this URL."
"Preamble, to be inserted just after <body>. Set by publishing functions.
This may also be a function, building and inserting the preamble.")
(defvar org-export-html-postamble nil
"Preamble, to be inserted just before </body>. Set by publishing functions.
"Postamble, to be inserted just before </body>. Set by publishing functions.
This may also be a function, building and inserting the postamble.")
(defvar org-export-html-auto-preamble t
"Should default preamble be inserted? Set by publishing functions.")
@ -674,7 +674,7 @@ See variable `org-export-html-link-org-files-as-html'"
(string-match "\\.org$" path)
(progn
(list
"http"
"file"
(concat
(substring path 0 (match-beginning 0))
"."

22
lisp/org-icalendar.el
View File

@ -194,6 +194,13 @@ When nil of the empty string, use the abbreviation retrieved from Emacs."
(const :tag "Unspecified" nil)
(string :tag "Time zone")))
(defcustom org-icalendar-use-UTC-date-time ()
"Non-nil force the use of the universal time for iCalendar DATE-TIME.
The iCalendar DATE-TIME can be expressed with local time or universal Time,
universal time could be more compatible with some external tools."
:group 'org-export-icalendar
:type 'boolean)
;;; iCalendar export
;;;###autoload
@ -311,7 +318,7 @@ When COMBINE is non nil, add the category to each line."
inc t
hd (condition-case nil
(org-icalendar-cleanup-string
(org-get-heading))
(org-get-heading t))
(error (throw :skip nil)))
summary (org-icalendar-cleanup-string
(org-entry-get nil "SUMMARY"))
@ -439,7 +446,7 @@ END:VEVENT\n"
(when org-icalendar-include-todo
(setq prefix "TODO-")
(goto-char (point-min))
(while (re-search-forward org-todo-line-regexp nil t)
(while (re-search-forward org-complex-heading-regexp nil t)
(catch :skip
(org-agenda-skip)
(when org-icalendar-verify-function
@ -471,7 +478,7 @@ END:VEVENT\n"
((eq org-icalendar-include-todo t)
;; include everything that is not done
(member state org-not-done-keywords))))
(setq hd (match-string 3)
(setq hd (match-string 4)
summary (org-icalendar-cleanup-string
(org-entry-get nil "SUMMARY"))
desc (org-icalendar-cleanup-string
@ -634,8 +641,13 @@ a time), or the day by one (if it does not contain a time)."
(setq h (+ 2 h)))
(setq d (1+ d))))
(setq time (encode-time s mi h d m y)))
(setq fmt (if have-time ":%Y%m%dT%H%M%S" ";VALUE=DATE:%Y%m%d"))
(concat keyword (format-time-string fmt time)))))
(setq fmt (if have-time (if org-icalendar-use-UTC-date-time
":%Y%m%dT%H%M%SZ"
":%Y%m%dT%H%M%S")
";VALUE=DATE:%Y%m%d"))
(concat keyword (format-time-string fmt time
(and org-icalendar-use-UTC-date-time
have-time))))))
(provide 'org-icalendar)

47
lisp/org-latex.el
View File

@ -280,6 +280,11 @@ markup defined, the first one in the association list will be used."
(string :tag "Keyword")
(string :tag "Markup")))))
(defcustom org-export-latex-tag-markup "\\textbf{%s}"
"Markup for tags, as a printf format."
:group 'org-export-latex
:type 'string)
(defcustom org-export-latex-timestamp-markup "\\textit{%s}"
"A printf format string to be applied to time stamps."
:group 'org-export-latex
@ -451,8 +456,11 @@ allowed. The default we use here encompasses both."
:group 'org-export)
(defcustom org-latex-to-pdf-process
'("pdflatex -interaction nonstopmode -output-directory %o %f"
"pdflatex -interaction nonstopmode -output-directory %o %f")
(if (executable-find "texi2dvi")
'("texi2dvi -p -b -c -V %f")
'("pdflatex -interaction nonstopmode -output-directory %o %f"
"pdflatex -interaction nonstopmode -output-directory %o %f"
"pdflatex -interaction nonstopmode -output-directory %o %f"))
"Commands to process a LaTeX file to a PDF file.
This is a list of strings, each of them will be given to the shell
as a command. %f in the command will be replaced by the full file name, %b
@ -463,6 +471,9 @@ pdflatex, maybe mixed with a call to bibtex. Org does not have a clever
mechanism to detect which of these commands have to be run to get to a stable
result, and it also does not do any error checking.
By default, Org used texi2dvi to do the processing, if that command
is on the system. If not, it uses 2 pdflatex runs.
Alternatively, this may be a Lisp function that does the processing, so you
could use this to apply the machinery of AUCTeX or the Emacs LaTeX mode.
This function should accept the file name as its single argument."
@ -841,7 +852,7 @@ when PUB-DIR is set, use this as the publishing directory."
(save-excursion
(goto-char (point-min))
(re-search-forward "\\\\bibliography{" nil t))))
cmd output-dir)
cmd output-dir errors)
(with-current-buffer outbuf (erase-buffer))
(message (concat "Processing LaTeX file " file "..."))
(setq output-dir (file-name-directory file))
@ -866,16 +877,40 @@ when PUB-DIR is set, use this as the publishing directory."
t t cmd)))
(shell-command cmd outbuf outbuf)))
(message (concat "Processing LaTeX file " file "...done"))
(setq errors (org-export-latex-get-error outbuf))
(if (not (file-exists-p pdffile))
(error (concat "PDF file " pdffile " was not produced"))
(error (concat "PDF file " pdffile " was not produced"
(if errors (concat ":" errors "") "")))
(set-window-configuration wconfig)
(when org-export-pdf-remove-logfiles
(dolist (ext org-export-pdf-logfiles)
(setq file (concat base "." ext))
(and (file-exists-p file) (delete-file file))))
(message "Exporting to PDF...done")
(message (concat
"Exporting to PDF...done"
(if errors
(concat ", with some errors:" errors)
"")))
pdffile)))
(defun org-export-latex-get-error (buf)
"Collect the kinds of errors that remain in pdflatex processing."
(with-current-buffer buf
(save-excursion
(goto-char (point-max))
(when (re-search-backward "^[ \t]*This is pdf.*?TeX.*?Version" nil t)
;; OK, we are at the location of the final run
(let ((pos (point)) (errors "") (case-fold-search t))
(if (re-search-forward "Reference.*?undefined" nil t)
(setq errors (concat errors " [undefined reference]")))
(goto-char pos)
(if (re-search-forward "Citation.*?undefined" nil t)
(setq errors (concat errors " [undefined citation]")))
(goto-char pos)
(if (re-search-forward "Undefined control sequence" nil t)
(setq errors (concat errors " [undefined control sequence]")))
(and (org-string-nw-p errors) errors))))))
;;;###autoload
(defun org-export-as-pdf-and-open (arg)
"Export as LaTeX, then process through to PDF, and open."
@ -1335,7 +1370,7 @@ links, keywords, lists, tables, fixed-width"
(replace-match "")
(replace-match
(org-export-latex-protect-string
(format "\\textbf{%s}"
(format org-export-latex-tag-markup
(save-match-data
(replace-regexp-in-string
"_" "\\\\_" (match-string 0)))))

323
lisp/org-list.el
View File

@ -40,6 +40,9 @@
(defvar org-M-RET-may-split-line)
(defvar org-complex-heading-regexp)
(defvar org-odd-levels-only)
(defvar org-outline-regexp)
(defvar org-ts-regexp)
(defvar org-ts-regexp-both)
(declare-function org-invisible-p "org" ())
(declare-function org-on-heading-p "org" (&optional invisible-ok))
@ -55,6 +58,13 @@
(pom property &optional inherit literal-nil))
(declare-function org-narrow-to-subtree "org" ())
(declare-function org-show-subtree "org" ())
(declare-function org-in-regexps-block-p "org"
(start-re end-re &optional bound))
(declare-function org-level-increment "org" ())
(declare-function org-at-heading-p "org" (&optional ignored))
(declare-function outline-previous-heading "outline" ())
(declare-function org-icompleting-read "org" (&rest args))
(declare-function org-time-string-to-seconds "org" (s))
(defgroup org-plain-lists nil
"Options concerning plain lists in Org-mode."
@ -63,7 +73,6 @@
(defcustom org-cycle-include-plain-lists t
"When t, make TAB cycle visibility on plain list items.
Cycling plain lists works only when the cursor is on a plain list
item. When the cursor is on an outline heading, plain lists are
treated as text. This is the most stable way of handling this,
@ -151,7 +160,6 @@ spaces instead of one after the bullet in each item of the list."
(defcustom org-list-ending-method 'both
"Determine where plain lists should end.
Valid values are: `regexp', `indent' or `both'.
When set to `regexp', Org will look into two variables,
@ -173,7 +181,6 @@ determine lists endings. This is the default method."
(defcustom org-empty-line-terminates-plain-lists nil
"Non-nil means an empty line ends all plain list levels.
This variable only makes sense if `org-list-ending-method' is set
to `regexp' or `both'. This is then equivalent to set
`org-list-end-regexp' to \"^[ \\t]*$\"."
@ -193,14 +200,12 @@ precedence over it."
(indent . t)
(insert . t))
"Non-nil means apply set of rules when acting on lists.
By default, automatic actions are taken when using
\\[org-shiftmetaup], \\[org-shiftmetadown], \\[org-meta-return],
\\[org-metaright], \\[org-metaleft], \\[org-shiftmetaright],
\\[org-shiftmetaleft], \\[org-ctrl-c-minus],
\\[org-toggle-checkbox] or \\[org-insert-todo-heading]. You can
disable individually these rules by setting them to nil. Valid
rules are:
\\[org-meta-return], \\[org-metaright], \\[org-metaleft],
\\[org-shiftmetaright], \\[org-shiftmetaleft],
\\[org-ctrl-c-minus], \\[org-toggle-checkbox] or
\\[org-insert-todo-heading]. You can disable individually these
rules by setting them to nil. Valid rules are:
bullet when non-nil, cycling bullet do not allow lists at
column 0 to have * as a bullet and descriptions lists
@ -317,7 +322,6 @@ the end of the nearest terminator from MAX."
(defun org-list-maybe-skip-block (search limit)
"Return non-nil value if point is in a block, skipping it on the way.
It looks for the boundary of the block in SEARCH direction,
stopping at LIMIT."
(save-match-data
@ -331,7 +335,6 @@ stopping at LIMIT."
(defun org-list-search-unenclosed-generic (search re bound noerr)
"Search a string outside blocks and protected places.
Arguments SEARCH, RE, BOUND and NOERR are similar to those in
`search-forward', `search-backward', `re-search-forward' and
`re-search-backward'."
@ -350,7 +353,6 @@ Arguments SEARCH, RE, BOUND and NOERR are similar to those in
(defun org-search-backward-unenclosed (regexp &optional bound noerror)
"Like `re-search-backward' but don't stop inside blocks or protected places.
Arguments REGEXP, BOUND and NOERROR are similar to those used in
`re-search-backward'."
(org-list-search-unenclosed-generic
@ -358,7 +360,6 @@ Arguments REGEXP, BOUND and NOERROR are similar to those used in
(defun org-search-forward-unenclosed (regexp &optional bound noerror)
"Like `re-search-forward' but don't stop inside blocks or protected places.
Arguments REGEXP, BOUND and NOERROR are similar to those used in
`re-search-forward'."
(org-list-search-unenclosed-generic
@ -366,7 +367,6 @@ Arguments REGEXP, BOUND and NOERROR are similar to those used in
(defun org-list-in-item-p-with-indent (limit)
"Is the cursor inside a plain list?
Plain lists are considered ending when a non-blank line is less
indented than the previous item within LIMIT."
(save-excursion
@ -403,7 +403,6 @@ indented than the previous item within LIMIT."
(defun org-list-in-item-p-with-regexp (limit)
"Is the cursor inside a plain list?
Plain lists end when `org-list-end-regexp' is matched, or at a
blank line if `org-empty-line-terminates-plain-lists' is true.
@ -424,7 +423,6 @@ Argument LIMIT specifies the upper-bound of the search."
(defun org-list-top-point-with-regexp (limit)
"Return point at the top level item in a list.
Argument LIMIT specifies the upper-bound of the search.
List ending is determined by regexp. See
@ -440,7 +438,6 @@ List ending is determined by regexp. See
(defun org-list-bottom-point-with-regexp (limit)
"Return point just before list ending.
Argument LIMIT specifies the lower-bound of the search.
List ending is determined by regexp. See
@ -454,7 +451,6 @@ List ending is determined by regexp. See
(defun org-list-top-point-with-indent (limit)
"Return point at the top level in a list.
Argument LIMIT specifies the upper-bound of the search.
List ending is determined by indentation of text. See
@ -491,7 +487,6 @@ List ending is determined by indentation of text. See
(defun org-list-bottom-point-with-indent (limit)
"Return point just before list ending or nil if not in a list.
Argument LIMIT specifies the lower-bound of the search.
List ending is determined by the indentation of text. See
@ -520,7 +515,7 @@ List ending is determined by the indentation of text. See
(skip-chars-forward " \r\t\n")
(beginning-of-line))
((org-at-item-p)
(setq ind-ref (min ind ind-ref))
(setq ind-ref ind)
(forward-line 1))
((<= ind ind-ref)
(throw 'exit (point-at-bol)))
@ -558,7 +553,6 @@ uses PRE-MOVE before search. Return nil if no item was found."
(defun org-list-separating-blank-lines-number (pos top bottom)
"Return number of blank lines that should separate items in list.
POS is the position of point to be considered.
TOP and BOTTOM are respectively position of list beginning and
@ -603,7 +597,6 @@ some heuristics to guess the result."
(defun org-list-insert-item-generic (pos &optional checkbox after-bullet)
"Insert a new list item at POS.
If POS is before first character after bullet of the item, the
new item will be created before the current one.
@ -659,6 +652,9 @@ function ends."
;; recompute next-item: last sexp modified list
(goto-char (org-get-next-item (point) bottom))
(org-move-to-column col)))
;; checkbox update might modify bottom point, so use a
;; marker here
(setq bottom (copy-marker bottom))
(when checkbox (org-update-checkbox-count-maybe))
(org-list-repair nil top bottom))))
(goto-char true-pos)
@ -690,7 +686,6 @@ function ends."
(defun org-list-indent-item-generic (arg no-subtree top bottom)
"Indent a local list item including its children.
When number ARG is a negative, item will be outdented, otherwise
it will be indented.
@ -863,8 +858,10 @@ A checkbox is blocked if all of the following conditions are fulfilled:
;; already in a list and doesn't compute list boundaries.
;; If you plan to use more than one org-list function is some code,
;; you should therefore first compute list boundaries, and then make
;; use of non-interactive forms.
;; you should therefore first check if point is in a list with
;; `org-in-item-p' or `org-at-item-p', then compute list boundaries
;; with `org-list-top-point' and `org-list-bottom-point', and make use
;; of non-interactive forms.
(defun org-list-top-point ()
"Return point at the top level in a list.
@ -960,8 +957,8 @@ If the cursor in not in an item, throw an error."
(defun org-get-end-of-item (bottom)
"Return position at the end of the current item.
BOTTOM is the position at list ending."
(let* ((next-p (org-get-next-item (point) bottom)))
(or next-p (org-get-end-of-list bottom))))
(or (org-get-next-item (point) bottom)
(org-get-end-of-list bottom)))
(defun org-end-of-item ()
"Go to the end of the current hand-formatted item.
@ -998,7 +995,6 @@ Stop searching at LIMIT. Return nil if no item is found."
(defun org-previous-item ()
"Move to the beginning of the previous item.
Item is at the same level in the current plain list. Error if not
in a plain list, or if this is the first item in the list."
(interactive)
@ -1015,7 +1011,6 @@ Stop searching at LIMIT. Return nil if no item is found."
(defun org-next-item ()
"Move to the beginning of the next item.
Item is at the same level in the current plain list. Error if not
in a plain list, or if this is the last item in the list."
(interactive)
@ -1028,7 +1023,6 @@ in a plain list, or if this is the last item in the list."
(defun org-list-exchange-items (beg-A beg-B bottom)
"Swap item starting at BEG-A with item starting at BEG-B.
Blank lines at the end of items are left in place. Assume BEG-A
is lesser than BEG-B.
@ -1049,7 +1043,6 @@ BOTTOM is the position at list ending."
(defun org-move-item-down ()
"Move the plain list item at point down, i.e. swap with following item.
Subitems (items with larger indentation) are considered part of the item,
so this really moves item trees."
(interactive)
@ -1071,7 +1064,6 @@ so this really moves item trees."
(defun org-move-item-up ()
"Move the plain list item at point up, i.e. swap with previous item.
Subitems (items with larger indentation) are considered part of the item,
so this really moves item trees."
(interactive)
@ -1093,7 +1085,6 @@ so this really moves item trees."
(defun org-insert-item (&optional checkbox)
"Insert a new item at the current level.
If cursor is before first character after bullet of the item, the
new item will be created before the current one.
@ -1102,7 +1093,9 @@ If CHECKBOX is non-nil, add a checkbox next to the bullet.
Return t when things worked, nil when we are not in an item, or
item is invisible."
(unless (or (not (org-in-item-p))
(org-invisible-p))
(save-excursion
(goto-char (org-get-item-beginning))
(org-invisible-p)))
(if (save-excursion
(goto-char (org-get-item-beginning))
(org-at-item-timer-p))
@ -1151,7 +1144,6 @@ bullet string and bullet counter, if any."
(defun org-list-struct (begin end top bottom &optional outdent)
"Return the structure containing the list between BEGIN and END.
A structure is an alist where key is point of item and values
are, in that order, indentation, bullet string and value of
counter, if any. A structure contains every list and sublist that
@ -1217,7 +1209,6 @@ change is an outdent."
(defun org-list-struct-origins (struct)
"Return an alist where key is item's position and value parent's.
STRUCT is the list's structure looked up."
(let* ((struct-rev (reverse struct))
(acc (list (cons (nth 1 (car struct)) 0)))
@ -1248,7 +1239,6 @@ STRUCT is the list's structure looked up."
(defun org-list-struct-get-parent (item struct origins)
"Return parent association of ITEM in STRUCT or nil.
ORIGINS is the alist of parents. See `org-list-struct-origins'."
(let* ((parent-pos (cdr (assq (car item) origins))))
(when (> parent-pos 0) (assq parent-pos struct))))
@ -1261,7 +1251,6 @@ ORIGINS is the alist of parents. See `org-list-struct-origins'."
(defun org-list-struct-fix-bul (struct origins)
"Verify and correct bullets for every association in STRUCT.
ORIGINS is the alist of parents. See `org-list-struct-origins'.
This function modifies STRUCT."
@ -1302,7 +1291,6 @@ This function modifies STRUCT."
(defun org-list-struct-fix-ind (struct origins)
"Verify and correct indentation for every association in STRUCT.
ORIGINS is the alist of parents. See `org-list-struct-origins'.
This function modifies STRUCT."
@ -1322,7 +1310,6 @@ This function modifies STRUCT."
(defun org-list-struct-fix-struct (struct origins)
"Return STRUCT with correct bullets and indentation.
ORIGINS is the alist of parents. See `org-list-struct-origins'.
Only elements of STRUCT that have changed are returned."
@ -1333,7 +1320,6 @@ Only elements of STRUCT that have changed are returned."
(defun org-list-struct-outdent (start end origins)
"Outdent items in a structure.
Items are indented when their key is between START, included, and
END, excluded.
@ -1366,7 +1352,6 @@ STRUCT is the concerned structure."
(defun org-list-struct-indent (start end origins struct)
"Indent items in a structure.
Items are indented when their key is between START, included, and
END, excluded.
@ -1429,7 +1414,6 @@ END."
(defun org-list-struct-apply-struct (struct bottom)
"Apply modifications to list so it mirrors STRUCT.
BOTTOM is position at list ending.
Initial position is restored after the changes."
@ -1502,7 +1486,6 @@ BOTTOM is position at list ending."
(defun org-outdent-item ()
"Outdent a local list item, but not its children.
If a region is active, all items inside will be moved."
(interactive)
(org-list-indent-item-generic
@ -1510,7 +1493,6 @@ If a region is active, all items inside will be moved."
(defun org-indent-item ()
"Indent a local list item, but not its children.
If a region is active, all items inside will be moved."
(interactive)
(org-list-indent-item-generic
@ -1518,7 +1500,6 @@ If a region is active, all items inside will be moved."
(defun org-outdent-item-tree ()
"Outdent a local list item including its children.
If a region is active, all items inside will be moved."
(interactive)
(org-list-indent-item-generic
@ -1526,7 +1507,6 @@ If a region is active, all items inside will be moved."
(defun org-indent-item-tree ()
"Indent a local list item including its children.
If a region is active, all items inside will be moved."
(interactive)
(org-list-indent-item-generic
@ -1535,9 +1515,8 @@ If a region is active, all items inside will be moved."
(defvar org-tab-ind-state)
(defun org-cycle-item-indentation ()
"Cycle levels of indentation of an empty item.
The first run indent the item, if applicable. Subsequents runs
outdent it at meaningful levels in the list. When done, item is
The first run indent the item, if applicable. Subsequents runs
outdent it at meaningful levels in the list. When done, item is
put back at its original position with its original bullet.
Return t at each successful move."
@ -1664,12 +1643,12 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is
(unless (and bullet-rule-p
(looking-at "\\S-")) '("*"))
;; Description items cannot be numbered
(unless (and bullet-rule-p
(or (eq org-plain-list-ordered-item-terminator ?.)
(org-at-item-description-p))) '("1)"))
(unless (and bullet-rule-p
(or (eq org-plain-list-ordered-item-terminator ?\))
(org-at-item-description-p))) '("1."))))
(org-at-item-description-p))) '("1."))
(unless (and bullet-rule-p
(or (eq org-plain-list-ordered-item-terminator ?.)
(org-at-item-description-p))) '("1)"))))
(len (length bullet-list))
(item-index (- len (length (member current bullet-list))))
(get-value (lambda (index) (nth (mod index len) bullet-list)))
@ -1684,17 +1663,16 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is
(defun org-toggle-checkbox (&optional toggle-presence)
"Toggle the checkbox in the current line.
With prefix arg TOGGLE-PRESENCE, add or remove checkboxes. With
double prefix, set checkbox to [-].
When there is an active region, toggle status or presence of the
checkbox in the first line, and make every item in the region
have the same status or presence, respectively.
first checkbox there, and make every item inside have the
same status or presence, respectively.
If the cursor is in a headline, apply this to all checkbox items
in the text below the heading, taking as reference the first item
in subtree."
in subtree, ignoring drawers."
(interactive "P")
;; Bounds is a list of type (beg end single-p) where single-p is t
;; when `org-toggle-checkbox' is applied to a single item. Only
@ -1702,22 +1680,34 @@ in subtree."
(let* ((bounds
(cond
((org-region-active-p)
(list (region-beginning) (region-end) nil))
(let ((rbeg (region-beginning))
(rend (region-end)))
(save-excursion
(goto-char rbeg)
(if (org-search-forward-unenclosed org-item-beginning-re rend 'move)
(list (point-at-bol) rend nil)
(error "No item in region")))))
((org-on-heading-p)
;; In this case, reference line is the first item in subtree
(let ((limit (save-excursion (outline-next-heading) (point))))
;; In this case, reference line is the first item in
;; subtree outside drawers
(let ((pos (point))
(limit (save-excursion (outline-next-heading) (point))))
(save-excursion
(goto-char limit)
(org-search-backward-unenclosed ":END:" pos 'move)
(org-search-forward-unenclosed
org-item-beginning-re limit 'move)
(list (point) limit nil))))
((org-at-item-p)
(list (point-at-bol) (point-at-eol) t))
(t (error "Not at an item or heading, and no active region"))))
;; marker is needed because deleting checkboxes will change END
(beg (car bounds))
;; marker is needed because deleting or inserting checkboxes
;; will change bottom point
(end (copy-marker (nth 1 bounds)))
(single-p (nth 2 bounds))
(ref-presence (save-excursion
(goto-char (car bounds))
(goto-char beg)
(org-at-item-checkbox-p)))
(ref-status (equal (match-string 1) "[X]"))
(act-on-item
@ -1751,7 +1741,7 @@ in subtree."
(t "[X]"))
t t nil 1))))))))
(save-excursion
(beginning-of-line)
(goto-char beg)
(while (< (point) end)
(funcall act-on-item ref-presence ref-status)
(org-search-forward-unenclosed org-item-beginning-re end 'move)))
@ -1792,104 +1782,105 @@ with the current numbers. With optional prefix argument ALL, do this for
the whole buffer."
(interactive "P")
(save-excursion
(let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21
(beg (condition-case nil
(progn (org-back-to-heading) (point))
(error (point-min))))
(end (move-marker (make-marker)
(progn (outline-next-heading) (point))))
(re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
(re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)")
(re-find (concat re "\\|" re-box))
beg-cookie end-cookie is-percent c-on c-off lim new
eline curr-ind next-ind continue-from startsearch
(recursive
(or (not org-hierarchical-checkbox-statistics)
(string-match "\\<recursive\\>"
(or (ignore-errors
(org-entry-get nil "COOKIE_DATA"))
""))))
(cstat 0))
(when all
(goto-char (point-min))
(outline-next-heading)
(setq beg (point) end (point-max)))
(goto-char end)
;; find each statistics cookie
(while (and (org-search-backward-unenclosed re-find beg t)
(not (save-match-data
(and (org-on-heading-p)
(string-match "\\<todo\\>"
(downcase
(or (org-entry-get
nil "COOKIE_DATA")
"")))))))
(setq beg-cookie (match-beginning 1)
end-cookie (match-end 1)
cstat (+ cstat (if end-cookie 1 0))
startsearch (point-at-eol)
continue-from (match-beginning 0)
is-percent (match-beginning 2)
lim (cond
((org-on-heading-p) (outline-next-heading) (point))
((org-at-item-p) (org-end-of-item) (point))
(t nil))
c-on 0
c-off 0)
(when lim
;; find first checkbox for this cookie and gather
;; statistics from all that are at this indentation level
(goto-char startsearch)
(if (org-search-forward-unenclosed re-box lim t)
(progn
(goto-char (org-get-item-beginning))
(setq curr-ind (org-get-indentation))
(setq next-ind curr-ind)
(while (and (bolp) (org-at-item-p)
(if recursive
(<= curr-ind next-ind)
(= curr-ind next-ind)))
(setq eline (point-at-eol))
(if (org-search-forward-unenclosed re-box eline t)
(if (member (match-string 2) '("[ ]" "[-]"))
(setq c-off (1+ c-off))
(setq c-on (1+ c-on))))
(if (not recursive)
;; org-get-next-item goes through list-enders
;; with proper limit.
(goto-char (or (org-get-next-item (point) lim) lim))
(end-of-line)
(when (org-search-forward-unenclosed
org-item-beginning-re lim t)
(beginning-of-line)))
(setq next-ind (org-get-indentation)))))
(goto-char continue-from)
;; update cookie
(when end-cookie
(setq new (if is-percent
(format "[%d%%]" (/ (* 100 c-on)
(max 1 (+ c-on c-off))))
(format "[%d/%d]" c-on (+ c-on c-off))))
(goto-char beg-cookie)
(insert new)
(delete-region (point) (+ (point) (- end-cookie beg-cookie))))
;; update items checkbox if it has one
(when (org-at-item-p)
(goto-char (org-get-item-beginning))
(when (and (> (+ c-on c-off) 0)
(org-search-forward-unenclosed re-box (point-at-eol) t))
(setq beg-cookie (match-beginning 2)
end-cookie (match-end 2))
(delete-region beg-cookie end-cookie)
(goto-char beg-cookie)
(cond ((= c-off 0) (insert "[X]"))
((= c-on 0) (insert "[ ]"))
(t (insert "[-]")))
)))
(goto-char continue-from))
(let ((cstat 0))
(catch 'exit
(while t
(let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21
(beg (condition-case nil
(progn (org-back-to-heading) (point))
(error (point-min))))
(end (copy-marker (save-excursion
(outline-next-heading) (point))))
(re-cookie "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
(re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)")
beg-cookie end-cookie is-percent c-on c-off lim new
curr-ind next-ind continue-from startsearch list-beg list-end
(recursive
(or (not org-hierarchical-checkbox-statistics)
(string-match "\\<recursive\\>"
(or (ignore-errors
(org-entry-get nil "COOKIE_DATA"))
"")))))
(goto-char end)
;; find each statistics cookie
(while (and (org-search-backward-unenclosed re-cookie beg 'move)
(not (save-match-data
(and (org-on-heading-p)
(string-match "\\<todo\\>"
(downcase
(or (org-entry-get
nil "COOKIE_DATA")
"")))))))
(setq beg-cookie (match-beginning 1)
end-cookie (match-end 1)
cstat (+ cstat (if end-cookie 1 0))
startsearch (point-at-eol)
continue-from (match-beginning 0)
is-percent (match-beginning 2)
lim (cond
((org-on-heading-p) (outline-next-heading) (point))
;; Ensure many cookies in the same list won't imply
;; computing list boundaries as many times.
((org-at-item-p)
(unless (and list-beg (>= (point) list-beg))
(setq list-beg (org-list-top-point)
list-end (copy-marker
(org-list-bottom-point))))
(org-get-end-of-item list-end))
(t nil))
c-on 0
c-off 0)
(when lim
;; find first checkbox for this cookie and gather
;; statistics from all that are at this indentation level
(goto-char startsearch)
(if (org-search-forward-unenclosed re-box lim t)
(progn
(beginning-of-line)
(setq curr-ind (org-get-indentation))
(setq next-ind curr-ind)
(while (and (bolp) (org-at-item-p)
(if recursive
(<= curr-ind next-ind)
(= curr-ind next-ind)))
(when (org-at-item-checkbox-p)
(if (member (match-string 1) '("[ ]" "[-]"))
(setq c-off (1+ c-off))
(setq c-on (1+ c-on))))
(if (not recursive)
;; org-get-next-item goes through list-enders
;; with proper limit.
(goto-char (or (org-get-next-item (point) lim) lim))
(end-of-line)
(when (org-search-forward-unenclosed
org-item-beginning-re lim t)
(beginning-of-line)))
(setq next-ind (org-get-indentation)))))
(goto-char continue-from)
;; update cookie
(when end-cookie
(setq new (if is-percent
(format "[%d%%]" (/ (* 100 c-on)
(max 1 (+ c-on c-off))))
(format "[%d/%d]" c-on (+ c-on c-off))))
(goto-char beg-cookie)
(insert new)
(delete-region (point) (+ (point) (- end-cookie beg-cookie))))
;; update items checkbox if it has one
(when (and (org-at-item-checkbox-p)
(> (+ c-on c-off) 0))
(setq beg-cookie (match-beginning 1)
end-cookie (match-end 1))
(delete-region beg-cookie end-cookie)
(goto-char beg-cookie)
(cond ((= c-off 0) (insert "[X]"))
((= c-on 0) (insert "[ ]"))
(t (insert "[-]")))))
(goto-char continue-from)))
(unless (and all (outline-next-heading)) (throw 'exit nil))))
(when (interactive-p)
(message "Checkbox statistics updated %s (%d places)"
(if all "in entire file" "in current outline entry") cstat)))))
(message "Checkbox statistics updated %s (%d places)"
(if all "in entire file" "in current outline entry") cstat)))))
(defun org-get-checkbox-statistics-face ()
"Select the face for checkbox statistics.
@ -1907,8 +1898,7 @@ Otherwise it will be `org-todo'."
;;; Misc Tools
(defun org-apply-on-list (function init-value &rest args)
"Call FUNCTION for each item of a the list under point.
"Call FUNCTION on each item of the list at point.
FUNCTION must be called with at least one argument: INIT-VALUE,
that will contain the value returned by the function at the
previous item, plus ARGS extra arguments.
@ -1916,7 +1906,7 @@ previous item, plus ARGS extra arguments.
As an example, (org-apply-on-list (lambda (result) (1+ result)) 0)
will return the number of items in the current list.
Sublists of the list are skipped. Cursor is always at the
Sublists of the list are skipped. Cursor is always at the
beginning of the item."
(let* ((pos (copy-marker (point)))
(end (copy-marker (org-list-bottom-point)))
@ -2161,7 +2151,6 @@ this list."
(defun org-list-to-generic (list params)
"Convert a LIST parsed through `org-list-parse-list' to other formats.
Valid parameters PARAMS are
:ustart String to start an unordered list
@ -2217,7 +2206,7 @@ Valid parameters PARAMS are
(while (setq sublist (pop list))
(cond ((symbolp sublist) nil)
((stringp sublist)
(when (string-match "^\\(\\S-+\\)[ \t]+::" sublist)
(when (string-match "^\\(.*\\)[ \t]+::" sublist)
(setq term (org-trim (format (concat dtstart "%s" dtend)
(match-string 1 sublist))))
(setq sublist (concat ddstart

12
lisp/org-mew.el
View File

@ -81,7 +81,7 @@
(mew-case-folder (mew-sinfo-get-case)
(nth 1 (mew-refile-get msgnum)))
(mew-summary-folder-name)))
message-id from to subject desc link)
message-id from to subject desc link date date-ts date-ts-ia)
(save-window-excursion
(if (fboundp 'mew-summary-set-message-buffer)
(mew-summary-set-message-buffer folder-name msgnum)
@ -89,9 +89,19 @@
(setq message-id (mew-header-get-value "Message-Id:"))
(setq from (mew-header-get-value "From:"))
(setq to (mew-header-get-value "To:"))
(setq date (mew-header-get-value "Date:"))
(setq date-ts (and date (format-time-string
(org-time-stamp-format t)
(date-to-time date))))
(setq date-ts-ia (and date (format-time-string
(org-time-stamp-format t t)
(date-to-time date))))
(setq subject (mew-header-get-value "Subject:")))
(org-store-link-props :type "mew" :from from :to to
:subject subject :message-id message-id)
(when date
(org-add-link-props :date date :date-timestamp date-ts
:date-timestamp-inactive date-ts-ia))
(setq message-id (org-remove-angle-brackets message-id))
(setq desc (org-email-link-description))
(setq link (org-make-link "mew:" folder-name

21
lisp/org-mhe.el
View File

@ -83,13 +83,22 @@ supported by MH-E."
"Store a link to an MH-E folder or message."
(when (or (equal major-mode 'mh-folder-mode)
(equal major-mode 'mh-show-mode))
(let ((from (org-mhe-get-header "From:"))
(to (org-mhe-get-header "To:"))
(message-id (org-mhe-get-header "Message-Id:"))
(subject (org-mhe-get-header "Subject:"))
link desc)
(let* ((from (org-mhe-get-header "From:"))
(to (org-mhe-get-header "To:"))
(message-id (org-mhe-get-header "Message-Id:"))
(subject (org-mhe-get-header "Subject:"))
(date (org-mhe-get-header "Date:"))
(date-ts (and date (format-time-string
(org-time-stamp-format t) (date-to-time date))))
(date-ts-ia (and date (format-time-string
(org-time-stamp-format t t)
(date-to-time date))))
link desc)
(org-store-link-props :type "mh" :from from :to to
:subject subject :message-id message-id)
(when date
(org-add-link-props :date date :date-timestamp date-ts
:date-timestamp-inactive date-ts-ia))
(setq desc (org-email-link-description))
(setq link (org-make-link "mhe:" (org-mhe-get-message-real-folder) "#"
(org-remove-angle-brackets message-id)))
@ -181,7 +190,7 @@ you have a better idea of how to do this then please let us know."
(if (equal major-mode 'mh-folder-mode)
(mh-show)
(mh-show-show))
header-field)))
(org-trim header-field))))
(defun org-mhe-follow-link (folder article)
"Follow an MH-E link to FOLDER and ARTICLE.

59
lisp/org-mobile.el
View File

@ -90,12 +90,29 @@ You might want to put this file into a directory where only you have access."
This is a single password which is used for AES-256 encryption. The same
password must also be set in the MobileOrg application. All Org files,
including mobileorg.org will be encrypted using this password.
SECURITY CONSIDERATIONS:
Note that, when Org runs the encryption commands, the password could
be visible on your system with the `ps' command. So this method is only
intended to keep the files secure on the server, not on your own machine."
be visible briefly on your system with the `ps' command. So this method is
only intended to keep the files secure on the server, not on your own machine.
Also, if you set this variable in an init file (.emacs or .emacs.d/init.el
or custom.el...) and if that file is stored in a way so that other can read
it, this also limits the security of this approach. You can also leave
this variable empty - Org will then ask for the password once per Emacs
session."
:group 'org-mobile
:type '(string :tag "Password"))
(defvar org-mobile-encryption-password-session nil)
(defun org-mobile-encryption-password ()
(or (org-string-nw-p org-mobile-encryption-password)
(org-string-nw-p org-mobile-encryption-password-session)
(setq org-mobile-encryption-password-session
(read-passwd "Password for MobileOrg: " t))))
(defcustom org-mobile-inbox-for-pull "~/org/from-mobile.org"
"The file where captured notes and flags will be appended to.
During the execution of `org-mobile-pull', the file
@ -133,7 +150,7 @@ list a list of selection key(s) as string."
(string :tag "Selection Keys"))))
(defcustom org-mobile-force-id-on-agenda-items t
"Non-nil means make all agenda items carry and ID."
"Non-nil means make all agenda items carry an ID."
:group 'org-mobile
:type 'boolean)
@ -356,7 +373,7 @@ agenda view showing the flagged items."
(string-match "\\S-" org-mobile-checksum-binary))
(error "No executable found to compute checksums"))
(when org-mobile-use-encryption
(unless (string-match "\\S-" org-mobile-encryption-password)
(unless (string-match "\\S-" (org-mobile-encryption-password))
(error
"To use encryption, you must set `org-mobile-encryption-password'"))
(unless (file-writable-p org-mobile-encryption-tempfile)
@ -459,7 +476,10 @@ agenda view showing the flagged items."
(and (= (point-min) (point-max)) (insert "\n"))
(save-buffer)
(push (cons org-mobile-capture-file (md5 (buffer-string)))
org-mobile-checksum-files))
org-mobile-checksum-files)
(when org-mobile-use-encryption
(write-file org-mobile-encryption-tempfile)
(org-mobile-encrypt-and-move org-mobile-encryption-tempfile file)))
(kill-buffer buf)))
(defun org-mobile-write-checksums ()
@ -606,14 +626,30 @@ The table of checksums is written to the file mobile-checksums."
(if (org-bound-and-true-p
org-mobile-force-id-on-agenda-items)
(org-id-get m 'create)
(org-entry-get m "ID")))
(or (org-entry-get m "ID")
(org-mobile-get-outline-path-link m))))
(insert " :PROPERTIES:\n :ORIGINAL_ID: " id
"\n :END:\n")))))
(beginning-of-line 2))
(push (cons (file-name-nondirectory file) (md5 (buffer-string)))
(push (cons "agendas.org" (md5 (buffer-string)))
org-mobile-checksum-files))
(message "Agenda written to Org file %s" file)))
(defun org-mobile-get-outline-path-link (pom)
(org-with-point-at pom
(concat "olp:"
(org-mobile-escape-olp (file-name-nondirectory buffer-file-name))
"/"
(mapconcat 'org-mobile-escape-olp
(org-get-outline-path)
"/")
"/"
(org-mobile-escape-olp (nth 4 (org-heading-components))))))
(defun org-mobile-escape-olp (s)
(let ((table '((?: . "%3a") (?\[ . "%5b") (?\] . "%5d") (?/ . "%2f"))))
(org-link-escape s table)))
;;;###autoload
(defun org-mobile-create-sumo-agenda ()
"Create a file that contains all custom agenda views."
@ -649,7 +685,8 @@ encryption program does not understand them."
"Encrypt INFILE to OUTFILE, using `org-mobile-encryption-password'."
(shell-command
(format "openssl enc -aes-256-cbc -salt -pass %s -in %s -out %s"
(shell-quote-argument (concat "pass:" org-mobile-encryption-password))
(shell-quote-argument (concat "pass:"
(org-mobile-encryption-password)))
(shell-quote-argument (expand-file-name infile))
(shell-quote-argument (expand-file-name outfile)))))
@ -657,7 +694,8 @@ encryption program does not understand them."
"Decrypt INFILE to OUTFILE, using `org-mobile-encryption-password'."
(shell-command
(format "openssl enc -d -aes-256-cbc -salt -pass %s -in %s -out %s"
(shell-quote-argument (concat "pass:" org-mobile-encryption-password))
(shell-quote-argument (concat "pass:"
(org-mobile-encryption-password)))
(shell-quote-argument (expand-file-name infile))
(shell-quote-argument (expand-file-name outfile)))))
@ -673,7 +711,8 @@ If nothing new has been added, return nil."
(capture-buffer
(if (not org-mobile-use-encryption)
(find-file-noselect capture-file)
(delete-file org-mobile-encryption-tempfile)
(if (file-exists-p org-mobile-encryption-tempfile)
(delete-file org-mobile-encryption-tempfile))
(setq encfile (concat org-mobile-encryption-tempfile "_enc"))
(copy-file capture-file encfile)
(org-mobile-decrypt-file encfile org-mobile-encryption-tempfile)

14
lisp/org-mouse.el
View File

@ -148,6 +148,7 @@
(declare-function org-agenda-change-all-lines "org-agenda"
(newhead hdmarker &optional fixface just-this))
(declare-function org-verify-change-for-undo "org-agenda" (l1 l2))
(declare-function org-apply-on-list "org-list" (function init-value &rest args))
(defvar org-mouse-plain-list-regexp "\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) "
"Regular expression that matches a plain list.")
@ -576,14 +577,11 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
(goto-char (second contextdata))
(re-search-forward ".*" (third contextdata))))))
(defun org-mouse-for-each-item (function)
(save-excursion
(ignore-errors
(while t (org-previous-item)))
(ignore-errors
(while t
(funcall function)
(org-next-item)))))
(defun org-mouse-for-each-item (funct)
;; Functions called by `org-apply-on-list' need an argument
(let ((wrap-fun (lambda (c) (funcall funct))))
(when (org-in-item-p)
(org-apply-on-list wrap-fun nil))))
(defun org-mouse-bolp ()
"Return true if there only spaces, tabs, and '*' before point.

13
lisp/org-publish.el
View File

@ -578,10 +578,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)))
@ -601,13 +601,13 @@ See `org-publish-projects'."
(error "File %s not part of any known project"
(abbreviate-file-name filename)))))
(project-plist (cdr project))
(ftname (file-truename filename))
(ftname (expand-file-name filename))
(publishing-function
(or (plist-get project-plist :publishing-function)
'org-publish-org-to-html))
(base-dir
(file-name-as-directory
(file-truename
(expand-file-name
(or (plist-get project-plist :base-directory)
(error "Project %s does not have :base-directory defined"
(car project))))))
@ -794,7 +794,6 @@ directory and force publishing all files."
(interactive "P")
(when force
(org-publish-remove-all-timestamps))
;; (org-publish-initialize-files-alist force)
(save-window-excursion
(let ((org-publish-use-timestamps-flag
(if force nil org-publish-use-timestamps-flag)))

5
lisp/org-remember.el
View File

@ -157,7 +157,7 @@ Furthermore, the following %-escapes will be replaced with content:
Apart from these general escapes, you can access information specific to the
link type that is created. For example, calling `remember' in emails or gnus
will record the author and the subject of the message, which you can access
with %:author and %:subject, respectively. Here is a complete list of what
with %:fromname and %:subject, respectively. Here is a complete list of what
is recorded for each link type.
Link type | Available information
@ -167,7 +167,8 @@ vm, wl, mh, rmail | %:type %:subject %:message-id
| %:from %:fromname %:fromaddress
| %:to %:toname %:toaddress
| %:fromto (either \"to NAME\" or \"from NAME\")
gnus | %:group, for messages also all email fields
gnus | %:group, for messages also all email fields and
| %:org-date (the Date: header in Org format)
w3, w3m | %:type %:url
info | %:type %:file %:node
calendar | %:type %:date"

10
lisp/org-rmail.el
View File

@ -59,10 +59,20 @@
(from (mail-fetch-field "from"))
(to (mail-fetch-field "to"))
(subject (mail-fetch-field "subject"))
(date (mail-fetch-field "date"))
(date-ts (and date (format-time-string
(org-time-stamp-format t)
(date-to-time date))))
(date-ts-ia (and date (format-time-string
(org-time-stamp-format t t)
(date-to-time date))))
desc link)
(org-store-link-props
:type "rmail" :from from :to to
:subject subject :message-id message-id)
(when date
(org-add-link-props :date date :date-timestamp date-ts
:date-timestamp-inactive date-ts-ia))
(setq message-id (org-remove-angle-brackets message-id))
(setq desc (org-email-link-description))
(setq link (org-make-link "rmail:" folder "#" message-id))

50
lisp/org-src.el
View File

@ -109,6 +109,10 @@ editing it with \\[org-edit-src-code]. Has no effect if
:group 'org-edit-structure
:type 'integer)
(defvar org-src-strip-leading-and-trailing-blank-lines nil
"If non-nil, blank lines are removed when exiting the code edit
buffer.")
(defcustom org-edit-src-persistent-message t
"Non-nil means show persistent exit help message while editing src examples.
The message is shown in the header-line, which will be created in the
@ -207,8 +211,7 @@ buffer."
(interactive)
(unless (eq context 'save)
(setq org-edit-src-saved-temp-window-config (current-window-configuration)))
(let ((line (org-current-line))
(col (current-column))
(let ((mark (and (use-region-p) (mark)))
(case-fold-search t)
(info (org-edit-src-find-region-and-lang))
(babel-info (org-babel-get-src-block-info))
@ -217,7 +220,8 @@ buffer."
(end (make-marker))
(preserve-indentation org-src-preserve-indentation)
(allow-write-back-p (null code))
block-nindent total-nindent ovl lang lang-f single lfmt begline buffer msg)
block-nindent total-nindent ovl lang lang-f single lfmt buffer msg
begline markline markcol line col)
(if (not info)
nil
(setq beg (move-marker beg (nth 0 info))
@ -235,6 +239,10 @@ buffer."
block-nindent (nth 5 info)
lang-f (intern (concat lang "-mode"))
begline (save-excursion (goto-char beg) (org-current-line)))
(if (and mark (>= mark beg) (<= mark end))
(save-excursion (goto-char mark)
(setq markline (org-current-line)
markcol (current-column))))
(if (equal lang-f 'table.el-mode)
(setq lang-f (lambda ()
(text-mode)
@ -244,7 +252,10 @@ buffer."
(org-set-local 'org-edit-src-content-indentation 0))))
(unless (functionp lang-f)
(error "No such language mode: %s" lang-f))
(org-goto-line line)
(save-excursion
(if (> (point) end) (goto-char end))
(setq line (org-current-line)
col (current-column)))
(if (and (setq buffer (org-edit-src-find-buffer beg end))
(if org-src-ask-before-returning-to-edit-buffer
(y-or-n-p "Return to existing edit buffer? [n] will revert changes: ") t))
@ -276,7 +287,10 @@ buffer."
(unless preserve-indentation
(setq total-nindent (or (org-do-remove-indentation) 0)))
(let ((org-inhibit-startup t))
(funcall lang-f))
(condition-case e
(funcall lang-f)
(error
(error "Language mode `%s' fails with: %S" lang-f (nth 1 e)))))
(set (make-local-variable 'org-edit-src-force-single-line) single)
(set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p)
(set (make-local-variable 'org-edit-src-allow-write-back-p) allow-write-back-p)
@ -290,6 +304,12 @@ buffer."
(while (re-search-forward "^," nil t)
(if (eq (org-current-line) line) (setq total-nindent (1+ total-nindent)))
(replace-match "")))
(when markline
(org-goto-line (1+ (- markline begline)))
(org-move-to-column
(if preserve-indentation markcol (max 0 (- markcol total-nindent))))
(push-mark (point) 'no-message t)
(setq deactivate-mark nil))
(org-goto-line (1+ (- line begline)))
(org-move-to-column
(if preserve-indentation col (max 0 (- col total-nindent))))
@ -565,11 +585,12 @@ the language, a switch telling if the content should be in a single line."
(delta 0) code line col indent)
(when allow-write-back-p
(unless preserve-indentation (untabify (point-min) (point-max)))
(save-excursion
(goto-char (point-min))
(if (looking-at "[ \t\n]*\n") (replace-match ""))
(unless macro
(if (re-search-forward "\n[ \t\n]*\\'" nil t) (replace-match "")))))
(if org-src-strip-leading-and-trailing-blank-lines
(save-excursion
(goto-char (point-min))
(if (looking-at "[ \t\n]*\n") (replace-match ""))
(unless macro
(if (re-search-forward "\n[ \t\n]*\\'" nil t) (replace-match ""))))))
(setq line (if (org-bound-and-true-p org-edit-src-force-single-line)
1
(org-current-line))
@ -715,16 +736,19 @@ Org-babel commands."
(call-interactively
(lookup-key org-babel-map key)))))
(defvar org-src-tab-acts-natively nil
(defcustom org-src-tab-acts-natively nil
"If non-nil, the effect of TAB in a code block is as if it were
issued in the language major mode buffer.")
issued in the language major mode buffer."
:type 'boolean
:group 'org-babel)
(defun org-src-native-tab-command-maybe ()
"Perform language-specific TAB action.
Alter code block according to effect of TAB in the language major
mode."
(and org-src-tab-acts-natively
(org-babel-do-key-sequence-in-edit-buffer (kbd "TAB"))))
(let ((org-src-strip-leading-and-trailing-blank-lines nil))
(org-babel-do-key-sequence-in-edit-buffer (kbd "TAB")))))
(add-hook 'org-tab-first-hook 'org-src-native-tab-command-maybe)

3
lisp/org-table.el
View File

@ -1151,11 +1151,14 @@ is always the old value."
(defun org-table-current-column ()
"Find out which column we are in."
(interactive)
(if (interactive-p) (org-table-check-inside-data-field))
(save-excursion
(let ((cnt 0) (pos (point)))
(beginning-of-line 1)
(while (search-forward "|" pos t)
(setq cnt (1+ cnt)))
(if (interactive-p) (message "In table column %d" cnt))
cnt)))
(defun org-table-current-dline ()

7
lisp/org-timer.el
View File

@ -31,7 +31,7 @@
(require 'org)
(declare-function org-show-notification "org-clock" (parameters))
(declare-function org-notify "org-clock" (notification &optional play-sound))
(declare-function org-agenda-error "org-agenda" ())
(defvar org-timer-start-time nil
@ -322,10 +322,6 @@ VALUE can be `on', `off', or `pause'."
(message "%d minute(s) %d seconds left before next time out"
rmins rsecs))))
(defun bzg-test (&optional test)
(interactive "P")
test)
;;;###autoload
(defun org-timer-set-timer (&optional opt)
"Prompt for a duration and set a timer.
@ -378,6 +374,7 @@ replace any running timer."
(y-or-n-p "Replace current timer? ")))
(not org-timer-current-timer))
(progn
(require 'org-clock)
(when org-timer-current-timer
(cancel-timer org-timer-current-timer))
(setq org-timer-current-timer

10
lisp/org-vm.el
View File

@ -66,9 +66,19 @@
(to (vm-get-header-contents message "To"))
(from (vm-get-header-contents message "From"))
(message-id (vm-su-message-id message))
(date (vm-get-header-contents message "Date"))
(date-ts (and date (format-time-string
(org-time-stamp-format t)
(date-to-time date))))
(date-ts-ia (and date (format-time-string
(org-time-stamp-format t t)
(date-to-time date))))
desc link)
(org-store-link-props :type "vm" :from from :to to :subject subject
:message-id message-id)
(when date
(org-add-link-props :date date :date-timestamp date-ts
:date-timestamp-inactive date-ts-ia))
(setq message-id (org-remove-angle-brackets message-id))
(setq folder (abbreviate-file-name folder))
(if (and vm-folder-directory

38
lisp/org-wl.el
View File

@ -84,6 +84,8 @@ googlegroups otherwise."
(declare-function wl-summary-buffer-msgdb "ext:wl-folder" () t)
(declare-function wl-summary-jump-to-msg-by-message-id "ext:wl-summary"
(&optional id))
(declare-function wl-summary-jump-to-msg "ext:wl-summary"
(&optional number beg end))
(declare-function wl-summary-line-from "ext:wl-summary" ())
(declare-function wl-summary-line-subject "ext:wl-summary" ())
(declare-function wl-summary-message-number "ext:wl-summary" ())
@ -100,6 +102,7 @@ googlegroups otherwise."
(defvar wl-summary-buffer-folder-name)
(defvar wl-folder-group-regexp)
(defvar wl-auto-check-folder-name)
(defvar elmo-nntp-default-server)
(defconst org-wl-folder-types
'(("%" . imap) ("-" . nntp) ("+" . mh) ("=" . spool)
@ -137,7 +140,7 @@ folder name determines the the folder type."
"Return content of FIELD in ENTITY.
FIELD is a symbol of a rfc822 message header field.
ENTITY is a message entity."
(let ((content (elmo-message-entity-field entity field)))
(let ((content (elmo-message-entity-field entity field 'string)))
(if (listp content) (car content) content)))
(defun org-wl-store-link ()
@ -196,6 +199,13 @@ ENTITY is a message entity."
(to (org-wl-message-field 'to wl-message-entity))
(xref (org-wl-message-field 'xref wl-message-entity))
(subject (org-wl-message-field 'subject wl-message-entity))
(date (org-wl-message-field 'date wl-message-entity))
(date-ts (and date (format-time-string
(org-time-stamp-format t)
(date-to-time date))))
(date-ts-ia (and date (format-time-string
(org-time-stamp-format t t)
(date-to-time date))))
desc link)
;; remove text properties of subject string to avoid possible bug
@ -235,8 +245,26 @@ ENTITY is a message entity."
(setq desc (org-email-link-description))
(setq link (org-make-link "wl:" folder-name "#" message-id-no-brackets))
(org-add-link-props :link link :description desc)))
(when date
(org-add-link-props :date date :date-timestamp date-ts
:date-timestamp-inactive date-ts-ia))
(or link xref)))))))
(defun org-wl-open-nntp (path)
"Follow the nntp: link specified by PATH."
(let* ((spec (split-string path "/"))
(server (split-string (nth 2 spec) "@"))
(group (nth 3 spec))
(article (nth 4 spec)))
(org-wl-open
(concat "-" group ":" (if (cdr server)
(car (split-string (car server) ":"))
"")
(if (string= elmo-nntp-default-server (nth 2 spec))
""
(concat "@" (or (cdr server) (car server))))
(if article (concat "#" article) "")))))
(defun org-wl-open (path)
"Follow the WL message link specified by PATH.
When called with one prefix, open message in namazu search folder
@ -272,8 +300,12 @@ for namazu index."
;; beginning of the current line. So, restore the point
;; in the old buffer.
(goto-char old-point))
(and article (wl-summary-jump-to-msg-by-message-id (org-add-angle-brackets
article))
(when article
(if (org-string-match-p "@" article)
(wl-summary-jump-to-msg-by-message-id (org-add-angle-brackets
article))
(or (wl-summary-jump-to-msg (string-to-number article))
(error "No such message: %s" article)))
(wl-summary-redisplay))))))
(provide 'org-wl)

228
lisp/org.el
View File

@ -471,6 +471,15 @@ the following lines anywhere in the buffer:
:group 'org-startup
:type 'boolean)
(defcustom org-startup-with-inline-images nil
"Non-nil means show inline images when loading a new Org file.
This can also be configured on a per-file basis by adding one of
the following lines anywhere in the buffer:
#+STARTUP: inlineimages
#+STARTUP: noinlineimages"
:group 'org-startup
:type 'boolean)
(defcustom org-insert-mode-line-in-empty-file nil
"Non-nil means insert the first line setting Org-mode in empty files.
When the function `org-mode' is called interactively in an empty file, this
@ -1067,9 +1076,13 @@ for the duration of the command."
(plain-list-item . auto))
"Should `org-insert-heading' leave a blank line before new heading/item?
The value is an alist, with `heading' and `plain-list-item' as car,
and a boolean flag as cdr. For plain lists, if the variable
`org-empty-line-terminates-plain-lists' is set, the setting here
is ignored and no empty line is inserted, to keep the list in tact."
and a boolean flag as cdr. The cdr may lso be the symbol `auto', and then
Org will look at the surrounding headings/items and try to make an
intelligent decision wether to insert a blank line or not.
For plain lists, if the variable `org-empty-line-terminates-plain-lists' is
set, the setting here is ignored and no empty line is inserted, to avoid
breaking the list structure."
:group 'org-edit-structure
:type '(list
(cons (const heading)
@ -4148,6 +4161,8 @@ After a match, the following groups carry important information:
("oddeven" org-odd-levels-only nil)
("align" org-startup-align-all-tables t)
("noalign" org-startup-align-all-tables nil)
("inlineimages" org-startup-with-inline-images t)
("noinlineimages" org-startup-with-inline-images nil)
("customtime" org-display-custom-times t)
("logdone" org-log-done time)
("lognotedone" org-log-done note)
@ -4718,6 +4733,8 @@ The following commands are available:
(let ((bmp (buffer-modified-p)))
(org-table-map-tables 'org-table-align 'quietly)
(set-buffer-modified-p bmp)))
(when org-startup-with-inline-images
(org-display-inline-images))
(when org-startup-indented
(require 'org-indent)
(org-indent-mode 1))
@ -4755,7 +4772,7 @@ The following commands are available:
(defconst org-non-link-chars "]\t\n\r<>")
(defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news"
"shell" "elisp" "doi"))
"shell" "elisp" "doi" "message"))
(defvar org-link-types-re nil
"Matches a link that has a url-like prefix like \"http:\"")
(defvar org-link-re-with-space nil
@ -5022,8 +5039,11 @@ will be prompted for."
'(display t invisible t intangible t))
t)))
(defvar org-src-fontify-natively t
"When non-nil, fontify code in code blocks.")
(defcustom org-src-fontify-natively nil
"When non-nil, fontify code in code blocks."
:type 'boolean
:group 'org-appearance
:group 'org-babel)
(defun org-fontify-meta-lines-and-blocks (limit)
"Fontify #+ lines and blocks, in the correct ways."
@ -6235,8 +6255,8 @@ Optional argument N means put the headline into the Nth line of the window."
(defun org-outline-overlay-data (&optional use-markers)
"Return a list of the locations of all outline overlays.
The are overlays with the `invisible' property value `outline'.
The return values is a list of cons cells, with start and stop
These are overlays with the `invisible' property value `outline'.
The return value is a list of cons cells, with start and stop
positions for each overlay.
If USE-MARKERS is set, return the positions as markers."
(let (beg end)
@ -6670,7 +6690,9 @@ This is important for non-interactive uses of the command."
(and (not (save-excursion (and (ignore-errors (org-back-to-heading invisible-ok))
(org-on-heading-p))))
(not (org-in-item-p))))
(insert "\n* ")
(progn
(insert "\n* ")
(run-hooks 'org-insert-heading-hook))
(when (or force-heading (not (org-insert-item)))
(let* ((empty-line-p nil)
(head (save-excursion
@ -8141,11 +8163,13 @@ It should be a function accepting three arguments:
path the path of the link, the text after the prefix (like \"http:\")
desc the description of the link, if any, nil if there was no description
format the export format, a symbol like `html' or `latex'.
format the export format, a symbol like `html' or `latex' or `ascii'..
The function may use the FORMAT information to return different values
depending on the format. The return value will be put literally into
the exported file.
the exported file. If the return value is nil, this means Org should
do what it normally does with links which do not have EXPORT defined.
Org-mode has a built-in default for exporting links. If you are happy with
this default, there is no need to define an export function for the link
type. For a simple example of an export function, see `org-bbdb.el'."
@ -8417,8 +8441,6 @@ according to FMT (default from `org-email-link-description-format')."
(setq s (replace-match "" t t s)))
(while (string-match org-ts-regexp s)
(setq s (replace-match "" t t s))))
(while (string-match "[^a-zA-Z_0-9 \t]+" s)
(setq s (replace-match " " t t s)))
(or string (setq s (concat "*" s))) ; Add * for headlines
(mapconcat 'identity (org-split-string s "[ \t]+") " ")))
@ -8446,7 +8468,11 @@ according to FMT (default from `org-email-link-description-format')."
(when (and (not description)
(not (equal link (org-link-escape link))))
(setq description (org-extract-attributes link)))
(concat "[[" (org-link-escape link) "]"
(setq link (if (string-match org-link-types-re link)
(concat (match-string 1 link)
(org-link-escape (substring link (match-end 1))))
(org-link-escape link)))
(concat "[[" link "]"
(if description (concat "[" description "]") "")
"]"))
@ -10456,7 +10482,7 @@ This function can be used in a hook."
"BEGIN_VERSE" "END_VERSE"
"BEGIN_CENTER" "END_CENTER"
"BEGIN_SRC" "END_SRC"
"CATEGORY" "COLUMNS"
"CATEGORY" "COLUMNS" "PROPERTY"
"CAPTION" "LABEL"
"SETUPFILE"
"BIND"
@ -10575,8 +10601,10 @@ At all other locations, this simply calls the value of
(throw 'exit t)))
(tag (and (equal (char-before beg1) ?:)
(equal (char-after (point-at-bol)) ?*)))
(prop (and (equal (char-before beg1) ?:)
(not (equal (char-after (point-at-bol)) ?*))))
(prop (or (and (equal (char-before beg1) ?:)
(not (equal (char-after (point-at-bol)) ?*)))
(string-match "^#\\+PROPERTY:.*"
(buffer-substring (point-at-bol) (point)))))
(texp (equal (char-before beg) ?\\))
(link (equal (char-before beg) ?\[))
(opt (equal (buffer-substring (max (point-at-bol) (- beg 2))
@ -10653,7 +10681,10 @@ At all other locations, this simply calls the value of
(delete-window (get-buffer-window "*Completions*")))
(if (assoc completion table)
(if (eq type :todo) (insert " ")
(if (memq type '(:tag :prop)) (insert ":"))))
(if (and (memq type '(:tag :prop))
(not (string-match "^#[ \t]*\\+property:"
(org-current-line-string t))))
(insert ":"))))
(if (and (equal type :opt) (assoc completion table))
(message "%s" (substitute-command-keys
"Press \\[org-complete] again to insert example settings"))))
@ -10691,27 +10722,6 @@ this is nil.")
(defvar org-setting-tags nil) ; dynamically skipped
(defun org-parse-local-options (string var)
"Parse STRING for startup setting relevant for variable VAR."
(let ((rtn (symbol-value var))
e opts)
(save-match-data
(if (or (not string) (not (string-match "\\S-" string)))
rtn
(setq opts (delq nil (mapcar (lambda (x)
(setq e (assoc x org-startup-options))
(if (eq (nth 1 e) var) e nil))
(org-split-string string "[ \t]+"))))
(if (not opts)
rtn
(setq rtn nil)
(while (setq e (pop opts))
(if (not (nth 3 e))
(setq rtn (nth 2 e))
(if (not (listp rtn)) (setq rtn nil))
(push (nth 2 e) rtn)))
rtn)))))
(defvar org-todo-setup-filter-hook nil
"Hook for functions that pre-filter todo specs.
Each function takes a todo spec and returns either nil or the spec
@ -11770,10 +11780,11 @@ EXTRA is additional text that will be inserted into the notes buffer."
(defun org-skip-over-state-notes ()
"Skip past the list of State notes in an entry."
(if (looking-at "\n[ \t]*- State") (forward-char 1))
(while (looking-at "[ \t]*- State")
(condition-case nil
(org-next-item)
(error (org-end-of-item)))))
(when (org-in-item-p)
(let ((limit (org-list-bottom-point)))
(while (looking-at "[ \t]*- State")
(goto-char (or (org-get-next-item (point) limit)
(org-get-end-of-item limit)))))))
(defun org-add-log-note (&optional purpose)
"Pop up a window for taking a note, and add this note later at point."
@ -11818,7 +11829,7 @@ EXTRA is additional text that will be inserted into the notes buffer."
"Finish taking a log note, and insert it to where it belongs."
(let ((txt (buffer-string))
(note (cdr (assq org-log-note-purpose org-log-note-headings)))
lines ind)
lines ind bul)
(kill-buffer (current-buffer))
(while (string-match "\\`#.*\n[ \t\n]*" txt)
(setq txt (replace-match "" t t txt)))
@ -11858,13 +11869,26 @@ EXTRA is additional text that will be inserted into the notes buffer."
(move-marker org-log-note-marker nil)
(end-of-line 1)
(if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n")))
(org-indent-line-function)
(insert "- " (pop lines))
(beginning-of-line 1)
(looking-at "[ \t]*")
(setq ind (concat (match-string 0) " "))
(end-of-line 1)
(while lines (insert "\n" ind (pop lines)))
(setq ind (save-excursion
(if (org-in-item-p)
(progn
(goto-char (org-list-top-point))
(org-get-indentation))
(skip-chars-backward " \r\t\n")
(cond
((and (org-at-heading-p)
org-adapt-indentation)
(1+ (org-current-level)))
((org-at-heading-p) 0)
(t (org-get-indentation))))))
(setq bul (org-list-bullet-string "-"))
(org-indent-line-to ind)
(insert bul (pop lines))
(let ((ind-body (+ (length bul) ind)))
(while lines
(insert "\n")
(org-indent-line-to ind-body)
(insert (pop lines))))
(message "Note stored")
(org-back-to-heading t)
(org-cycle-hide-drawers 'children)))))
@ -12102,7 +12126,8 @@ ACTION can be `set', `up', `down', or a character."
(setq new action)
(message "Priority %c-%c, SPC to remove: "
org-highest-priority org-lowest-priority)
(setq new (read-char-exclusive)))
(save-match-data
(setq new (read-char-exclusive))))
(if (and (= (upcase org-highest-priority) org-highest-priority)
(= (upcase org-lowest-priority) org-lowest-priority))
(setq new (upcase new)))
@ -12748,8 +12773,10 @@ With prefix ARG, realign all tags in headings in the current buffer."
(save-excursion
(setq table (append org-tag-persistent-alist
(or org-tag-alist (org-get-buffer-tags))
(and org-complete-tags-always-offer-all-agenda-tags
(org-global-tags-completion-table (org-agenda-files))))
(and
org-complete-tags-always-offer-all-agenda-tags
(org-global-tags-completion-table
(org-agenda-files))))
org-last-tags-completion-table table
current-tags (org-split-string current ":")
inherited-tags (nreverse
@ -12761,19 +12788,24 @@ With prefix ARG, realign all tags in headings in the current buffer."
(delq nil (mapcar 'cdr table))))
(org-fast-tag-selection
current-tags inherited-tags table
(if org-fast-tag-selection-include-todo org-todo-key-alist))
(if org-fast-tag-selection-include-todo
org-todo-key-alist))
(let ((org-add-colon-after-tag-completion t))
(org-trim
(org-without-partial-completion
(org-icompleting-read "Tags: " 'org-tags-completion-function
(org-icompleting-read "Tags: "
'org-tags-completion-function
nil nil current 'org-tags-history)))))))
(while (string-match "[-+&]+" tags)
;; No boolean logic, just a list
(setq tags (replace-match ":" t t tags))))
(setq tags (replace-regexp-in-string "[ ,]" ":" tags))
(if org-tags-sort-function
(setq tags (mapconcat 'identity
(sort (org-split-string tags (org-re "[^[:alnum:]_@#%]+"))
(sort (org-split-string
tags (org-re "[^[:alnum:]_@#%]+"))
org-tags-sort-function) ":")))
(if (string-match "\\`[\t ]*\\'" tags)
@ -12853,7 +12885,7 @@ This works in the agenda, and also in an org-mode buffer."
(defun org-tags-completion-function (string predicate &optional flag)
(let (s1 s2 rtn (ctable org-last-tags-completion-table)
(confirm (lambda (x) (stringp (car x)))))
(if (string-match "^\\(.*[-+:&|]\\)\\([^-+:&|]*\\)$" string)
(if (string-match "^\\(.*[-+:&,|]\\)\\([^-+:&,|]*\\)$" string)
(setq s1 (match-string 1 string)
s2 (match-string 2 string))
(setq s1 "" s2 string))
@ -14584,9 +14616,10 @@ user function argument order change dependent on argument order."
(list arg2 arg1 arg3))
((eq calendar-date-style 'iso)
(list arg2 arg3 arg1)))
(if (org-bound-and-true-p european-calendar-style)
(list arg2 arg1 arg3)
(list arg1 arg2 arg3))))
(with-no-warnings ;; european-calendar-style is obsolete as of version 23.1
(if (org-bound-and-true-p european-calendar-style)
(list arg2 arg1 arg3)
(list arg1 arg2 arg3)))))
(defun org-eval-in-calendar (form &optional keepdate)
"Eval FORM in the calendar window and return to current window.
@ -16385,6 +16418,7 @@ BEG and END default to the buffer boundaries."
(org-defkey org-mode-map "\C-c\C-x." 'org-timer)
(org-defkey org-mode-map "\C-c\C-x-" 'org-timer-item)
(org-defkey org-mode-map "\C-c\C-x0" 'org-timer-start)
(org-defkey org-mode-map "\C-c\C-x_" 'org-timer-stop)
(org-defkey org-mode-map "\C-c\C-x," 'org-timer-pause-or-continue)
(define-key org-mode-map "\C-c\C-x\C-c" 'org-columns)
@ -16493,6 +16527,40 @@ If not, return to the original position and throw an error."
(defvar org-table-auto-blank-field) ; defined in org-table.el
(defvar org-speed-command nil)
(defun org-speed-command-default-hook (keys)
"Hook for activating single-letter speed commands.
`org-speed-commands-default' specifies a minimal command set. Use
`org-speed-commands-user' for further customization."
(when (or (and (bolp) (looking-at outline-regexp))
(and (functionp org-use-speed-commands)
(funcall org-use-speed-commands)))
(cdr (assoc keys (append org-speed-commands-user
org-speed-commands-default)))))
(defun org-babel-speed-command-hook (keys)
"Hook for activating single-letter code block commands."
(when (and (bolp) (looking-at org-babel-src-block-regexp))
(cdr (assoc keys org-babel-key-bindings))))
(defcustom org-speed-command-hook
'(org-speed-command-default-hook org-babel-speed-command-hook)
"Hook for activating speed commands at strategic locations.
Hook functions are called in sequence until a valid handler is
found.
Each hook takes a single argument, a user-pressed command key
which is also a `self-insert-command' from the global map.
Within the hook, examine the cursor position and the command key
and return nil or a valid handler as appropriate. Handler could
be one of an interactive command, a function, or a form.
Set `org-use-speed-commands' to non-nil value to enable this
hook. The default setting is `org-speed-command-default-hook'."
:group 'org-structure
:type 'hook)
(defun org-self-insert-command (N)
"Like `self-insert-command', use overwrite-mode for whitespace in tables.
If the cursor is in a table looking at whitespace, the whitespace is
@ -16500,13 +16568,9 @@ overwritten, and the table is not marked as requiring realignment."
(interactive "p")
(cond
((and org-use-speed-commands
(or (and (bolp) (looking-at outline-regexp))
(and (functionp org-use-speed-commands)
(funcall org-use-speed-commands)))
(setq
org-speed-command
(or (cdr (assoc (this-command-keys) org-speed-commands-user))
(cdr (assoc (this-command-keys) org-speed-commands-default)))))
(setq org-speed-command
(run-hook-with-args-until-success
'org-speed-command-hook (this-command-keys))))
(cond
((commandp org-speed-command)
(setq this-command org-speed-command)
@ -16573,9 +16637,11 @@ because, in this case the deletion might narrow the column."
(noalign (looking-at "[^|\n\r]* |"))
(c org-table-may-need-update))
(backward-delete-char N)
(skip-chars-forward "^|")
(insert " ")
(goto-char (1- pos))
(if (not overwrite-mode)
(progn
(skip-chars-forward "^|")
(insert " ")
(goto-char (1- pos))))
;; noalign: if there were two spaces at the end, this field
;; does not determine the width of the column.
(if noalign (setq org-table-may-need-update c)))
@ -18244,7 +18310,7 @@ really on, so that the block visually is on the match."
nil))))
(defun org-in-regexps-block-p (start-re end-re &optional bound)
"Returns t if the current point is between matches of START-RE and END-RE.
"Return t if the current point is between matches of START-RE and END-RE.
This will also return t if point is on one of the two matches or
in an unfinished block. END-RE can be a string or a form
returning a string.
@ -18567,7 +18633,7 @@ which make use of the date at the cursor."
;; Lists
((org-in-item-p)
(org-beginning-of-item)
(looking-at "[ \t]*\\(\\S-+\\)[ \t]*\\(\\[[- X]\\][ \t]*\\|.*? :: \\)?")
(looking-at "[ \t]*\\(\\S-+\\)[ \t]*\\(\\(:?\\[@\\(:?start:\\)?[0-9]+\\][ \t]*\\)?\\[[- X]\\][ \t]*\\|.*? :: \\)?")
(setq bpos (match-beginning 1) tpos (match-end 0)
bcol (progn (goto-char bpos) (current-column))
tcol (progn (goto-char tpos) (current-column))
@ -19176,6 +19242,18 @@ move point."
(while (org-goto-sibling 'previous)
(org-flag-heading nil))))
(defun org-goto-first-child ()
"Goto the first child, even if it is invisible.
Return t when a child was found. Otherwise don't move point and
return nil."
(let (level (pos (point)) (re (concat "^" outline-regexp)))
(when (condition-case nil (org-back-to-heading t) (error nil))
(setq level (outline-level))
(forward-char 1)
(if (and (re-search-forward re nil t) (> (outline-level) level))
(progn (goto-char (match-beginning 0)) t)
(goto-char pos) nil))))
(defun org-show-hidden-entry ()
"Show an entry where even the heading is hidden."
(save-excursion
@ -19267,7 +19345,9 @@ If there is no such heading, return nil."
(defun org-forward-same-level (arg &optional invisible-ok)
"Move forward to the arg'th subheading at same level as this one.
Stop at the first and last subheadings of a superior heading."
Stop at the first and last subheadings of a superior heading.
Normally this only looks at visible headings, but when INVISIBLE-OK is non-nil
it wil also look at invisible ones."
(interactive "p")
(org-back-to-heading invisible-ok)
(org-on-heading-p)

50
testing/README.org Normal file
View File

@ -0,0 +1,50 @@
#+Title: Org-mode Testing
#+Babel: results silent
The following instructions describe how to get started using the
Org-mode test framework.
1) Install the ERT and jump.el testing dependencies which are included
as git submodules in the org-mode repository. To do so run the
following git submodule commands from inside the base of the
Org-mode directory (or just execute the following code block).
#+begin_src sh
cd ..
git submodule init
git submodule update
#+end_src
2) Load the [[file:org-test.el][org-test.el]] file
#+begin_src emacs-lisp
(load-file "org-test.el")
#+end_src
3) The =org-test-jump= command is now bound to =M-C-j= in all
emacs-lisp files. Call this command from any file in the =lisp/=
directory of the org-mode repository to jump to the related test
file in the =testing/= directory. Call this functions with a
prefix argument, and the corresponding test file will be stubbed
out if it doesn't already exist.
4) Review the ERT documentation, to do this run =makeinfo= in the
=testing/ert= directory,
#+begin_src sh
cd ert
makeinfo ert.texinfo
#+end_src
then browse the [[elisp:(info (expand-file-name "ert/ert.info"))][resulting info file]].
5) A number of org-mode-specific functions and macros are provided in
=org-test.el= see the [[file:org-test.el::%3B%3B%3B%20Functions%20for%20writing%20tests][;;; Functions for Writing Tests]] subsection of
that file. Some of these functions make use of example org-mode
files located in the [[file:examples][examples/]] directory.
6) Functions for loading and running the Org-mode tests are provided
in the [[file:org-test.el::%3B%3B%3B%20Load%20and%20Run%20tests][;;; Load and Run Tests]] subsection, the most important of
which are
- =org-test-load= which loads the entire Org-mode test suite
- =org-test-current-defun= which runs all tests for the current
function around point (should be called from inside of an
Org-mode elisp file)
- =org-test-run-all-tests= which runs the entire Org-mode test suite
- also note that the =ert= command can also be used to run tests

1
testing/contrib/lisp/.gitignore vendored Normal file
View File

@ -0,0 +1 @@
# this file ensures that the testing/contrib/lisp directory is created by git

1
testing/ert Submodule

@ -0,0 +1 @@
Subproject commit 87b475f856ab6eab479b439b911c5e0c23918a36

29
testing/examples/babel.org Normal file
View File

@ -0,0 +1,29 @@
#+Title: a collection of examples for Babel tests
* =:noweb= header argument expansion
:PROPERTIES:
:ID: eb1f6498-5bd9-45e0-9c56-50717053e7b7
:END:
#+source: noweb-example
#+begin_src emacs-lisp
(message "expanded")
#+end_src
#+begin_src emacs-lisp :noweb yes
;; noweb-yes-start
<<noweb-example>>
;; noweb-yes-end
#+end_src
#+begin_src emacs-lisp :noweb no
;; noweb-no-start
<<noweb-example>>
;; noweb-no-end
#+end_src
#+begin_src emacs-lisp :noweb tangle
;; noweb-tangle-start
<<noweb-example>>
;; noweb-tangle-end
#+end_src

10
testing/examples/link-in-heading.org Normal file
View File

@ -0,0 +1,10 @@
this file has a link in it's heading, which can cause problems
* [[http://www.example.com][example]]
what a weird heading...
#+begin_src emacs-lisp
;; a8b1d111-eca8-49f0-8930-56d4f0875155
(message "my heading has a link")
#+end_src

9
testing/examples/no-heading.org Normal file
View File

@ -0,0 +1,9 @@
This is an example file for use by the Org-mode tests.
This file is special because it has no headings, which can be
erroneously assumed by some code.
#+begin_src emacs-lisp :tangle no
;; 94839181-184f-4ff4-a72f-94214df6f5ba
(message "I am code")
#+end_src

18
testing/examples/normal.org Normal file
View File

@ -0,0 +1,18 @@
#+TITLE: Example file
#+OPTIONS: num:nil ^:nil
#+STARTUP: hideblocks
This is an example file for use by the Org-mode tests.
* top
** code block
:PROPERTIES:
:tangle: yes
:CUSTOM_ID: code-block-section
:END:
Here are a couple of code blocks.
#+begin_src emacs-lisp :tangle no
;; 94839181-184f-4ff4-a72f-94214df6f5ba
(message "I am code")
#+end_src

1
testing/jump Submodule

@ -0,0 +1 @@
Subproject commit 0def5442723f8a2928eda7bcf428aa29f8aa97c1

89
testing/lisp/test-ob-exp.el Normal file
View File

@ -0,0 +1,89 @@
;;; test-ob-exp.el
;; Copyright (c) 2010 Eric Schulte
;; Authors: Eric Schulte
;; Released under the GNU General Public License version 3
;; see: http://www.gnu.org/licenses/gpl-3.0.html
;;;; Comments:
;; Template test file for Org-mode tests
;;; Code:
(let ((load-path (cons (expand-file-name
".." (file-name-directory
(or load-file-name buffer-file-name)))
load-path)))
(require 'org-test)
(require 'org-test-ob-consts))
;;; Tests
(ert-deftest test-ob-exp/org-babel-exp-src-blocks/w-no-headers ()
"Testing export without any headlines in the org-mode file."
(let ((html-file (concat (file-name-sans-extension org-test-no-heading-file)
".html")))
(when (file-exists-p html-file) (delete-file html-file))
(org-test-in-example-file org-test-no-heading-file
;; export the file to html
(org-export-as-html nil))
;; should create a .html file
(should (file-exists-p html-file))
;; should not create a file with "::" appended to it's name
(should-not (file-exists-p (concat org-test-no-heading-file "::")))
(when (file-exists-p html-file) (delete-file html-file))))
(ert-deftest test-ob-exp/org-babel-exp-src-blocks/w-no-file ()
"Testing export from buffers which are not visiting any file."
(when (get-buffer "*Org HTML Export*") (kill-buffer "*Org HTML Export*"))
(should-not (get-buffer "*Org HTML Export*"))
;; export the file to HTML in a temporary buffer
(org-test-in-example-file nil (org-export-as-html-to-buffer nil))
;; should create a .html buffer
(should (buffer-live-p (get-buffer "*Org HTML Export*")))
;; should contain the content of the buffer
(save-excursion
(set-buffer (get-buffer "*Org HTML Export*"))
(should (string-match (regexp-quote org-test-file-ob-anchor)
(buffer-string))))
(when (get-buffer "*Org HTML Export*") (kill-buffer "*Org HTML Export*")))
(ert-deftest test-ob-exp/org-babel-exp-src-blocks/w-no-headers ()
"Testing export without any headlines in the org-mode file."
(let ((html-file (concat (file-name-sans-extension
org-test-link-in-heading-file)
".html")))
(when (file-exists-p html-file) (delete-file html-file))
(org-test-in-example-file org-test-link-in-heading-file
;; export the file to html
(org-export-as-html nil))
;; should create a .html file
(should (file-exists-p html-file))
;; should not create a file with "::" appended to it's name
(should-not (file-exists-p (concat org-test-link-in-heading-file "::")))
(when (file-exists-p html-file) (delete-file html-file))))
(ert-deftest ob-exp/noweb-on-export ()
"Noweb header arguments export correctly.
- yes expand on both export and tangle
- no expand on neither export or tangle
- tangle expand on only tangle not export"
(let (html)
(org-test-at-id "eb1f6498-5bd9-45e0-9c56-50717053e7b7"
(org-narrow-to-subtree)
(setq html (org-export-as-html nil nil nil 'string)))
(flet ((exp-p (arg)
(and
(string-match
(format "noweb-%s-start\\([^\000]*\\)noweb-%s-end" arg arg)
html)
(string-match "expanded" (match-string 1 html)))))
(should (exp-p "yes"))
(should-not (exp-p "no"))
(should-not (exp-p "tangle")))))
(provide 'test-ob-exp)
;;; test-ob-exp.el ends here

48
testing/lisp/test-ob-tangle.el Normal file
View File

@ -0,0 +1,48 @@
;;; test-ob-tangle.el
;; Copyright (c) 2010 Eric Schulte
;; Authors: Eric Schulte
;; Released under the GNU General Public License version 3
;; see: http://www.gnu.org/licenses/gpl-3.0.html
;;;; Comments:
;; Template test file for Org-mode tests
;;; Code:
(let ((load-path (cons (expand-file-name
".." (file-name-directory
(or load-file-name buffer-file-name)))
load-path)))
(require 'org-test)
(require 'org-test-ob-consts))
;;; Tests
(ert-deftest ob-tangle/noweb-on-tangle ()
"Noweb header arguments tangle correctly.
- yes expand on both export and tangle
- no expand on neither export or tangle
- tangle expand on only tangle not export"
(let ((target-file (make-temp-file "ob-tangle-test-")))
(org-test-at-id "eb1f6498-5bd9-45e0-9c56-50717053e7b7"
(org-narrow-to-subtree)
(org-babel-tangle target-file))
(let ((tang (with-temp-buffer
(insert-file-contents target-file)
(buffer-string))))
(flet ((exp-p (arg)
(and
(string-match
(format "noweb-%s-start\\([^\000]*\\)noweb-%s-end" arg arg)
tang)
(string-match "expanded" (match-string 1 tang)))))
(should (exp-p "yes"))
(should-not (exp-p "no"))
(should (exp-p "tangle"))))))
(provide 'test-ob-tangle)
;;; test-ob-tangle.el ends here

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

@ -0,0 +1,41 @@
;;; test-ob.el --- tests for ob.el
;; Copyright (c) 2010 Eric Schulte
;; Authors: Eric Schulte
;; Released under the GNU General Public License version 3
;; see: http://www.gnu.org/licenses/gpl-3.0.html
;;;; Comments:
;; Template test file for Org-mode tests
;;; Code:
(let ((load-path (cons (expand-file-name
".." (file-name-directory
(or load-file-name buffer-file-name)))
load-path)))
(require 'org-test)
(require 'org-test-ob-consts))
(ert-deftest test-org-babel-get-src-block-info-language ()
(org-test-at-marker nil org-test-file-ob-anchor
(let ((info (org-babel-get-src-block-info)))
(should (string= "emacs-lisp" (nth 0 info))))))
(ert-deftest test-org-babel-get-src-block-info-body ()
(org-test-at-marker nil org-test-file-ob-anchor
(let ((info (org-babel-get-src-block-info)))
(should (string-match (regexp-quote org-test-file-ob-anchor)
(nth 1 info))))))
(ert-deftest test-org-babel-get-src-block-info-tangle ()
(org-test-at-marker nil org-test-file-ob-anchor
(let ((info (org-babel-get-src-block-info)))
(should (string= "no" (cdr (assoc :tangle (nth 2 info))))))))
(provide 'test-ob)
;;; test-ob ends here

0
testing/org-html/tests.el → testing/old/org-html.el
View File

23
testing/org-test-ob-consts.el Normal file
View File

@ -0,0 +1,23 @@
;;; org-test-ob-consts.el --- constants for use in code block tests
;; Copyright (c) 2010 Eric Schulte
;; Authors: Eric Schulte
;; Released under the GNU General Public License version 3
;; see: http://www.gnu.org/licenses/gpl-3.0.html
;;;; Comments:
;; Template test file for Org-mode tests
;;; Code:
(defconst org-test-file-ob-anchor
"94839181-184f-4ff4-a72f-94214df6f5ba")
(defconst org-test-link-in-heading-file-ob-anchor
"a8b1d111-eca8-49f0-8930-56d4f0875155")
(provide 'org-test-ob-consts)
;;; org-test-ob-consts.el ends here

210
testing/org-test.el Normal file
View File

@ -0,0 +1,210 @@
;;;; org-test.el --- Tests for Org-mode
;; Copyright (c) 2010 Sebastian Rose, Eric Schulte
;; Authors:
;; Sebastian Rose, Hannover, Germany, sebastian_rose gmx de
;; Eric Schulte, Santa Fe, New Mexico, USA, schulte.eric gmail com
;; Released under the GNU General Public License version 3
;; see: http://www.gnu.org/licenses/gpl-3.0.html
;;;; Comments:
;; Interactive testing for Org mode.
;; The heart of all this is the commands `org-test-current-defun'. If
;; called while in a `defun' all ert tests with names matching the
;; name of the function are run.
;;; Prerequisites:
;; ERT and jump.el are both included as git submodules, install with
;; $ git submodule init
;; $ git submodule update
;;;; Code:
(let* ((org-test-dir (expand-file-name
(file-name-directory
(or load-file-name buffer-file-name))))
(load-path (cons
(expand-file-name "ert" org-test-dir)
(cons
(expand-file-name "jump" org-test-dir)
load-path))))
(require 'ert-batch)
(require 'ert)
(require 'ert-exp)
(require 'ert-exp-t)
(require 'ert-run)
(require 'ert-ui)
(require 'jump)
(require 'which-func)
(require 'org))
(defconst org-test-default-test-file-name "tests.el"
"For each defun a separate file with tests may be defined.
tests.el is the fallback or default if you like.")
(defconst org-test-default-directory-name "testing"
"Basename or the directory where the tests live.
org-test searches this directory up the directory tree.")
(defconst org-test-dir
(expand-file-name (file-name-directory (or load-file-name buffer-file-name))))
(defconst org-base-dir
(expand-file-name ".." org-test-dir))
(defconst org-test-example-dir
(expand-file-name "examples" org-test-dir))
(defconst org-test-file
(expand-file-name "normal.org" org-test-example-dir))
(defconst org-test-no-heading-file
(expand-file-name "no-heading.org" org-test-example-dir))
(defconst org-test-link-in-heading-file
(expand-file-name "link-in-heading.org" org-test-dir))
;;; Functions for writing tests
(defun org-test-buffer (&optional file)
"TODO: Setup and return a buffer to work with.
If file is non-nil insert it's contents in there.")
(defun org-test-compare-with-file (&optional file)
"TODO: Compare the contents of the test buffer with FILE.
If file is not given, search for a file named after the test
currently executed.")
(defmacro org-test-at-id (id &rest body)
"Run body after placing the point in the headline identified by ID."
(declare (indent 1))
`(let* ((id-location (org-id-find ,id))
(id-file (car id-location))
(visited-p (get-file-buffer id-file))
to-be-removed)
(save-window-excursion
(save-match-data
(org-id-goto ,id)
(setq to-be-removed (current-buffer))
(condition-case nil
(progn
(org-show-subtree)
(org-show-block-all))
(error nil))
(save-restriction ,@body)))
(unless visited-p
(kill-buffer to-be-removed))))
(defmacro org-test-in-example-file (file &rest body)
"Execute body in the Org-mode example file."
(declare (indent 1))
`(let* ((my-file (or ,file org-test-file))
(visited-p (get-file-buffer my-file))
to-be-removed)
(save-window-excursion
(save-match-data
(find-file my-file)
(setq to-be-removed (current-buffer))
(goto-char (point-min))
(condition-case nil
(progn
(outline-next-visible-heading 1)
(org-show-subtree)
(org-show-block-all))
(error nil))
(save-restriction ,@body)))
(unless visited-p
(kill-buffer to-be-removed))))
(defmacro org-test-at-marker (file marker &rest body)
"Run body after placing the point at MARKER in FILE.
Note the uuidgen command-line command can be useful for
generating unique markers for insertion as anchors into org
files."
(declare (indent 2))
`(org-test-in-example-file ,file
(goto-char (point-min))
(re-search-forward (regexp-quote ,marker))
,@body))
;;; Navigation Functions
(defjump 'org-test-jump
'(("lisp/\\1.el" . "testing/lisp/test-\\1.el")
("lisp/\\1.el" . "testing/lisp/\\1.el/test.*.el")
("contrib/lisp/\\1.el" . "testing/contrib/lisp/test-\\1.el")
("contrib/lisp/\\1.el" . "testing/contrib/lisp/\\1.el/test.*.el")
("testing/lisp/test-\\1.el" . "lisp/\\1.el")
("testing/lisp/\\1.el" . "lisp/\\1.el/test.*.el")
("testing/contrib/lisp/test-\\1.el" . "contrib/lisp/\\1.el")
("testing/contrib/lisp/test-\\1.el" . "contrib/lisp/\\1.el/test.*.el"))
(concat org-base-dir "/")
"Jump between org-mode files and their tests."
(lambda (path)
(let* ((full-path (expand-file-name path org-base-dir))
(file-name (file-name-nondirectory path))
(name (file-name-sans-extension file-name)))
(find-file full-path)
(insert
";;; " file-name "\n\n"
";; Copyright (c) 2010 " user-full-name "\n"
";; Authors: " user-full-name "\n\n"
";; Released under the GNU General Public License version 3\n"
";; see: http://www.gnu.org/licenses/gpl-3.0.html\n\n"
";;;; Comments:\n\n"
";; Template test file for Org-mode tests\n\n"
" \n"
";;; Code:\n"
"(let ((load-path (cons (expand-file-name\n"
" \"..\" (file-name-directory\n"
" (or load-file-name buffer-file-name)))\n"
" load-path)))\n"
" (require 'org-test)\n"
" (require 'org-test-ob-consts))\n\n"
" \n"
";;; Tests\n"
"(ert-deftest " name "/example-test ()\n"
" \"Just an example to get you started.\"\n"
" (should t)\n"
" (should-not nil)\n"
" (should-error (error \"errr...\")))\n\n\n"
"(provide '" name ")\n\n"
";;; " file-name " ends here\n") full-path))
(lambda () ((lambda (res) (if (listp res) (car res) res)) (which-function))))
(define-key emacs-lisp-mode-map "\M-\C-j" 'org-test-jump)
;;; Load and Run tests
(defun org-test-load ()
"Load up the org-mode test suite."
(interactive)
(flet ((rload (base)
(mapc
(lambda (path)
(if (file-directory-p path) (rload path) (load-file path)))
(directory-files base 'full
"^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.el"))))
(rload (expand-file-name "lisp" org-test-dir))
(rload (expand-file-name "lisp"
(expand-file-name "contrib" org-test-dir)))))
(defun org-test-current-defun ()
"Test the current function."
(interactive)
(ert (car (which-function))))
(defun org-test-run-all-tests ()
"Run all defined tests matching \"\\(org\\|ob\\)\".
Load all test files first."
(interactive)
(org-test-load)
(ert "\\(org\\|ob\\)"))
(provide 'org-test)
;;; org-test.el ends here