123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157 |
- (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))
- (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)))
- (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)
-
- (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)
|