Use entire directory for org-mode file list.
Rework my archive functions to process all org-files by one command.
--- a/.emacs-my Fri Feb 12 15:55:06 2016 +0200
+++ b/.emacs-my Fri Feb 12 17:55:01 2016 +0200
@@ -1550,8 +1550,10 @@
)
(setq my-org-agenda-todo-file (concat org-directory "/TODO.org"))
(setq my-org-agenda-note-file (concat org-directory "/NOTE.org"))
- (setq my-org-agenda-learning-file (concat org-directory "/LEARNING.org"))
- (setq org-agenda-files `(,my-org-agenda-todo-file ,my-org-agenda-note-file ,my-org-agenda-learning-file))
+ (setq org-agenda-file-regexp "\\`[^.#].*[^_]\\.org\\'"
+ org-agenda-files (list org-directory))
+ ;; (setq my-org-agenda-learning-file (concat org-directory "/LEARNING.org"))
+ ;; (setq org-agenda-files `(,my-org-agenda-todo-file ,my-org-agenda-note-file ,my-org-agenda-learning-file))
(define-key global-map "\C-va" 'org-agenda)
(define-key global-map "\C-ve" (lambda nil (interactive) (find-file my-org-agenda-note-file)))
@@ -1607,39 +1609,55 @@
)
-
-(defun my-org-archive-location (org-file)
- (concat (if (string-match "\\(.*\\)\\.org$" org-file)
- (match-string 1 org-file)
- org-file)
- "_done.org"))
-
-(defun my-org-archive ()
- "Move marked by `org-done-keywords' entries to archive file defined by `my-org-archive-location'."
- (interactive)
- (let ( (org-archive (my-org-archive-location (buffer-file-name)))
- (entry-re (concat "^\\* "))
- (entry-done-re (concat "^\\* *" (mapconcat 'regexp-quote org-done-keywords "\\|") " "))
+(defun my/org-archive-location (path)
+ "For given PATH make path to archive. Currently add undescore
+before file extention. If file name doesn't match
+`org-agenda-file-regexp' or have no extention return `nil'."
+ (if (and (file-name-extension path)
+ (string-match org-agenda-file-regexp (file-name-nondirectory path)))
+ (concat (file-name-sans-extension path) "_." (file-name-extension path))
+ nil))
+
+(defun my/org-archive-file (path)
+ "Move marked by `org-done-keywords' entries to archive file.
+
+Archive file name constructed by `my/org-archive-location'."
+ (let ( (archive (my/org-archive-location path))
+ entry-re entry-done-re
entry-beg entry-end )
+ (unless archive
+ (error "'%s' looks like a non-org file..." path))
(save-excursion
- (show-all)
- (kill-new "")
- (goto-char (point-min))
- (while (re-search-forward entry-done-re nil t)
- (setq entry-beg (line-beginning-position))
- ()
- (if (re-search-forward entry-re nil t)
- (beginning-of-line)
- (goto-char (point-max)))
- (setq entry-end (point))
- (let ( (last-command 'kill-region) )
- (kill-region entry-beg entry-end))
- )
- (find-file org-archive)
- (goto-char (point-max))
- (insert ?\n)
- (yank)
- )))
+ (with-current-buffer (find-file-noselect path)
+ (org-set-regexps-and-options)
+ (setq entry-re "^\\* "
+ entry-done-re (concat "^\\* *" (mapconcat 'regexp-quote org-done-keywords "\\|") " "))
+ (kill-new "")
+ (goto-char (point-min))
+ (while (re-search-forward entry-done-re nil t)
+ (setq entry-beg (line-beginning-position))
+ (if (re-search-forward entry-re nil t)
+ (beginning-of-line)
+ (goto-char (point-max)))
+ (setq entry-end (point))
+ (let ( (last-command 'kill-region) )
+ (kill-region entry-beg entry-end))
+ )
+ (with-current-buffer (find-file-noselect archive)
+ (goto-char (point-max))
+ (insert ?\n)
+ (yank)
+ (save-buffer))
+ (save-buffer) ))))
+
+(defun my/org-archive (&optional prefix)
+ "Move all entries marked by `org-done-keywords' to archive
+files with name mangled by `my/org-archive-location'.
+
+Without prefix work on current file. With prefix work on "
+ (interactive "P")
+ (loop for file in (if prefix (org-agenda-files) (list (buffer-file-name))) do
+ (my/org-archive-file file)))
(setq org-agenda-include-diary t)