浏览代码

More options for categories in iCalendar export.

Tags and the todo state can now be listed as categories.
Carsten Dominik 16 年之前
父节点
当前提交
8ad796156e
共有 4 个文件被更改,包括 60 次插入8 次删除
  1. 4 1
      doc/org.texi
  2. 5 0
      lisp/ChangeLog
  3. 36 4
      lisp/org-exp.el
  4. 15 3
      lisp/org.el

+ 4 - 1
doc/org.texi

@@ -7643,7 +7643,10 @@ stamps as VEVENT, and TODO items as VTODO.  It will also create events from
 deadlines that are in non-TODO items.  Deadlines and scheduling dates in TODO
 items will be used to set the start and due dates for the todo
 entry@footnote{See the variables @code{org-icalendar-use-deadline} and
-@code{org-icalendar-use-scheduled}.}.
+@code{org-icalendar-use-scheduled}.}.  As categories, it will use the tags
+locally defined in the heading, and the file/tree category@footnote{To add
+inherited tags or the TODO state, configure the variable
+@code{org-icalendar-categories}.}. 
 
 The iCalendar standard requires each entry to have a globally unique
 identifier (UID).  Org creates these identifiers during export.  If you set

+ 5 - 0
lisp/ChangeLog

@@ -1,5 +1,10 @@
 2008-09-18  Carsten Dominik  <dominik@science.uva.nl>
 
+	* org.el (org-get-local-tags-at): New function.
+	(org-get-local-tags): New function.
+
+	* org-exp.el (org-export-get-categories): New function.
+
 	* org-agenda.el (org-sorting-choice)
 	(org-agenda-sorting-strategy, org-agenda-get-todos)
 	(org-agenda-get-timestamps, org-agenda-get-deadlines)

+ 36 - 4
lisp/org-exp.el

@@ -713,6 +713,22 @@ todo-start          Scheduling time stamps in TODO entries become start date.
 	      (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
@@ -4177,7 +4193,7 @@ When COMBINE is non nil, add the category to each line."
 	      "DTSTART"))
 	hd ts ts2 state status (inc t) pos b sexp rrule
 	scheduledp deadlinep todo prefix due start
-	tmp pri category entry location summary desc uid
+	tmp pri categories entry location summary desc uid
 	(sexp-buffer (get-buffer-create "*ical-tmp*")))
     (org-refresh-category-properties)
     (save-excursion
@@ -4208,7 +4224,7 @@ When COMBINE is non nil, add the category to each line."
 		uid (if org-icalendar-store-UID
 			(org-id-get-create)
 		      (or (org-id-get) (org-id-new)))
-		category (org-get-category)
+		categories (org-export-get-categories)
 		deadlinep nil scheduledp nil)
 	  (if (looking-at re2)
 	      (progn
@@ -4280,7 +4296,7 @@ END:VEVENT\n"
 			       (concat "\nDESCRIPTION: " desc) "")
 			   (if (and location (string-match "\\S-" location))
 			       (concat "\nLOCATION: " location) "")
-			   category)))))
+			   categories)))))
       (when (and org-icalendar-include-sexps
 		 (condition-case nil (require 'icalendar) (error nil))
 		 (fboundp 'icalendar-export-region))
@@ -4331,6 +4347,7 @@ END:VEVENT\n"
 			     (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))))
@@ -4366,9 +4383,24 @@ END:VTODO\n"
 			     (if (and desc (string-match "\\S-" desc))
 				 (concat "\nDESCRIPTION: " desc) "")
 			     (if due (concat "\n" due) "")
-			     category
+			     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

+ 15 - 3
lisp/org.el

@@ -9723,11 +9723,21 @@ it as a time string and apply `float-time' to it.  f S is nil, just return 0."
 (defvar org-tags-overlay (org-make-overlay 1 1))
 (org-detach-overlay org-tags-overlay)
 
-(defun org-get-tags-at (&optional pos)
+(defun org-get-local-tags-at (&optional pos)
+  "Get a list of tags defined in the current headline."
+  (org-get-tags-at pos 'local))
+
+(defun org-get-local-tags ()
+  "Get a list of tags defined in the current headline."
+  (org-get-tags-at nil 'local))
+
+(defun org-get-tags-at (&optional pos local)
   "Get a list of all headline tags applicable at POS.
 POS defaults to point.  If tags are inherited, the list contains
 the targets in the same sequence as the headlines appear, i.e.
-the tags of the current headline come last."
+the tags of the current headline come last.
+When LOCAL is non-nil, only return tags from the current headline,
+ignore inherited ones."
   (interactive)
   (let (tags ltags lastpos parent)
     (save-excursion
@@ -9746,7 +9756,9 @@ the tags of the current headline come last."
 		    (setq tags (append (org-remove-uniherited-tags ltags)
 				       tags)))
 		  (or org-use-tag-inheritance (error ""))
-		  (org-up-heading-all 1)
+		  (if local
+		      (setq lastpos (point)) ; stop here
+		    (org-up-heading-all 1))
 		  (setq parent t)))
 	    (error nil))))
       (append (org-remove-uniherited-tags org-file-tags) tags))))