Browse Source

iCalendar and XOXO export: Functions moved to new files.

Carsten Dominik 16 years ago
parent
commit
b6c7e8054e
8 changed files with 698 additions and 609 deletions
  1. 5 1
      Makefile
  2. 4 0
      lisp/ChangeLog
  3. 2 2
      lisp/org-ascii.el
  4. 3 0
      lisp/org-compat.el
  5. 2 598
      lisp/org-exp.el
  6. 538 0
      lisp/org-icalendar.el
  7. 124 0
      lisp/org-xoxo.el
  8. 20 8
      lisp/org.el

+ 5 - 1
Makefile

@@ -77,6 +77,7 @@ LISPF      = 	org.el			\
 		org-faces.el		\
 		org-footnote.el		\
 		org-gnus.el		\
+		org-icalendar.el	\
 		org-id.el		\
 		org-info.el		\
 		org-inlinetask.el	\
@@ -97,7 +98,8 @@ LISPF      = 	org.el			\
 		org-timer.el		\
 		org-vm.el		\
 		org-w3m.el              \
-		org-wl.el
+		org-wl.el		\
+		org-xoxo.el
 
 LISPFILES0 = $(LISPF:%=lisp/%)
 LISPFILES  = $(LISPFILES0) lisp/org-install.el
@@ -332,6 +334,7 @@ lisp/org-docbook.elc:      lisp/org.el lisp/org-exp.el
 lisp/org-faces.elc:        lisp/org-macs.el lisp/org-compat.el
 lisp/org-footnotes.elc:    lisp/org-macs.el lisp/org-compat.el
 lisp/org-gnus.elc:         lisp/org.el
+lisp/org-icalendar.elc:    lisp/org-exp.el
 lisp/org-id.elc:           lisp/org.el
 lisp/org-info.elc:         lisp/org.el
 lisp/org-inlinetask.elc:
@@ -353,3 +356,4 @@ lisp/org-timer.elc:         lisp/org.el
 lisp/org-vm.elc:           lisp/org.el
 lisp/org-w3m.elc:          lisp/org.el
 lisp/org-wl.elc:           lisp/org.el
+lisp/org-xoxo.elc:         lisp/org-exp.el

+ 4 - 0
lisp/ChangeLog

@@ -1,5 +1,9 @@
 2009-04-07  Carsten Dominik  <carsten.dominik@gmail.com>
 
+	* org-icalendar.el: New file, split out from org-exp.el.
+
+	* org-xoxo.el: New file, split out from org-exp.el.
+
 	* org-ascii.el: New file, split out from org-exp.el.
 
 2009-04-06  Carsten Dominik  <carsten.dominik@gmail.com>

+ 2 - 2
lisp/org-ascii.el

@@ -1,4 +1,4 @@
-;;; org-exp.el --- ASCII export for Org-mode
+;;; org-ascii.el --- ASCII export for Org-mode
 
 ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009
 ;;   Free Software Foundation, Inc.
@@ -371,7 +371,7 @@ underlined headlines.  The default is 3."
 	(goto-char beg)))
     (goto-char (point-min))))
 
-(defun org-export-ascii-preprocess ()
+(defun org-export-ascii-preprocess (parameters)
   "Do extra work for ASCII export"
   ;; Put quotes around verbatim text
   (goto-char (point-min))

+ 3 - 0
lisp/org-compat.el

@@ -31,6 +31,9 @@
 
 ;;; Code:
 
+(eval-when-compile
+  (require 'cl))
+
 (require 'org-macs)
 
 (declare-function find-library-name             "find-func"  (library))

+ 2 - 598
lisp/org-exp.el

@@ -32,6 +32,7 @@
   (require 'cl))
 
 (declare-function org-export-latex-preprocess "org-export-latex" (parameters))
+(declare-function org-export-ascii-preprocess "org-ascii" (parameters))
 (declare-function org-export-docbook-preprocess "org-docbook" (parameters))
 (declare-function org-agenda-skip "org-agenda" ())
 (declare-function org-infojs-options-inbuffer-template "org-jsinfo" ())
@@ -786,113 +787,6 @@ in all modes you want.  Then, use the command
   :group 'org-export-htmlize
   :type 'string)
 
-(defgroup org-export-icalendar nil
-  "Options specific for iCalendar export of Org-mode files."
-  :tag "Org Export iCalendar"
-  :group 'org-export)
-
-(defcustom org-combined-agenda-icalendar-file "~/org.ics"
-  "The file name for the iCalendar file covering all agenda files.
-This file is created with the command \\[org-export-icalendar-all-agenda-files].
-The file name should be absolute, the file will be overwritten without warning."
-  :group 'org-export-icalendar
-  :type 'file)
-
-(defcustom org-icalendar-combined-name "OrgMode"
-  "Calendar name for the combined iCalendar representing all agenda files."
-  :group 'org-export-icalendar
-  :type 'string)
-
-(defcustom org-icalendar-use-deadline '(event-if-not-todo todo-due)
-  "Contexts where iCalendar export should use a deadline time stamp.
-This is a list with several symbols in it.  Valid symbol are:
-
-event-if-todo       Deadlines in TODO entries become calendar events.
-event-if-not-todo   Deadlines in non-TODO entries become calendar events.
-todo-due            Use deadlines in TODO entries as due-dates"
-  :group 'org-export-icalendar
-  :type '(set :greedy t
-	      (const :tag "Deadlines in non-TODO entries become events"
-		     event-if-not-todo)
-	      (const :tag "Deadline in TODO entries become events"
-		     event-if-todo)
-	      (const :tag "Deadlines in TODO entries become due-dates"
-		     todo-due)))
-
-(defcustom org-icalendar-use-scheduled '(todo-start)
-  "Contexts where iCalendar export should use a scheduling time stamp.
-This is a list with several symbols in it.  Valid symbol are:
-
-event-if-todo       Scheduling time stamps in TODO entries become an event.
-event-if-not-todo   Scheduling time stamps in non-TODO entries become an event.
-todo-start          Scheduling time stamps in TODO entries become start date.
-                    Some calendar applications show TODO entries only after
-                    that date."
-  :group 'org-export-icalendar
-  :type '(set :greedy t
-	      (const :tag
-		     "SCHEDULED timestamps in non-TODO entries become events"
-		     event-if-not-todo)
-	      (const :tag "SCHEDULED timestamps in TODO entries become events"
-		     event-if-todo)
-	      (const :tag "SCHEDULED in TODO entries become start date"
-		     todo-start)))
-
-(defcustom org-icalendar-categories '(local-tags category)
-  "Items that should be entered into the categories field.
-This is a list of symbols, the following are valid:
-
-category    The Org-mode category of the current file or tree
-todo-state  The todo state, if any
-local-tags  The tags, defined in the current line
-all-tags    All tags, including inherited ones."
-  :group 'org-export-icalendar
-  :type '(repeat
-	  (choice
-	   (const :tag "The file or tree category" category)
-	   (const :tag "The TODO state" todo-state)
-	   (const :tag "Tags defined in current line" local-tags)
-	   (const :tag "All tags, including inherited ones" all-tags))))
-
-(defcustom org-icalendar-include-todo nil
-  "Non-nil means, export to iCalendar files should also cover TODO items."
-  :group 'org-export-icalendar
-  :type '(choice
-	  (const :tag "None" nil)
-	  (const :tag "Unfinished" t)
-	  (const :tag "All" all)))
-
-(defcustom org-icalendar-include-sexps t
-  "Non-nil means, export to iCalendar files should also cover sexp entries.
-These are entries like in the diary, but directly in an Org-mode file."
-  :group 'org-export-icalendar
-  :type 'boolean)
-
-(defcustom org-icalendar-include-body 100
-  "Amount of text below headline to be included in iCalendar export.
-This is a number of characters that should maximally be included.
-Properties, scheduling and clocking lines will always be removed.
-The text will be inserted into the DESCRIPTION field."
-  :group 'org-export-icalendar
-  :type '(choice
-	  (const :tag "Nothing" nil)
-	  (const :tag "Everything" t)
-	  (integer :tag "Max characters")))
-
-(defcustom org-icalendar-store-UID nil
-  "Non-nil means, store any created UIDs in properties.
-The iCalendar standard requires that all entries have a unique identifier.
-Org will create these identifiers as needed.  When this variable is non-nil,
-the created UIDs will be stored in the ID property of the entry.  Then the
-next time this entry is exported, it will be exported with the same UID,
-superceding the previous form of it.  This is essential for
-synchronization services.
-This variable is not turned on by default because we want to avoid creating
-a property drawer in every entry if people are only playing with this feature,
-or if they are only using it locally."
-  :group 'org-export-icalendar
-  :type 'boolean)
-
 ;;;; Exporting
 
 ;;; Variables, constants, and parameter plists
@@ -1677,7 +1571,7 @@ on this string to produce the exported version."
 
       ;; ASCII-specific preprocessing
       (when asciip
-	(org-export-ascii-preprocess))
+	(org-export-ascii-preprocess parameters))
 
       ;; HTML-specific preprocessing
       (when htmlp
@@ -4495,496 +4389,6 @@ Replaces invalid characters with \"_\" and then prepends a prefix."
     (org-close-li)
     (insert "</ul>\n")))
 
-;;; iCalendar export
-
-;;;###autoload
-(defun org-export-icalendar-this-file ()
-  "Export current file as an iCalendar file.
-The iCalendar file will be located in the same directory as the Org-mode
-file, but with extension `.ics'."
-  (interactive)
-  (org-export-icalendar nil buffer-file-name))
-
-;;;###autoload
-(defun org-export-icalendar-all-agenda-files ()
-  "Export all files in `org-agenda-files' to iCalendar .ics files.
-Each iCalendar file will be located in the same directory as the Org-mode
-file, but with extension `.ics'."
-  (interactive)
-  (apply 'org-export-icalendar nil (org-agenda-files t)))
-
-;;;###autoload
-(defun org-export-icalendar-combine-agenda-files ()
-  "Export all files in `org-agenda-files' to a single combined iCalendar file.
-The file is stored under the name `org-combined-agenda-icalendar-file'."
-  (interactive)
-  (apply 'org-export-icalendar t (org-agenda-files t)))
-
-(defun org-export-icalendar (combine &rest files)
-  "Create iCalendar files for all elements of FILES.
-If COMBINE is non-nil, combine all calendar entries into a single large
-file and store it under the name `org-combined-agenda-icalendar-file'."
-  (save-excursion
-    (org-prepare-agenda-buffers files)
-    (let* ((dir (org-export-directory
-		 :ical (list :publishing-directory
-			     org-export-publishing-directory)))
-	   file ical-file ical-buffer category started org-agenda-new-buffers)
-      (and (get-buffer "*ical-tmp*") (kill-buffer "*ical-tmp*"))
-      (when combine
-	(setq ical-file
-	      (if (file-name-absolute-p org-combined-agenda-icalendar-file)
-		  org-combined-agenda-icalendar-file
-		(expand-file-name org-combined-agenda-icalendar-file dir))
-	      ical-buffer (org-get-agenda-file-buffer ical-file))
-	(set-buffer ical-buffer) (erase-buffer))
-      (while (setq file (pop files))
-	(catch 'nextfile
-	  (org-check-agenda-file file)
-	  (set-buffer (org-get-agenda-file-buffer file))
-	  (unless combine
-	    (setq ical-file (concat (file-name-as-directory dir)
-				    (file-name-sans-extension
-				     (file-name-nondirectory buffer-file-name))
-				    ".ics"))
-	    (setq ical-buffer (org-get-agenda-file-buffer ical-file))
-	    (with-current-buffer ical-buffer (erase-buffer)))
-	  (setq category (or org-category
-			     (file-name-sans-extension
-			      (file-name-nondirectory buffer-file-name))))
-	  (if (symbolp category) (setq category (symbol-name category)))
-	  (let ((standard-output ical-buffer))
-	    (if combine
-		(and (not started) (setq started t)
-		     (org-start-icalendar-file org-icalendar-combined-name))
-	      (org-start-icalendar-file category))
-	    (org-print-icalendar-entries combine)
-	    (when (or (and combine (not files)) (not combine))
-	      (org-finish-icalendar-file)
-	      (set-buffer ical-buffer)
-	      (run-hooks 'org-before-save-iCalendar-file-hook)
-	      (save-buffer)
-	      (run-hooks 'org-after-save-iCalendar-file-hook)
-	      (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait))
-	      ))))
-      (org-release-buffers org-agenda-new-buffers))))
-
-(defvar org-before-save-iCalendar-file-hook nil
-  "Hook run before  an iCalendar file has been saved.
-This can be used to modify the result of the export.")
-
-(defvar org-after-save-iCalendar-file-hook nil
-  "Hook run after an iCalendar file has been saved.
-The iCalendar buffer is still current when this hook is run.
-A good way to use this is to tell a desktop calendar application to re-read
-the iCalendar file.")
-
-(defvar org-agenda-default-appointment-duration) ; defined in org-agenda.el
-(defun org-print-icalendar-entries (&optional combine)
-  "Print iCalendar entries for the current Org-mode file to `standard-output'.
-When COMBINE is non nil, add the category to each line."
-  (require 'org-agenda)
-  (let ((re1 (concat org-ts-regexp "\\|<%%([^>\n]+>"))
-	(re2 (concat "--?-?\\(" org-ts-regexp "\\)"))
-	(dts (org-ical-ts-to-string
-	      (format-time-string (cdr org-time-stamp-formats) (current-time))
-	      "DTSTART"))
-	hd ts ts2 state status (inc t) pos b sexp rrule
-	scheduledp deadlinep todo prefix due start
-	tmp pri categories location summary desc uid
-	(sexp-buffer (get-buffer-create "*ical-tmp*")))
-    (org-refresh-category-properties)
-    (save-excursion
-      (goto-char (point-min))
-      (while (re-search-forward re1 nil t)
-	(catch :skip
-	  (org-agenda-skip)
-	  (when (boundp 'org-icalendar-verify-function)
-	    (unless (funcall org-icalendar-verify-function)
-	      (outline-next-heading)
-	      (backward-char 1)
-	      (throw :skip nil)))
-	  (setq pos (match-beginning 0)
-		ts (match-string 0)
-		inc t
-		hd (condition-case nil
-		       (org-icalendar-cleanup-string
-			(org-get-heading))
-		     (error (throw :skip nil)))
-		summary (org-icalendar-cleanup-string
-			 (org-entry-get nil "SUMMARY"))
-		desc (org-icalendar-cleanup-string
-		      (or (org-entry-get nil "DESCRIPTION")
-			  (and org-icalendar-include-body (org-get-entry)))
-		      t org-icalendar-include-body)
-		location (org-icalendar-cleanup-string
-			  (org-entry-get nil "LOCATION" 'selective))
-		uid (if org-icalendar-store-UID
-			(org-id-get-create)
-		      (or (org-id-get) (org-id-new)))
-		categories (org-export-get-categories)
-		deadlinep nil scheduledp nil)
-	  (if (looking-at re2)
-	      (progn
-		(goto-char (match-end 0))
-		(setq ts2 (match-string 1)
-		      inc (not (string-match "[0-9]\\{1,2\\}:[0-9][0-9]" ts2))))
-	    (setq tmp (buffer-substring (max (point-min)
-					     (- pos org-ds-keyword-length))
-					pos)
-		  ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts)
-			  (progn
-			    (setq inc nil)
-			    (replace-match "\\1" t nil ts))
-			ts)
-		  deadlinep (string-match org-deadline-regexp tmp)
-		  scheduledp (string-match org-scheduled-regexp tmp)
-		  todo (org-get-todo-state)
-		  ;; donep (org-entry-is-done-p)
-		  ))
-	  (when (and
-		 deadlinep
-		 (if todo
-		     (not (memq 'event-if-todo org-icalendar-use-deadline))
-		   (not (memq 'event-if-not-todo org-icalendar-use-deadline))))
-	    (throw :skip t))
-	  (when (and
-		 scheduledp
-		 (if todo
-		     (not (memq 'event-if-todo org-icalendar-use-scheduled))
-		   (not (memq 'event-if-not-todo org-icalendar-use-scheduled))))
-	    (throw :skip t))
-	  (setq prefix (if deadlinep "DL-" (if scheduledp "SC-" "TS-")))
-	  (if (or (string-match org-tr-regexp hd)
-		  (string-match org-ts-regexp hd))
-	      (setq hd (replace-match "" t t hd)))
-	  (if (string-match "\\+\\([0-9]+\\)\\([dwmy]\\)>" ts)
-	      (setq rrule
-		    (concat "\nRRULE:FREQ="
-			    (cdr (assoc
-				  (match-string 2 ts)
-				  '(("d" . "DAILY")("w" . "WEEKLY")
-				    ("m" . "MONTHLY")("y" . "YEARLY"))))
-			    ";INTERVAL=" (match-string 1 ts)))
-	    (setq rrule ""))
-	  (setq summary (or summary hd))
-	  (if (string-match org-bracket-link-regexp summary)
-	      (setq summary
-		    (replace-match (if (match-end 3)
-				       (match-string 3 summary)
-				     (match-string 1 summary))
-				   t t summary)))
-	  (if deadlinep (setq summary (concat "DL: " summary)))
-	  (if scheduledp (setq summary (concat "S: " summary)))
-	  (if (string-match "\\`<%%" ts)
-	      (with-current-buffer sexp-buffer
-		(insert (substring ts 1 -1) " " summary "\n"))
-	    (princ (format "BEGIN:VEVENT
-UID: %s
-%s
-%s%s
-SUMMARY:%s%s%s
-CATEGORIES:%s
-END:VEVENT\n"
-			   (concat prefix uid)
-			   (org-ical-ts-to-string ts "DTSTART")
-			   (org-ical-ts-to-string ts2 "DTEND" inc)
-			   rrule summary
-			   (if (and desc (string-match "\\S-" desc))
-			       (concat "\nDESCRIPTION: " desc) "")
-			   (if (and location (string-match "\\S-" location))
-			       (concat "\nLOCATION: " location) "")
-			   categories)))))
-      (when (and org-icalendar-include-sexps
-		 (condition-case nil (require 'icalendar) (error nil))
-		 (fboundp 'icalendar-export-region))
-	;; Get all the literal sexps
-	(goto-char (point-min))
-	(while (re-search-forward "^&?%%(" nil t)
-	  (catch :skip
-	    (org-agenda-skip)
-	    (setq b (match-beginning 0))
-	    (goto-char (1- (match-end 0)))
-	    (forward-sexp 1)
-	    (end-of-line 1)
-	    (setq sexp (buffer-substring b (point)))
-	    (with-current-buffer sexp-buffer
-	      (insert sexp "\n"))))
-	(princ (org-diary-to-ical-string sexp-buffer))
-	(kill-buffer sexp-buffer))
-
-      (when org-icalendar-include-todo
-	(setq prefix "TODO-")
-	(goto-char (point-min))
-	(while (re-search-forward org-todo-line-regexp nil t)
-	  (catch :skip
-	    (org-agenda-skip)
-	    (when (boundp 'org-icalendar-verify-function)
-	      (unless (funcall org-icalendar-verify-function)
-		(outline-next-heading)
-		(backward-char 1)
-		(throw :skip nil)))
-	    (setq state (match-string 2))
-	    (setq status (if (member state org-done-keywords)
-			     "COMPLETED" "NEEDS-ACTION"))
-	    (when (and state
-		       (or (not (member state org-done-keywords))
-			   (eq org-icalendar-include-todo 'all))
-		       (not (member org-archive-tag (org-get-tags-at)))
-		       )
-	      (setq hd (match-string 3)
-		    summary (org-icalendar-cleanup-string
-			     (org-entry-get nil "SUMMARY"))
-		    desc (org-icalendar-cleanup-string
-			  (or (org-entry-get nil "DESCRIPTION")
-			      (and org-icalendar-include-body (org-get-entry)))
-			  t org-icalendar-include-body)
-		    location (org-icalendar-cleanup-string
-			      (org-entry-get nil "LOCATION" 'selective))
-		    due (and (member 'todo-due org-icalendar-use-deadline)
-			     (org-entry-get nil "DEADLINE"))
-		    start (and (member 'todo-start org-icalendar-use-scheduled)
-			     (org-entry-get nil "SCHEDULED"))
-		    categories (org-export-get-categories)
-		    uid (if org-icalendar-store-UID
-			    (org-id-get-create)
-			  (or (org-id-get) (org-id-new))))
-	      (and due (setq due (org-ical-ts-to-string due "DUE")))
-	      (and start (setq start (org-ical-ts-to-string start "DTSTART")))
-
-	      (if (string-match org-bracket-link-regexp hd)
-		  (setq hd (replace-match (if (match-end 3) (match-string 3 hd)
-					    (match-string 1 hd))
-					  t t hd)))
-	      (if (string-match org-priority-regexp hd)
-		  (setq pri (string-to-char (match-string 2 hd))
-			hd (concat (substring hd 0 (match-beginning 1))
-				   (substring hd (match-end 1))))
-		(setq pri org-default-priority))
-	      (setq pri (floor (- 9 (* 8. (/ (float (- org-lowest-priority pri))
-					     (- org-lowest-priority org-highest-priority))))))
-
-	      (princ (format "BEGIN:VTODO
-UID: %s
-%s
-SUMMARY:%s%s%s%s
-CATEGORIES:%s
-SEQUENCE:1
-PRIORITY:%d
-STATUS:%s
-END:VTODO\n"
-			     (concat prefix uid)
-			     (or start dts)
-			     (or summary hd)
-			     (if (and location (string-match "\\S-" location))
-				 (concat "\nLOCATION: " location) "")
-			     (if (and desc (string-match "\\S-" desc))
-				 (concat "\nDESCRIPTION: " desc) "")
-			     (if due (concat "\n" due) "")
-			     categories
-			     pri status)))))))))
-
-(defun org-export-get-categories ()
-  "Get categories according to `org-icalendar-categories'."
-  (let ((cs org-icalendar-categories) c rtn tmp)
-    (while (setq c (pop cs))
-      (cond
-       ((eq c 'category) (push (org-get-category) rtn))
-       ((eq c 'todo-state)
-	(setq tmp (org-get-todo-state))
-	(and tmp (push tmp rtn)))
-       ((eq c 'local-tags)
-	(setq rtn (append (nreverse (org-get-local-tags-at (point))) rtn)))
-       ((eq c 'all-tags)
-	(setq rtn (append (nreverse (org-get-tags-at (point))) rtn)))))
-    (mapconcat 'identity (nreverse rtn) ",")))
-
-(defun org-icalendar-cleanup-string (s &optional is-body maxlength)
-  "Take out stuff and quote what needs to be quoted.
-When IS-BODY is non-nil, assume that this is the body of an item, clean up
-whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH
-characters."
-  (if (not s)
-      nil
-    (when is-body
-      (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?"))
-	    (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?")))
-	(while (string-match re s) (setq s (replace-match "" t t s)))
-	(while (string-match re2 s) (setq s (replace-match "" t t s)))))
-    (let ((start 0))
-      (while (string-match "\\([,;]\\)" s start)
-	(setq start (+ (match-beginning 0) 2)
-	      s (replace-match "\\\\\\1" nil nil s))))
-    (setq s (org-trim s))
-    (when is-body
-      (while (string-match "[ \t]*\n[ \t]*" s)
-	(setq s (replace-match "\\n" t t s))))
-    (if is-body
-	(if maxlength
-	    (if (and (numberp maxlength)
-		     (> (length s) maxlength))
-		(setq s (substring s 0 maxlength)))))
-    s))
-
-(defun org-icalendar-cleanup-string-rfc2455 (s &optional is-body maxlength)
-  "Take out stuff and quote what needs to be quoted.
-When IS-BODY is non-nil, assume that this is the body of an item, clean up
-whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH
-characters.
-This seems to be more like RFC 2455, but it causes problems, so it is
-not used right now."
-  (if (not s)
-      nil
-    (if is-body
-	(let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?"))
-	      (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?")))
-	  (while (string-match re s) (setq s (replace-match "" t t s)))
-	  (while (string-match re2 s) (setq s (replace-match "" t t s)))
-	  (setq s (org-trim s))
-	  (while (string-match "[ \t]*\n[ \t]*" s)
-	    (setq s (replace-match "\\n" t t s)))
-	  (if maxlength
-	      (if (and (numberp maxlength)
-		       (> (length s) maxlength))
-		  (setq s (substring s 0 maxlength)))))
-      (setq s (org-trim s)))
-    (while (string-match "\"" s) (setq s (replace-match "''" t t s)))
-    (when (string-match "[;,:]" s) (setq s (concat "\"" s "\"")))
-    s))
-
-(defun org-get-entry ()
-  "Clean-up description string."
-  (save-excursion
-    (org-back-to-heading t)
-    (buffer-substring (point-at-bol 2) (org-end-of-subtree t))))
-
-(defun org-start-icalendar-file (name)
-  "Start an iCalendar file by inserting the header."
-  (let ((user user-full-name)
-	(name (or name "unknown"))
-	(timezone (cadr (current-time-zone))))
-    (princ
-     (format "BEGIN:VCALENDAR
-VERSION:2.0
-X-WR-CALNAME:%s
-PRODID:-//%s//Emacs with Org-mode//EN
-X-WR-TIMEZONE:%s
-CALSCALE:GREGORIAN\n" name user timezone))))
-
-(defun org-finish-icalendar-file ()
-  "Finish an iCalendar file by inserting the END statement."
-  (princ "END:VCALENDAR\n"))
-
-(defun org-ical-ts-to-string (s keyword &optional inc)
-  "Take a time string S and convert it to iCalendar format.
-KEYWORD is added in front, to make a complete line like DTSTART....
-When INC is non-nil, increase the hour by two (if time string contains
-a time), or the day by one (if it does not contain a time)."
-  (let ((t1 (org-parse-time-string s 'nodefault))
-	t2 fmt have-time time)
-    (if (and (car t1) (nth 1 t1) (nth 2 t1))
-	(setq t2 t1 have-time t)
-      (setq t2 (org-parse-time-string s)))
-    (let ((s (car t2))   (mi (nth 1 t2)) (h (nth 2 t2))
-	  (d (nth 3 t2)) (m  (nth 4 t2)) (y (nth 5 t2)))
-      (when inc
-	(if have-time
-	    (if org-agenda-default-appointment-duration
-		(setq mi (+ org-agenda-default-appointment-duration mi))
-	      (setq h (+ 2 h)))
-	  (setq d (1+ d))))
-      (setq time (encode-time s mi h d m y)))
-    (setq fmt (if have-time ":%Y%m%dT%H%M%S" ";VALUE=DATE:%Y%m%d"))
-    (concat keyword (format-time-string fmt time))))
-
-;;; XOXO export
-
-(defun org-export-as-xoxo-insert-into (buffer &rest output)
-  (with-current-buffer buffer
-    (apply 'insert output)))
-(put 'org-export-as-xoxo-insert-into 'lisp-indent-function 1)
-
-;;;###autoload
-(defun org-export-as-xoxo (&optional buffer)
-  "Export the org buffer as XOXO.
-The XOXO buffer is named *xoxo-<source buffer name>*"
-  (interactive (list (current-buffer)))
-  ;; A quickie abstraction
-
-  ;; Output everything as XOXO
-  (with-current-buffer (get-buffer buffer)
-    (let* ((pos (point))
-	   (opt-plist (org-combine-plists (org-default-export-plist)
-					(org-infile-export-plist)))
-	   (filename (concat (file-name-as-directory
-			      (org-export-directory :xoxo opt-plist))
-			     (file-name-sans-extension
-			      (file-name-nondirectory buffer-file-name))
-			     ".html"))
-	   (out (find-file-noselect filename))
-	   (last-level 1)
-	   (hanging-li nil))
-      (goto-char (point-min))  ;; CD:  beginning-of-buffer is not allowed.
-      ;; Check the output buffer is empty.
-      (with-current-buffer out (erase-buffer))
-      ;; Kick off the output
-      (org-export-as-xoxo-insert-into out "<ol class='xoxo'>\n")
-      (while (re-search-forward "^\\(\\*+\\)[ \t]+\\(.+\\)" (point-max) 't)
-	(let* ((hd (match-string-no-properties 1))
-	       (level (length hd))
-	       (text (concat
-		      (match-string-no-properties 2)
-		      (save-excursion
-			(goto-char (match-end 0))
-			(let ((str ""))
-			  (catch 'loop
-			    (while 't
-			      (forward-line)
-			      (if (looking-at "^[ \t]\\(.*\\)")
-				  (setq str (concat str (match-string-no-properties 1)))
-				(throw 'loop str)))))))))
-
-	  ;; Handle level rendering
-	  (cond
-	   ((> level last-level)
-	    (org-export-as-xoxo-insert-into out "\n<ol>\n"))
-
-	   ((< level last-level)
-	    (dotimes (- (- last-level level) 1)
-	      (if hanging-li
-		  (org-export-as-xoxo-insert-into out "</li>\n"))
-	      (org-export-as-xoxo-insert-into out "</ol>\n"))
-	    (when hanging-li
-	      (org-export-as-xoxo-insert-into out "</li>\n")
-	      (setq hanging-li nil)))
-
-	   ((equal level last-level)
-	    (if hanging-li
-		(org-export-as-xoxo-insert-into out "</li>\n")))
-	   )
-
-	  (setq last-level level)
-
-	  ;; And output the new li
-	  (setq hanging-li 't)
-	  (if (equal ?+ (elt text 0))
-	      (org-export-as-xoxo-insert-into out "<li class='" (substring text 1) "'>")
-	    (org-export-as-xoxo-insert-into out "<li>" text))))
-
-      ;; Finally finish off the ol
-      (dotimes (- last-level 1)
-	(if hanging-li
-	    (org-export-as-xoxo-insert-into out "</li>\n"))
-	(org-export-as-xoxo-insert-into out "</ol>\n"))
-
-      (goto-char pos)
-      ;; Finish the buffer off and clean it up.
-      (switch-to-buffer-other-window out)
-      (indent-region (point-min) (point-max) nil)
-      (save-buffer)
-      (goto-char (point-min))
-      )))
-
 (provide 'org-exp)
 
 ;; arch-tag: 65985fe9-095c-49c7-a7b6-cb4ee15c0a95

+ 538 - 0
lisp/org-icalendar.el

@@ -0,0 +1,538 @@
+;;; org-icalendar.el --- iCalendar export for Org-mode
+
+;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009
+;;   Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;; Version: 6.25trans
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+(require 'org-exp)
+
+(defgroup org-export-icalendar nil
+  "Options specific for iCalendar export of Org-mode files."
+  :tag "Org Export iCalendar"
+  :group 'org-export)
+
+(defcustom org-combined-agenda-icalendar-file "~/org.ics"
+  "The file name for the iCalendar file covering all agenda files.
+This file is created with the command \\[org-export-icalendar-all-agenda-files].
+The file name should be absolute, the file will be overwritten without warning."
+  :group 'org-export-icalendar
+  :type 'file)
+
+(defcustom org-icalendar-combined-name "OrgMode"
+  "Calendar name for the combined iCalendar representing all agenda files."
+  :group 'org-export-icalendar
+  :type 'string)
+
+(defcustom org-icalendar-use-deadline '(event-if-not-todo todo-due)
+  "Contexts where iCalendar export should use a deadline time stamp.
+This is a list with several symbols in it.  Valid symbol are:
+
+event-if-todo       Deadlines in TODO entries become calendar events.
+event-if-not-todo   Deadlines in non-TODO entries become calendar events.
+todo-due            Use deadlines in TODO entries as due-dates"
+  :group 'org-export-icalendar
+  :type '(set :greedy t
+	      (const :tag "Deadlines in non-TODO entries become events"
+		     event-if-not-todo)
+	      (const :tag "Deadline in TODO entries become events"
+		     event-if-todo)
+	      (const :tag "Deadlines in TODO entries become due-dates"
+		     todo-due)))
+
+(defcustom org-icalendar-use-scheduled '(todo-start)
+  "Contexts where iCalendar export should use a scheduling time stamp.
+This is a list with several symbols in it.  Valid symbol are:
+
+event-if-todo       Scheduling time stamps in TODO entries become an event.
+event-if-not-todo   Scheduling time stamps in non-TODO entries become an event.
+todo-start          Scheduling time stamps in TODO entries become start date.
+                    Some calendar applications show TODO entries only after
+                    that date."
+  :group 'org-export-icalendar
+  :type '(set :greedy t
+	      (const :tag
+		     "SCHEDULED timestamps in non-TODO entries become events"
+		     event-if-not-todo)
+	      (const :tag "SCHEDULED timestamps in TODO entries become events"
+		     event-if-todo)
+	      (const :tag "SCHEDULED in TODO entries become start date"
+		     todo-start)))
+
+(defcustom org-icalendar-categories '(local-tags category)
+  "Items that should be entered into the categories field.
+This is a list of symbols, the following are valid:
+
+category    The Org-mode category of the current file or tree
+todo-state  The todo state, if any
+local-tags  The tags, defined in the current line
+all-tags    All tags, including inherited ones."
+  :group 'org-export-icalendar
+  :type '(repeat
+	  (choice
+	   (const :tag "The file or tree category" category)
+	   (const :tag "The TODO state" todo-state)
+	   (const :tag "Tags defined in current line" local-tags)
+	   (const :tag "All tags, including inherited ones" all-tags))))
+
+(defcustom org-icalendar-include-todo nil
+  "Non-nil means, export to iCalendar files should also cover TODO items."
+  :group 'org-export-icalendar
+  :type '(choice
+	  (const :tag "None" nil)
+	  (const :tag "Unfinished" t)
+	  (const :tag "All" all)))
+
+(defcustom org-icalendar-include-sexps t
+  "Non-nil means, export to iCalendar files should also cover sexp entries.
+These are entries like in the diary, but directly in an Org-mode file."
+  :group 'org-export-icalendar
+  :type 'boolean)
+
+(defcustom org-icalendar-include-body 100
+  "Amount of text below headline to be included in iCalendar export.
+This is a number of characters that should maximally be included.
+Properties, scheduling and clocking lines will always be removed.
+The text will be inserted into the DESCRIPTION field."
+  :group 'org-export-icalendar
+  :type '(choice
+	  (const :tag "Nothing" nil)
+	  (const :tag "Everything" t)
+	  (integer :tag "Max characters")))
+
+(defcustom org-icalendar-store-UID nil
+  "Non-nil means, store any created UIDs in properties.
+The iCalendar standard requires that all entries have a unique identifier.
+Org will create these identifiers as needed.  When this variable is non-nil,
+the created UIDs will be stored in the ID property of the entry.  Then the
+next time this entry is exported, it will be exported with the same UID,
+superceding the previous form of it.  This is essential for
+synchronization services.
+This variable is not turned on by default because we want to avoid creating
+a property drawer in every entry if people are only playing with this feature,
+or if they are only using it locally."
+  :group 'org-export-icalendar
+  :type 'boolean)
+
+;;; iCalendar export
+
+;;;###autoload
+(defun org-export-icalendar-this-file ()
+  "Export current file as an iCalendar file.
+The iCalendar file will be located in the same directory as the Org-mode
+file, but with extension `.ics'."
+  (interactive)
+  (org-export-icalendar nil buffer-file-name))
+
+;;;###autoload
+(defun org-export-icalendar-all-agenda-files ()
+  "Export all files in `org-agenda-files' to iCalendar .ics files.
+Each iCalendar file will be located in the same directory as the Org-mode
+file, but with extension `.ics'."
+  (interactive)
+  (apply 'org-export-icalendar nil (org-agenda-files t)))
+
+;;;###autoload
+(defun org-export-icalendar-combine-agenda-files ()
+  "Export all files in `org-agenda-files' to a single combined iCalendar file.
+The file is stored under the name `org-combined-agenda-icalendar-file'."
+  (interactive)
+  (apply 'org-export-icalendar t (org-agenda-files t)))
+
+(defun org-export-icalendar (combine &rest files)
+  "Create iCalendar files for all elements of FILES.
+If COMBINE is non-nil, combine all calendar entries into a single large
+file and store it under the name `org-combined-agenda-icalendar-file'."
+  (save-excursion
+    (org-prepare-agenda-buffers files)
+    (let* ((dir (org-export-directory
+		 :ical (list :publishing-directory
+			     org-export-publishing-directory)))
+	   file ical-file ical-buffer category started org-agenda-new-buffers)
+      (and (get-buffer "*ical-tmp*") (kill-buffer "*ical-tmp*"))
+      (when combine
+	(setq ical-file
+	      (if (file-name-absolute-p org-combined-agenda-icalendar-file)
+		  org-combined-agenda-icalendar-file
+		(expand-file-name org-combined-agenda-icalendar-file dir))
+	      ical-buffer (org-get-agenda-file-buffer ical-file))
+	(set-buffer ical-buffer) (erase-buffer))
+      (while (setq file (pop files))
+	(catch 'nextfile
+	  (org-check-agenda-file file)
+	  (set-buffer (org-get-agenda-file-buffer file))
+	  (unless combine
+	    (setq ical-file (concat (file-name-as-directory dir)
+				    (file-name-sans-extension
+				     (file-name-nondirectory buffer-file-name))
+				    ".ics"))
+	    (setq ical-buffer (org-get-agenda-file-buffer ical-file))
+	    (with-current-buffer ical-buffer (erase-buffer)))
+	  (setq category (or org-category
+			     (file-name-sans-extension
+			      (file-name-nondirectory buffer-file-name))))
+	  (if (symbolp category) (setq category (symbol-name category)))
+	  (let ((standard-output ical-buffer))
+	    (if combine
+		(and (not started) (setq started t)
+		     (org-start-icalendar-file org-icalendar-combined-name))
+	      (org-start-icalendar-file category))
+	    (org-print-icalendar-entries combine)
+	    (when (or (and combine (not files)) (not combine))
+	      (org-finish-icalendar-file)
+	      (set-buffer ical-buffer)
+	      (run-hooks 'org-before-save-iCalendar-file-hook)
+	      (save-buffer)
+	      (run-hooks 'org-after-save-iCalendar-file-hook)
+	      (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait))
+	      ))))
+      (org-release-buffers org-agenda-new-buffers))))
+
+(defvar org-before-save-iCalendar-file-hook nil
+  "Hook run before  an iCalendar file has been saved.
+This can be used to modify the result of the export.")
+
+(defvar org-after-save-iCalendar-file-hook nil
+  "Hook run after an iCalendar file has been saved.
+The iCalendar buffer is still current when this hook is run.
+A good way to use this is to tell a desktop calendar application to re-read
+the iCalendar file.")
+
+(defvar org-agenda-default-appointment-duration) ; defined in org-agenda.el
+(defun org-print-icalendar-entries (&optional combine)
+  "Print iCalendar entries for the current Org-mode file to `standard-output'.
+When COMBINE is non nil, add the category to each line."
+  (require 'org-agenda)
+  (let ((re1 (concat org-ts-regexp "\\|<%%([^>\n]+>"))
+	(re2 (concat "--?-?\\(" org-ts-regexp "\\)"))
+	(dts (org-ical-ts-to-string
+	      (format-time-string (cdr org-time-stamp-formats) (current-time))
+	      "DTSTART"))
+	hd ts ts2 state status (inc t) pos b sexp rrule
+	scheduledp deadlinep todo prefix due start
+	tmp pri categories location summary desc uid
+	(sexp-buffer (get-buffer-create "*ical-tmp*")))
+    (org-refresh-category-properties)
+    (save-excursion
+      (goto-char (point-min))
+      (while (re-search-forward re1 nil t)
+	(catch :skip
+	  (org-agenda-skip)
+	  (when (boundp 'org-icalendar-verify-function)
+	    (unless (funcall org-icalendar-verify-function)
+	      (outline-next-heading)
+	      (backward-char 1)
+	      (throw :skip nil)))
+	  (setq pos (match-beginning 0)
+		ts (match-string 0)
+		inc t
+		hd (condition-case nil
+		       (org-icalendar-cleanup-string
+			(org-get-heading))
+		     (error (throw :skip nil)))
+		summary (org-icalendar-cleanup-string
+			 (org-entry-get nil "SUMMARY"))
+		desc (org-icalendar-cleanup-string
+		      (or (org-entry-get nil "DESCRIPTION")
+			  (and org-icalendar-include-body (org-get-entry)))
+		      t org-icalendar-include-body)
+		location (org-icalendar-cleanup-string
+			  (org-entry-get nil "LOCATION" 'selective))
+		uid (if org-icalendar-store-UID
+			(org-id-get-create)
+		      (or (org-id-get) (org-id-new)))
+		categories (org-export-get-categories)
+		deadlinep nil scheduledp nil)
+	  (if (looking-at re2)
+	      (progn
+		(goto-char (match-end 0))
+		(setq ts2 (match-string 1)
+		      inc (not (string-match "[0-9]\\{1,2\\}:[0-9][0-9]" ts2))))
+	    (setq tmp (buffer-substring (max (point-min)
+					     (- pos org-ds-keyword-length))
+					pos)
+		  ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts)
+			  (progn
+			    (setq inc nil)
+			    (replace-match "\\1" t nil ts))
+			ts)
+		  deadlinep (string-match org-deadline-regexp tmp)
+		  scheduledp (string-match org-scheduled-regexp tmp)
+		  todo (org-get-todo-state)
+		  ;; donep (org-entry-is-done-p)
+		  ))
+	  (when (and
+		 deadlinep
+		 (if todo
+		     (not (memq 'event-if-todo org-icalendar-use-deadline))
+		   (not (memq 'event-if-not-todo org-icalendar-use-deadline))))
+	    (throw :skip t))
+	  (when (and
+		 scheduledp
+		 (if todo
+		     (not (memq 'event-if-todo org-icalendar-use-scheduled))
+		   (not (memq 'event-if-not-todo org-icalendar-use-scheduled))))
+	    (throw :skip t))
+	  (setq prefix (if deadlinep "DL-" (if scheduledp "SC-" "TS-")))
+	  (if (or (string-match org-tr-regexp hd)
+		  (string-match org-ts-regexp hd))
+	      (setq hd (replace-match "" t t hd)))
+	  (if (string-match "\\+\\([0-9]+\\)\\([dwmy]\\)>" ts)
+	      (setq rrule
+		    (concat "\nRRULE:FREQ="
+			    (cdr (assoc
+				  (match-string 2 ts)
+				  '(("d" . "DAILY")("w" . "WEEKLY")
+				    ("m" . "MONTHLY")("y" . "YEARLY"))))
+			    ";INTERVAL=" (match-string 1 ts)))
+	    (setq rrule ""))
+	  (setq summary (or summary hd))
+	  (if (string-match org-bracket-link-regexp summary)
+	      (setq summary
+		    (replace-match (if (match-end 3)
+				       (match-string 3 summary)
+				     (match-string 1 summary))
+				   t t summary)))
+	  (if deadlinep (setq summary (concat "DL: " summary)))
+	  (if scheduledp (setq summary (concat "S: " summary)))
+	  (if (string-match "\\`<%%" ts)
+	      (with-current-buffer sexp-buffer
+		(insert (substring ts 1 -1) " " summary "\n"))
+	    (princ (format "BEGIN:VEVENT
+UID: %s
+%s
+%s%s
+SUMMARY:%s%s%s
+CATEGORIES:%s
+END:VEVENT\n"
+			   (concat prefix uid)
+			   (org-ical-ts-to-string ts "DTSTART")
+			   (org-ical-ts-to-string ts2 "DTEND" inc)
+			   rrule summary
+			   (if (and desc (string-match "\\S-" desc))
+			       (concat "\nDESCRIPTION: " desc) "")
+			   (if (and location (string-match "\\S-" location))
+			       (concat "\nLOCATION: " location) "")
+			   categories)))))
+      (when (and org-icalendar-include-sexps
+		 (condition-case nil (require 'icalendar) (error nil))
+		 (fboundp 'icalendar-export-region))
+	;; Get all the literal sexps
+	(goto-char (point-min))
+	(while (re-search-forward "^&?%%(" nil t)
+	  (catch :skip
+	    (org-agenda-skip)
+	    (setq b (match-beginning 0))
+	    (goto-char (1- (match-end 0)))
+	    (forward-sexp 1)
+	    (end-of-line 1)
+	    (setq sexp (buffer-substring b (point)))
+	    (with-current-buffer sexp-buffer
+	      (insert sexp "\n"))))
+	(princ (org-diary-to-ical-string sexp-buffer))
+	(kill-buffer sexp-buffer))
+
+      (when org-icalendar-include-todo
+	(setq prefix "TODO-")
+	(goto-char (point-min))
+	(while (re-search-forward org-todo-line-regexp nil t)
+	  (catch :skip
+	    (org-agenda-skip)
+	    (when (boundp 'org-icalendar-verify-function)
+	      (unless (funcall org-icalendar-verify-function)
+		(outline-next-heading)
+		(backward-char 1)
+		(throw :skip nil)))
+	    (setq state (match-string 2))
+	    (setq status (if (member state org-done-keywords)
+			     "COMPLETED" "NEEDS-ACTION"))
+	    (when (and state
+		       (or (not (member state org-done-keywords))
+			   (eq org-icalendar-include-todo 'all))
+		       (not (member org-archive-tag (org-get-tags-at)))
+		       )
+	      (setq hd (match-string 3)
+		    summary (org-icalendar-cleanup-string
+			     (org-entry-get nil "SUMMARY"))
+		    desc (org-icalendar-cleanup-string
+			  (or (org-entry-get nil "DESCRIPTION")
+			      (and org-icalendar-include-body (org-get-entry)))
+			  t org-icalendar-include-body)
+		    location (org-icalendar-cleanup-string
+			      (org-entry-get nil "LOCATION" 'selective))
+		    due (and (member 'todo-due org-icalendar-use-deadline)
+			     (org-entry-get nil "DEADLINE"))
+		    start (and (member 'todo-start org-icalendar-use-scheduled)
+			     (org-entry-get nil "SCHEDULED"))
+		    categories (org-export-get-categories)
+		    uid (if org-icalendar-store-UID
+			    (org-id-get-create)
+			  (or (org-id-get) (org-id-new))))
+	      (and due (setq due (org-ical-ts-to-string due "DUE")))
+	      (and start (setq start (org-ical-ts-to-string start "DTSTART")))
+
+	      (if (string-match org-bracket-link-regexp hd)
+		  (setq hd (replace-match (if (match-end 3) (match-string 3 hd)
+					    (match-string 1 hd))
+					  t t hd)))
+	      (if (string-match org-priority-regexp hd)
+		  (setq pri (string-to-char (match-string 2 hd))
+			hd (concat (substring hd 0 (match-beginning 1))
+				   (substring hd (match-end 1))))
+		(setq pri org-default-priority))
+	      (setq pri (floor (- 9 (* 8. (/ (float (- org-lowest-priority pri))
+					     (- org-lowest-priority org-highest-priority))))))
+
+	      (princ (format "BEGIN:VTODO
+UID: %s
+%s
+SUMMARY:%s%s%s%s
+CATEGORIES:%s
+SEQUENCE:1
+PRIORITY:%d
+STATUS:%s
+END:VTODO\n"
+			     (concat prefix uid)
+			     (or start dts)
+			     (or summary hd)
+			     (if (and location (string-match "\\S-" location))
+				 (concat "\nLOCATION: " location) "")
+			     (if (and desc (string-match "\\S-" desc))
+				 (concat "\nDESCRIPTION: " desc) "")
+			     (if due (concat "\n" due) "")
+			     categories
+			     pri status)))))))))
+
+(defun org-export-get-categories ()
+  "Get categories according to `org-icalendar-categories'."
+  (let ((cs org-icalendar-categories) c rtn tmp)
+    (while (setq c (pop cs))
+      (cond
+       ((eq c 'category) (push (org-get-category) rtn))
+       ((eq c 'todo-state)
+	(setq tmp (org-get-todo-state))
+	(and tmp (push tmp rtn)))
+       ((eq c 'local-tags)
+	(setq rtn (append (nreverse (org-get-local-tags-at (point))) rtn)))
+       ((eq c 'all-tags)
+	(setq rtn (append (nreverse (org-get-tags-at (point))) rtn)))))
+    (mapconcat 'identity (nreverse rtn) ",")))
+
+(defun org-icalendar-cleanup-string (s &optional is-body maxlength)
+  "Take out stuff and quote what needs to be quoted.
+When IS-BODY is non-nil, assume that this is the body of an item, clean up
+whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH
+characters."
+  (if (not s)
+      nil
+    (when is-body
+      (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?"))
+	    (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?")))
+	(while (string-match re s) (setq s (replace-match "" t t s)))
+	(while (string-match re2 s) (setq s (replace-match "" t t s)))))
+    (let ((start 0))
+      (while (string-match "\\([,;]\\)" s start)
+	(setq start (+ (match-beginning 0) 2)
+	      s (replace-match "\\\\\\1" nil nil s))))
+    (setq s (org-trim s))
+    (when is-body
+      (while (string-match "[ \t]*\n[ \t]*" s)
+	(setq s (replace-match "\\n" t t s))))
+    (if is-body
+	(if maxlength
+	    (if (and (numberp maxlength)
+		     (> (length s) maxlength))
+		(setq s (substring s 0 maxlength)))))
+    s))
+
+(defun org-icalendar-cleanup-string-rfc2455 (s &optional is-body maxlength)
+  "Take out stuff and quote what needs to be quoted.
+When IS-BODY is non-nil, assume that this is the body of an item, clean up
+whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH
+characters.
+This seems to be more like RFC 2455, but it causes problems, so it is
+not used right now."
+  (if (not s)
+      nil
+    (if is-body
+	(let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?"))
+	      (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?")))
+	  (while (string-match re s) (setq s (replace-match "" t t s)))
+	  (while (string-match re2 s) (setq s (replace-match "" t t s)))
+	  (setq s (org-trim s))
+	  (while (string-match "[ \t]*\n[ \t]*" s)
+	    (setq s (replace-match "\\n" t t s)))
+	  (if maxlength
+	      (if (and (numberp maxlength)
+		       (> (length s) maxlength))
+		  (setq s (substring s 0 maxlength)))))
+      (setq s (org-trim s)))
+    (while (string-match "\"" s) (setq s (replace-match "''" t t s)))
+    (when (string-match "[;,:]" s) (setq s (concat "\"" s "\"")))
+    s))
+
+(defun org-start-icalendar-file (name)
+  "Start an iCalendar file by inserting the header."
+  (let ((user user-full-name)
+	(name (or name "unknown"))
+	(timezone (cadr (current-time-zone))))
+    (princ
+     (format "BEGIN:VCALENDAR
+VERSION:2.0
+X-WR-CALNAME:%s
+PRODID:-//%s//Emacs with Org-mode//EN
+X-WR-TIMEZONE:%s
+CALSCALE:GREGORIAN\n" name user timezone))))
+
+(defun org-finish-icalendar-file ()
+  "Finish an iCalendar file by inserting the END statement."
+  (princ "END:VCALENDAR\n"))
+
+(defun org-ical-ts-to-string (s keyword &optional inc)
+  "Take a time string S and convert it to iCalendar format.
+KEYWORD is added in front, to make a complete line like DTSTART....
+When INC is non-nil, increase the hour by two (if time string contains
+a time), or the day by one (if it does not contain a time)."
+  (let ((t1 (org-parse-time-string s 'nodefault))
+	t2 fmt have-time time)
+    (if (and (car t1) (nth 1 t1) (nth 2 t1))
+	(setq t2 t1 have-time t)
+      (setq t2 (org-parse-time-string s)))
+    (let ((s (car t2))   (mi (nth 1 t2)) (h (nth 2 t2))
+	  (d (nth 3 t2)) (m  (nth 4 t2)) (y (nth 5 t2)))
+      (when inc
+	(if have-time
+	    (if org-agenda-default-appointment-duration
+		(setq mi (+ org-agenda-default-appointment-duration mi))
+	      (setq h (+ 2 h)))
+	  (setq d (1+ d))))
+      (setq time (encode-time s mi h d m y)))
+    (setq fmt (if have-time ":%Y%m%dT%H%M%S" ";VALUE=DATE:%Y%m%d"))
+    (concat keyword (format-time-string fmt time))))
+
+(provide 'org-icalendar)
+
+;; arch-tag: 2dee2b6e-9211-4aee-8a47-a3c7e5bc30cf
+
+;;; org-icalendar.el ends here

+ 124 - 0
lisp/org-xoxo.el

@@ -0,0 +1,124 @@
+;;; org-xoxo.el --- XOXO export for Org-mode
+
+;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009
+;;   Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;; Version: 6.25trans
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+(require 'org-exp)
+
+;;; XOXO export
+
+(defun org-export-as-xoxo-insert-into (buffer &rest output)
+  (with-current-buffer buffer
+    (apply 'insert output)))
+(put 'org-export-as-xoxo-insert-into 'lisp-indent-function 1)
+
+;;;###autoload
+(defun org-export-as-xoxo (&optional buffer)
+  "Export the org buffer as XOXO.
+The XOXO buffer is named *xoxo-<source buffer name>*"
+  (interactive (list (current-buffer)))
+  ;; A quickie abstraction
+
+  ;; Output everything as XOXO
+  (with-current-buffer (get-buffer buffer)
+    (let* ((pos (point))
+	   (opt-plist (org-combine-plists (org-default-export-plist)
+					(org-infile-export-plist)))
+	   (filename (concat (file-name-as-directory
+			      (org-export-directory :xoxo opt-plist))
+			     (file-name-sans-extension
+			      (file-name-nondirectory buffer-file-name))
+			     ".html"))
+	   (out (find-file-noselect filename))
+	   (last-level 1)
+	   (hanging-li nil))
+      (goto-char (point-min))  ;; CD:  beginning-of-buffer is not allowed.
+      ;; Check the output buffer is empty.
+      (with-current-buffer out (erase-buffer))
+      ;; Kick off the output
+      (org-export-as-xoxo-insert-into out "<ol class='xoxo'>\n")
+      (while (re-search-forward "^\\(\\*+\\)[ \t]+\\(.+\\)" (point-max) 't)
+	(let* ((hd (match-string-no-properties 1))
+	       (level (length hd))
+	       (text (concat
+		      (match-string-no-properties 2)
+		      (save-excursion
+			(goto-char (match-end 0))
+			(let ((str ""))
+			  (catch 'loop
+			    (while 't
+			      (forward-line)
+			      (if (looking-at "^[ \t]\\(.*\\)")
+				  (setq str (concat str (match-string-no-properties 1)))
+				(throw 'loop str)))))))))
+
+	  ;; Handle level rendering
+	  (cond
+	   ((> level last-level)
+	    (org-export-as-xoxo-insert-into out "\n<ol>\n"))
+
+	   ((< level last-level)
+	    (dotimes (- (- last-level level) 1)
+	      (if hanging-li
+		  (org-export-as-xoxo-insert-into out "</li>\n"))
+	      (org-export-as-xoxo-insert-into out "</ol>\n"))
+	    (when hanging-li
+	      (org-export-as-xoxo-insert-into out "</li>\n")
+	      (setq hanging-li nil)))
+
+	   ((equal level last-level)
+	    (if hanging-li
+		(org-export-as-xoxo-insert-into out "</li>\n")))
+	   )
+
+	  (setq last-level level)
+
+	  ;; And output the new li
+	  (setq hanging-li 't)
+	  (if (equal ?+ (elt text 0))
+	      (org-export-as-xoxo-insert-into out "<li class='" (substring text 1) "'>")
+	    (org-export-as-xoxo-insert-into out "<li>" text))))
+
+      ;; Finally finish off the ol
+      (dotimes (- last-level 1)
+	(if hanging-li
+	    (org-export-as-xoxo-insert-into out "</li>\n"))
+	(org-export-as-xoxo-insert-into out "</ol>\n"))
+
+      (goto-char pos)
+      ;; Finish the buffer off and clean it up.
+      (switch-to-buffer-other-window out)
+      (indent-region (point-min) (point-max) nil)
+      (save-buffer)
+      (goto-char (point-min))
+      )))
+
+(provide 'org-xoxo)
+
+;; arch-tag: 16e6a31f-f4f5-46f1-af18-48dc89faa702
+
+
+;;; org-xoxo.el ends here

+ 20 - 8
lisp/org.el

@@ -2922,15 +2922,20 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables."
    org-insert-export-options-template org-export-as-html-and-open
    org-export-as-html-batch org-export-as-html-to-buffer
    org-replace-region-by-html org-export-region-as-html
-   org-export-as-html org-export-icalendar-this-file
-   org-export-icalendar-all-agenda-files
+   org-export-as-html 
    org-table-clean-before-export
-   org-export-icalendar-combine-agenda-files org-export-as-xoxo)))
+   )))
 
 (eval-and-compile
   (org-autoload "org-ascii"
-		'(org-export-as-ascii)))
-
+		'(org-export-as-ascii org-export-ascii-preprocess)))
+(eval-and-compile
+  (org-autoload "org-icalendar"
+		'(org-export-icalendar-this-file
+		  org-export-icalendar-all-agenda-files
+		  org-export-icalendar-combine-agenda-files)))
+(eval-and-compile
+  (org-autoload "org-xoxo" '(org-export-as-xoxo)))
 
 ;; Declare and autoload functions from org-agenda.el
 
@@ -5333,6 +5338,12 @@ This is a list with the following elements:
 	      (org-match-string-no-properties 4)
 	      (org-match-string-no-properties 5)))))
 
+(defun org-get-entry ()
+  "Get the entry text, after heading, entire subtree."
+  (save-excursion
+    (org-back-to-heading t)
+    (buffer-substring (point-at-bol 2) (org-end-of-subtree t))))
+
 (defun org-insert-heading-after-current ()
   "Insert a new heading with same level as current, after current subtree."
   (interactive)
@@ -14721,9 +14732,10 @@ With optional NODE, go directly to that node."
 (defun org-require-autoloaded-modules ()
   (interactive)
   (mapc 'require
-	'(org-agenda org-archive org-attach org-clock org-colview
-		     org-exp org-ascii org-id org-export-latex org-docbook
-		     org-publish org-remember org-table org-timer)))
+	'(org-agenda org-archive org-ascii org-attach org-clock org-colview
+		     org-docbook org-exp org-export-latex org-icalendar
+		     org-id org-publish org-remember org-table
+		     org-timer org-xoxo)))
 
 ;;;###autoload
 (defun org-reload (&optional uncompiled)