org-odt.el: Add support for annotation blocks

* contrib/lisp/org-lparse.el (org-lparse-special-blocks): New
variable.  Add "annotation" blocks in addition to the already
existing "list-table" blocks.
(org-lparse-get-block-params): New helper routine to read
params passed to a special block.  Used in conjunction with
OpenDocument annotations and with parsing of "#+ATTR_ODT:..."
lines attached to images.
(org-lparse-par-open-stashed): New let-bound variable.
(org-do-lparse): Bind `org-lparse-par-open-stashed'.  Treat
all blocks listed in `org-lparse-special-blocks' as special
environments.  Honor options passed as part of
"#+begin_<block-name>[options]".
(org-lparse-preprocess-after-blockquote-hook): Handle all
blocks listed in `org-lparse-special-blocks' specially.
(org-lparse-strip-experimental-blocks-maybe-hook): New hook
that hooks up to `org-export-preprocess-hook'.  Removes blocks
listed under `org-lparse-special-blocks' while exporting to
formats other than "odt" or "xhtml".
(org-lparse-begin-environment, org-lparse-end-environment):
Modified signature to accomodate block params.
(org-lparse-stash-save-paragraph-state)
(org-lparse-stash-pop-paragraph-state): New helper routines
for use with emitting of OpenDocument annotations.
(org-lparse-list-table-enable): Removed.  "list tables" are
now always enabled.

* contrib/lisp/org-odt.el (org-odt-begin-annotation)
(org-odt-end-annotation): New routines.
(org-odt-begin-environment, org-odt-end-environment): Handle
block params.  Handle the new "annotation" block.
(org-odt-format-author, org-odt-iso-date-from-org-timestamp):
New helper routnes for emitting author and comment timestamps
with annotation blocks.
(org-odt-update-meta-file): Use above routines.
(org-export-odt-format-image): Use
`org-lparse-get-block-params' to parse inline image attributes.
(org-odt-format-date): Removed.  Superceded by
`org-odt-iso-date-from-org-timestamp'.

See http://lists.gnu.org/archive/html/emacs-orgmode/2011-10/msg01251.html

contrib/lisp/org-lparse.el

@@ -305,6 +305,16 @@ OPT-PLIST is the export options list."
 	    start (+ start (length rpl))))
     line))
 
+(defvar org-lparse-par-open-stashed)	; bound during `org-do-lparse'
+(defun org-lparse-stash-save-paragraph-state ()
+  (assert (zerop org-lparse-par-open-stashed))
+  (setq org-lparse-par-open-stashed org-lparse-par-open)
+  (setq org-lparse-par-open nil))
+
+(defun org-lparse-stash-pop-paragraph-state ()
+  (setq org-lparse-par-open org-lparse-par-open-stashed)
+  (setq org-lparse-par-open-stashed 0))
+
 (defmacro with-org-lparse-preserve-paragraph-state (&rest body)
   `(let ((org-lparse-do-open-par org-lparse-par-open))
      (org-lparse-end-paragraph)
@@ -543,6 +553,15 @@ and then converted to \"doc\" then org-lparse-backend is set to
 (defvar org-lparse-to-buffer nil
   "Bind this to TO-BUFFER arg of `org-lparse'.")
 
+(defun org-lparse-get-block-params (params)
+  (save-match-data
+    (when params
+      (setq params (org-trim params))
+      (unless (string-match "\\`(.*)\\'" params)
+	(setq params (format "(%s)" params)))
+      (ignore-errors (read params)))))
+
+(defvar org-lparse-special-blocks '("list-table" "annotation"))
 (defun org-do-lparse (arg &optional hidden ext-plist
 			  to-buffer body-only pub-dir)
   "Export the outline to various formats.
@@ -572,6 +591,7 @@ version."
 					; collecting styles
 	 org-lparse-encode-pending
 	 org-lparse-par-open
+	 (org-lparse-par-open-stashed 0)
 
 	 ;; list related vars
 	 (org-lparse-list-level 0)	; list level starts at 1. A
@@ -902,13 +922,19 @@ version."
 	    (throw 'nextline nil))
 
 	  ;; Blockquotes, verse, and center
-	  (when (string-match  "^ORG-\\(.+\\)-\\(START\\|END\\)$" line)
+	  (when (string-match
+		 "^ORG-\\(.+\\)-\\(START\\|END\\)\\([ \t]+.*\\)?$" line)
 	    (let* ((style (intern (downcase (match-string 1 line))))
+		   (env-options-plist (org-lparse-get-block-params
+				       (match-string 3 line)))
 		   (f (cdr (assoc (match-string 2 line)
 				  '(("START" . org-lparse-begin-environment)
 				    ("END" . org-lparse-end-environment))))))
-	      (when (memq style '(blockquote verse center list-table))
-		(funcall f style)
+	      (when (memq style
+			  (append
+			   '(blockquote verse center)
+			   (mapcar 'intern org-lparse-special-blocks)))
+		(funcall f style env-options-plist)
 		(throw 'nextline nil))))
 
 	  (run-hooks 'org-export-html-after-blockquotes-hook)
@@ -1713,48 +1739,58 @@ information."
   (org-lparse-end-paragraph)
   (org-lparse-end-list-item (or type "u")))
 
-(defcustom org-lparse-list-table-enable nil
-  "Specify whether a list be exported as a table.
-When this option is enabled, lists that are enclosed in
-\"#+begin_list-table...#+end_list-table\" are exported as
-tables. Otherwise they are exported normally."
-  :type 'boolean
-  :group 'org-lparse)
-
 (defun org-lparse-preprocess-after-blockquote-hook ()
-  "Treat #+begin_list-table...#+end_list-table blocks specially.
-When `org-lparse-list-table-enable' is non-nil, enclose these
-blocks within ORG-LIST-TABLE-START...ORG-LIST-TABLE-END."
-  (when org-lparse-list-table-enable
-    (goto-char (point-min))
-    (while (re-search-forward "^[ \t]*#\\+\\(begin\\|end\\)_\\(.*\\)$" nil t)
-      (when (string= (downcase (match-string 2)) "list-table")
-	(replace-match (if (equal (downcase (match-string 1)) "begin")
-			   "ORG-LIST-TABLE-START"
-			 "ORG-LIST-TABLE-END") t t)))))
+  "Treat `org-lparse-special-blocks' specially."
+  (goto-char (point-min))
+  (while (re-search-forward
+	  "^[ \t]*#\\+\\(begin\\|end\\)_\\(\\S-+\\)[ \t]*\\(.*\\)$" nil t)
+    (when (member (downcase (match-string 2)) org-lparse-special-blocks)
+      (replace-match
+       (if (equal (downcase (match-string 1)) "begin")
+	   (format "ORG-%s-START %s" (upcase (match-string 2))
+		   (match-string 3))
+	 (format "ORG-%s-END %s" (upcase (match-string 2))
+		 (match-string 3))) t t))))
 
 (add-hook 'org-export-preprocess-after-blockquote-hook
 	  'org-lparse-preprocess-after-blockquote-hook)
 
+(defun org-lparse-strip-experimental-blocks-maybe-hook ()
+  "Strip \"list-table\" and \"annotation\" blocks.
+Stripping happens only when the exported backend is not one of
+\"odt\" or \"xhtml\"."
+  (when (not org-lparse-backend)
+    (message "Stripping following blocks - %S" org-lparse-special-blocks)
+    (goto-char (point-min))
+    (let ((case-fold-search t))
+      (while
+	  (re-search-forward
+	   "^[ \t]*#\\+begin_\\(\\S-+\\)\\([ \t]+.*\\)?\n\\([^\000]*?\\)\n[ \t]*#\\+end_\\1\\>.*"
+	   nil t)
+	(when (member (match-string 1) org-lparse-special-blocks)
+	  (replace-match "" t t))))))
+
+(add-hook 'org-export-preprocess-hook
+	  'org-lparse-strip-experimental-blocks-maybe-hook)
+
 (defvar org-lparse-list-table-p nil
-  "Non-nil if `org-do-lparse' is within a list-table.
-See `org-lparse-list-table-enable'.")
+  "Non-nil if `org-do-lparse' is within a list-table.")
 
 (defvar org-lparse-dyn-current-environment nil)
-(defun org-lparse-begin-environment (style)
+(defun org-lparse-begin-environment (style &optional env-options-plist)
   (case style
     (list-table
-     (setq org-lparse-list-table-p org-lparse-list-table-enable))
+     (setq org-lparse-list-table-p t))
     (t
      (setq org-lparse-dyn-current-environment style)
-     (org-lparse-begin 'ENVIRONMENT  style))))
+     (org-lparse-begin 'ENVIRONMENT  style env-options-plist))))
 
-(defun org-lparse-end-environment (style)
+(defun org-lparse-end-environment (style &optional env-options-plist)
   (case style
     (list-table
      (setq org-lparse-list-table-p nil))
     (t
-     (org-lparse-end 'ENVIRONMENT style)
+     (org-lparse-end 'ENVIRONMENT style env-options-plist)
      (setq org-lparse-dyn-current-environment nil))))
 
 (defun org-lparse-current-environment-p (style)
@@ -2061,7 +2097,7 @@ When TITLE is nil, just close all open levels."
 
 ;; Notes on LIST-TABLES
 ;; ====================
-;; When `org-lparse-list-table-enable' is non-nil, the following list
+;; Lists withing "list-table" blocks (as shown below)
 ;;
 ;; #+begin_list-table
 ;; - Row 1

contrib/lisp/org-odt.el

@@ -504,8 +504,41 @@ PUB-DIR is set, use this as the publishing directory."
    '("<text:p%s>" . "</text:p>") text
    (org-odt-get-extra-attrs-for-paragraph-style style)))
 
-(defun org-odt-begin-environment (style)
+(defvar org-lparse-opt-plist)		    ; bound during org-do-lparse
+(defun org-odt-format-author (&optional author)
+  (when (setq author (or author (plist-get org-lparse-opt-plist :author)))
+    (org-odt-format-tags '("<dc:creator>" . "</dc:creator>") author)))
+
+(defun org-odt-iso-date-from-org-timestamp (&optional org-ts)
+  (save-match-data
+    (let* ((time
+	    (and (stringp org-ts)
+		 (string-match org-ts-regexp0 org-ts)
+		 (apply 'encode-time
+			(org-fix-decoded-time
+			 (org-parse-time-string (match-string 0 org-ts) t)))))
+	   (date (format-time-string "%Y-%m-%dT%H:%M:%S%z" time)))
+      (format "%s:%s" (substring date 0 -2) (substring date -2)))))
+
+(defun org-odt-begin-annotation (&optional author date)
+  (org-lparse-insert-tag "<office:annotation>")
+  (when (setq author (org-odt-format-author author))
+    (insert author))
+  (insert (org-odt-format-tags
+	   '("<dc:date>" . "</dc:date>")
+	   (org-odt-iso-date-from-org-timestamp
+	    (or date (plist-get org-lparse-opt-plist :date)))))
+  (org-lparse-begin-paragraph))
+
+(defun org-odt-end-annotation ()
+  (org-lparse-insert-tag  "</office:annotation>"))
+
+(defun org-odt-begin-environment (style env-options-plist)
   (case style
+    (annotation
+     (org-lparse-stash-save-paragraph-state)
+     (org-odt-begin-annotation (plist-get env-options-plist 'author)
+			       (plist-get env-options-plist 'date)))
     ((blockquote verse center quote)
      (org-lparse-begin-paragraph style)
      (list))
@@ -514,8 +547,12 @@ PUB-DIR is set, use this as the publishing directory."
      (list))
     (t (error "Unknown environment %s" style))))
 
-(defun org-odt-end-environment (style)
+(defun org-odt-end-environment (style env-options-plist)
   (case style
+    (annotation
+     (org-lparse-end-paragraph)
+     (org-odt-end-annotation)
+     (org-lparse-stash-pop-paragraph-state))
     ((blockquote verse center quote)
      (org-lparse-end-paragraph)
      (list))
@@ -1446,7 +1483,7 @@ MAY-INLINE-P allows inlining it as an image."
 			     (or (org-find-text-property-in-string
 				  'org-latex-src-embed-type src) 'character)
 			   'paragraph)))
-	   (attr-plist (when attr (read  attr)))
+	   (attr-plist (org-lparse-get-block-params attr))
 	   (size (org-odt-image-size-from-file
 		  src (plist-get attr-plist :width)
 		  (plist-get attr-plist :height)
@@ -1840,37 +1877,9 @@ visually."
 	    xml-files)
 
       (delete-directory zipdir)))
-
   (message "Created %s" target)
   (set-buffer (find-file-noselect target t)))
 
-(defun org-odt-format-date (date)
-  (let ((warning-msg
-	 "OpenDocument files require that dates be in ISO-8601 format. Please review your DATE options for compatibility."))
-    ;; If the user is not careful with the date specification, an
-    ;; invalid meta.xml will be emitted.
-
-    ;; For now honor user's diktat and let him off with a warning
-    ;; message. This is OK as LibreOffice (and possibly other
-    ;; apps) doesn't deem this deviation as critical and continue
-    ;; to load the file.
-
-    ;; FIXME: Surely there a better way to handle this. Revisit this
-    ;; later.
-    (cond
-     ((and date (string-match "%" date))
-      ;; Honor user's diktat. See comments above
-      (org-lparse-warn warning-msg)
-      (format-time-string date))
-     (date
-      ;; Honor user's diktat. See comments above
-      (org-lparse-warn warning-msg)
-      date)
-     (t
-      ;; ISO 8601 format
-      (let ((stamp (format-time-string "%Y-%m-%dT%H:%M:%S%z")))
-	(format "%s:%s" (substring stamp 0 -2) (substring stamp -2)))))))
-
 (defconst org-odt-manifest-file-entry-tag
   "
 <manifest:file-entry manifest:media-type=\"%s\" manifest:full-path=\"%s\"%s/>")
@@ -1900,13 +1909,13 @@ visually."
     (write-region "\n</manifest:manifest>" nil manifest-file t)))
 
 (defun org-odt-update-meta-file (opt-plist)
-  (let ((date (org-odt-format-date (plist-get opt-plist :date)))
+  (let ((date (org-odt-iso-date-from-org-timestamp
+	       (plist-get opt-plist :date)))
 	(author (or (plist-get opt-plist :author) ""))
 	(email (plist-get opt-plist :email))
 	(keywords (plist-get opt-plist :keywords))
 	(description (plist-get opt-plist :description))
 	(title (plist-get opt-plist :title)))
-
     (write-region
      (concat
       "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
@@ -1918,7 +1927,7 @@ visually."
          xmlns:ooo=\"http://openoffice.org/2004/office\"
          office:version=\"1.2\">
        <office:meta>" "\n"
-      (org-odt-format-tags '("<dc:creator>" . "</dc:creator>") author)
+      (org-odt-format-author)
       (org-odt-format-tags
        '("\n<meta:initial-creator>" . "</meta:initial-creator>") author)
       (org-odt-format-tags '("\n<dc:date>" . "</dc:date>") date)
@@ -2100,7 +2109,6 @@ using `org-open-file'."
     (t (error "Unknown property: %s"  what))))
 
 (defvar org-lparse-latex-fragment-fallback) ; set by org-do-lparse
-(defvar org-lparse-opt-plist)		    ; bound during org-do-lparse
 (defun org-export-odt-do-preprocess-latex-fragments ()
   "Convert LaTeX fragments to images."
   (let* ((latex-frag-opt (plist-get org-lparse-opt-plist :LaTeX-fragments))