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