branch: elpa/annotate commit 54aefdec8d7d366d0987aec9242f035a52c54aa2 Merge: d60feb9cab b180248ddc Author: Bastian Bechtold <bast...@users.noreply.github.com> Commit: GitHub <nore...@github.com>
Merge pull request #46 from cage2/master - added a secondary color for highlight and annotation text --- annotate.el | 166 ++++++++++++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 127 insertions(+), 39 deletions(-) diff --git a/annotate.el b/annotate.el index 55e8cf348a..1c7cf94af7 100644 --- a/annotate.el +++ b/annotate.el @@ -82,11 +82,21 @@ "Face for annotation highlights." :group 'annotate) +(defface annotate-highlight-secondary + '((t (:underline "khaki"))) + "Face for secondary annotation highlights." + :group 'annotate) + (defface annotate-annotation '((t (:background "coral" :foreground "black"))) "Face for annotations." :group 'annotate) +(defface annotate-annotation-secondary + '((t (:background "khaki" :foreground "black"))) + "Face for secondary annotations." + :group 'annotate) + (defcustom annotate-annotation-column 85 "Where annotations appear." :type 'number @@ -173,11 +183,47 @@ major mode is a member of this list (space separated entries)." ,@body) (setf inhibit-modification-hooks t))) +(defun annotate-end-of-line-pos () + "Get the position of the end of line and rewind the point's +position (so that it is unchanged after this function is called)." + (save-excursion + (end-of-line) + (point))) + +(defun annotate-beginning-of-line-pos () + "Get the position of the beginning of line and rewind the point's +position (so that it is unchanged after this function is called)." + (save-excursion + (beginning-of-line) + (point))) + +(defun annotate-before-change-fn (a b) + "This function is added to 'before-change-functions' hook and +it is called any time the buffer content is changed (so, for +example, text is added or deleted). In particular, it will +rearrange the overlays bounds when an annotated text is +modified (for example a newline is inserted)." + (annotate-with-inhibit-modification-hooks + (save-excursion + (let* ((bol (annotate-beginning-of-line-pos)) + (eol (annotate-end-of-line-pos)) + (ov (cl-remove-if-not 'annotationp + (overlays-in bol eol)))) + (dolist (overlay ov) + (annotate--remove-annotation-property (overlay-start overlay) + (overlay-end overlay)) + ;; move the overlay if we are breaking it + (when (<= (overlay-start overlay) + a + (overlay-end overlay)) + (move-overlay overlay (overlay-start overlay) a))))))) + (defun annotate-initialize () "Load annotations and set up save and display hooks." (annotate-load-annotations) (add-hook 'after-save-hook 'annotate-save-annotations t t) (add-hook 'window-configuration-change-hook 'font-lock-fontify-buffer t t) + (add-hook 'before-change-functions 'annotate-before-change-fn t t) (font-lock-add-keywords nil '((annotate--font-lock-matcher (2 (annotate--annotation-builder)) @@ -188,6 +234,7 @@ major mode is a member of this list (space separated entries)." (annotate-clear-annotations) (remove-hook 'after-save-hook 'annotate-save-annotations t) (remove-hook 'window-configuration-change-hook 'font-lock-fontify-buffer t) + (remove-hook 'before-change-functions 'annotate-before-change-fn t) (font-lock-remove-keywords nil '((annotate--font-lock-matcher (2 (annotate--annotation-builder)) @@ -207,13 +254,16 @@ major mode is a member of this list (space separated entries)." "Create, modify, or delete annotation." (interactive) (let ((overlay (car (overlays-at (point))))) - (cond ((and (overlayp overlay) (overlay-get overlay 'annotation)) - (annotate-change-annotation (point))) - (t - (cl-destructuring-bind (start end) (annotate-bounds) - (annotate-create-annotation start end))))) - (font-lock-fontify-block 1) - (set-buffer-modified-p t)) + (cond + ((and (overlayp overlay) + (overlay-get overlay 'annotation)) + (annotate-change-annotation (point)) + (font-lock-fontify-buffer nil)) + (t + (cl-destructuring-bind (start end) (annotate-bounds) + (annotate-create-annotation start end) + (font-lock-fontify-block 1)))) + (set-buffer-modified-p t))) (defun annotate-next-annotation () "Move point to the next annotation." @@ -663,38 +713,65 @@ to 'maximum-width'." "Searches the line before point for annotations, and returns a `facespec` with the annotation in its `display` property." (save-excursion - (goto-char (1- (point))) ; we start at the start of the next line - ;; find overlays in the preceding line - (let ((prefix (annotate-make-prefix)) ; white space before first annotation - (bol (progn (beginning-of-line) (point))) - (eol (progn (end-of-line) (point))) - (text "") - (overlays nil)) - ;; include previous line if point is at bol: - (when (eq nil (overlays-in bol eol)) - (setq bol (1- bol))) - (setq overlays (sort (overlays-in bol eol) - (lambda (x y) - (< (overlay-end x) (overlay-end y))))) - ;; put each annotation on its own line - (dolist (ov overlays) - (if (overlay-get ov 'annotation) + (let ((newline-position (point))) + (goto-char (1- (point))) ; we start at the start of the previous line + ;; find overlays in the preceding line + (let ((prefix (annotate-make-prefix)) ; white spaces before first annotation + (bol (progn (beginning-of-line) (point))) + (eol (progn (end-of-line) (point))) + (text "") + (overlays nil) + (annotation-counter 1)) + ;; include previous line if point is at bol: + (when (eq nil (overlays-in bol eol)) + (setq bol (1- bol))) + (setq overlays + (sort (cl-remove-if (lambda (a) (or (not (annotationp a)) + ;; if an annotated + ;; text contains a + ;; newline (is a + ;; multiline one) do + ;; not add + ;; annotation for it + ;; here (i.e. remove + ;; from that list), + ;; this annotation + ;; will be shown on + ;; the next newline + ;; instead + (<= (overlay-start a) + newline-position + (overlay-end a)))) + (overlays-in bol eol)) + (lambda (x y) + (< (overlay-end x) (overlay-end y))))) + ;; put each annotation on its own line + (dolist (ov overlays) + (cl-incf annotation-counter) + (let ((face (if (= (cl-rem annotation-counter 2) 0) + 'annotate-annotation + 'annotate-annotation-secondary)) + (face-highlight (if (= (cl-rem annotation-counter 2) 0) + 'annotate-highlight + 'annotate-highlight-secondary))) + (overlay-put ov 'face face-highlight) (dolist (l (save-match-data (split-string (annotate-lineate (overlay-get ov 'annotation) (- eol bol)) "\n"))) (setq text - (concat text prefix - (propertize l 'face 'annotate-annotation) + (concat text + prefix + (propertize l 'face face) "\n")) ;; white space before for all but the first annotation line (setq prefix (make-string annotate-annotation-column ? ))))) - ;; build facespec with the annotation text as display property - (if (string= text "") - ;; annotation has been removed: remove display prop - (list 'face 'default 'display nil) - ;; annotation has been changed/added: change/add display prop - (list 'face 'default 'display text))))) + ;; build facespec with the annotation text as display property + (if (string= text "") + ;; annotation has been removed: remove display prop + (list 'face 'default 'display nil) + ;; annotation has been changed/added: change/add display prop + (list 'face 'default 'display text)))))) (defun annotate--remove-annotation-property (begin end) "Cleans up annotation properties associated with a region." @@ -880,7 +957,8 @@ essentially what you get from: (let ((highlight (make-overlay start end))) (overlay-put highlight 'face 'annotate-highlight) (overlay-put highlight 'annotation annotation)) - (if (use-region-p) (deactivate-mark)))) + (when (use-region-p) + (deactivate-mark)))) (save-excursion (goto-char end) (font-lock-fontify-block 1))) @@ -914,19 +992,29 @@ essentially what you get from: (progn (end-of-line) (point)))) (prefix-length (- annotate-annotation-column (string-width line-text)))) (if (< prefix-length 1) - (concat "\n" (make-string annotate-annotation-column ? )) + (concat " \n" (make-string annotate-annotation-column ? )) (make-string prefix-length ? ))))) (defun annotate-bounds () "The bounds of the region or whatever is at point." (list (cond - ((use-region-p) (region-beginning)) - ((thing-at-point 'symbol) (car (bounds-of-thing-at-point 'symbol))) - (t (point))) + ((use-region-p) + (region-beginning)) + ((thing-at-point 'symbol) + (car (bounds-of-thing-at-point 'symbol))) + (t + (point))) (cond - ((use-region-p) (region-end)) - ((thing-at-point 'symbol) (cdr (bounds-of-thing-at-point 'symbol))) - (t (1+ (point)))))) + ((use-region-p) + (if (and (char-before (region-end)) + (char-equal (char-before (region-end)) + ?\n)) + (1- (region-end)) + (region-end))) + ((thing-at-point 'symbol) + (cdr (bounds-of-thing-at-point 'symbol))) + (t + (1+ (point)))))) (defun annotate-describe-annotations () "Return a list of all annotations in the current buffer."