浏览代码

Define and use org-archive-subtree-add-inherited-tags.

* org-archive.el (org-archive-save-context-info): Fix
docstring typo.
(org-archive-subtree-add-inherited-tags): New variable to
control whether inherited tags should be appended to local
tags when archiving subtrees.
(org-archive-subtree): Use the new variable.

This feature was suggested by Carsten, after a request by Osamu OKANO.
Bastien Guerry 14 年之前
父节点
当前提交
4cc1063dd2
共有 1 个文件被更改,包括 19 次插入4 次删除
  1. 19 4
      lisp/org-archive.el

+ 19 - 4
lisp/org-archive.el

@@ -71,6 +71,14 @@ This variable is obsolete and has no effect anymore, instead add or remove
   :group 'org-archive
   :group 'org-archive
   :type 'boolean)
   :type 'boolean)
 
 
+(defcustom org-archive-subtree-add-inherited-tags 'infile
+  "Non-nil means append inherited tags when archiving a subtree."
+  :group 'org-archive
+  :type '(choice
+	  (const :tag "Never" nil)
+	  (const :tag "When archiving a subtree to the same file" infile)
+	  (const :tag "Always" t)))
+
 (defcustom org-archive-save-context-info '(time file olpath category todo itags)
 (defcustom org-archive-save-context-info '(time file olpath category todo itags)
   "Parts of context info that should be stored as properties when archiving.
   "Parts of context info that should be stored as properties when archiving.
 When a subtree is moved to an archive file, it loses information given by
 When a subtree is moved to an archive file, it loses information given by
@@ -201,14 +209,15 @@ this heading."
 	  (time (format-time-string
 	  (time (format-time-string
 		 (substring (cdr org-time-stamp-formats) 1 -1)
 		 (substring (cdr org-time-stamp-formats) 1 -1)
 		 (current-time)))
 		 (current-time)))
-	  category todo priority ltags itags
+	  category todo priority ltags itags atags
           ;; end of variables that will be used for saving context
           ;; end of variables that will be used for saving context
 	  location afile heading buffer level newfile-p visiting)
 	  location afile heading buffer level newfile-p visiting)
 
 
       ;; Find the local archive location
       ;; Find the local archive location
       (setq location (org-get-local-archive-location)
       (setq location (org-get-local-archive-location)
 	    afile (org-extract-archive-file location)
 	    afile (org-extract-archive-file location)
-	    heading (org-extract-archive-heading location))
+	    heading (org-extract-archive-heading location)
+	    infile-p (equal file (abbreviate-file-name afile)))
       (unless afile
       (unless afile
 	(error "Invalid `org-archive-location'"))
 	(error "Invalid `org-archive-location'"))
 
 
@@ -232,7 +241,8 @@ this heading."
 	      priority (org-get-priority
 	      priority (org-get-priority
 			(if (match-end 3) (match-string 3) ""))
 			(if (match-end 3) (match-string 3) ""))
 	      ltags (org-get-tags)
 	      ltags (org-get-tags)
-	      itags (org-delete-all ltags (org-get-tags-at)))
+	      itags (org-delete-all ltags (org-get-tags-at))
+	      atags (org-get-tags-at))
 	(setq ltags (mapconcat 'identity ltags " ")
 	(setq ltags (mapconcat 'identity ltags " ")
 	      itags (mapconcat 'identity itags " "))
 	      itags (mapconcat 'identity itags " "))
 	;; We first only copy, in case something goes wrong
 	;; We first only copy, in case something goes wrong
@@ -289,7 +299,12 @@ this heading."
 	    (goto-char (point-max)) (insert "\n"))
 	    (goto-char (point-max)) (insert "\n"))
 	  ;; Paste
 	  ;; Paste
 	  (org-paste-subtree (org-get-valid-level level (and heading 1)))
 	  (org-paste-subtree (org-get-valid-level level (and heading 1)))
-
+	  ;; Shall we append inherited tags?
+	  (and itags
+	       (or (and (eq org-archive-subtree-add-inherited-tags 'infile) 
+			infile-p)
+		   (eq org-archive-subtree-add-inherited-tags t))
+	       (org-set-tags-to atags))
 	  ;; Mark the entry as done
 	  ;; Mark the entry as done
 	  (when (and org-archive-mark-done
 	  (when (and org-archive-mark-done
 		     (looking-at org-todo-line-regexp)
 		     (looking-at org-todo-line-regexp)