Last edit
Summary: Adde option ipa-file-function to allow dynamic storage file selection.
Changed:
< "File where annotations are stored.")
to
> "File where annotations are stored, but see also
> `ipa-file-function'")
> (defvar ipa-file-function 'ipa-get-global-file
> "Function to get the name of the annotation storage file. By
> default it returns `ipa-file', but it can be used, for example,
> to use different storage files in each directory. See
> `ipa-get-directory-file'")
Changed:
< (with-current-buffer (find-file-noselect ipa-file)
to
> (with-current-buffer (find-file-noselect (funcall ipa-file-function))
Added:
> (defun ipa-get-global-file ()
> ipa-file)
> (defun ipa-get-directory-file ()
> (let ((current-file (ipa-get-buffer-file-name)))
> (if current-file
> (concat (if (file-directory-p current-file)
> current-file
> (file-name-directory current-file))
> (file-name-nondirectory ipa-file)))))
;;; ipa.el --- In-place annotations ;; Copyright (C) 2007 Tamas Patrovics ;; This file 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 file 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 GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;;; With this package you can add annotations to your files without ;;; modifying them. Each file can have multiple annotations at various ;;; buffer positions. The annotation texts are not parts of the files, ;;; they are stored separately. ;;; ;;; All annotations are stored in a common file, so searching ;;; annotations is trivial. ;;; ;;; ;;; Installation: ;;; ;;; (require 'ipa) ;;; ;;; ;;; The following commands can be used: ;;; ;;; ipa-insert - insert annotation at point ;;; ;;; ipa-edit - edit the first annotation after point ;;; (with universal argument: before point) ;;; ;;; ipa-next - goes to the next annotation in the buffer ;;; ;;; ipa-previous - goes to the previous annotation in the buffer ;;; ;;; ipa-move - move the first annotation after point ;;; (with universal argument: before point) ;;; ;;; ipa-toggle - hide/show annotations ;;; ;;; ipa-show - show all saved annotations for the current file ;;; (in the storage buffer you can press Enter on any ;;; annotation to go to its location) ;;; ;;; ipa-jump - jump to any annotation with id completion ;;; ;;; Annotations can optionally have ids in their ;;; text with the following format: [id]annotation-text ;;; ;;; The id itself doesn't appear in the annotated ;;; buffer. It only serves the purpose of giving a ;;; unique id to the annotation, so that you can jump ;;; to it quickly. ;;; ;;; If an annotation has an id, but no other text ;;; then it is effectively the same as a usual ;;; bookmark in emacs. ;;; ;;; Only annotations appearing in `ipa-file' can be ;;; jumped to, so unsaved annotations does not count. ;;; If there are more annotations defined with the ;;; same id then the first one found in `ipa-file' is ;;; used. ;;; ;;; ;;; Annotations are saved when the file itself is saved. If the file ;;; is not modified annotations are saved immediately when ;;; added/changed. ;;; ;; Tested on Emacs 22. ;;; Code: ;; User configuration (defvar ipa-file "~/.ipa" "File where annotations are stored, but see also `ipa-file-function'") (defvar ipa-file-function 'ipa-get-global-file "Function to get the name of the annotation storage file. By default it returns `ipa-file', but it can be used, for example, to use different storage files in each directory. See `ipa-get-directory-file'") (defvar ipa-context-size 16 "Length of before and after context of annotation position in characters used to reposition the annotation if the annotated file is changed behind Emacs's back.") (defvar ipa-annotation-face 'highlight "Face for annotations.") (defvar ipa-file-face 'header-line "Face for header lines in the IpA buffer.") ;;---------------------------------------------------------------------- (defvar ipa-annotations-in-buffer nil) (make-variable-buffer-local 'ipa-annotations-in-buffer) (defvar ipa-annotation-display t) (defconst ipa-line-continuation "|") (defconst ipa-file-marker "\f") (defconst ipa-file-regexp (concat "^" ipa-file-marker "\\s-*")) (defconst ipa-annotation-id-regexp "\\s-*\\[\\(.+\\)?\\]\\(.*\\)") (defvar ipa-pos-info-face '(face nil invisible t)) (defvar ipa-font-lock-keywords `((,(concat ipa-file-regexp "\\(.*\\)\n") . ipa-file-face) ("^|" . (0 ipa-annotation-face t)) (ipa-font-lock-pos-info . ((1 ipa-pos-info-face t) (2 ipa-annotation-face t))))) (define-derived-mode ipa-mode fundamental-mode "IPA" (set (make-local-variable 'font-lock-defaults) '(ipa-font-lock-keywords))) (define-key ipa-mode-map (kbd "<return>") 'ipa-go-to-annotation) (defvar ipa-overriding-map (let ((map (make-sparse-keymap))) (define-key map (kbd "<left>") 'ipa-move-left) (define-key map (kbd "<right>") 'ipa-move-right) (define-key map (kbd "<up>") 'ipa-move-line-up) (define-key map (kbd "<down>") 'ipa-move-line-down) (define-key map (kbd "<prior>") 'ipa-move-page-up) (define-key map (kbd "<next>") 'ipa-move-page-down) (define-key map (kbd "<return>") 'ipa-move-finish) (define-key map (kbd "<escape>") 'ipa-move-cancel) (define-key map (kbd "h") 'ipa-move-help) map)) (defvar ipa-old-global-map nil) (defvar ipa-overlay-being-moved nil) (defvar ipa-original-position-of-overlay-being-moved nil) (defun ipa-insert () (interactive) (unless ipa-annotation-display (ipa-toggle)) (let ((text (read-string "text: "))) (if (equal text "") (message "Empty annotations are not inserted.") (ipa-create-overlay (point) text) (if (ipa-get-buffer-file-name) (ipa-save-annotations-if-necessary) (message "Annotations in this buffer will be saved only if you save the buffer as a file."))))) (defun ipa-edit (&optional arg) (interactive "P") (unless ipa-annotation-display (ipa-toggle)) (let ((annotation (if arg (ipa-previous) (ipa-next)))) (if annotation (let* ((text (read-string "text (empty to remove): " (cdr annotation)))) (if (equal text "") (progn (delete-overlay (car annotation)) (setq ipa-annotations-in-buffer (delq annotation ipa-annotations-in-buffer)) (message "Deleted annotation.")) (ipa-set-overlay-text (car annotation) text) (setcdr annotation text) (message "Updated annotation.")) (ipa-save-annotations-if-necessary t))))) (defun ipa-move (&optional arg) (interactive "P") (unless ipa-annotation-display (ipa-toggle)) (let ((annotation (if arg (ipa-previous) (ipa-next)))) (when annotation (setq ipa-overlay-being-moved (car annotation)) (setq ipa-original-position-of-overlay-being-moved (overlay-start ipa-overlay-being-moved)) (setq ipa-old-global-map global-map) (use-global-map ipa-overriding-map) (setq overriding-terminal-local-map ipa-overriding-map) (add-hook 'post-command-hook 'ipa-show-help)))) (defun ipa-show-help () (message (substitute-command-keys (concat "Press \\[ipa-move-help] for help, " "\\[ipa-move-cancel] to cancel.")))) (defun ipa-move-cancel () (interactive) (goto-char ipa-original-position-of-overlay-being-moved) (move-overlay ipa-overlay-being-moved (point) (point)) (ipa-cleanup) (message "Moving of annotation is canceled.")) (defun ipa-move-help () (interactive) (tooltip-show (substitute-command-keys "\\{ipa-overriding-map}"))) (defun ipa-move-finish () (interactive) (ipa-cleanup) (ipa-sort-overlays) (ipa-save-annotations-if-necessary)) (defun ipa-cleanup () (interactive) (use-global-map ipa-old-global-map) (setq overriding-terminal-local-map nil) (remove-hook 'post-command-hook 'ipa-show-help)) (defun ipa-move-left () (interactive) (ipa-move-overlay 'backward-char)) (defun ipa-move-right () (interactive) (ipa-move-overlay 'forward-char)) (defun ipa-move-line-up () (interactive) (ipa-move-overlay 'previous-line)) (defun ipa-move-line-down () (interactive) (ipa-move-overlay 'next-line)) (defun ipa-move-page-up () (interactive) (ipa-move-overlay 'scroll-down)) (defun ipa-move-page-down () (interactive) (ipa-move-overlay 'scroll-up)) (defun ipa-move-overlay (movefunc) (condition-case nil (funcall movefunc) (beginning-of-buffer (goto-char (point-min))) (end-of-buffer (goto-char (point-max)))) (move-overlay ipa-overlay-being-moved (point) (point))) (defun ipa-next () (interactive) (unless ipa-annotation-display (ipa-toggle)) (let ((annotations ipa-annotations-in-buffer) annotation) (while (and annotations (not annotation)) (if (> (overlay-start (car (car annotations))) (point)) (setq annotation (car annotations)) (pop annotations))) (if (not annotation) (message "No annotations found after point.") (goto-char (overlay-start (car annotation))) (ipa-warn-if-annotation-is-empty (car annotation))) annotation)) (defun ipa-previous () (interactive) (unless ipa-annotation-display (ipa-toggle)) (let ((annotations ipa-annotations-in-buffer) (continue t) annotation) (while (and annotations continue) (if (> (overlay-start (car (car annotations))) (point)) (setq continue nil) (setq annotation (pop annotations)))) (if (not annotation) (message "No annotations found before point.") (goto-char (1- (overlay-start (car annotation)))) (ipa-warn-if-annotation-is-empty (car annotation))) annotation)) (defun ipa-warn-if-annotation-is-empty (overlay) (if (equal (overlay-get overlay 'before-string) "") (message "The text of this annotation is empty."))) (defun ipa-toggle (&optional arg) (interactive "P") (setq ipa-annotation-display (if arg (> (prefix-numeric-value arg) 0) (not ipa-annotation-display))) (if ipa-annotation-display (dolist (buffer (buffer-list)) (with-current-buffer buffer (dolist (annotation ipa-annotations-in-buffer) (ipa-set-overlay-text (car annotation) (cdr annotation)) (message "Annotations are shown.")))) (dolist (buffer (buffer-list)) (with-current-buffer buffer (dolist (annotation ipa-annotations-in-buffer) (ipa-set-overlay-text (car annotation) "") (message "Annotations are hidden.")))))) (defun ipa-show () (interactive) (if (not (ipa-get-buffer-file-name)) (message "This buffer has no associated file.") (let ((filename (ipa-get-buffer-file-name))) (with-current-buffer (ipa-find-storage-file) (goto-char (point-min)) (if (re-search-forward (concat ipa-file-regexp filename "\n") nil t) (switch-to-buffer (current-buffer)) (message "No annotations found for file.")))))) (defun ipa-save-annotations-in-buffer (&optional even-if-empty) (when (or ipa-annotations-in-buffer even-if-empty) (let ((filename (ipa-get-buffer-file-name)) (buffer (current-buffer)) (annotations ipa-annotations-in-buffer)) (with-current-buffer (ipa-find-storage-file) (save-excursion (goto-char (point-min)) (unless (re-search-forward (concat ipa-file-regexp filename "\n") nil t) (goto-char (point-max)) (insert ipa-file-marker " " filename "\n")) (let ((start (point))) (if (re-search-forward ipa-file-regexp nil t) (beginning-of-line) (goto-char (point-max))) (delete-region start (point))) (if annotations (dolist (annotation annotations) (let* ((pos (overlay-start (car annotation))) (pos-info (with-current-buffer buffer (list 'pos pos 'before (if (>= (- pos (point-min)) ipa-context-size) (buffer-substring-no-properties (- pos ipa-context-size) pos)) 'after (if (>= (- (point-max) pos) ipa-context-size) (buffer-substring-no-properties pos (+ pos ipa-context-size))))))) (insert (let ((print-escape-newlines t)) (prin1-to-string pos-info)) ":" (replace-regexp-in-string "\n" (concat "\n" ipa-line-continuation) (cdr annotation)) "\n\n"))) ;; delete header (let ((end (point))) (forward-line -1) (delete-region (point) end))) (save-buffer) (message "Annotations saved.")))))) (add-hook 'after-save-hook 'ipa-save-annotations-in-buffer) (defun ipa-load-annotations-into-buffer () (let ((filename (ipa-get-buffer-file-name)) (buffer (current-buffer))) (with-current-buffer (ipa-find-storage-file) (save-excursion (goto-char (point-min)) (if (re-search-forward (concat ipa-file-regexp filename "\n") nil t) (let ((end (save-excursion (if (re-search-forward ipa-file-regexp nil t) (line-beginning-position) (point-max))))) (with-current-buffer buffer (setq ipa-annotations-in-buffer nil)) (let (text pos) (while (< (point) end) (if (and (not (looking-at ipa-line-continuation)) text) (with-current-buffer buffer (ipa-create-overlay pos text) (setq text nil) (setq pos nil))) (cond ((let ((pos-info (ipa-get-pos-info))) (when pos-info (let ((after (plist-get pos-info 'after)) (before (plist-get pos-info 'before))) (with-current-buffer buffer (save-excursion ;; using the same algorithm as bookmarks (goto-char (plist-get pos-info 'pos)) (if (and after (search-forward after nil t)) (goto-char (match-beginning 0))) (if (and before (search-backward before nil t)) (goto-char (match-end 0))) (setq pos (point))))) (if (looking-at ":\\(.+\\)") (setq text (match-string 1)) (error "Annotation storage format error")) ;; making it explicit t))) ((looking-at ipa-line-continuation) (setq text (concat text "\n" (buffer-substring (1+ (point)) (line-end-position))))) (t 'skip)) (forward-line 1))) (message "Resaving annotations so that positions are updated...") (with-current-buffer buffer (ipa-save-annotations-in-buffer)) (message "Annotations loaded."))))))) (add-hook 'find-file-hook 'ipa-load-annotations-into-buffer) (add-hook 'dired-after-readin-hook 'ipa-load-annotations-into-buffer) (defun ipa-get-pos-info () (and (looking-at "(") (read (current-buffer)))) (defun ipa-set-overlay-text (overlay text) (if (string-match ipa-annotation-id-regexp text) (setq text (match-string 2 text))) (overlay-put overlay 'before-string (if (equal text "") "" (propertize (concat "[" text "]") 'face ipa-annotation-face)))) (defun ipa-save-annotations-if-necessary (&optional even-if-empty) (if (and (ipa-get-buffer-file-name) (not (buffer-modified-p))) (ipa-save-annotations-in-buffer even-if-empty))) (defun ipa-create-overlay (pos text) (let ((overlay (make-overlay pos pos nil t nil))) (ipa-set-overlay-text overlay text) (push (cons overlay text) ipa-annotations-in-buffer) (ipa-sort-overlays))) (defun ipa-sort-overlays () (setq ipa-annotations-in-buffer (sort ipa-annotations-in-buffer (lambda (first second) (< (overlay-start (car first)) (overlay-start (car second))))))) (defun ipa-find-storage-file () (with-current-buffer (find-file-noselect (funcall ipa-file-function)) (ipa-mode) (current-buffer))) (defun ipa-get-global-file () ipa-file) (defun ipa-get-directory-file () (let ((current-file (ipa-get-buffer-file-name))) (if current-file (concat (if (file-directory-p current-file) current-file (file-name-directory current-file)) (file-name-nondirectory ipa-file))))) (defun ipa-go-to-annotation () (interactive) (cond ((save-excursion (beginning-of-line) (looking-at (concat ipa-file-regexp "\\(.*\\)"))) (unless ipa-annotation-display (ipa-toggle)) (find-file (match-string 1))) ((let ((pos-info (save-excursion (beginning-of-line) (ipa-get-pos-info)))) (when pos-info (save-excursion (if (not (re-search-backward ipa-file-regexp nil t)) (error "Containing file header is not found") (ipa-go-to-annotation) (goto-char (plist-get pos-info 'pos)) t))))) ((save-excursion (beginning-of-line) (looking-at ipa-line-continuation)) (save-excursion (if (re-search-backward "^(" nil t) (ipa-go-to-annotation) (error "Containing annotation is not found")))) (t (message "There is nothing on the current line.")))) (defun ipa-font-lock-pos-info (limit) (when (re-search-forward "^(" limit t) (beginning-of-line) (let ((sexp-start (point)) sexp-end colon-end) (forward-sexp) (setq sexp-end (point)) (forward-char) (setq colon-end (point)) (set-match-data (list sexp-start ;; whole colon-end sexp-start ;; sexp sexp-end sexp-end ;; colon colon-end))) t)) (defun ipa-jump () (interactive) (with-current-buffer (ipa-find-storage-file) (save-excursion (goto-char (point-min)) (let (ids) (while (re-search-forward "^(" nil t) (backward-char) (forward-sexp) (if (looking-at (concat ":" ipa-annotation-id-regexp)) (let ((id (match-string-no-properties 1))) (unless (some (lambda (id-info) (equal (car id-info) id)) ids) (push (cons id (point)) ids))))) (if ids (let ((selected (completing-read "Jump to annotation: " ids nil t))) (unless (equal selected "") (goto-char (assoc-default selected ids)) (ipa-go-to-annotation))) (message "There are no annotations with ids.")))))) (defun ipa-get-buffer-file-name () (let ((name (or (buffer-file-name) (save-excursion (goto-char (point-min)) (dired-current-directory))))) (if name (file-truename name)))) (provide 'ipa) ;;; ipa.el ends here