.emacs-my
changeset 1335 c8606339804e
parent 1334 6e334301afb1
child 1336 7c93663d44f3
--- 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)