Merge branch 'maint'
[org-mode.git] / contrib / lisp / org-annotate-file.el
blob55e5a3270df0b8a4adf4cedd4b74fe068aa2ecae
1 ;;; org-annotate-file.el --- Annotate a file with org syntax
3 ;; Copyright (C) 2008-2012 Philip Jackson
5 ;; Author: Philip Jackson <phil@shellarchive.co.uk>
6 ;; Version: 0.2
8 ;; This file is not currently part of GNU Emacs.
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.
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.
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.
25 ;;; Commentary:
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.
31 ;; To use you might put the following in your .emacs:
33 ;; (require 'org-annotate-file)
34 ;; (global-set-key (kbd "C-c C-l") 'org-annotate-file) ; for example
36 ;; To change the location of the annotation file:
38 ;; (setq org-annotate-file-storage-file "~/annotated.org")
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:
44 ;; * ~/org-annotate-file.el
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.
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:
53 ;; * ~/org-annotate-file.el
54 ;; ** `org-annotate-file-add-search` to non-nil value. Then whe...
56 ;; Note that both of the above will be links.
58 (require 'org)
60 (defvar org-annotate-file-storage-file "~/.org-annotate-file.org"
61 "File in which to keep annotations.")
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")
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'.")
71 (defun org-annotate-file-elipsify-desc (string &optional after)
72 "Strip starting and ending whitespace and replace any chars
73 that appear after the value in `after' with '...'"
74 (let* ((after (number-to-string (or after 30)))
75 (replace-map (list (cons "^[ \t]*" "")
76 (cons "[ \t]*$" "")
77 (cons (concat "^\\(.\\{" after
78 "\\}\\).*") "\\1..."))))
79 (mapc (lambda (x)
80 (when (string-match (car x) string)
81 (setq string (replace-match (cdr x) nil nil string))))
82 replace-map)
83 string))
85 (defun org-annotate-file ()
86 "Put a section for the current file into your annotation file"
87 (interactive)
88 (unless (buffer-file-name)
89 (error "This buffer has no associated file"))
90 (org-annotate-file-show-section))
92 (defun org-annotate-file-show-section (&optional buffer)
93 "Visit the buffer named `org-annotate-file-storage-file' and
94 show the relevant section"
95 (let* ((filename (abbreviate-file-name (or buffer (buffer-file-name))))
96 (line (buffer-substring-no-properties (point-at-bol) (point-at-eol)))
97 (link (org-make-link-string (concat "file:" filename) filename))
98 (search-link (org-make-link-string
99 (concat "file:" filename "::" line)
100 (org-annotate-file-elipsify-desc line))))
101 (with-current-buffer (find-file org-annotate-file-storage-file)
102 (unless (eq major-mode 'org-mode)
103 (org-mode))
104 (goto-char (point-min))
105 (widen)
106 (when org-annotate-file-always-open
107 (show-all))
108 (unless (search-forward-regexp
109 (concat "^* " (regexp-quote link)) nil t)
110 (org-annotate-file-add-upper-level link))
111 (beginning-of-line)
112 (org-narrow-to-subtree)
113 ;; deal with a '::' search if need be
114 (when org-annotate-file-add-search
115 (unless (search-forward-regexp
116 (concat "^** " (regexp-quote search-link)) nil t)
117 (org-annotate-file-add-second-level search-link))))))
119 (defun org-annotate-file-add-upper-level (link)
120 (goto-char (point-min))
121 (call-interactively 'org-insert-heading)
122 (insert link))
124 (defun org-annotate-file-add-second-level (link)
125 (goto-char (point-at-eol))
126 (call-interactively 'org-insert-subheading)
127 (insert link))
129 (provide 'org-annotate-file)
131 ;;; org-annotate-file.el ends here