CONTRIB/lisp/org-annotate-file.el

   1 ;;; org-annotate-file.el --- Annotate a file with org syntax
   2
   3 ;; Copyright (C) 2008 Philip Jackson
   4
   5 ;; Author: Philip Jackson <phil@shellarchive.co.uk>
   6 ;; Version: 0.2
   7
   8 ;; This file is not currently part of GNU Emacs.
   9
  10 ;; This program is free software; you can redistribute it and/or
  11 ;; modify it under the terms of the GNU General Public License as
  12 ;; published by the Free Software Foundation; either version 2, or (at
  13 ;; your option) any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful, but
  16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18 ;; General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with this program ; see the file COPYING.  If not, write to
  22 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; This is yet another implementation to allow the annotation of a
  28 ;; file without modification of the file itself. The annotation is in
  29 ;; org syntax so you can use all of the org features you are used to.
  30
  31 ;; To use you might put the following in your .emacs:
  32 ;;
  33 ;; (require 'org-annotate-file)
  34 ;; (global-set-key (kbd "C-c C-l") 'org-annotate-file) ; for example
  35 ;;
  36 ;; To change the location of the annotation file:
  37 ;;
  38 ;; (setq org-annotate-file-storage-file "~/annotated.org")
  39 ;;
  40 ;; Then when you visit any file and hit C-c C-l you will find yourself
  41 ;; in an org buffer on a headline which links to the file you were
  42 ;; visiting, e.g:
  43
  44 ;; * ~/org-annotate-file.el
  45
  46 ;; Under here you can put anything you like, save the file
  47 ;; and next time you hit C-c C-l you will hit those notes again.
  48 ;;
  49 ;; To put a subheading with a text search for the current line set
  50 ;; `org-annotate-file-add-search` to non-nil value. Then when you hit
  51 ;; C-c C-l (on the above line for example) you will get:
  52
  53 ;; * ~/org-annotate-file.el
  54 ;; ** `org-annotate-file-add-search` to non-nil value. Then whe...
  55
  56 ;; Note that both of the above will be links.
  57
  58 (require 'org)
  59
  60 (defvar org-annotate-file-storage-file "~/.org-annotate-file.org"
  61   "File in which to keep annotations.")
  62
  63 (defvar org-annotate-file-add-search nil
  64   "If non-nil then add a link as a second level to the actual
  65 location in the file")
  66
  67 (defvar org-annotate-file-always-open t
  68   "non-nil means always expand the full tree when you visit
  69 `org-annotate-file-storage-file'.")
  70
  71 (defun org-annotate-file-prettyfy-desc (string)
  72   "Strip starting and ending whitespace and replace any chars
  73 after the 60th with '...'"
  74   (let ((replace-map '(("^[ \t]*" . "")
  75                        ("[ \t]*$" . "")
  76                        ("^\\(.\\{60\\}\\).*" . "\\1..."))))
  77     (dolist (replace replace-map)
  78       (when (string-match (car replace) string)
  79         (setq string (replace-match (cdr replace) nil nil string))))
  80     string))
  81
  82 (defun org-annotate-file ()
  83   "Put a section for the current file into your annotation file"
  84   (interactive)
  85   (unless (buffer-file-name)
  86     (error "This buffer has no associated file."))
  87   (org-annotate-file-show-section))
  88
  89 (defun org-annotate-file-show-section (&optional buffer)
  90   "Visit the buffer named `org-annotate-file-storage-file' and
  91 show the relevant section"
  92   (let* ((filename (abbreviate-file-name (or buffer (buffer-file-name))))
  93          (line (buffer-substring-no-properties (point-at-bol) (point-at-eol)))
  94          (link (org-make-link-string (concat "file:" filename)))
  95          (search-link (org-make-link-string
  96                        (concat "file:" filename "::" line)
  97                                (org-annotate-file-prettyfy-desc line))))
  98     (with-current-buffer (find-file org-annotate-file-storage-file)
  99       (unless (org-mode-p)
 100         (org-mode))
 101       (goto-char (point-min))
 102       (widen)
 103       (when org-annotate-file-always-open
 104         (show-all))
 105       (unless (search-forward-regexp
 106                (concat "^* " (regexp-quote link)) nil t)
 107         (org-annotate-file-add-upper-level link))
 108       (beginning-of-line)
 109       (org-narrow-to-subtree)
 110       ;; deal with a '::' search if need be
 111       (when org-annotate-file-add-search
 112         (unless (search-forward-regexp
 113                  (concat "^** " (regexp-quote search-link)) nil t)
 114           (org-annotate-file-add-second-level search-link))))))
 115
 116 (defun org-annotate-file-add-upper-level (link)
 117   (goto-char (point-min))
 118   (call-interactively 'org-insert-heading)
 119   (insert link))
 120
 121 (defun org-annotate-file-add-second-level (link)
 122   (goto-char (point-at-eol))
 123   (call-interactively 'org-insert-subheading)
 124   (insert link))
 125
 126 (provide 'org-annotate-file)
 127 ;;; org-annotate-file.el ends here