org-annotate-file.el 4.8 KB

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