Browse Source

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

Carsten Dominik 15 years ago
parent
commit
63e4b4528e
76 changed files with 3131 additions and 1370 deletions
  1. 6 0
      .gitmodules
  2. 297 87
      EXPERIMENTAL/org-export.el
  3. 5 4
      ORGWEBPAGE/Changes_old.org
  4. 4 2
      ORGWEBPAGE/index.org
  5. 14 0
      contrib/babel/library-of-babel.org
  6. 588 219
      contrib/lisp/org-drill.el
  7. 355 344
      doc/org.texi
  8. 3 0
      doc/orgcard.tex
  9. 2 4
      lisp/ob-C.el
  10. 6 6
      lisp/ob-R.el
  11. 9 5
      lisp/ob-asymptote.el
  12. 7 3
      lisp/ob-clojure.el
  13. 1 1
      lisp/ob-comint.el
  14. 3 1
      lisp/ob-ditaa.el
  15. 12 7
      lisp/ob-dot.el
  16. 4 5
      lisp/ob-eval.el
  17. 39 6
      lisp/ob-exp.el
  18. 6 3
      lisp/ob-gnuplot.el
  19. 3 1
      lisp/ob-haskell.el
  20. 3 1
      lisp/ob-js.el
  21. 4 0
      lisp/ob-keys.el
  22. 8 5
      lisp/ob-ledger.el
  23. 3 1
      lisp/ob-lisp.el
  24. 14 10
      lisp/ob-octave.el
  25. 31 1
      lisp/ob-org.el
  26. 3 2
      lisp/ob-perl.el
  27. 6 5
      lisp/ob-plantuml.el
  28. 83 67
      lisp/ob-python.el
  29. 12 9
      lisp/ob-ruby.el
  30. 3 1
      lisp/ob-sass.el
  31. 3 2
      lisp/ob-scheme.el
  32. 1 1
      lisp/ob-screen.el
  33. 14 15
      lisp/ob-sh.el
  34. 7 1
      lisp/ob-sql.el
  35. 112 46
      lisp/ob-tangle.el
  36. 232 147
      lisp/ob.el
  37. 28 6
      lisp/org-agenda.el
  38. 1 1
      lisp/org-archive.el
  39. 22 16
      lisp/org-ascii.el
  40. 17 12
      lisp/org-capture.el
  41. 10 8
      lisp/org-clock.el
  42. 2 1
      lisp/org-exp-blocks.el
  43. 2 1
      lisp/org-exp.el
  44. 1 1
      lisp/org-feed.el
  45. 57 2
      lisp/org-gnus.el
  46. 3 3
      lisp/org-html.el
  47. 17 5
      lisp/org-icalendar.el
  48. 41 6
      lisp/org-latex.el
  49. 156 167
      lisp/org-list.el
  50. 11 1
      lisp/org-mew.el
  51. 15 6
      lisp/org-mhe.el
  52. 49 10
      lisp/org-mobile.el
  53. 6 8
      lisp/org-mouse.el
  54. 6 7
      lisp/org-publish.el
  55. 3 2
      lisp/org-remember.el
  56. 10 0
      lisp/org-rmail.el
  57. 37 13
      lisp/org-src.el
  58. 3 0
      lisp/org-table.el
  59. 2 5
      lisp/org-timer.el
  60. 10 0
      lisp/org-vm.el
  61. 35 3
      lisp/org-wl.el
  62. 154 74
      lisp/org.el
  63. 50 0
      testing/README.org
  64. 1 0
      testing/contrib/lisp/.gitignore
  65. 1 0
      testing/ert
  66. 29 0
      testing/examples/babel.org
  67. 10 0
      testing/examples/link-in-heading.org
  68. 9 0
      testing/examples/no-heading.org
  69. 18 0
      testing/examples/normal.org
  70. 1 0
      testing/jump
  71. 89 0
      testing/lisp/test-ob-exp.el
  72. 48 0
      testing/lisp/test-ob-tangle.el
  73. 41 0
      testing/lisp/test-ob.el
  74. 0 0
      testing/old/org-html.el
  75. 23 0
      testing/org-test-ob-consts.el
  76. 210 0
      testing/org-test.el

+ 6 - 0
.gitmodules

@@ -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

+ 297 - 87
EXPERIMENTAL/org-export.el

@@ -1,14 +1,14 @@
 ;;; org-export.el --- Export engine for Org
 ;;; org-export.el --- Export engine for Org
 ;;
 ;;
-;; Copyright 2008 Bastien Guerry
+;; Copyright 2008 2010 Bastien Guerry
 ;;
 ;;
 ;; Emacs Lisp Archive Entry
 ;; Emacs Lisp Archive Entry
 ;; Filename: org-export.el
 ;; Filename: org-export.el
-;; Version: 0.1a
+;; Version: 0.3
 ;; Author: Bastien <bzg AT altern DOT org>
 ;; Author: Bastien <bzg AT altern DOT org>
 ;; Maintainer: Bastien <bzg AT altern DOT org>
 ;; Maintainer: Bastien <bzg AT altern DOT org>
-;; Keywords: 
-;; Description: 
+;; Keywords:
+;; Description:
 ;; URL: [Not distributed yet]
 ;; URL: [Not distributed yet]
 ;;
 ;;
 ;; This program is free software; you can redistribute it and/or modify
 ;; This program is free software; you can redistribute it and/or modify
@@ -27,23 +27,50 @@
 ;;
 ;;
 ;;; Commentary:
 ;;; 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:
 ;; Put this file into your load-path and the following into your ~/.emacs:
 ;;   (require 'org-export)
 ;;   (require 'org-export)
 ;;
 ;;
+;;; Todo:
+;; 
+;; Rewrite `org-export-export-preprocess-string'.
+;;
 ;;; Code:
 ;;; Code:
 
 
 (eval-when-compile
 (eval-when-compile
   (require 'cl))
   (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:
 ;;; Parsing functions:
 
 
 (defun org-export-parse (&optional level)
 (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)
   (let (output eos)
     (save-excursion
     (save-excursion
       (goto-char (point-min))
       (goto-char (point-min))
@@ -52,116 +79,101 @@ its content."
 	      (properties (org-entry-properties)))
 	      (properties (org-entry-properties)))
 	  (save-restriction
 	  (save-restriction
 	    (narrow-to-region (if (looking-at "\n") (1+ (point)) (point))
 	    (narrow-to-region (if (looking-at "\n") (1+ (point)) (point))
-			      (save-excursion 
+			      (save-excursion
 				(setq eos (org-end-of-subtree t t))))
 				(setq eos (org-end-of-subtree t t))))
 	    (setq output
 	    (setq output
 		  (append output
 		  (append output
-			  (list 
+			  (list
 			   (list :level (or level 1)
 			   (list :level (or level 1)
 				 :heading heading
 				 :heading heading
 				 :properties properties
 				 :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)))))))
 					   (if level (1+ level) 2)))))))
 	  (goto-char (1- eos)))))
 	  (goto-char (1- eos)))))
     output))
     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
   (save-excursion
     (goto-char (point-min))
     (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
     (buffer-substring
      (point)
      (point)
      (if (re-search-forward org-complex-heading-regexp nil t)
      (if (re-search-forward org-complex-heading-regexp nil t)
 	 (match-beginning 0) (point-max)))))
 	 (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:
 ;;; 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-structure
-  (parsed-buffer props filter struct-backend content-backend)
+(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 &optional filter)
   "Render PARSED-BUFFER.
   "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."
 rendering engine."
   (mapc (lambda(s)
   (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)))
 	(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
   (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)))
     (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)
 (defun org-export-filter (parsed-buffer filter)
   "Filter out PARSED-BUFFER with 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
 produced by `org-export-parse'.  FILTER is an alist of rules to
 apply to PARSED-BUFFER.  For the syntax of a filter, please check
 apply to PARSED-BUFFER.  For the syntax of a filter, please check
 the docstring of `org-export-latex-filter'."
 the docstring of `org-export-latex-filter'."
-  (delete 
-   nil    
-   (mapcar 
+  ;; FIXME where is org-export-latex-filter
+  (delete
+   nil
+   (mapcar
     (lambda(s)
     (lambda(s)
       (if (delete
       (if (delete
-	   nil 
+	   nil
 	   (mapcar
 	   (mapcar
 	    (lambda(f)
 	    (lambda(f)
 	      (let ((cnd (car f)) (re (cadr f)) prop-cnd)
 	      (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)))
 			 (string-match re (plist-get s :heading)))
 		    (and (eq cnd 'content)
 		    (and (eq cnd 'content)
 			 (string-match re (plist-get s :content)))
 			 (string-match re (plist-get s :content)))
-		    (and (setq prop-cnd 
+		    (and (setq prop-cnd
 			       (assoc cnd (plist-get s :properties)))
 			       (assoc cnd (plist-get s :properties)))
 			 (string-match re (cadr prop-cnd))))))
 			 (string-match re (cadr prop-cnd))))))
 	    filter))
 	    filter))
 	  nil  ;; return nil if the section is filtered out
 	  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))
 			  (org-export-filter (plist-get s :subtree) filter))
 	       s))) ;; return the section if it isn't filtered out
 	       s))) ;; return the section if it isn't filtered out
     parsed-buffer)))
     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)
 (provide 'org-export)
 
 
 ;;;  User Options, Variables
 ;;;  User Options, Variables

+ 5 - 4
ORGWEBPAGE/Changes_old.org

@@ -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
 the variable =org-startup-indented=.  But you can turn it on
 for a particular buffer using
 for a particular buffer using
 
 
-#+begin_src org
+#+begin_example
   ,#+STARTUP: indent
   ,#+STARTUP: indent
-#+end_src
+#+end_example
 
 
 Turning on this minor mode automatically turns on
 Turning on this minor mode automatically turns on
 =org-hide-leading-stars=, and it turns off
 =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
    - Export content specified via the #+TEXT construct is now
      fully processed, i.e. links, emphasis etc. are all
      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}
    - During HTML export, you can request to have a_{b}
      interpreted as a subscript, but to leave a_b as it is.  This
      interpreted as a subscript, but to leave a_b as it is.  This

+ 4 - 2
ORGWEBPAGE/index.org

@@ -117,11 +117,11 @@ a look at our [[http://orgmode.org/worg/org-quotes.php][collected quotes about O
 #+ATTR_HTML: style="float:right;"
 #+ATTR_HTML: style="float:right;"
   [[http://mobileorg.ncogni.to/][http://mobileorg.ncogni.to/images/screenshot-browse.png]]
   [[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-04-06 Tue>: Release 7.01
 - <2010-06-06 Sun>: iPhone App [[http://mobileorg.ncogni.to/][MobileOrg]] version 1.3 introduces
 - <2010-06-06 Sun>: iPhone App [[http://mobileorg.ncogni.to/][MobileOrg]] version 1.3 introduces
   DropBox support, for vastly easier setup.
   DropBox support, for vastly easier setup.
 - <2010-04-06 Tue>: Release 6.35
 - <2010-04-06 Tue>: Release 6.35
-- <2010-01-10 Sun>: Release 6.34
 
 
 * Current Version (7.01h)
 * Current Version (7.01h)
 
 
@@ -200,7 +200,9 @@ and corresponding to the latest git version.
 
 
 ** Talks about Org-mode
 ** Talks about Org-mode
    Check out the [[file:talks/index.html#sec-1][Google Tech Talk]] about Org-mode, or another talk
    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
 ** Mailing list
    :PROPERTIES:
    :PROPERTIES:
    :ID:       0B280B26-A3AB-4E5C-B4EE-B7FFC52C4D26
    :ID:       0B280B26-A3AB-4E5C-B4EE-B7FFC52C4D26

+ 14 - 0
contrib/babel/library-of-babel.org

@@ -161,6 +161,20 @@ plot(data)
 
 
 ** Gnuplot
 ** 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
 * Tables
 ** LaTeX Table export
 ** LaTeX Table export
 *** booktabs
 *** booktabs

+ 588 - 219
contrib/lisp/org-drill.el

@@ -1,7 +1,7 @@
 ;;; org-drill.el - Self-testing with org-learn
 ;;; org-drill.el - Self-testing with org-learn
 ;;;
 ;;;
 ;;; Author: Paul Sexton <eeeickythump@gmail.com>
 ;;; Author: Paul Sexton <eeeickythump@gmail.com>
-;;; Version: 1.0
+;;; Version: 1.4
 ;;; Repository at http://bitbucket.org/eeeickythump/org-drill/
 ;;; Repository at http://bitbucket.org/eeeickythump/org-drill/
 ;;;
 ;;;
 ;;;
 ;;;
@@ -96,6 +96,12 @@ Possible values:
 
 
 
 
 (defface org-drill-visible-cloze-face
 (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")))
   '((t (:foreground "dark slate blue")))
   "The face used to hide the contents of cloze phrases."
   "The face used to hide the contents of cloze phrases."
   :group 'org-drill)
   :group 'org-drill)
@@ -115,6 +121,35 @@ buffers?"
   :group 'org-drill)
   :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
 (setplist 'org-drill-cloze-overlay-defaults
           '(display "[...]"
           '(display "[...]"
                     face org-drill-hidden-cloze-face
                     face org-drill-hidden-cloze-face
@@ -124,7 +159,15 @@ buffers?"
 (defvar org-drill-cloze-regexp
 (defvar org-drill-cloze-regexp
   ;; ver 1   "[^][]\\(\\[[^][][^]]*\\]\\)"
   ;; ver 1   "[^][]\\(\\[[^][][^]]*\\]\\)"
   ;; ver 2   "\\(\\[.*?\\]\\|^[^[[:cntrl:]]*?\\]\\|\\[.*?$\\)"
   ;; 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
 (defcustom org-drill-card-type-alist
@@ -132,6 +175,7 @@ buffers?"
     ("simple" . org-drill-present-simple-card)
     ("simple" . org-drill-present-simple-card)
     ("twosided" . org-drill-present-two-sided-card)
     ("twosided" . org-drill-present-two-sided-card)
     ("multisided" . org-drill-present-multi-sided-card)
     ("multisided" . org-drill-present-multi-sided-card)
+    ("multicloze" . org-drill-present-multicloze)
     ("spanish_verb" . org-drill-present-spanish-verb))
     ("spanish_verb" . org-drill-present-spanish-verb))
   "Alist associating card types with presentation functions. Each entry in the
   "Alist associating card types with presentation functions. Each entry in the
 alist takes the form (CARDTYPE . FUNCTION), where CARDTYPE is a string
 alist takes the form (CARDTYPE . FUNCTION), where CARDTYPE is a string
@@ -158,11 +202,41 @@ random noise is adapted from Mnemosyne."
   :group 'org-drill
   :group 'org-drill
   :type 'boolean)
   :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-session-qualities* nil)
 (defvar *org-drill-start-time* 0)
 (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)
 (defun shuffle-list (list)
@@ -181,10 +255,52 @@ random noise is adapted from Mnemosyne."
   list)
   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 ()
 (defun org-drill-entry-p ()
   "Is the current entry a 'drill item'?"
   "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))))
       (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))))
       (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 ()
 (defun org-drill-entry-leech-p ()
   "Is the current entry a 'leech item'?"
   "Is the current entry a 'leech item'?"
   (and (org-drill-entry-p)
   (and (org-drill-entry-p)
@@ -203,25 +332,32 @@ or a subheading within a drill item?"
 
 
 
 
 (defun org-drill-entry-due-p ()
 (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 ()
 (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))))
          (null item-time))))
 
 
 
 
 
 
 (defun org-drill-entry-last-quality ()
 (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
     (if quality
         (string-to-number quality)
         (string-to-number quality)
       nil)))
       nil)))
@@ -351,6 +487,8 @@ Returns a list: (INTERVAL N EF OFMATRIX), where:
     (cond
     (cond
      ((= 0 (nth 0 learn-data))
      ((= 0 (nth 0 learn-data))
       (org-schedule t))
       (org-schedule t))
+     ((minusp (first learn-data))
+      (org-schedule nil (current-time)))
      (t
      (t
       (org-schedule nil (time-add (current-time)
       (org-schedule nil (time-add (current-time)
 				  (days-to-time (nth 0 learn-data))))))))
 				  (days-to-time (nth 0 learn-data))))))))
@@ -359,8 +497,8 @@ Returns a list: (INTERVAL N EF OFMATRIX), where:
 (defun org-drill-reschedule ()
 (defun org-drill-reschedule ()
   "Returns quality rating (0-5), or nil if the user quit."
   "Returns quality rating (0-5), or nil if the user quit."
   (let ((ch nil))
   (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 ??)
                 (if (eq ch ??)
                     "0-2 Means you have forgotten the item.
                     "0-2 Means you have forgotten the item.
 3-5 Means you have remembered 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.
 4 - After a little bit of thought you remembered.
 5 - You remembered the item really easily.
 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
     (cond
      ((and (>= ch ?0) (<= ch ?5))
      ((and (>= ch ?0) (<= ch ?5))
       (let ((quality (- ch ?0))
       (let ((quality (- ch ?0))
-            (failures (cdr (assoc "DRILL_FAILURE_COUNT" (org-entry-properties nil)))))
+            (failures (org-entry-get (point) "DRILL_FAILURE_COUNT")))
         (save-excursion
         (save-excursion
           (org-drill-smart-reschedule quality))
           (org-drill-smart-reschedule quality))
         (push quality *org-drill-session-qualities*)
         (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"
             (org-set-property "DRILL_FAILURE_COUNT"
                               (format "%d" (1+ failures)))
                               (format "%d" (1+ failures)))
             (if (> (1+ failures) org-drill-leech-failure-threshold)
             (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_QUALITY" (format "%d" quality))
+        (org-set-property "DRILL_LAST_REVIEWED"
+                          (time-to-inactive-org-timestamp (current-time)))
         quality))
         quality))
+     ((= ch ?e)
+      'edit)
      (t
      (t
       nil))))
       nil))))
 
 
@@ -416,42 +567,92 @@ the current topic."
 
 
 
 
 (defun org-drill-presentation-prompt (&rest fmt-and-args)
 (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
     (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)
     (if (and (eql 'warn org-drill-leech-method)
              (org-drill-entry-leech-p))
              (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.
 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
     (case ch
       (?q nil)
       (?q nil)
       (?e 'edit)
       (?e 'edit)
+      (?s 'skip)
       (otherwise t))))
       (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 ()
 (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 ()
 (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.
 ;; recall, nil if they chose to quit.
 
 
 (defun org-drill-present-simple-card ()
 (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 ()
 (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 ()
 (defun org-drill-present-multi-sided-card ()
-  (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)))
-    (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 (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 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 ()
 (defun org-drill-present-spanish-verb ()
-  (case (random 6)
-    (0
-     (org-drill-hide-all-subheadings-except '("Infinitive"))
-     (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"))
+  (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
      (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."
 See `org-drill' for more details."
   (interactive)
   (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))
         (cont nil))
     (save-restriction
     (save-restriction
       (org-narrow-to-subtree) 
       (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))))
       (let ((presentation-fn (cdr (assoc card-type org-drill-card-type-alist))))
         (cond
         (cond
          (presentation-fn
          (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
          (t
           (error "Unknown card type: '%s'" card-type))))
           (error "Unknown card type: '%s'" card-type))))
       
       
@@ -589,83 +815,188 @@ See `org-drill' for more details."
         nil)
         nil)
        ((eql cont 'edit)
        ((eql cont 'edit)
         'edit)
         'edit)
+       ((eql cont 'skip)
+        'skip)
        (t
        (t
         (save-excursion
         (save-excursion
           (org-drill-reschedule)))))))
           (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
   "Returns nil, t, or a list of markers representing entries that were
 'failed' and need to be presented again before the session ends."
 '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
           (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
            (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 ()
 (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
 Session duration %s
 
 
 Recall of reviewed items:
 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..." 
 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)
   (interactive)
   (let ((entries nil)
   (let ((entries nil)
         (failed-entries nil)
         (failed-entries nil)
-        (new-entries nil)
-        (old-entries nil)
         (result nil)
         (result nil)
         (results nil)
         (results nil)
-        (end-pos nil))
+        (end-pos nil)
+        (cnt 0))
     (block org-drill
     (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-session-qualities* nil)
       (setq *org-drill-start-time* (float-time (current-time)))
       (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
     (cond
      (end-pos
      (end-pos
       (switch-to-buffer (marker-buffer end-pos))
       (switch-to-buffer (marker-buffer end-pos))
@@ -761,15 +1120,25 @@ agenda-with-archives
       (org-drill-final-report)))))
       (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
 (add-hook 'org-mode-hook
           (lambda ()
           (lambda ()
             (if org-drill-use-visible-cloze-face-p
             (if org-drill-use-visible-cloze-face-p
                 (font-lock-add-keywords
                 (font-lock-add-keywords
                  'org-mode
                  'org-mode
-                 `((,org-drill-cloze-regexp
-                    (0 'org-drill-visible-cloze-face nil)))
-                 t)))) 
+                 org-drill-cloze-keywords
+                 t))))
+
 
 
 
 
 (provide 'org-drill)
 (provide 'org-drill)

File diff suppressed because it is too large
+ 355 - 344
doc/org.texi


+ 3 - 0
doc/orgcard.tex

@@ -480,8 +480,11 @@ formula, \kbd{:=} a field formula.
 \key{view expanded body of code block at point}{C-c C-v v}
 \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 code block}{C-c C-v g}
 \key{go to named result}{C-c C-v r}
 \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 next code block}{C-c C-v n}
 \key{go to the previous code block}{C-c C-v p}
 \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 buffer}{C-c C-v b}
 \key{execute all code blocks in current subtree}{C-c C-v s}
 \key{execute all code blocks in current subtree}{C-c C-v s}
 \key{tangle code blocks in current file}{C-c C-v t}
 \key{tangle code blocks in current file}{C-c C-v t}

+ 2 - 4
lisp/ob-C.el

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

+ 6 - 6
lisp/ob-R.el

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

+ 9 - 5
lisp/ob-asymptote.el

@@ -74,11 +74,15 @@ This function is called by `org-babel-execute-src-block'."
                      "pdf"))
                      "pdf"))
          (cmdline (cdr (assoc :cmdline params)))
          (cmdline (cdr (assoc :cmdline params)))
          (in-file (org-babel-temp-file "asymptote-"))
          (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
     (with-temp-file in-file
       (insert (org-babel-expand-body:asymptote body params processed-params)))
       (insert (org-babel-expand-body:asymptote body params processed-params)))
     (message cmd) (shell-command cmd)
     (message cmd) (shell-command cmd)

+ 7 - 3
lisp/ob-clojure.el

@@ -261,9 +261,13 @@ repl buffer."
 				       " "))))
 				       " "))))
     (case result-type
     (case result-type
       (output (org-babel-eval cmd body))
       (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-clojure-table-or-string
 		(org-babel-eval-read-file tmp-file)))))))
 		(org-babel-eval-read-file tmp-file)))))))
 
 

+ 1 - 1
lisp/ob-comint.el

@@ -45,7 +45,7 @@
 (defmacro org-babel-comint-in-buffer (buffer &rest body)
 (defmacro org-babel-comint-in-buffer (buffer &rest body)
   "Check BUFFER and execute BODY.
   "Check BUFFER and execute BODY.
 BUFFER is checked with `org-babel-comint-buffer-livep'.  BODY is
 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'."
 `save-match-data'."
   (declare (indent 1))
   (declare (indent 1))
   `(save-excursion
   `(save-excursion

+ 3 - 1
lisp/ob-ditaa.el

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

+ 12 - 7
lisp/ob-dot.el

@@ -65,15 +65,20 @@
 (defun org-babel-execute:dot (body params)
 (defun org-babel-execute:dot (body params)
   "Execute a block of Dot code with org-babel.
   "Execute a block of Dot code with org-babel.
 This function is called by `org-babel-execute-src-block'."
 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
     (with-temp-file in-file
       (insert (org-babel-expand-body:dot body params processed-params)))
       (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))
     out-file))
 
 
 (defun org-babel-prep-session:dot (session params)
 (defun org-babel-prep-session:dot (session params)

+ 4 - 5
lisp/ob-eval.el

@@ -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.
 ;; Copyright (C) 2009, 2010  Free Software Foundation, Inc.
 
 
@@ -42,7 +42,7 @@
 
 
 (defun org-babel-eval (cmd body)
 (defun org-babel-eval (cmd body)
   "Run CMD on 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'."
 STDERR with `org-babel-eval-error-notify'."
   (let ((err-buff (get-buffer-create "*Org-Babel Error*")) exit-code)
   (let ((err-buff (get-buffer-create "*Org-Babel Error*")) exit-code)
     (with-current-buffer err-buff (erase-buffer))
     (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)
 (defun org-babel-eval-read-file (file)
   "Return the contents of FILE as a string."
   "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)))
 		    (buffer-string)))
 
 
 (defun org-babel-shell-command-on-region (start end command
 (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
 ;; arch-tag: 5328b17f-957d-42d9-94da-a2952682d04d
 
 
-;;; ob-comint.el ends here
+;;; ob-eval.el ends here

+ 39 - 6
lisp/ob-exp.el

@@ -49,7 +49,7 @@
 
 
 (defcustom org-export-babel-evaluate t
 (defcustom org-export-babel-evaluate t
   "Switch controlling code evaluation during export.
   "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."
 process."
   :group 'org-babel
   :group 'org-babel
   :type 'boolean)
   :type 'boolean)
@@ -95,14 +95,47 @@ none ----- do not display either code or results upon export"
   (message "org-babel-exp processing...")
   (message "org-babel-exp processing...")
   (save-excursion
   (save-excursion
     (goto-char (match-beginning 0))
     (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
       ;; bail if we couldn't get any info from the block
       (when info
       (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
 	;; expand noweb references in the original file
 	(setf (nth 1 info)
 	(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
 		  (org-babel-expand-noweb-references
 		   info (get-file-buffer org-current-export-file))
 		   info (get-file-buffer org-current-export-file))
 		(nth 1 info))))
 		(nth 1 info))))
@@ -209,7 +242,7 @@ The function respects the value of the :exports header argument."
 (defvar backend)
 (defvar backend)
 (defun org-babel-exp-code (info type)
 (defun org-babel-exp-code (info type)
   "Prepare and return code in the current code block for export.
   "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'.
 org-mode.  This function is called by `org-babel-exp-do-export'.
 The code block is not evaluated."
 The code block is not evaluated."
   (let ((lang (nth 0 info))
   (let ((lang (nth 0 info))

+ 6 - 3
lisp/ob-gnuplot.el

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

+ 3 - 1
lisp/ob-haskell.el

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

+ 3 - 1
lisp/ob-js.el

@@ -100,7 +100,9 @@ This function is called by `org-babel-execute-src-block'"
             (if (string= result-type "value")
             (if (string= result-type "value")
                 (format org-babel-js-function-wrapper full-body)
                 (format org-babel-js-function-wrapper full-body)
               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)
 (defun org-babel-js-read (results)
   "Convert RESULTS into an appropriate elisp value.
   "Convert RESULTS into an appropriate elisp value.

+ 4 - 0
lisp/ob-keys.el

@@ -58,6 +58,8 @@ functions which are assigned key bindings, and see
     ("\C-o" . org-babel-open-src-block-result)
     ("\C-o" . org-babel-open-src-block-result)
     ("\C-v" . org-babel-expand-src-block)
     ("\C-v" . org-babel-expand-src-block)
     ("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)
     ("g" . org-babel-goto-named-src-block)
     ("r" . org-babel-goto-named-result)
     ("r" . org-babel-goto-named-result)
     ("\C-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)
     ("b" . org-babel-execute-buffer)
     ("\C-s" . org-babel-execute-subtree)
     ("\C-s" . org-babel-execute-subtree)
     ("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)
     ("\C-t" . org-babel-tangle)
     ("t" . org-babel-tangle)
     ("t" . org-babel-tangle)
     ("\C-f" . org-babel-tangle-file)
     ("\C-f" . org-babel-tangle-file)

+ 8 - 5
lisp/ob-ledger.el

@@ -38,7 +38,6 @@
 
 
 ;;; Code:
 ;;; Code:
 (require 'ob)
 (require 'ob)
-(require 'org)
 
 
 (defvar org-babel-default-header-args:ledger
 (defvar org-babel-default-header-args:ledger
   '((:results . "output") (:cmdline . "bal"))
   '((: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)) "")))
   (let ((result-params (split-string (or (cdr (assoc :results params)) "")))
 	(cmdline (cdr (assoc :cmdline params)))
 	(cmdline (cdr (assoc :cmdline params)))
         (in-file (org-babel-temp-file "ledger-"))
         (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))
     (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
     (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))))
     (with-temp-buffer (insert-file-contents out-file) (buffer-string))))
 
 
 (defun org-babel-prep-session:ledger (session params)
 (defun org-babel-prep-session:ledger (session params)

+ 3 - 1
lisp/ob-lisp.el

@@ -81,7 +81,9 @@ This function is called by `org-babel-execute-src-block'"
             (if (string= result-type "value")
             (if (string= result-type "value")
                 (format "(print %s)" full-body)
                 (format "(print %s)" full-body)
               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
 ;; This function should be used to assign any variables in params in
 ;; the context of the session environment.
 ;; the context of the session environment.

+ 14 - 10
lisp/ob-octave.el

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

+ 31 - 1
lisp/ob-org.el

@@ -30,17 +30,47 @@
 ;;; Code:
 ;;; Code:
 (require 'ob)
 (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
 (defvar org-babel-default-header-args:org
   '((:results . "raw silent") (:exports . "results"))
   '((:results . "raw silent") (:exports . "results"))
   "Default arguments for evaluating a org source block.")
   "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)
 (defun org-babel-expand-body:org (body params &optional processed-params)
   "Expand BODY according to PARAMS, return the expanded body." body)
   "Expand BODY according to PARAMS, return the expanded body." body)
 
 
 (defun org-babel-execute:org (body params)
 (defun org-babel-execute:org (body params)
   "Execute a block of Org code with.
   "Execute a block of Org code with.
 This function is called by `org-babel-execute-src-block'."
 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)
 (defun org-babel-prep-session:org (session params)
   "Return an error because org does not support sessions."
   "Return an error because org does not support sessions."

+ 3 - 2
lisp/ob-perl.el

@@ -107,10 +107,11 @@ return the value of the last statement in BODY, as elisp."
   (when session (error "Sessions are not supported for Perl."))
   (when session (error "Sessions are not supported for Perl."))
   (case result-type
   (case result-type
     (output (org-babel-eval org-babel-perl-command body))
     (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-eval
 	      org-babel-perl-command
 	      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)))))
 	     (org-babel-eval-read-file tmp-file)))))
 
 
 (provide 'ob-perl)
 (provide 'ob-perl)

+ 6 - 5
lisp/ob-plantuml.el

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

+ 83 - 67
lisp/ob-python.el

@@ -194,73 +194,89 @@ def main():
 open('%s', 'w').write( pprint.pformat(main()) )")
 open('%s', 'w').write( pprint.pformat(main()) )")
 
 
 (defun org-babel-python-evaluate
 (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)
 (defun org-babel-python-read-string (string)
   "Strip 's from around python string"
   "Strip 's from around python string"

+ 12 - 9
lisp/ob-ruby.el

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

+ 3 - 1
lisp/ob-sass.el

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

+ 3 - 2
lisp/ob-scheme.el

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

+ 1 - 1
lisp/ob-screen.el

@@ -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)
 (defun org-babel-execute:screen (body params)
   "Send a block of code via screen to a terminal using Babel.
   "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...")
   (message "Sending source code block to interactive terminal session...")
   (save-window-excursion
   (save-window-excursion
     (let* ((processed-params (org-babel-process-params params))
     (let* ((processed-params (org-babel-process-params params))

+ 14 - 15
lisp/ob-sh.el

@@ -160,21 +160,20 @@ return the value of the last statement in BODY."
 	 (org-babel-import-elisp-from-file tmp-file))))
 	 (org-babel-import-elisp-from-file tmp-file))))
    (if (not session)
    (if (not session)
        (org-babel-eval org-babel-sh-command (org-babel-trim body))
        (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)
 (defun org-babel-sh-strip-weird-long-prompt (string)
   "Remove prompt cruft from a string of shell output."
   "Remove prompt cruft from a string of shell output."

+ 7 - 1
lisp/ob-sql.el

@@ -65,7 +65,13 @@ This function is called by `org-babel-execute-src-block'."
                        (org-babel-temp-file "sql-out-")))
                        (org-babel-temp-file "sql-out-")))
          (command (case (intern engine)
          (command (case (intern engine)
                     ('mysql (format "mysql %s -e \"source %s\" > %s"
                     ('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)))))
                     (t (error "no support for the %s sql engine" engine)))))
     (with-temp-file in-file
     (with-temp-file in-file
       (insert (org-babel-expand-body:sql body params)))
       (insert (org-babel-expand-body:sql body params)))

+ 112 - 46
lisp/ob-tangle.el

@@ -34,7 +34,10 @@
 
 
 (declare-function org-link-escape "org" (text &optional table))
 (declare-function org-link-escape "org" (text &optional table))
 (declare-function org-heading-components "org" ())
 (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
 (defcustom org-babel-tangle-lang-exts
   '(("emacs-lisp" . "el"))
   '(("emacs-lisp" . "el"))
   "Alist mapping languages to their file extensions.
   "Alist mapping languages to their file extensions.
@@ -53,6 +56,38 @@ then the name of the language is used."
   :group 'org-babel
   :group 'org-babel
   :type 'hook)
   :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)
 (defun org-babel-find-file-noselect-refresh (file)
   "Find file ensuring that the latest changes on disk are
   "Find file ensuring that the latest changes on disk are
 represented in the file."
 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
 source blocks.  Optional argument LANG can be used to limit the
 exported source code blocks by language."
 exported source code blocks by language."
   (interactive)
   (interactive)
-  (save-buffer)
+  (run-hooks 'org-babel-pre-tangle-hook)
   (save-excursion
   (save-excursion
     (let ((block-counter 0)
     (let ((block-counter 0)
 	  (org-babel-default-header-args
 	  (org-babel-default-header-args
@@ -152,7 +187,7 @@ exported source code blocks by language."
            (mapc
            (mapc
             (lambda (spec)
             (lambda (spec)
               (flet ((get-spec (name)
               (flet ((get-spec (name)
-                               (cdr (assoc name (nth 2 spec)))))
+                               (cdr (assoc name (nth 4 spec)))))
                 (let* ((tangle (get-spec :tangle))
                 (let* ((tangle (get-spec :tangle))
                        (she-bang ((lambda (sheb) (when (> (length sheb) 0) sheb))
                        (she-bang ((lambda (sheb) (when (> (length sheb) 0) sheb))
 				  (get-spec :shebang)))
 				  (get-spec :shebang)))
@@ -193,8 +228,9 @@ exported source code blocks by language."
                     (add-to-list 'path-collector file-name)))))
                     (add-to-list 'path-collector file-name)))))
             specs)))
             specs)))
        (org-babel-tangle-collect-blocks lang))
        (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
       ;; run `org-babel-post-tangle-hook' in all tangled files
       (when org-babel-post-tangle-hook
       (when org-babel-post-tangle-hook
 	(mapc
 	(mapc
@@ -219,7 +255,7 @@ references."
                    (save-excursion (end-of-line 1) (forward-char 1) (point)))))
                    (save-excursion (end-of-line 1) (forward-char 1) (point)))))
 
 
 (defvar org-stored-links)
 (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.
   "Collect source blocks in the current Org-mode file.
 Return an association list of source-code block specifications of
 Return an association list of source-code block specifications of
 the form used by `org-babel-spec-to-string' grouped by language.
 the form used by `org-babel-spec-to-string' grouped by language.
@@ -237,43 +273,56 @@ code blocks by language."
 				 (condition-case nil
 				 (condition-case nil
 				     (nth 4 (org-heading-components))
 				     (nth 4 (org-heading-components))
 				   (error (buffer-file-name)))))
 				   (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
                           (org-babel-clean-text-properties
 			   (car (pop org-stored-links)))))
 			   (car (pop org-stored-links)))))
              (info (org-babel-get-src-block-info))
              (info (org-babel-get-src-block-info))
+	     (params (nth 2 info))
              (source-name (intern (or (nth 4 info)
              (source-name (intern (or (nth 4 info)
                                       (format "%s:%d"
                                       (format "%s:%d"
 					      current-heading block-counter))))
 					      current-heading block-counter))))
-             (src-lang (nth 0 info))
+	     (src-lang (nth 0 info))
 	     (expand-cmd (intern (concat "org-babel-expand-body:" src-lang)))
 	     (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)
              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
             ;; add the spec for this block to blocks under it's language
             (setq by-lang (cdr (assoc src-lang blocks)))
             (setq by-lang (cdr (assoc src-lang blocks)))
             (setq blocks (delq (assoc src-lang blocks) 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
     ;; ensure blocks in the correct order
     (setq blocks
     (setq blocks
           (mapcar
           (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
 assumes that the appropriate major-mode is set.  SPEC has the
 form
 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)
     (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)
 (provide 'ob-tangle)
 
 

+ 232 - 147
lisp/ob.el

@@ -57,6 +57,7 @@
 (declare-function org-at-table-p "org" (&optional table-type))
 (declare-function org-at-table-p "org" (&optional table-type))
 (declare-function org-cycle "org" (&optional arg))
 (declare-function org-cycle "org" (&optional arg))
 (declare-function org-uniquify "org" (list))
 (declare-function org-uniquify "org" (list))
+(declare-function org-current-level "org" ())
 (declare-function org-table-import "org-table" (file arg))
 (declare-function org-table-import "org-table" (file arg))
 (declare-function org-add-hook "org-compat" (hook function &optional append local))
 (declare-function org-add-hook "org-compat" (hook function &optional append local))
 (declare-function org-table-align "org-table" ())
 (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]+?\\)}\\)")
    "{\\([^\f\n\r\v]+?\\)}\\)")
   "Regexp used to identify inline src-blocks.")
   "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.
   "Get information on the current source block.
 
 
 Returns a list
 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))
     (if (setq head (org-babel-where-is-src-block-head))
         (save-excursion
         (save-excursion
 	  (goto-char head)
 	  (goto-char head)
@@ -150,29 +147,16 @@ added to the header-arguments-alist."
 	  (setq indent (car (last info)))
 	  (setq indent (car (last info)))
 	  (setq info (butlast info))
 	  (setq info (butlast info))
 	  (forward-line -1)
 	  (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
       (if (save-excursion ;; inline source block
             (re-search-backward "[ \f\t\n\r\v]" nil t)
             (re-search-backward "[ \f\t\n\r\v]" nil t)
             (looking-at org-babel-inline-src-block-regexp))
             (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)))
   (let* ((eval (or (cdr (assoc :eval (nth 2 info)))
 		   (when (assoc :noeval (nth 2 info)) "no")))
 		   (when (assoc :noeval (nth 2 info)) "no")))
 	 (query (or (equal eval "query")
 	 (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")
     (if (or (equal eval "never") (equal eval "no")
 	    (and query
 	    (and query
 		 (not (yes-or-no-p
 		 (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.
   "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."
 Return t if a code block was found at point, nil otherwise."
   `(let ((org-src-window-setup 'switch-invisibly))
   `(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)))
        t)))
 
 
 (defun org-babel-do-key-sequence-in-edit-buffer (key)
 (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
 Call `org-babel-execute-src-block' on every source block in
 the current buffer."
 the current buffer."
   (interactive "P")
   (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
 ;;;###autoload
 (defun org-babel-execute-subtree (&optional arg)
 (defun org-babel-execute-subtree (&optional arg)
@@ -595,9 +574,17 @@ the current subtree."
   "Generate an sha1 hash based on the value of info."
   "Generate an sha1 hash based on the value of info."
   (interactive)
   (interactive)
   (let* ((info (or info (org-babel-get-src-block-info)))
   (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))
     (when (interactive-p) (message hash))
     hash))
     hash))
 
 
@@ -728,8 +715,26 @@ portions of results lines."
 			      'org-babel-show-result-all 'append 'local)))
 			      'org-babel-show-result-all 'append 'local)))
 
 
 (defmacro org-babel-map-src-blocks (file &rest body)
 (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))
   (declare (indent 1))
   `(let ((visited-p (or (null ,file)
   `(let ((visited-p (or (null ,file)
 			(get-file-buffer (expand-file-name ,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))
        (goto-char (point-min))
        (while (re-search-forward org-babel-src-block-regexp nil t)
        (while (re-search-forward org-babel-src-block-regexp nil t)
          (goto-char (match-beginning 0))
          (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))))
          (goto-char (match-end 0))))
      (unless visited-p
      (unless visited-p
        (kill-buffer to-be-removed))
        (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))
 	       (looking-at org-babel-src-block-regexp))
         (point))))))
         (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
 ;;;###autoload
 (defun org-babel-goto-named-src-block (name)
 (defun org-babel-goto-named-src-block (name)
   "Go to a named source-code block."
   "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."
 With optional prefix argument ARG, jump forward ARG many source blocks."
   (interactive "P")
   (interactive "P")
   (when (looking-at org-babel-src-block-regexp) (forward-char 1))
   (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))
   (goto-char (match-beginning 0)) (org-show-context))
 
 
 ;;;###autoload
 ;;;###autoload
@@ -1072,9 +1102,56 @@ With optional prefix argument ARG, jump forward ARG many source blocks."
   "Jump to the previous source block.
   "Jump to the previous source block.
 With optional prefix argument ARG, jump backward ARG many source blocks."
 With optional prefix argument ARG, jump backward ARG many source blocks."
   (interactive "P")
   (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))
   (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)
 (defvar org-babel-lob-one-liner-regexp)
 (defun org-babel-where-is-src-block-result (&optional insert info hash indent)
 (defun org-babel-where-is-src-block-result (&optional insert info hash indent)
   "Find where the current source block results begin.
   "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)
         (when (member "file" result-params)
           (setq result (org-babel-result-to-file result))))
           (setq result (org-babel-result-to-file result))))
     (unless (listp result) (setq result (format "%S" 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))
 	    (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
 	  (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"))))
       (message "finished"))))
 
 
 (defun org-babel-remove-result (&optional info)
 (defun org-babel-remove-result (&optional info)
@@ -1366,7 +1446,7 @@ file's directory then expand relative links."
   (let ((size (count-lines beg end)))
   (let ((size (count-lines beg end)))
     (save-excursion
     (save-excursion
       (cond ((= size 0)
       (cond ((= size 0)
-	     (error (concat "This should be impossible:"
+	     (error (concat "This should not be impossible:"
                             "a newline was appended to result if missing")))
                             "a newline was appended to result if missing")))
 	    ((< size org-babel-min-lines-for-block-output)
 	    ((< size org-babel-min-lines-for-block-output)
 	     (goto-char beg)
 	     (goto-char beg)
@@ -1591,7 +1671,7 @@ This is taken almost directly from `org-read-prop'."
     cell))
     cell))
 
 
 (defun org-babel-number-p (string)
 (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)
   (if (and (string-match "^-?[0-9]*\\.?[0-9]*$" string)
            (= (length (substring string (match-beginning 0)
            (= (length (substring string (match-beginning 0)
 				 (match-end 0)))
 				 (match-end 0)))
@@ -1668,18 +1748,7 @@ Fixes a bug in `tramp-handle-call-process-region'."
     (apply org-babel-call-process-region-original
     (apply org-babel-call-process-region-original
            start end program delete buffer display args)))
            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."
   "Return the local name component of FILE."
   (if (file-remote-p file)
   (if (file-remote-p file)
       (let (localname)
       (let (localname)
@@ -1687,13 +1756,27 @@ the remote connection."
 	  localname))
 	  localname))
     file))
     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
 Used by `org-babel-temp-file'.  This directory will be removed on
-Emacs shutdown.")
+Emacs shutdown."))
 
 
 (defun org-babel-temp-file (prefix &optional suffix)
 (defun org-babel-temp-file (prefix &optional suffix)
   "Create a temporary file in the `org-babel-temporary-directory'.
   "Create a temporary file in the `org-babel-temporary-directory'.
@@ -1706,14 +1789,16 @@ of `org-babel-temporary-directory'."
 	       (expand-file-name 
 	       (expand-file-name 
 		prefix temporary-file-directory)
 		prefix temporary-file-directory)
 	       nil suffix))
 	       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))))
       (make-temp-file prefix nil suffix))))
 
 
 (defun org-babel-remove-temporary-directory ()
 (defun org-babel-remove-temporary-directory ()
   "Remove `org-babel-temporary-directory' on Emacs shutdown."
   "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
     ;; taken from `delete-directory' in files.el
     (mapc (lambda (file)
     (mapc (lambda (file)
 	    ;; This test is equivalent to
 	    ;; This test is equivalent to

+ 28 - 6
lisp/org-agenda.el

@@ -2829,7 +2829,11 @@ the global options and expect it to be applied to the entire view.")
 	(switch-to-buffer-other-frame abuf))
 	(switch-to-buffer-other-frame abuf))
        ((equal org-agenda-window-setup 'reorganize-frame)
        ((equal org-agenda-window-setup 'reorganize-frame)
 	(delete-other-windows)
 	(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)
     (setq buffer-read-only nil)
     (let ((inhibit-read-only t)) (erase-buffer))
     (let ((inhibit-read-only t)) (erase-buffer))
     (org-agenda-mode)
     (org-agenda-mode)
@@ -3552,6 +3556,20 @@ in `org-agenda-text-search-extra-files'."
 	    (member (string-to-char words) '(?- ?+ ?\{)))
 	    (member (string-to-char words) '(?- ?+ ?\{)))
 	(setq boolean t))
 	(setq boolean t))
     (setq words (org-split-string words))
     (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)
     (setq org-agenda-last-search-view-search-was-boolean boolean)
     (when boolean
     (when boolean
       (let (wds w)
       (let (wds w)
@@ -5117,13 +5135,13 @@ The modified list may contain inherited tags, and tags matched by
 	  (throw 'exit list))
 	  (throw 'exit list))
       (while (setq time (pop gridtimes))
       (while (setq time (pop gridtimes))
 	(unless (and remove (member time have))
 	(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
 	  (push (org-format-agenda-item
 		 nil string "" nil
 		 nil string "" nil
 		 (concat (substring time 0 -2) ":" (substring time -2)))
 		 (concat (substring time 0 -2) ":" (substring time -2)))
 		new)
 		new)
 	  (put-text-property
 	  (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)
       (if (member 'time-up org-agenda-sorting-strategy-selected)
 	  (append new list)
 	  (append new list)
 	(append list new)))))
 	(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))
 	      (if (not (eval org-agenda-filter-form))
 		  (org-agenda-filter-by-tag-hide-line))
 		  (org-agenda-filter-by-tag-hide-line))
 	      (beginning-of-line 2))
 	      (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 ()
 (defun org-agenda-filter-by-tag-hide-line ()
   (let (ov)
   (let (ov)
@@ -5803,7 +5823,8 @@ Negative selection means regexp must not match for selection of an entry."
 
 
 (defun org-agenda-goto-date (date)
 (defun org-agenda-goto-date (date)
   "Jump to DATE in agenda."
   "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))
   (org-agenda-list nil date))
 
 
 (defun org-agenda-goto-today ()
 (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
       (let ((calendar-date-display-form
 	     (if (if (boundp 'calendar-date-style)
 	     (if (if (boundp 'calendar-date-style)
 		     (eq calendar-date-style 'european)
 		     (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)
 		 '(day " " month " " year)
 	       '(month " " day " " year))))
 	       '(month " " day " " year))))
 
 

+ 1 - 1
lisp/org-archive.el

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

+ 22 - 16
lisp/org-ascii.el

@@ -311,7 +311,7 @@ publishing directory."
 		  :add-text (plist-get opt-plist :text))
 		  :add-text (plist-get opt-plist :text))
 		 "\n"))
 		 "\n"))
 	 thetoc have-headings first-heading-pos
 	 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))
     (let ((inhibit-read-only t))
       (org-unmodified
       (org-unmodified
        (remove-text-properties (point-min) (point-max)
        (remove-text-properties (point-min) (point-max)
@@ -347,7 +347,7 @@ publishing directory."
 
 
       (if (and (or author email)
       (if (and (or author email)
 	       org-export-author-info)
 	       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
 			  (if (and org-export-email-info
 				   email (string-match "\\S-" email))
 				   email (string-match "\\S-" email))
 			      (concat " <" email ">") "")
 			      (concat " <" email ">") "")
@@ -431,10 +431,12 @@ publishing directory."
       ;; Remove the quoted HTML tags.
       ;; Remove the quoted HTML tags.
       (setq line (org-html-expand-for-ascii line))
       (setq line (org-html-expand-for-ascii line))
       ;; Replace links with the description when possible
       ;; 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)
 	(if (and (> (length link) 8)
 		 (equal (substring link 0 8) "coderef:"))
 		 (equal (substring link 0 8) "coderef:"))
 	    (setq line (replace-match
 	    (setq line (replace-match
@@ -443,15 +445,18 @@ publishing directory."
 				      (substring link 8)
 				      (substring link 8)
 				      org-export-code-refs)))
 				      org-export-code-refs)))
 			t t line))
 			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))))
 	  (setq line (replace-match rpl t t line))))
       (when custom-times
       (when custom-times
 	(setq line (org-translate-time line)))
 	(setq line (org-translate-time line)))
@@ -482,7 +487,8 @@ publishing directory."
 		   (org-format-table-ascii table-buffer)
 		   (org-format-table-ascii table-buffer)
 		   "\n") "\n")))
 		   "\n") "\n")))
        (t
        (t
-	(if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)" line)
+	(if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)"
+			  line)
 	    (setq line (replace-match "\\1\\3:" t nil line)))
 	    (setq line (replace-match "\\1\\3:" t nil line)))
 	(setq line (org-fix-indentation line org-ascii-current-indentation))
 	(setq line (org-fix-indentation line org-ascii-current-indentation))
 	;; Remove forced line breaks
 	;; Remove forced line breaks

+ 17 - 12
lisp/org-capture.el

@@ -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
 Apart from these general escapes, you can access information specific to the
 link type that is created.  For example, calling `org-capture' in emails
 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
 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.
 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
   :group 'org-capture
   :type
   :type
   '(repeat
   '(repeat
@@ -678,6 +681,7 @@ already gone."
   (delete-other-windows)
   (delete-other-windows)
   (org-switch-to-buffer-other-window
   (org-switch-to-buffer-other-window
    (org-capture-get-indirect-buffer (org-capture-get :buffer) "CAPTURE"))
    (org-capture-get-indirect-buffer (org-capture-get :buffer) "CAPTURE"))
+  (widen)
   (show-all)
   (show-all)
   (goto-char (org-capture-get :pos))
   (goto-char (org-capture-get :pos))
   (org-set-local 'org-capture-target-marker
   (org-set-local 'org-capture-target-marker
@@ -1198,6 +1202,7 @@ The template may still contain \"%?\" for cursor positioning."
 				   "org-capture-template-prompt-history::"
 				   "org-capture-template-prompt-history::"
 				   (or prompt "")))
 				   (or prompt "")))
 		  completions (mapcar 'list completions)))
 		  completions (mapcar 'list completions)))
+	  (unless (boundp histvar) (set histvar nil))
 	  (cond
 	  (cond
 	   ((member char '("G" "g"))
 	   ((member char '("G" "g"))
 	    (let* ((org-last-tags-completion-table
 	    (let* ((org-last-tags-completion-table

+ 10 - 8
lisp/org-clock.el

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

+ 2 - 1
lisp/org-exp-blocks.el

@@ -201,7 +201,8 @@ which defaults to the value of `org-export-blocks-witheld'."
 	(interblock start (point-max))
 	(interblock start (point-max))
 	(run-hooks 'org-export-blocks-postblock-hook)))))
 	(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
 ;; type specific functions

+ 2 - 1
lisp/org-exp.el

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

+ 1 - 1
lisp/org-feed.el

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

+ 57 - 2
lisp/org-gnus.el

@@ -39,6 +39,7 @@
 ;; Declare external functions and variables
 ;; Declare external functions and variables
 (declare-function message-fetch-field "message" (header &optional not-all))
 (declare-function message-fetch-field "message" (header &optional not-all))
 (declare-function message-narrow-to-head-1 "message" nil)
 (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
 ;; The following line suppresses a compiler warning stemming from gnus-sum.el
 (declare-function gnus-summary-last-subject "gnus-sum" nil)
 (declare-function gnus-summary-last-subject "gnus-sum" nil)
 ;; Customization variables
 ;; Customization variables
@@ -54,12 +55,40 @@ negates this setting for the duration of the command."
   :group 'org-link-store
   :group 'org-link-store
   :type 'boolean)
   :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
 ;; Install the link type
 (org-add-link-type "gnus" 'org-gnus-open)
 (org-add-link-type "gnus" 'org-gnus-open)
 (add-hook 'org-store-link-functions 'org-gnus-store-link)
 (add-hook 'org-store-link-functions 'org-gnus-store-link)
 
 
 ;; Implementation
 ;; 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)
 (defun org-gnus-group-link (group)
   "Create a link to the Gnus group GROUP.
   "Create a link to the Gnus group GROUP.
 If GROUP is a newsgroup and `org-gnus-prefer-web-links' is
 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))
 	   (from (mail-header-from header))
 	   (message-id (org-remove-angle-brackets (mail-header-id header)))
 	   (message-id (org-remove-angle-brackets (mail-header-id header)))
 	   (date (mail-header-date 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)))
 	   (subject (copy-sequence (mail-header-subject header)))
 	   (to (cdr (assq 'To (mail-header-extra header))))
 	   (to (cdr (assq 'To (mail-header-extra header))))
 	   newsgroups x-no-archive desc link)
 	   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"))
 	(setq to (or to (gnus-fetch-original-field "To"))
 	      newsgroups (gnus-fetch-original-field "Newsgroups")
 	      newsgroups (gnus-fetch-original-field "Newsgroups")
 	      x-no-archive (gnus-fetch-original-field "x-no-archive")))
 	      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)
 			    :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)
       (setq desc (org-email-link-description)
 	    link (org-gnus-article-link
 	    link (org-gnus-article-link
 		  group	newsgroups message-id x-no-archive))
 		  group	newsgroups message-id x-no-archive))
       (org-add-link-props :link link :description desc)
       (org-add-link-props :link link :description desc)
       link))))
       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)
 (defun org-gnus-open (path)
   "Follow the Gnus message or folder link specified by PATH."
   "Follow the Gnus message or folder link specified by PATH."
   (let (group article)
   (let (group article)
@@ -171,7 +218,9 @@ If `org-store-link' was called with a prefix arg the meaning of
   (cond ((and group article)
   (cond ((and group article)
 	 (gnus-activate-group group t)
 	 (gnus-activate-group group t)
 	 (condition-case nil
 	 (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
 	       (cond
 		((eq backend 'nndoc)
 		((eq backend 'nndoc)
 		 (if (gnus-group-read-group t nil group)
 		 (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
 		(t
 		 (let ((articles 1)
 		 (let ((articles 1)
 		       group-opened)
 		       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)
 		   (while (and (not group-opened)
 			       ;; stop on integer overflows
 			       ;; stop on integer overflows
 			       (> articles 0))
 			       (> articles 0))

+ 3 - 3
lisp/org-html.el

@@ -387,7 +387,7 @@ be linked only."
 		 (const :tag "When there is no description" maybe)))
 		 (const :tag "When there is no description" maybe)))
 
 
 (defcustom org-export-html-inline-image-extensions
 (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."
   "Extensions of image files that can be inlined into HTML."
   :group 'org-export-html
   :group 'org-export-html
   :type '(repeat (string :tag "Extension")))
   :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.
   "Preamble, to be inserted just after <body>.  Set by publishing functions.
 This may also be a function, building and inserting the preamble.")
 This may also be a function, building and inserting the preamble.")
 (defvar org-export-html-postamble nil
 (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.")
 This may also be a function, building and inserting the postamble.")
 (defvar org-export-html-auto-preamble t
 (defvar org-export-html-auto-preamble t
   "Should default preamble be inserted?  Set by publishing functions.")
   "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)
 	 (string-match "\\.org$" path)
 	 (progn
 	 (progn
 	    (list
 	    (list
-	       "http"
+	       "file"
 	       (concat
 	       (concat
 		  (substring path 0 (match-beginning 0))
 		  (substring path 0 (match-beginning 0))
 		  "."
 		  "."

+ 17 - 5
lisp/org-icalendar.el

@@ -194,6 +194,13 @@ When nil of the empty string, use the abbreviation retrieved from Emacs."
 	  (const :tag "Unspecified" nil)
 	  (const :tag "Unspecified" nil)
 	  (string :tag "Time zone")))
 	  (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
 ;;; iCalendar export
 
 
 ;;;###autoload
 ;;;###autoload
@@ -311,7 +318,7 @@ When COMBINE is non nil, add the category to each line."
 		inc t
 		inc t
 		hd (condition-case nil
 		hd (condition-case nil
 		       (org-icalendar-cleanup-string
 		       (org-icalendar-cleanup-string
-			(org-get-heading))
+			(org-get-heading t))
 		     (error (throw :skip nil)))
 		     (error (throw :skip nil)))
 		summary (org-icalendar-cleanup-string
 		summary (org-icalendar-cleanup-string
 			 (org-entry-get nil "SUMMARY"))
 			 (org-entry-get nil "SUMMARY"))
@@ -439,7 +446,7 @@ END:VEVENT\n"
       (when org-icalendar-include-todo
       (when org-icalendar-include-todo
 	(setq prefix "TODO-")
 	(setq prefix "TODO-")
 	(goto-char (point-min))
 	(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
 	  (catch :skip
 	    (org-agenda-skip)
 	    (org-agenda-skip)
 	    (when org-icalendar-verify-function
 	    (when org-icalendar-verify-function
@@ -471,7 +478,7 @@ END:VEVENT\n"
 			((eq org-icalendar-include-todo t)
 			((eq org-icalendar-include-todo t)
 			 ;; include everything that is not done
 			 ;; include everything that is not done
 			 (member state org-not-done-keywords))))
 			 (member state org-not-done-keywords))))
-	      (setq hd (match-string 3)
+	      (setq hd (match-string 4)
 		    summary (org-icalendar-cleanup-string
 		    summary (org-icalendar-cleanup-string
 			     (org-entry-get nil "SUMMARY"))
 			     (org-entry-get nil "SUMMARY"))
 		    desc (org-icalendar-cleanup-string
 		    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 h (+ 2 h)))
 	    (setq d (1+ d))))
 	    (setq d (1+ d))))
 	(setq time (encode-time s mi h d m y)))
 	(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)
 (provide 'org-icalendar)
 
 

+ 41 - 6
lisp/org-latex.el

@@ -280,6 +280,11 @@ markup defined, the first one in the association list will be used."
 		   (string :tag "Keyword")
 		   (string :tag "Keyword")
 		   (string :tag "Markup")))))
 		   (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}"
 (defcustom org-export-latex-timestamp-markup "\\textit{%s}"
   "A printf format string to be applied to time stamps."
   "A printf format string to be applied to time stamps."
   :group 'org-export-latex
   :group 'org-export-latex
@@ -451,8 +456,11 @@ allowed.  The default we use here encompasses both."
   :group 'org-export)
   :group 'org-export)
 
 
 (defcustom org-latex-to-pdf-process
 (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.
   "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
 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
 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
 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.
 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
 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.
 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."
 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
 		     (save-excursion
 		       (goto-char (point-min))
 		       (goto-char (point-min))
 		       (re-search-forward "\\\\bibliography{" nil t))))
 		       (re-search-forward "\\\\bibliography{" nil t))))
-	 cmd output-dir)
+	 cmd output-dir errors)
     (with-current-buffer outbuf (erase-buffer))
     (with-current-buffer outbuf (erase-buffer))
     (message (concat "Processing LaTeX file " file "..."))
     (message (concat "Processing LaTeX file " file "..."))
     (setq output-dir (file-name-directory 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)))
 		     t t cmd)))
 	(shell-command cmd outbuf outbuf)))
 	(shell-command cmd outbuf outbuf)))
     (message (concat "Processing LaTeX file " file "...done"))
     (message (concat "Processing LaTeX file " file "...done"))
+    (setq errors (org-export-latex-get-error outbuf))
     (if (not (file-exists-p pdffile))
     (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)
       (set-window-configuration wconfig)
       (when org-export-pdf-remove-logfiles
       (when org-export-pdf-remove-logfiles
 	(dolist (ext org-export-pdf-logfiles)
 	(dolist (ext org-export-pdf-logfiles)
 	  (setq file (concat base "." ext))
 	  (setq file (concat base "." ext))
 	  (and (file-exists-p file) (delete-file file))))
 	  (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)))
       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
 ;;;###autoload
 (defun org-export-as-pdf-and-open (arg)
 (defun org-export-as-pdf-and-open (arg)
   "Export as LaTeX, then process through to PDF, and open."
   "Export as LaTeX, then process through to PDF, and open."
@@ -1335,7 +1370,7 @@ links, keywords, lists, tables, fixed-width"
 	  (replace-match "")
 	  (replace-match "")
 	(replace-match
 	(replace-match
 	 (org-export-latex-protect-string
 	 (org-export-latex-protect-string
-	  (format "\\textbf{%s}"
+	  (format org-export-latex-tag-markup
 		  (save-match-data
 		  (save-match-data
 		    (replace-regexp-in-string
 		    (replace-regexp-in-string
 		     "_" "\\\\_" (match-string 0)))))
 		     "_" "\\\\_" (match-string 0)))))

+ 156 - 167
lisp/org-list.el

@@ -40,6 +40,9 @@
 (defvar org-M-RET-may-split-line)
 (defvar org-M-RET-may-split-line)
 (defvar org-complex-heading-regexp)
 (defvar org-complex-heading-regexp)
 (defvar org-odd-levels-only)
 (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-invisible-p "org" ())
 (declare-function org-on-heading-p "org" (&optional invisible-ok))
 (declare-function org-on-heading-p "org" (&optional invisible-ok))
@@ -55,6 +58,13 @@
 		  (pom property &optional inherit literal-nil))
 		  (pom property &optional inherit literal-nil))
 (declare-function org-narrow-to-subtree "org" ())
 (declare-function org-narrow-to-subtree "org" ())
 (declare-function org-show-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
 (defgroup org-plain-lists nil
   "Options concerning plain lists in Org-mode."
   "Options concerning plain lists in Org-mode."
@@ -63,7 +73,6 @@
 
 
 (defcustom org-cycle-include-plain-lists t
 (defcustom org-cycle-include-plain-lists t
   "When t, make TAB cycle visibility on plain list items.
   "When t, make TAB cycle visibility on plain list items.
-
 Cycling plain lists works only when the cursor is on a plain list
 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
 item.  When the cursor is on an outline heading, plain lists are
 treated as text.  This is the most stable way of handling this,
 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
 (defcustom org-list-ending-method 'both
   "Determine where plain lists should end.
   "Determine where plain lists should end.
-
 Valid values are: `regexp', `indent' or `both'.
 Valid values are: `regexp', `indent' or `both'.
 
 
 When set to `regexp', Org will look into two variables,
 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
 (defcustom org-empty-line-terminates-plain-lists nil
   "Non-nil means an empty line ends all plain list levels.
   "Non-nil means an empty line ends all plain list levels.
-
 This variable only makes sense if `org-list-ending-method' is set
 This variable only makes sense if `org-list-ending-method' is set
 to `regexp' or `both'. This is then equivalent to set
 to `regexp' or `both'. This is then equivalent to set
 `org-list-end-regexp' to \"^[ \\t]*$\"."
 `org-list-end-regexp' to \"^[ \\t]*$\"."
@@ -193,14 +200,12 @@ precedence over it."
 				      (indent . t)
 				      (indent . t)
 				      (insert . t))
 				      (insert . t))
   "Non-nil means apply set of rules when acting on lists.
   "Non-nil means apply set of rules when acting on lists.
-
 By default, automatic actions are taken when using
 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
 bullet    when non-nil, cycling bullet do not allow lists at
           column 0 to have * as a bullet and descriptions lists
           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)
 (defun org-list-maybe-skip-block (search limit)
   "Return non-nil value if point is in a block, skipping it on the way.
   "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,
 It looks for the boundary of the block in SEARCH direction,
 stopping at LIMIT."
 stopping at LIMIT."
   (save-match-data
   (save-match-data
@@ -331,7 +335,6 @@ stopping at LIMIT."
 
 
 (defun org-list-search-unenclosed-generic (search re bound noerr)
 (defun org-list-search-unenclosed-generic (search re bound noerr)
   "Search a string outside blocks and protected places.
   "Search a string outside blocks and protected places.
-
 Arguments SEARCH, RE, BOUND and NOERR are similar to those in
 Arguments SEARCH, RE, BOUND and NOERR are similar to those in
 `search-forward', `search-backward', `re-search-forward' and
 `search-forward', `search-backward', `re-search-forward' and
 `re-search-backward'."
 `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)
 (defun org-search-backward-unenclosed (regexp &optional bound noerror)
   "Like `re-search-backward' but don't stop inside blocks or protected places.
   "Like `re-search-backward' but don't stop inside blocks or protected places.
-
 Arguments REGEXP, BOUND and NOERROR are similar to those used in
 Arguments REGEXP, BOUND and NOERROR are similar to those used in
 `re-search-backward'."
 `re-search-backward'."
   (org-list-search-unenclosed-generic
   (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)
 (defun org-search-forward-unenclosed (regexp &optional bound noerror)
   "Like `re-search-forward' but don't stop inside blocks or protected places.
   "Like `re-search-forward' but don't stop inside blocks or protected places.
-
 Arguments REGEXP, BOUND and NOERROR are similar to those used in
 Arguments REGEXP, BOUND and NOERROR are similar to those used in
 `re-search-forward'."
 `re-search-forward'."
   (org-list-search-unenclosed-generic
   (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)
 (defun org-list-in-item-p-with-indent (limit)
   "Is the cursor inside a plain list?
   "Is the cursor inside a plain list?
-
 Plain lists are considered ending when a non-blank line is less
 Plain lists are considered ending when a non-blank line is less
 indented than the previous item within LIMIT."
 indented than the previous item within LIMIT."
   (save-excursion
   (save-excursion
@@ -403,7 +403,6 @@ indented than the previous item within LIMIT."
 
 
 (defun org-list-in-item-p-with-regexp (limit)
 (defun org-list-in-item-p-with-regexp (limit)
   "Is the cursor inside a plain list?
   "Is the cursor inside a plain list?
-
 Plain lists end when `org-list-end-regexp' is matched, or at a
 Plain lists end when `org-list-end-regexp' is matched, or at a
 blank line if `org-empty-line-terminates-plain-lists' is true.
 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)
 (defun org-list-top-point-with-regexp (limit)
   "Return point at the top level item in a list.
   "Return point at the top level item in a list.
-
 Argument LIMIT specifies the upper-bound of the search.
 Argument LIMIT specifies the upper-bound of the search.
 
 
 List ending is determined by regexp. See
 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)
 (defun org-list-bottom-point-with-regexp (limit)
   "Return point just before list ending.
   "Return point just before list ending.
-
 Argument LIMIT specifies the lower-bound of the search.
 Argument LIMIT specifies the lower-bound of the search.
 
 
 List ending is determined by regexp. See
 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)
 (defun org-list-top-point-with-indent (limit)
   "Return point at the top level in a list.
   "Return point at the top level in a list.
-
 Argument LIMIT specifies the upper-bound of the search.
 Argument LIMIT specifies the upper-bound of the search.
 
 
 List ending is determined by indentation of text. See
 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)
 (defun org-list-bottom-point-with-indent (limit)
   "Return point just before list ending or nil if not in a list.
   "Return point just before list ending or nil if not in a list.
-
 Argument LIMIT specifies the lower-bound of the search.
 Argument LIMIT specifies the lower-bound of the search.
 
 
 List ending is determined by the indentation of text. See
 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")
 	      (skip-chars-forward " \r\t\n")
 	      (beginning-of-line))
 	      (beginning-of-line))
 	     ((org-at-item-p)
 	     ((org-at-item-p)
-	      (setq ind-ref (min ind ind-ref))
+	      (setq ind-ref ind)
 	      (forward-line 1))
 	      (forward-line 1))
 	     ((<= ind ind-ref)
 	     ((<= ind ind-ref)
 	      (throw 'exit (point-at-bol)))
 	      (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)
 (defun org-list-separating-blank-lines-number (pos top bottom)
   "Return number of blank lines that should separate items in list.
   "Return number of blank lines that should separate items in list.
-
 POS is the position of point to be considered.
 POS is the position of point to be considered.
 
 
 TOP and BOTTOM are respectively position of list beginning and
 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)
 (defun org-list-insert-item-generic (pos &optional checkbox after-bullet)
   "Insert a new list item at POS.
   "Insert a new list item at POS.
-
 If POS is before first character after bullet of the item, the
 If POS is before first character after bullet of the item, the
 new item will be created before the current one.
 new item will be created before the current one.
 
 
@@ -659,6 +652,9 @@ function ends."
 	      ;; recompute next-item: last sexp modified list
 	      ;; recompute next-item: last sexp modified list
 	      (goto-char (org-get-next-item (point) bottom))
 	      (goto-char (org-get-next-item (point) bottom))
 	      (org-move-to-column col)))
 	      (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))
 	    (when checkbox (org-update-checkbox-count-maybe))
 	    (org-list-repair nil top bottom))))
 	    (org-list-repair nil top bottom))))
     (goto-char true-pos)
     (goto-char true-pos)
@@ -690,7 +686,6 @@ function ends."
 
 
 (defun org-list-indent-item-generic (arg no-subtree top bottom)
 (defun org-list-indent-item-generic (arg no-subtree top bottom)
   "Indent a local list item including its children.
   "Indent a local list item including its children.
-
 When number ARG is a negative, item will be outdented, otherwise
 When number ARG is a negative, item will be outdented, otherwise
 it will be indented.
 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.
 ;; already in a list and doesn't compute list boundaries.
 
 
 ;; If you plan to use more than one org-list function is some code,
 ;; 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 ()
 (defun org-list-top-point ()
   "Return point at the top level in a list.
   "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)
 (defun org-get-end-of-item (bottom)
   "Return position at the end of the current item.
   "Return position at the end of the current item.
 BOTTOM is the position at list ending."
 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 ()
 (defun org-end-of-item ()
   "Go to the end of the current hand-formatted 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 ()
 (defun org-previous-item ()
   "Move to the beginning of the previous item.
   "Move to the beginning of the previous item.
-
 Item is at the same level in the current plain list. Error if not
 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."
 in a plain list, or if this is the first item in the list."
   (interactive)
   (interactive)
@@ -1015,7 +1011,6 @@ Stop searching at LIMIT. Return nil if no item is found."
 
 
 (defun org-next-item ()
 (defun org-next-item ()
   "Move to the beginning of the next item.
   "Move to the beginning of the next item.
-
 Item is at the same level in the current plain list. Error if not
 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."
 in a plain list, or if this is the last item in the list."
   (interactive)
   (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)
 (defun org-list-exchange-items (beg-A beg-B bottom)
   "Swap item starting at BEG-A with item starting at BEG-B.
   "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
 Blank lines at the end of items are left in place. Assume BEG-A
 is lesser than BEG-B.
 is lesser than BEG-B.
 
 
@@ -1049,7 +1043,6 @@ BOTTOM is the position at list ending."
 
 
 (defun org-move-item-down ()
 (defun org-move-item-down ()
   "Move the plain list item at point down, i.e. swap with following item.
   "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,
 Subitems (items with larger indentation) are considered part of the item,
 so this really moves item trees."
 so this really moves item trees."
   (interactive)
   (interactive)
@@ -1071,7 +1064,6 @@ so this really moves item trees."
 
 
 (defun org-move-item-up ()
 (defun org-move-item-up ()
   "Move the plain list item at point up, i.e. swap with previous item.
   "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,
 Subitems (items with larger indentation) are considered part of the item,
 so this really moves item trees."
 so this really moves item trees."
   (interactive)
   (interactive)
@@ -1093,7 +1085,6 @@ so this really moves item trees."
 
 
 (defun org-insert-item (&optional checkbox)
 (defun org-insert-item (&optional checkbox)
   "Insert a new item at the current level.
   "Insert a new item at the current level.
-
 If cursor is before first character after bullet of the item, the
 If cursor is before first character after bullet of the item, the
 new item will be created before the current one.
 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
 Return t when things worked, nil when we are not in an item, or
 item is invisible."
 item is invisible."
   (unless (or (not (org-in-item-p))
   (unless (or (not (org-in-item-p))
-	      (org-invisible-p))
+	      (save-excursion
+		(goto-char (org-get-item-beginning))
+		(org-invisible-p)))
     (if (save-excursion
     (if (save-excursion
 	  (goto-char (org-get-item-beginning))
 	  (goto-char (org-get-item-beginning))
 	  (org-at-item-timer-p))
 	  (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)
 (defun org-list-struct (begin end top bottom &optional outdent)
   "Return the structure containing the list between BEGIN and END.
   "Return the structure containing the list between BEGIN and END.
-
 A structure is an alist where key is point of item and values
 A structure is an alist where key is point of item and values
 are, in that order, indentation, bullet string and value of
 are, in that order, indentation, bullet string and value of
 counter, if any. A structure contains every list and sublist that
 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)
 (defun org-list-struct-origins (struct)
   "Return an alist where key is item's position and value parent's.
   "Return an alist where key is item's position and value parent's.
-
 STRUCT is the list's structure looked up."
 STRUCT is the list's structure looked up."
   (let* ((struct-rev (reverse struct))
   (let* ((struct-rev (reverse struct))
 	 (acc (list (cons (nth 1 (car struct)) 0)))
 	 (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)
 (defun org-list-struct-get-parent (item struct origins)
   "Return parent association of ITEM in STRUCT or nil.
   "Return parent association of ITEM in STRUCT or nil.
-
 ORIGINS is the alist of parents. See `org-list-struct-origins'."
 ORIGINS is the alist of parents. See `org-list-struct-origins'."
   (let* ((parent-pos (cdr (assq (car item) origins))))
   (let* ((parent-pos (cdr (assq (car item) origins))))
     (when (> parent-pos 0) (assq parent-pos struct))))
     (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)
 (defun org-list-struct-fix-bul (struct origins)
   "Verify and correct bullets for every association in STRUCT.
   "Verify and correct bullets for every association in STRUCT.
-
 ORIGINS is the alist of parents. See `org-list-struct-origins'.
 ORIGINS is the alist of parents. See `org-list-struct-origins'.
 
 
 This function modifies STRUCT."
 This function modifies STRUCT."
@@ -1302,7 +1291,6 @@ This function modifies STRUCT."
 
 
 (defun org-list-struct-fix-ind (struct origins)
 (defun org-list-struct-fix-ind (struct origins)
   "Verify and correct indentation for every association in STRUCT.
   "Verify and correct indentation for every association in STRUCT.
-
 ORIGINS is the alist of parents. See `org-list-struct-origins'.
 ORIGINS is the alist of parents. See `org-list-struct-origins'.
 
 
 This function modifies STRUCT."
 This function modifies STRUCT."
@@ -1322,7 +1310,6 @@ This function modifies STRUCT."
 
 
 (defun org-list-struct-fix-struct (struct origins)
 (defun org-list-struct-fix-struct (struct origins)
   "Return STRUCT with correct bullets and indentation.
   "Return STRUCT with correct bullets and indentation.
-
 ORIGINS is the alist of parents. See `org-list-struct-origins'.
 ORIGINS is the alist of parents. See `org-list-struct-origins'.
 
 
 Only elements of STRUCT that have changed are returned."
 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)
 (defun org-list-struct-outdent (start end origins)
   "Outdent items in a structure.
   "Outdent items in a structure.
-
 Items are indented when their key is between START, included, and
 Items are indented when their key is between START, included, and
 END, excluded.
 END, excluded.
 
 
@@ -1366,7 +1352,6 @@ STRUCT is the concerned structure."
 
 
 (defun org-list-struct-indent (start end origins struct)
 (defun org-list-struct-indent (start end origins struct)
   "Indent items in a structure.
   "Indent items in a structure.
-
 Items are indented when their key is between START, included, and
 Items are indented when their key is between START, included, and
 END, excluded.
 END, excluded.
 
 
@@ -1429,7 +1414,6 @@ END."
 
 
 (defun org-list-struct-apply-struct (struct bottom)
 (defun org-list-struct-apply-struct (struct bottom)
   "Apply modifications to list so it mirrors STRUCT.
   "Apply modifications to list so it mirrors STRUCT.
-
 BOTTOM is position at list ending.
 BOTTOM is position at list ending.
 
 
 Initial position is restored after the changes."
 Initial position is restored after the changes."
@@ -1502,7 +1486,6 @@ BOTTOM is position at list ending."
 
 
 (defun org-outdent-item ()
 (defun org-outdent-item ()
   "Outdent a local list item, but not its children.
   "Outdent a local list item, but not its children.
-
 If a region is active, all items inside will be moved."
 If a region is active, all items inside will be moved."
   (interactive)
   (interactive)
   (org-list-indent-item-generic
   (org-list-indent-item-generic
@@ -1510,7 +1493,6 @@ If a region is active, all items inside will be moved."
 
 
 (defun org-indent-item ()
 (defun org-indent-item ()
   "Indent a local list item, but not its children.
   "Indent a local list item, but not its children.
-
 If a region is active, all items inside will be moved."
 If a region is active, all items inside will be moved."
   (interactive)
   (interactive)
   (org-list-indent-item-generic
   (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 ()
 (defun org-outdent-item-tree ()
   "Outdent a local list item including its children.
   "Outdent a local list item including its children.
-
 If a region is active, all items inside will be moved."
 If a region is active, all items inside will be moved."
   (interactive)
   (interactive)
   (org-list-indent-item-generic
   (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 ()
 (defun org-indent-item-tree ()
   "Indent a local list item including its children.
   "Indent a local list item including its children.
-
 If a region is active, all items inside will be moved."
 If a region is active, all items inside will be moved."
   (interactive)
   (interactive)
   (org-list-indent-item-generic
   (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)
 (defvar org-tab-ind-state)
 (defun org-cycle-item-indentation ()
 (defun org-cycle-item-indentation ()
   "Cycle levels of indentation of an empty item.
   "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.
 put back at its original position with its original bullet.
 
 
 Return t at each successful move."
 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
 			      (unless (and bullet-rule-p
 					   (looking-at "\\S-")) '("*"))
 					   (looking-at "\\S-")) '("*"))
 			      ;; Description items cannot be numbered
 			      ;; 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
 			      (unless (and bullet-rule-p
 					   (or (eq org-plain-list-ordered-item-terminator ?\))
 					   (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))
 	 (len (length bullet-list))
 	 (item-index (- len (length (member current bullet-list))))
 	 (item-index (- len (length (member current bullet-list))))
 	 (get-value (lambda (index) (nth (mod index len) 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)
 (defun org-toggle-checkbox (&optional toggle-presence)
   "Toggle the checkbox in the current line.
   "Toggle the checkbox in the current line.
-
 With prefix arg TOGGLE-PRESENCE, add or remove checkboxes.  With
 With prefix arg TOGGLE-PRESENCE, add or remove checkboxes.  With
 double prefix, set checkbox to [-].
 double prefix, set checkbox to [-].
 
 
 When there is an active region, toggle status or presence of the
 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
 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 the text below the heading, taking as reference the first item
-in subtree."
+in subtree, ignoring drawers."
   (interactive "P")
   (interactive "P")
   ;; Bounds is a list of type (beg end single-p) where single-p is t
   ;; 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
   ;; when `org-toggle-checkbox' is applied to a single item. Only
@@ -1702,22 +1680,34 @@ in subtree."
   (let* ((bounds
   (let* ((bounds
           (cond
           (cond
            ((org-region-active-p)
            ((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)
            ((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
               (save-excursion
+		(goto-char limit)
+		(org-search-backward-unenclosed ":END:" pos 'move)
                 (org-search-forward-unenclosed
                 (org-search-forward-unenclosed
 		 org-item-beginning-re limit 'move)
 		 org-item-beginning-re limit 'move)
                 (list (point) limit nil))))
                 (list (point) limit nil))))
            ((org-at-item-p)
            ((org-at-item-p)
             (list (point-at-bol) (point-at-eol) t))
             (list (point-at-bol) (point-at-eol) t))
            (t (error "Not at an item or heading, and no active region"))))
            (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)))
          (end (copy-marker (nth 1 bounds)))
          (single-p (nth 2 bounds))
          (single-p (nth 2 bounds))
          (ref-presence (save-excursion
          (ref-presence (save-excursion
-			 (goto-char (car bounds))
+			 (goto-char beg)
 			 (org-at-item-checkbox-p)))
 			 (org-at-item-checkbox-p)))
          (ref-status (equal (match-string 1) "[X]"))
          (ref-status (equal (match-string 1) "[X]"))
          (act-on-item
          (act-on-item
@@ -1751,7 +1741,7 @@ in subtree."
                          (t "[X]"))
                          (t "[X]"))
                    t t nil 1))))))))
                    t t nil 1))))))))
     (save-excursion
     (save-excursion
-      (beginning-of-line)
+      (goto-char beg)
       (while (< (point) end)
       (while (< (point) end)
         (funcall act-on-item ref-presence ref-status)
         (funcall act-on-item ref-presence ref-status)
         (org-search-forward-unenclosed org-item-beginning-re end 'move)))
         (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."
 the whole buffer."
   (interactive "P")
   (interactive "P")
   (save-excursion
   (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)
       (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 ()
 (defun org-get-checkbox-statistics-face ()
   "Select the face for checkbox statistics.
   "Select the face for checkbox statistics.
@@ -1907,8 +1898,7 @@ Otherwise it will be `org-todo'."
 ;;; Misc Tools
 ;;; Misc Tools
 
 
 (defun org-apply-on-list (function init-value &rest args)
 (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,
 FUNCTION must be called with at least one argument: INIT-VALUE,
 that will contain the value returned by the function at the
 that will contain the value returned by the function at the
 previous item, plus ARGS extra arguments.
 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)
 As an example, (org-apply-on-list (lambda (result) (1+ result)) 0)
 will return the number of items in the current list.
 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."
 beginning of the item."
   (let* ((pos (copy-marker (point)))
   (let* ((pos (copy-marker (point)))
 	 (end (copy-marker (org-list-bottom-point)))
 	 (end (copy-marker (org-list-bottom-point)))
@@ -2161,7 +2151,6 @@ this list."
 
 
 (defun org-list-to-generic (list params)
 (defun org-list-to-generic (list params)
   "Convert a LIST parsed through `org-list-parse-list' to other formats.
   "Convert a LIST parsed through `org-list-parse-list' to other formats.
-
 Valid parameters PARAMS are
 Valid parameters PARAMS are
 
 
 :ustart	    String to start an unordered list
 :ustart	    String to start an unordered list
@@ -2217,7 +2206,7 @@ Valid parameters PARAMS are
       (while (setq sublist (pop list))
       (while (setq sublist (pop list))
 	(cond ((symbolp sublist) nil)
 	(cond ((symbolp sublist) nil)
 	      ((stringp sublist)
 	      ((stringp sublist)
-	       (when (string-match "^\\(\\S-+\\)[ \t]+::" sublist)
+	       (when (string-match "^\\(.*\\)[ \t]+::" sublist)
 		 (setq term (org-trim (format (concat dtstart "%s" dtend)
 		 (setq term (org-trim (format (concat dtstart "%s" dtend)
 					      (match-string 1 sublist))))
 					      (match-string 1 sublist))))
 		 (setq sublist (concat ddstart
 		 (setq sublist (concat ddstart

+ 11 - 1
lisp/org-mew.el

@@ -81,7 +81,7 @@
 		(mew-case-folder (mew-sinfo-get-case)
 		(mew-case-folder (mew-sinfo-get-case)
 				 (nth 1 (mew-refile-get msgnum)))
 				 (nth 1 (mew-refile-get msgnum)))
 	      (mew-summary-folder-name)))
 	      (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
       (save-window-excursion
 	(if (fboundp 'mew-summary-set-message-buffer)
 	(if (fboundp 'mew-summary-set-message-buffer)
 	    (mew-summary-set-message-buffer folder-name msgnum)
 	    (mew-summary-set-message-buffer folder-name msgnum)
@@ -89,9 +89,19 @@
 	(setq message-id (mew-header-get-value "Message-Id:"))
 	(setq message-id (mew-header-get-value "Message-Id:"))
 	(setq from (mew-header-get-value "From:"))
 	(setq from (mew-header-get-value "From:"))
 	(setq to (mew-header-get-value "To:"))
 	(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:")))
 	(setq subject (mew-header-get-value "Subject:")))
       (org-store-link-props :type "mew" :from from :to to
       (org-store-link-props :type "mew" :from from :to to
 			    :subject subject :message-id message-id)
 			    :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 message-id (org-remove-angle-brackets message-id))
       (setq desc (org-email-link-description))
       (setq desc (org-email-link-description))
       (setq link (org-make-link "mew:" folder-name
       (setq link (org-make-link "mew:" folder-name

+ 15 - 6
lisp/org-mhe.el

@@ -83,13 +83,22 @@ supported by MH-E."
   "Store a link to an MH-E folder or message."
   "Store a link to an MH-E folder or message."
   (when (or (equal major-mode 'mh-folder-mode)
   (when (or (equal major-mode 'mh-folder-mode)
 	    (equal major-mode 'mh-show-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
       (org-store-link-props :type "mh" :from from :to to
 			    :subject subject :message-id message-id)
 			    :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 desc (org-email-link-description))
       (setq link (org-make-link "mhe:" (org-mhe-get-message-real-folder) "#"
       (setq link (org-make-link "mhe:" (org-mhe-get-message-real-folder) "#"
 				(org-remove-angle-brackets message-id)))
 				(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)
     (if (equal major-mode 'mh-folder-mode)
 	(mh-show)
 	(mh-show)
       (mh-show-show))
       (mh-show-show))
-    header-field)))
+    (org-trim header-field))))
 
 
 (defun org-mhe-follow-link (folder article)
 (defun org-mhe-follow-link (folder article)
   "Follow an MH-E link to FOLDER and ARTICLE.
   "Follow an MH-E link to FOLDER and ARTICLE.

+ 49 - 10
lisp/org-mobile.el

@@ -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
 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,
 password must also be set in the MobileOrg application.  All Org files,
 including mobileorg.org will be encrypted using this password.
 including mobileorg.org will be encrypted using this password.
+
+SECURITY CONSIDERATIONS:
+
 Note that, when Org runs the encryption commands, the password could
 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
   :group 'org-mobile
   :type '(string :tag "Password"))
   :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"
 (defcustom org-mobile-inbox-for-pull "~/org/from-mobile.org"
   "The file where captured notes and flags will be appended to.
   "The file where captured notes and flags will be appended to.
 During the execution of `org-mobile-pull', the file
 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"))))
 		  (string :tag "Selection Keys"))))
 
 
 (defcustom org-mobile-force-id-on-agenda-items t
 (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
   :group 'org-mobile
   :type 'boolean)
   :type 'boolean)
 
 
@@ -356,7 +373,7 @@ agenda view showing the flagged items."
 	       (string-match "\\S-" org-mobile-checksum-binary))
 	       (string-match "\\S-" org-mobile-checksum-binary))
     (error "No executable found to compute checksums"))
     (error "No executable found to compute checksums"))
   (when org-mobile-use-encryption
   (when org-mobile-use-encryption
-    (unless (string-match "\\S-" org-mobile-encryption-password)
+    (unless (string-match "\\S-" (org-mobile-encryption-password))
       (error
       (error
        "To use encryption, you must set `org-mobile-encryption-password'"))
        "To use encryption, you must set `org-mobile-encryption-password'"))
     (unless (file-writable-p org-mobile-encryption-tempfile)
     (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"))
       (and (= (point-min) (point-max)) (insert "\n"))
       (save-buffer)
       (save-buffer)
       (push (cons org-mobile-capture-file (md5 (buffer-string)))
       (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)))
     (kill-buffer buf)))
 
 
 (defun org-mobile-write-checksums ()
 (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
 			(if (org-bound-and-true-p
 			     org-mobile-force-id-on-agenda-items)
 			     org-mobile-force-id-on-agenda-items)
 			    (org-id-get m 'create)
 			    (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
 	      (insert "   :PROPERTIES:\n   :ORIGINAL_ID: " id
 		      "\n   :END:\n")))))
 		      "\n   :END:\n")))))
 	(beginning-of-line 2))
 	(beginning-of-line 2))
-      (push (cons (file-name-nondirectory file) (md5 (buffer-string)))
+      (push (cons "agendas.org" (md5 (buffer-string)))
 	    org-mobile-checksum-files))
 	    org-mobile-checksum-files))
     (message "Agenda written to Org file %s" file)))
     (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
 ;;;###autoload
 (defun org-mobile-create-sumo-agenda ()
 (defun org-mobile-create-sumo-agenda ()
   "Create a file that contains all custom agenda views."
   "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'."
   "Encrypt INFILE to OUTFILE, using `org-mobile-encryption-password'."
   (shell-command
   (shell-command
    (format "openssl enc -aes-256-cbc -salt -pass %s -in %s -out %s"
    (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 infile))
 	   (shell-quote-argument (expand-file-name outfile)))))
 	   (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'."
   "Decrypt INFILE to OUTFILE, using `org-mobile-encryption-password'."
   (shell-command
   (shell-command
    (format "openssl enc -d -aes-256-cbc -salt -pass %s -in %s -out %s"
    (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 infile))
 	   (shell-quote-argument (expand-file-name outfile)))))
 	   (shell-quote-argument (expand-file-name outfile)))))
 
 
@@ -673,7 +711,8 @@ If nothing new has been added, return nil."
 	 (capture-buffer
 	 (capture-buffer
 	  (if (not org-mobile-use-encryption)
 	  (if (not org-mobile-use-encryption)
 	      (find-file-noselect capture-file)
 	      (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"))
 	    (setq encfile (concat org-mobile-encryption-tempfile "_enc"))
 	    (copy-file capture-file encfile)
 	    (copy-file capture-file encfile)
 	    (org-mobile-decrypt-file encfile org-mobile-encryption-tempfile)
 	    (org-mobile-decrypt-file encfile org-mobile-encryption-tempfile)

+ 6 - 8
lisp/org-mouse.el

@@ -148,6 +148,7 @@
 (declare-function org-agenda-change-all-lines "org-agenda"
 (declare-function org-agenda-change-all-lines "org-agenda"
 		  (newhead hdmarker &optional fixface just-this))
 		  (newhead hdmarker &optional fixface just-this))
 (declare-function org-verify-change-for-undo "org-agenda" (l1 l2))
 (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]+[.)]\\) "
 (defvar org-mouse-plain-list-regexp "\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) "
   "Regular expression that matches a plain list.")
   "Regular expression that matches a plain list.")
@@ -576,14 +577,11 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
 	(goto-char (second contextdata))
 	(goto-char (second contextdata))
 	(re-search-forward ".*" (third 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 ()
 (defun org-mouse-bolp ()
   "Return true if there only spaces, tabs, and '*' before point.
   "Return true if there only spaces, tabs, and '*' before point.

+ 6 - 7
lisp/org-publish.el

@@ -578,10 +578,10 @@ See `org-publish-org-to' to the list of arguments."
   "Publish a file with no transformation of any kind.
   "Publish a file with no transformation of any kind.
 See `org-publish-org-to' to the list of arguments."
 See `org-publish-org-to' to the list of arguments."
   ;; make sure eshell/cp code is loaded
   ;; 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
       (copy-file filename
 		 (expand-file-name (file-name-nondirectory filename) pub-dir)
 		 (expand-file-name (file-name-nondirectory filename) pub-dir)
 		 t)))
 		 t)))
@@ -601,13 +601,13 @@ See `org-publish-projects'."
 		  (error "File %s not part of any known project"
 		  (error "File %s not part of any known project"
 			 (abbreviate-file-name filename)))))
 			 (abbreviate-file-name filename)))))
 	 (project-plist (cdr project))
 	 (project-plist (cdr project))
-	 (ftname (file-truename filename))
+	 (ftname (expand-file-name filename))
 	 (publishing-function
 	 (publishing-function
 	  (or (plist-get project-plist :publishing-function)
 	  (or (plist-get project-plist :publishing-function)
 	      'org-publish-org-to-html))
 	      'org-publish-org-to-html))
 	 (base-dir
 	 (base-dir
 	  (file-name-as-directory
 	  (file-name-as-directory
-	   (file-truename
+	   (expand-file-name
 	    (or (plist-get project-plist :base-directory)
 	    (or (plist-get project-plist :base-directory)
 		(error "Project %s does not have :base-directory defined"
 		(error "Project %s does not have :base-directory defined"
 		       (car project))))))
 		       (car project))))))
@@ -794,7 +794,6 @@ directory and force publishing all files."
   (interactive "P")
   (interactive "P")
   (when force
   (when force
     (org-publish-remove-all-timestamps))
     (org-publish-remove-all-timestamps))
-  ;;  (org-publish-initialize-files-alist force)
   (save-window-excursion
   (save-window-excursion
     (let ((org-publish-use-timestamps-flag
     (let ((org-publish-use-timestamps-flag
 	   (if force nil org-publish-use-timestamps-flag)))
 	   (if force nil org-publish-use-timestamps-flag)))

+ 3 - 2
lisp/org-remember.el

@@ -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
 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
 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
 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.
 is recorded for each link type.
 
 
 Link type          |  Available information
 Link type          |  Available information
@@ -167,7 +167,8 @@ vm, wl, mh, rmail  |  %:type %:subject %:message-id
                    |  %:from %:fromname %:fromaddress
                    |  %:from %:fromname %:fromaddress
                    |  %:to   %:toname   %:toaddress
                    |  %:to   %:toname   %:toaddress
                    |  %:fromto (either \"to NAME\" or \"from NAME\")
                    |  %: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
 w3, w3m            |  %:type %:url
 info               |  %:type %:file %:node
 info               |  %:type %:file %:node
 calendar           |  %:type %:date"
 calendar           |  %:type %:date"

+ 10 - 0
lisp/org-rmail.el

@@ -59,10 +59,20 @@
 	       (from (mail-fetch-field "from"))
 	       (from (mail-fetch-field "from"))
 	       (to (mail-fetch-field "to"))
 	       (to (mail-fetch-field "to"))
 	       (subject (mail-fetch-field "subject"))
 	       (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)
 	       desc link)
 	  (org-store-link-props
 	  (org-store-link-props
 	   :type "rmail" :from from :to to
 	   :type "rmail" :from from :to to
 	   :subject subject :message-id message-id)
 	   :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 message-id (org-remove-angle-brackets message-id))
 	  (setq desc (org-email-link-description))
 	  (setq desc (org-email-link-description))
 	  (setq link (org-make-link "rmail:" folder "#" message-id))
 	  (setq link (org-make-link "rmail:" folder "#" message-id))

+ 37 - 13
lisp/org-src.el

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

+ 3 - 0
lisp/org-table.el

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

+ 2 - 5
lisp/org-timer.el

@@ -31,7 +31,7 @@
 
 
 (require 'org)
 (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" ())
 (declare-function org-agenda-error "org-agenda" ())
 
 
 (defvar org-timer-start-time nil
 (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"
       (message "%d minute(s) %d seconds left before next time out"
 	       rmins rsecs))))
 	       rmins rsecs))))
 
 
-(defun bzg-test (&optional test)
-  (interactive "P")
-  test)
-
 ;;;###autoload
 ;;;###autoload
 (defun org-timer-set-timer (&optional opt)
 (defun org-timer-set-timer (&optional opt)
   "Prompt for a duration and set a timer.
   "Prompt for a duration and set a timer.
@@ -378,6 +374,7 @@ replace any running timer."
 		       (y-or-n-p "Replace current timer? ")))
 		       (y-or-n-p "Replace current timer? ")))
 	      (not org-timer-current-timer))
 	      (not org-timer-current-timer))
 	  (progn
 	  (progn
+	    (require 'org-clock)
 	    (when org-timer-current-timer
 	    (when org-timer-current-timer
 	      (cancel-timer org-timer-current-timer))
 	      (cancel-timer org-timer-current-timer))
 	    (setq org-timer-current-timer
 	    (setq org-timer-current-timer

+ 10 - 0
lisp/org-vm.el

@@ -66,9 +66,19 @@
 	     (to (vm-get-header-contents message "To"))
 	     (to (vm-get-header-contents message "To"))
 	     (from (vm-get-header-contents message "From"))
 	     (from (vm-get-header-contents message "From"))
 	     (message-id (vm-su-message-id message))
 	     (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)
 	     desc link)
 	(org-store-link-props :type "vm" :from from :to to :subject subject
 	(org-store-link-props :type "vm" :from from :to to :subject subject
 			      :message-id message-id)
 			      :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 message-id (org-remove-angle-brackets message-id))
 	(setq folder (abbreviate-file-name folder))
 	(setq folder (abbreviate-file-name folder))
 	(if (and vm-folder-directory
 	(if (and vm-folder-directory

+ 35 - 3
lisp/org-wl.el

@@ -84,6 +84,8 @@ googlegroups otherwise."
 (declare-function wl-summary-buffer-msgdb "ext:wl-folder" () t)
 (declare-function wl-summary-buffer-msgdb "ext:wl-folder" () t)
 (declare-function wl-summary-jump-to-msg-by-message-id "ext:wl-summary"
 (declare-function wl-summary-jump-to-msg-by-message-id "ext:wl-summary"
 		  (&optional id))
 		  (&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-from "ext:wl-summary" ())
 (declare-function wl-summary-line-subject "ext:wl-summary" ())
 (declare-function wl-summary-line-subject "ext:wl-summary" ())
 (declare-function wl-summary-message-number "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-summary-buffer-folder-name)
 (defvar wl-folder-group-regexp)
 (defvar wl-folder-group-regexp)
 (defvar wl-auto-check-folder-name)
 (defvar wl-auto-check-folder-name)
+(defvar elmo-nntp-default-server)
 
 
 (defconst org-wl-folder-types
 (defconst org-wl-folder-types
   '(("%" . imap) ("-" . nntp) ("+" . mh) ("=" . spool)
   '(("%" . imap) ("-" . nntp) ("+" . mh) ("=" . spool)
@@ -137,7 +140,7 @@ folder name determines the the folder type."
   "Return content of FIELD in ENTITY.
   "Return content of FIELD in ENTITY.
 FIELD is a symbol of a rfc822 message header field.
 FIELD is a symbol of a rfc822 message header field.
 ENTITY is a message entity."
 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)))
     (if (listp content) (car content) content)))
 
 
 (defun org-wl-store-link ()
 (defun org-wl-store-link ()
@@ -196,6 +199,13 @@ ENTITY is a message entity."
 		 (to (org-wl-message-field 'to wl-message-entity))
 		 (to (org-wl-message-field 'to wl-message-entity))
 		 (xref (org-wl-message-field 'xref wl-message-entity))
 		 (xref (org-wl-message-field 'xref wl-message-entity))
 		 (subject (org-wl-message-field 'subject 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)
 		 desc link)
 
 
 	    ;; remove text properties of subject string to avoid possible bug
 	    ;; 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 desc (org-email-link-description))
 	      (setq link (org-make-link "wl:" folder-name "#" message-id-no-brackets))
 	      (setq link (org-make-link "wl:" folder-name "#" message-id-no-brackets))
 	      (org-add-link-props :link link :description desc)))
 	      (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)))))))
 	    (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)
 (defun org-wl-open (path)
   "Follow the WL message link specified by PATH.
   "Follow the WL message link specified by PATH.
 When called with one prefix, open message in namazu search folder
 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
 	  ;; beginning of the current line.  So, restore the point
 	  ;; in the old buffer.
 	  ;; in the old buffer.
 	  (goto-char old-point))
 	  (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))))))
 	     (wl-summary-redisplay))))))
 
 
 (provide 'org-wl)
 (provide 'org-wl)

+ 154 - 74
lisp/org.el

@@ -471,6 +471,15 @@ the following lines anywhere in the buffer:
   :group 'org-startup
   :group 'org-startup
   :type 'boolean)
   :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
 (defcustom org-insert-mode-line-in-empty-file nil
   "Non-nil means insert the first line setting Org-mode in empty files.
   "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
 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))
 					(plain-list-item . auto))
   "Should `org-insert-heading' leave a blank line before new heading/item?
   "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,
 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
   :group 'org-edit-structure
   :type '(list
   :type '(list
 	  (cons (const heading)
 	  (cons (const heading)
@@ -4148,6 +4161,8 @@ After a match, the following groups carry important information:
     ("oddeven" org-odd-levels-only nil)
     ("oddeven" org-odd-levels-only nil)
     ("align" org-startup-align-all-tables t)
     ("align" org-startup-align-all-tables t)
     ("noalign" org-startup-align-all-tables nil)
     ("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)
     ("customtime" org-display-custom-times t)
     ("logdone" org-log-done time)
     ("logdone" org-log-done time)
     ("lognotedone" org-log-done note)
     ("lognotedone" org-log-done note)
@@ -4718,6 +4733,8 @@ The following commands are available:
       (let ((bmp (buffer-modified-p)))
       (let ((bmp (buffer-modified-p)))
 	(org-table-map-tables 'org-table-align 'quietly)
 	(org-table-map-tables 'org-table-align 'quietly)
 	(set-buffer-modified-p bmp)))
 	(set-buffer-modified-p bmp)))
+    (when org-startup-with-inline-images
+      (org-display-inline-images))
     (when org-startup-indented
     (when org-startup-indented
       (require 'org-indent)
       (require 'org-indent)
       (org-indent-mode 1))
       (org-indent-mode 1))
@@ -4755,7 +4772,7 @@ The following commands are available:
 
 
 (defconst org-non-link-chars "]\t\n\r<>")
 (defconst org-non-link-chars "]\t\n\r<>")
 (defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news"
 (defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news"
-			   "shell" "elisp" "doi"))
+			   "shell" "elisp" "doi" "message"))
 (defvar org-link-types-re nil
 (defvar org-link-types-re nil
    "Matches a link that has a url-like prefix like \"http:\"")
    "Matches a link that has a url-like prefix like \"http:\"")
 (defvar org-link-re-with-space nil
 (defvar org-link-re-with-space nil
@@ -5022,8 +5039,11 @@ will be prompted for."
 				'(display t invisible t intangible t))
 				'(display t invisible t intangible t))
 	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)
 (defun org-fontify-meta-lines-and-blocks (limit)
   "Fontify #+ lines and blocks, in the correct ways."
   "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)
 (defun org-outline-overlay-data (&optional use-markers)
   "Return a list of the locations of all outline overlays.
   "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.
 positions for each overlay.
 If USE-MARKERS is set, return the positions as markers."
 If USE-MARKERS is set, return the positions as markers."
   (let (beg end)
   (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))
 	  (and (not (save-excursion (and (ignore-errors (org-back-to-heading invisible-ok))
 					 (org-on-heading-p))))
 					 (org-on-heading-p))))
 	       (not (org-in-item-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)))
     (when (or force-heading (not (org-insert-item)))
       (let* ((empty-line-p nil)
       (let* ((empty-line-p nil)
 	     (head (save-excursion
 	     (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:\")
   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
   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
 The function may use the FORMAT information to return different values
 depending on the format.  The return value will be put literally into
 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
 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
 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'."
 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)))
 	  (setq s (replace-match "" t t s)))
       (while (string-match org-ts-regexp s)
       (while (string-match org-ts-regexp s)
 	(setq s (replace-match "" t t 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
     (or string (setq s (concat "*" s)))  ; Add * for headlines
     (mapconcat 'identity (org-split-string s "[ \t]+") " ")))
     (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)
   (when (and (not description)
 	     (not (equal link (org-link-escape link))))
 	     (not (equal link (org-link-escape link))))
     (setq description (org-extract-attributes 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 "]") "")
 	  (if description (concat "[" description "]") "")
 	  "]"))
 	  "]"))
 
 
@@ -10456,7 +10482,7 @@ This function can be used in a hook."
     "BEGIN_VERSE" "END_VERSE"
     "BEGIN_VERSE" "END_VERSE"
     "BEGIN_CENTER" "END_CENTER"
     "BEGIN_CENTER" "END_CENTER"
     "BEGIN_SRC" "END_SRC"
     "BEGIN_SRC" "END_SRC"
-    "CATEGORY" "COLUMNS"
+    "CATEGORY" "COLUMNS" "PROPERTY"
     "CAPTION" "LABEL"
     "CAPTION" "LABEL"
     "SETUPFILE"
     "SETUPFILE"
     "BIND"
     "BIND"
@@ -10575,8 +10601,10 @@ At all other locations, this simply calls the value of
 	       (throw 'exit t)))
 	       (throw 'exit t)))
 	    (tag (and (equal (char-before beg1) ?:)
 	    (tag (and (equal (char-before beg1) ?:)
 		      (equal (char-after (point-at-bol)) ?*)))
 		      (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) ?\\))
 	    (texp (equal (char-before beg) ?\\))
 	    (link (equal (char-before beg) ?\[))
 	    (link (equal (char-before beg) ?\[))
 	    (opt (equal (buffer-substring (max (point-at-bol) (- beg 2))
 	    (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*")))
 		  (delete-window (get-buffer-window "*Completions*")))
 	      (if (assoc completion table)
 	      (if (assoc completion table)
 		  (if (eq type :todo) (insert " ")
 		  (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))
 	      (if (and (equal type :opt) (assoc completion table))
 		  (message "%s" (substitute-command-keys
 		  (message "%s" (substitute-command-keys
 				 "Press \\[org-complete] again to insert example settings"))))
 				 "Press \\[org-complete] again to insert example settings"))))
@@ -10691,27 +10722,6 @@ this is nil.")
 
 
 (defvar org-setting-tags nil) ; dynamically skipped
 (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
 (defvar org-todo-setup-filter-hook nil
   "Hook for functions that pre-filter todo specs.
   "Hook for functions that pre-filter todo specs.
 Each function takes a todo spec and returns either nil or the spec
 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 ()
 (defun org-skip-over-state-notes ()
   "Skip past the list of State notes in an entry."
   "Skip past the list of State notes in an entry."
   (if (looking-at "\n[ \t]*- State") (forward-char 1))
   (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)
 (defun org-add-log-note (&optional purpose)
   "Pop up a window for taking a note, and add this note later at point."
   "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."
   "Finish taking a log note, and insert it to where it belongs."
   (let ((txt (buffer-string))
   (let ((txt (buffer-string))
 	(note (cdr (assq org-log-note-purpose org-log-note-headings)))
 	(note (cdr (assq org-log-note-purpose org-log-note-headings)))
-	lines ind)
+	lines ind bul)
     (kill-buffer (current-buffer))
     (kill-buffer (current-buffer))
     (while (string-match "\\`#.*\n[ \t\n]*" txt)
     (while (string-match "\\`#.*\n[ \t\n]*" txt)
       (setq txt (replace-match "" t t 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)
 	  (move-marker org-log-note-marker nil)
 	  (end-of-line 1)
 	  (end-of-line 1)
 	  (if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n")))
 	  (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")
 	  (message "Note stored")
 	  (org-back-to-heading t)
 	  (org-back-to-heading t)
 	  (org-cycle-hide-drawers 'children)))))
 	  (org-cycle-hide-drawers 'children)))))
@@ -12102,7 +12126,8 @@ ACTION can be `set', `up', `down', or a character."
 	    (setq new action)
 	    (setq new action)
 	  (message "Priority %c-%c, SPC to remove: "
 	  (message "Priority %c-%c, SPC to remove: "
 		   org-highest-priority org-lowest-priority)
 		   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)
 	(if (and (= (upcase org-highest-priority) org-highest-priority)
 		 (= (upcase org-lowest-priority) org-lowest-priority))
 		 (= (upcase org-lowest-priority) org-lowest-priority))
 	    (setq new (upcase new)))
 	    (setq new (upcase new)))
@@ -12748,8 +12773,10 @@ With prefix ARG, realign all tags in headings in the current buffer."
 	(save-excursion
 	(save-excursion
 	  (setq table (append org-tag-persistent-alist
 	  (setq table (append org-tag-persistent-alist
 			      (or org-tag-alist (org-get-buffer-tags))
 			      (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
 		org-last-tags-completion-table table
 		current-tags (org-split-string current ":")
 		current-tags (org-split-string current ":")
 		inherited-tags (nreverse
 		inherited-tags (nreverse
@@ -12761,19 +12788,24 @@ With prefix ARG, realign all tags in headings in the current buffer."
 			     (delq nil (mapcar 'cdr table))))
 			     (delq nil (mapcar 'cdr table))))
 		    (org-fast-tag-selection
 		    (org-fast-tag-selection
 		     current-tags inherited-tags table
 		     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))
 		  (let ((org-add-colon-after-tag-completion t))
 		    (org-trim
 		    (org-trim
 		     (org-without-partial-completion
 		     (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)))))))
 				       nil nil current 'org-tags-history)))))))
 	(while (string-match "[-+&]+" tags)
 	(while (string-match "[-+&]+" tags)
 	  ;; No boolean logic, just a list
 	  ;; No boolean logic, just a list
 	  (setq tags (replace-match ":" t t tags))))
 	  (setq tags (replace-match ":" t t tags))))
 
 
+      (setq tags (replace-regexp-in-string "[ ,]" ":" tags))
+
       (if org-tags-sort-function
       (if org-tags-sort-function
       	  (setq tags (mapconcat 'identity
       	  (setq tags (mapconcat 'identity
-      				(sort (org-split-string tags (org-re "[^[:alnum:]_@#%]+"))
+      				(sort (org-split-string
+				       tags (org-re "[^[:alnum:]_@#%]+"))
       				      org-tags-sort-function) ":")))
       				      org-tags-sort-function) ":")))
 
 
       (if (string-match "\\`[\t ]*\\'" tags)
       (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)
 (defun org-tags-completion-function (string predicate &optional flag)
   (let (s1 s2 rtn (ctable org-last-tags-completion-table)
   (let (s1 s2 rtn (ctable org-last-tags-completion-table)
 	   (confirm (lambda (x) (stringp (car x)))))
 	   (confirm (lambda (x) (stringp (car x)))))
-    (if (string-match "^\\(.*[-+:&|]\\)\\([^-+:&|]*\\)$" string)
+    (if (string-match "^\\(.*[-+:&,|]\\)\\([^-+:&,|]*\\)$" string)
         (setq s1 (match-string 1 string)
         (setq s1 (match-string 1 string)
               s2 (match-string 2 string))
               s2 (match-string 2 string))
       (setq s1 "" s2 string))
       (setq s1 "" s2 string))
@@ -14584,9 +14616,10 @@ user function argument order change dependent on argument order."
 	(list arg2 arg1 arg3))
 	(list arg2 arg1 arg3))
        ((eq calendar-date-style 'iso)
        ((eq calendar-date-style 'iso)
 	(list arg2 arg3 arg1)))
 	(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)
 (defun org-eval-in-calendar (form &optional keepdate)
   "Eval FORM in the calendar window and return to current window.
   "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)
 (org-defkey org-mode-map "\C-c\C-x-"    'org-timer-item)
 (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-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)
 (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)
 (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-table-auto-blank-field) ; defined in org-table.el
 (defvar org-speed-command nil)
 (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)
 (defun org-self-insert-command (N)
   "Like `self-insert-command', use overwrite-mode for whitespace in tables.
   "Like `self-insert-command', use overwrite-mode for whitespace in tables.
 If the cursor is in a table looking at whitespace, the whitespace is
 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")
   (interactive "p")
   (cond
   (cond
    ((and org-use-speed-commands
    ((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
     (cond
      ((commandp org-speed-command)
      ((commandp org-speed-command)
       (setq this-command 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]*  |"))
 	    (noalign (looking-at "[^|\n\r]*  |"))
 	    (c org-table-may-need-update))
 	    (c org-table-may-need-update))
 	(backward-delete-char N)
 	(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
 	;; noalign: if there were two spaces at the end, this field
 	;; does not determine the width of the column.
 	;; does not determine the width of the column.
 	(if noalign (setq org-table-may-need-update c)))
 	(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))))
 	nil))))
 
 
 (defun org-in-regexps-block-p (start-re end-re &optional bound)
 (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
 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
 in an unfinished block. END-RE can be a string or a form
 returning a string.
 returning a string.
@@ -18567,7 +18633,7 @@ which make use of the date at the cursor."
      ;; Lists
      ;; Lists
      ((org-in-item-p)
      ((org-in-item-p)
       (org-beginning-of-item)
       (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)
       (setq bpos (match-beginning 1) tpos (match-end 0)
 	    bcol (progn (goto-char bpos) (current-column))
 	    bcol (progn (goto-char bpos) (current-column))
 	    tcol (progn (goto-char tpos) (current-column))
 	    tcol (progn (goto-char tpos) (current-column))
@@ -19176,6 +19242,18 @@ move point."
     (while (org-goto-sibling 'previous)
     (while (org-goto-sibling 'previous)
       (org-flag-heading nil))))
       (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 ()
 (defun org-show-hidden-entry ()
   "Show an entry where even the heading is hidden."
   "Show an entry where even the heading is hidden."
   (save-excursion
   (save-excursion
@@ -19267,7 +19345,9 @@ If there is no such heading, return nil."
 
 
 (defun org-forward-same-level (arg &optional invisible-ok)
 (defun org-forward-same-level (arg &optional invisible-ok)
   "Move forward to the arg'th subheading at same level as this one.
   "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")
   (interactive "p")
   (org-back-to-heading invisible-ok)
   (org-back-to-heading invisible-ok)
   (org-on-heading-p)
   (org-on-heading-p)

+ 50 - 0
testing/README.org

@@ -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 - 0
testing/contrib/lisp/.gitignore

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

+ 1 - 0
testing/ert

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

+ 29 - 0
testing/examples/babel.org

@@ -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 - 0
testing/examples/link-in-heading.org

@@ -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 - 0
testing/examples/no-heading.org

@@ -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 - 0
testing/examples/normal.org

@@ -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 - 0
testing/jump

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

+ 89 - 0
testing/lisp/test-ob-exp.el

@@ -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 - 0
testing/lisp/test-ob-tangle.el

@@ -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 - 0
testing/lisp/test-ob.el

@@ -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 - 0
testing/org-html/tests.el → testing/old/org-html.el


+ 23 - 0
testing/org-test-ob-consts.el

@@ -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 - 0
testing/org-test.el

@@ -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

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