Browse Source

More options for categories in iCalendar export.

Tags and the todo state can now be listed as categories.
Carsten Dominik 16 năm trước cách đây
mục cha
commit
8ad796156e
4 tập tin đã thay đổi với 60 bổ sung8 xóa
  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))))