# HG changeset patch # User Oleksandr Gavenko # Date 1455292501 -7200 # Node ID c8606339804e6b835c8649293851419d2ce53d59 # Parent 6e334301afb1e208832c13442b24604d075bff83 Use entire directory for org-mode file list. Rework my archive functions to process all org-files by one command. diff -r 6e334301afb1 -r c8606339804e .emacs-my --- 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)