[Orgmode] org-autoclock.el

[Piotr Zielinski]

A piece of elisp code that some of you might find useful.

Piotr

==================

;;;; org-autoclock.el --- Automatically clock projects
;;
;; Author: Piotr Zielinski
;; Homepage: http://www.cl.cam.ac.uk/~pz215/
;; Version: 0.01
;;
;; Tested with emacs 22.0.50 and org-mode 4.58
;;
;; This package scans your org files looking for links to local files
;; and directories (file:/local/file/example/).  If you are editing a
;; file whose name starts with /local/file/example/, then this package
;; will assume that you are working on the project described by the
;; headline in your org file containing the link
;; file:/local/file/example and start org-clocking it.
;;
;; Current version at http://www.cl.cam.ac.uk/~pz215/files/org-autoclock.el
;;

(require 'org)
(require 'cl)

(defvar org-autoclock-cached-files nil
 "The cached list of links to local files collected by
 `org-autoclock-refresh'.")

(defvar org-autoclock-current-project nil
 "The name of the current project returned by
 `org-autoclock-get-project'.")

(defmacro org-autoclock-with-collect (variable &rest body)
 `(let (,variable)
    (labels ((,variable (item) (push item ,variable)))
      ,@body
      (nreverse ,variable))))

(defun org-autoclock-refresh ()
 "Update `org-autoclock-cached-files' by scanning files from
 `org-agenda-files' that are currently visited."
 (setf org-autoclock-cached-files
        (org-autoclock-with-collect result
         (dolist (file org-agenda-files)
           (let* ((fullname (expand-file-name file))
                  (buffer (find-buffer-visiting fullname)))
             (when buffer
               (with-current-buffer buffer
                 (save-excursion
                   (goto-char (point-min))
                   (while (re-search-forward "file:\\([^\n>]+\\)" nil t)
                     (result (list fullname
                                   (expand-file-name
                                    (match-string-no-properties 1))
                                   (match-string-no-properties 0))))))))))))

(defun org-autoclock-get-project (filename)
 "Returns the name of the current project or nil."
 (loop for (file project name) in org-autoclock-cached-files
        when (starts-with filename project)
        return (list file name)))

(defun org-autoclock-update-project ()
 "Updates `org-autoclock-current-project'."
 (destructuring-bind (&optional file project)
     (when (< (or (second (current-idle-time)) 0) 180)
        (org-autoclock-get-project (buffer-file-name)))
   (when (not (equal project org-autoclock-current-project))
     (if project
          (with-current-buffer (find-file-noselect file)
            (save-excursion
              (widen)
              (goto-char (point-min))
              (search-forward project)
              (org-back-to-heading t)
              (org-clock-in)))
        (org-clock-out t))
     (setf org-autoclock-current-project project))))

(run-with-idle-timer 180 t 'org-autoclock-update-project)
(run-with-timer 300 300 'org-autoclock-update-project)
(add-hook 'org-mode-hook 'org-autoclock-refresh)

(provide 'org-autoclock)                

======================

--
Piotr Zielinski, Research Associate
Cavendish Laboratory, University of Cambridge, UK
http://www.cl.cam.ac.uk/~pz215/