branch: elpa/annotate
commit 2e858729cbbaa0070a3d610ef7e0487f2f176339
Author: cage <cage-invalid@invalid>
Commit: cage <cage-invalid@invalid>
- saving annotations with newlines seems to works;
- fixed 'annotate-move-next-annotation' and
'annotate-move-previous-annotation';
- fixed 'annotate-previous-annotation-end' a variable incremented then was
added an harmful on to it.
---
annotate.el | 209 +++++++++++++++++++++++++++++++++++++++++-------------------
1 file changed, 144 insertions(+), 65 deletions(-)
diff --git a/annotate.el b/annotate.el
index 46cf145464..eec76934da 100644
--- a/annotate.el
+++ b/annotate.el
@@ -46,6 +46,9 @@
;; the previous annotation. Use M-x annotate-export-annotations to
;; save annotations as a no-difference diff file.
+;; Important note: annotation can not overlaps and newline character
+;; can not be annotated.
+
;;; Code:
(require 'cl-lib)
@@ -376,42 +379,49 @@ modified (for example a newline is inserted)."
(create-new-annotation)))
(set-buffer-modified-p t))))
-(defun annotate-move-next-annotation ()
+(cl-defun annotate-move-next-annotation (&key (startingp t))
"Move point to the next annotation."
(interactive)
- ;; get all following overlays
- (let ((overlays
- (overlays-in (point) (buffer-size))))
- ;; skip overlays not created by annotate.el
- (setq overlays (cl-remove-if (lambda (ov) (not (annotationp ov)))
- overlays))
- ;; skip properties under point
- (dolist (current (overlays-at (point)))
- (setq overlays (remove current overlays)))
- ;; sort overlays ascending
- (setq overlays (sort overlays (lambda (x y)
- (< (overlay-start x) (overlay-start y)))))
- (if (null overlays)
- (message "No further annotations.")
- ;; jump to first overlay list
- (goto-char (overlay-start (nth 0 overlays))))))
-
-(defun annotate-move-previous-annotation ()
+ (let ((annotation (annotate-annotation-at (point))))
+ (if startingp
+ (if annotation
+ (let* ((chain-last (annotate-chain-last annotation))
+ (annotation-last-end (overlay-end chain-last))
+ (look-ahead (annotate-next-annotation-starts
annotation-last-end)))
+ (if look-ahead
+ (progn
+ (goto-char annotation-last-end)
+ (annotate-move-next-annotation :startingp nil))
+ (message "This is the last annotation.")))
+ (let ((next-annotation (annotate-next-annotation-starts (point))))
+ (when next-annotation
+ (goto-char (overlay-start next-annotation)))))
+ (if annotation
+ (let ((chain-first (annotate-chain-first annotation)))
+ (goto-char (overlay-start chain-first)))
+ (annotate-move-next-annotation :startingp t)))))
+
+(cl-defun annotate-move-previous-annotation (&key (startingp t))
"Move point to the previous annotation."
(interactive)
- ;; get all previous overlays
- (let ((overlays
- (overlays-in 0 (point))))
- ;; skip overlays not created by annotate.el
- (setq overlays (cl-remove-if (lambda (ov) (not (annotationp ov)))
- overlays))
- ;; sort overlays descending
- (setq overlays (sort overlays (lambda (x y)
- (> (overlay-start x) (overlay-start y)))))
- (if (null overlays)
- (message "No previous annotations.")
- ;; jump to first overlay in list
- (goto-char (overlay-start (nth 0 overlays))))))
+ (let ((annotation (annotate-annotation-at (point))))
+ (if startingp
+ (if annotation
+ (let* ((chain-first (annotate-chain-first annotation))
+ (annotation-first-start (overlay-start chain-first))
+ (look-behind (annotate-previous-annotation-ends
annotation-first-start)))
+ (if look-behind
+ (progn
+ (goto-char (1- annotation-first-start))
+ (annotate-move-previous-annotation :startingp nil))
+ (message "This is the first annotation.")))
+ (let ((previous-annotation (annotate-previous-annotation-ends
(point))))
+ (when previous-annotation
+ (goto-char (1- (overlay-end previous-annotation))))))
+ (if annotation
+ (let ((chain-last (annotate-chain-last annotation)))
+ (goto-char (overlay-end chain-last)))
+ (annotate-move-previous-annotation :startingp t)))))
(defun annotate-actual-comment-start ()
"String for comment start related to current buffer's major
@@ -867,7 +877,7 @@ to 'maximum-width'."
(overlay-put ov
'face
(overlay-get first-in-chain 'face))))
- (when (annotate-chain-latest-p ov)
+ (when (annotate-chain-last-p ov)
(when position-new-line-p
(setf prefix-first " \n"))
(dolist (l multiline-annotation)
@@ -1301,25 +1311,35 @@ annotation."
(string= "" a)))
(cl-defmacro annotate-ensure-annotation ((overlay) &body body)
+ "Runs body only if overlay is an annotation (i.e. passes annotationp)"
`(and (annotationp ,overlay)
(progn ,@body)))
(defun annotate-annotation-prop-get (annotation property)
+ "Get property `property' from annotation `annotation'. If
+`annotation' does not pass `annotatonp' returns nil"
(annotate-ensure-annotation (annotation)
(overlay-get annotation property)))
(defun annotate-annotation-get-chain-position (annotation)
+ "Get property's value that define position of this annootation
+in a chain of annotations"
(annotate-annotation-prop-get annotation annotate-prop-chain-position))
(defun annotate-annotation-chain-position (annotation pos)
+ "Set property's value that define position of this annootation
+in a chain of annotations"
(overlay-put annotation annotate-prop-chain-position pos))
-(defun annotate-chain-latest-p (annotation)
+(defun annotate-chain-last-p (annotation)
+ "Non nil if this annotation is the last element of a chain of annotations"
(let ((value (annotate-annotation-get-chain-position annotation)))
(and value
(cl-equalp value annotate-prop-chain-pos-marker-last))))
(defun annotate-chain-first-p (annotation)
+ "Non nil if this annotation is the first element, or the only
+of a chain of annotations"
(let* ((chain-pos (annotate-annotation-get-chain-position
annotation))
(annotation-start (overlay-start annotation))
(previous-annotation (annotate-previous-annotation-ends
annotation-start))
@@ -1333,6 +1353,7 @@ annotation."
annotate-prop-chain-pos-marker-last))))))
(defun annotate-chain-first (annotation)
+ "Find first element of the chain where `annotation' belongs"
(cond
((null annotation)
nil)
@@ -1343,13 +1364,58 @@ annotation."
(previous-annotation (annotate-previous-annotation-ends
annotation-start)))
(annotate-chain-first previous-annotation)))))
+(defun annotate-chain-last (annotation)
+ "Find last element of the chain where `annotation' belongs"
+ (cond
+ ((null annotation)
+ nil)
+ ((annotate-chain-last-p annotation)
+ annotation)
+ (t
+ (let* ((annotation-end (overlay-end annotation))
+ (next-annotation (annotate-next-annotation-starts annotation-end)))
+ (annotate-chain-last next-annotation)))))
+
(defun annotate-chain-first-at (pos)
- (let* ((all-overlays (overlays-at pos))
- (annotation (cl-first (cl-remove-if-not #'annotationp
- all-overlays))))
+ "Find first element of the chain of annotation that overlap point `pos'"
+ (let ((annotation (annotate-annotation-at pos)))
(annotate-ensure-annotation (annotation)
(annotate-chain-first annotation))))
+(defun annotate-chain-last-at (pos)
+ "Find last element of the chain of annotation that overlap point `pos'"
+ (let ((annotation (annotate-annotation-at pos)))
+ (annotate-ensure-annotation (annotation)
+ (annotate-chain-last annotation))))
+
+(defun annotate-find-chain (annotation)
+ "Find all annotation that are parts of the chain where `annotation' belongs"
+ (annotate-ensure-annotation (annotation)
+ (cl-labels ((find-next-annotation (pos)
+ (annotate-annotation-at (next-overlay-change pos))))
+ (let* ((chain-first (annotate-chain-first annotation))
+ (results (list chain-first))
+ (chain-last (annotate-chain-last annotation))
+ (start-pos (overlay-end chain-first))
+ (next-annotation (find-next-annotation start-pos)))
+ (if (eq chain-first
+ chain-last)
+ results
+ (while (not (eq next-annotation
+ chain-last))
+ (if next-annotation
+ (progn
+ (cl-pushnew next-annotation results)
+ (setf start-pos (overlay-end next-annotation)))
+ (cl-incf start-pos))
+ (setf next-annotation (find-next-annotation start-pos)))
+ (push chain-last results)
+ (reverse results))))))
+
+(defun annotate-annotations-chain-at (pos)
+ "Find all annotation that are parts of the chain that overlaps at `point'"
+ (annotate-find-chain (annotate-annotation-at pos)))
+
(defun annotate-create-annotation (start end annotation-text annotated-text)
"Create a new annotation for selected region.
@@ -1462,24 +1528,31 @@ The searched interval can be customized setting the
variable:
(defun annotate-change-annotation (pos)
"Change annotation at point. If empty, delete annotation."
- (let* ((highlight (car (overlays-at pos)))
- (annotation (read-from-minibuffer
- annotate-annotation-prompt
- (overlay-get highlight 'annotation))))
+ (let* ((highlight (annotate-annotation-at pos))
+ (annotation-text (read-from-minibuffer annotate-annotation-prompt
+ (overlay-get highlight
'annotation))))
+ (cl-labels ((delete (annotation)
+ (let ((chain (annotate-find-chain annotation)))
+ (dolist (single-element chain)
+ (goto-char (overlay-end single-element))
+ (move-end-of-line nil)
+ (annotate--remove-annotation-property (overlay-start
single-element)
+ (overlay-end
single-element))
+ (delete-overlay single-element))))
+ (change (annotation)
+ (let ((chain (annotate-find-chain annotation)))
+ (dolist (single-element chain)
+ (overlay-put single-element 'annotation
annotation-text)))))
(save-excursion
- (goto-char (overlay-end highlight))
- (move-end-of-line nil)
(cond
;; annotation was cancelled:
- ((null annotation))
+ ((null annotation-text))
;; annotation was erased:
- ((string= "" annotation)
- (annotate--remove-annotation-property
- (overlay-start highlight)
- (overlay-end highlight))
- (delete-overlay highlight))
+ ((string= "" annotation-text)
+ (delete highlight))
;; annotation was changed:
- (t (overlay-put highlight 'annotation annotation))))))
+ (t
+ (change highlight)))))))
(defun annotate-make-prefix ()
"An empty string from the end of the line upto the annotation."
@@ -1512,7 +1585,7 @@ NOTE this assumes that annotations never overlaps"
(point-min))
(null annotation))
(setf start (1- start))
- (setf annotation (annotate-annotation-at (1- start))))
+ (setf annotation (annotate-annotation-at start)))
annotation)))
(let ((annotation (annotate-annotation-at pos)))
(if annotation
@@ -1529,7 +1602,7 @@ NOTE this assumes that annotations never overlaps"
(point-max))
(null annotation))
(setf start (1+ start))
- (setf annotation (annotate-annotation-at (1+ start))))
+ (setf annotation (annotate-annotation-at start)))
annotation)))
(let ((annotation (annotate-annotation-at pos)))
(if annotation
@@ -1596,19 +1669,25 @@ NOTE this assumes that annotations never overlaps"
(defun annotate-describe-annotations ()
"Return a list of all annotations in the current buffer."
- (let ((overlays (overlays-in 0 (buffer-size))))
- ;; skip non-annotation overlays
- (setq overlays
- (cl-remove-if (lambda (ov) (not (annotationp ov)))
- overlays))
- (mapcar (lambda (ov)
- (let ((from (overlay-start ov))
- (to (overlay-end ov)))
- (list from
- to
- (overlay-get ov 'annotation)
- (buffer-substring-no-properties from to))))
- overlays)))
+ (let ((all-annotations (cl-remove-if-not #'annotationp (overlays-in 0
(buffer-size))))
+ (chain-visited ()))
+ (cl-remove-if #'null
+ (mapcar (lambda (annotation)
+ (let* ((chain (annotate-find-chain
annotation))
+ (chain-first (annotate-chain-first
annotation))
+ (chain-last (annotate-chain-last
annotation))
+ (from (overlay-start chain-first))
+ (to (overlay-end chain-last)))
+ (when (not (cl-find-if (lambda (a)
+ (eq (cl-first chain)
+ (cl-first a)))
+ chain-visited))
+ (push chain chain-visited)
+ (list from
+ to
+ (overlay-get annotation 'annotation)
+ (buffer-substring-no-properties from
to)))))
+ all-annotations))))
(defun annotate-info-root-dir-p (filename)
"Is the name of this file equals to the info root node?"
