org-autoclock.el

["Piotr Zielinski" <piotr.zielinski@gmail.com>]

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/