contrib/lisp/org-annotate-file.el

   1 ;;; org-annotate-file.el --- Annotate a file with org syntax
   2
   3 ;; Copyright (C) 2008-2014 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 ;;; Code:
  59
  60 (require 'org)
  61
  62 (defgroup org-annotate-file nil
  63   "Org Annotate"
  64   :group 'org)
  65
  66 (defcustom org-annotate-file-storage-file "~/.org-annotate-file.org"
  67   "File in which to keep annotations."
  68   :group 'org-annotate-file
  69   :type 'file)
  70
  71 (defcustom org-annotate-file-add-search nil
  72   "If non-nil, add a link as a second level to the actual file location."
  73   :group 'org-annotate-file
  74   :type 'boolean)
  75
  76 (defcustom org-annotate-file-always-open t
  77   "If non-nil, always expand the full tree when visiting the annotation file."
  78   :group 'org-annotate-file
  79   :type 'boolean)
  80
  81 (defun org-annotate-file-ellipsify-desc (string &optional after)
  82   "Return shortened STRING with appended ellipsis.
  83 Trim whitespace at beginning and end of STRING and replace any
  84   characters that appear after the occurrence of AFTER with '...'"
  85   (let* ((after (number-to-string (or after 30)))
  86          (replace-map (list (cons "^[ \t]*" "")
  87                             (cons "[ \t]*$" "")
  88                             (cons (concat "^\\(.\\{" after
  89                                           "\\}\\).*") "\\1..."))))
  90     (mapc (lambda (x)
  91             (when (string-match (car x) string)
  92               (setq string (replace-match (cdr x) nil nil string))))
  93           replace-map)
  94     string))
  95
  96 ;;;###autoload
  97 (defun org-annotate-file ()
  98   "Visit `org-annotate-file-storage-file` and add a new annotation section.
  99 The annotation is opened at the new section which will be referencing
 100 the point in the current file."
 101   (interactive)
 102   (unless (buffer-file-name)
 103     (error "This buffer has no associated file!"))
 104   (switch-to-buffer
 105    (org-annotate-file-show-section org-annotate-file-storage-file)))
 106
 107 ;;;###autoload
 108 (defun org-annotate-file-show-section (storage-file &optional annotated-buffer)
 109   "Add or show annotation entry in STORAGE-FILE and return the buffer.
 110 The annotation will link to ANNOTATED-BUFFER if specified,
 111   otherwise the current buffer is used."
 112   (let ((filename (abbreviate-file-name (or annotated-buffer
 113                                             (buffer-file-name))))
 114         (line (buffer-substring-no-properties (point-at-bol) (point-at-eol)))
 115         (annotation-buffer (find-file-noselect storage-file)))
 116     (with-current-buffer annotation-buffer
 117       (org-annotate-file-annotate filename line))
 118     annotation-buffer))
 119
 120 (defun org-annotate-file-annotate (filename line)
 121   "Add annotation for FILENAME at LINE using current buffer."
 122   (let* ((link (org-make-link-string (concat "file:" filename) filename))
 123          (search-link (org-make-link-string
 124                        (concat "file:" filename "::" line)
 125                        (org-annotate-file-ellipsify-desc line))))
 126     (unless (eq major-mode 'org-mode)
 127       (org-mode))
 128     (goto-char (point-min))
 129     (widen)
 130     (when org-annotate-file-always-open
 131       (show-all))
 132     (unless (search-forward-regexp
 133              (concat "^* " (regexp-quote link)) nil t)
 134       (org-annotate-file-add-upper-level link))
 135     (beginning-of-line)
 136     (org-narrow-to-subtree)
 137     ;; deal with a '::' search if need be
 138     (when org-annotate-file-add-search
 139       (unless (search-forward-regexp
 140                (concat "^** " (regexp-quote search-link)) nil t)
 141         (org-annotate-file-add-second-level search-link)))))
 142
 143 (defun org-annotate-file-add-upper-level (link)
 144   "Add and link heading to LINK."
 145   (goto-char (point-min))
 146   (call-interactively 'org-insert-heading)
 147   (insert link))
 148
 149 (defun org-annotate-file-add-second-level (link)
 150   "Add and link subheading to LINK."
 151   (goto-char (point-at-eol))
 152   (call-interactively 'org-insert-subheading)
 153   (insert link))
 154
 155 (provide 'org-annotate-file)
 156
 157 ;;; org-annotate-file.el ends here